mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-30 14:31:04 +00:00
854a6779a9
If the return value is just a numeric constant or static address, it can simply be loaded right before the RTL instruction, avoiding any data movement. This could actually be applied to a somewhat broader class of expressions, but for now it only applies to numeric or address constants, for which it is clearly correct.
7740 lines
250 KiB
ObjectPascal
7740 lines
250 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
|
|
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
|
|
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);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end {else}
|
|
end {of smallMemoryModel}
|
|
else begin
|
|
if opcode in [pc_gil,pc_gli] then begin
|
|
lab1 := GenLabel;
|
|
GenImplied(m_clc);
|
|
GenNative(m_lda_long, longabsolute, q, lab, 0);
|
|
GenNative(m_adc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenNative(m_lda_long, longabsolute, q+2, lab, 0);
|
|
GenImplied(m_ina);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else {if opcode in [pc_gdl,pc_gld] then} begin
|
|
lab1 := GenLabel;
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_long, longabsolute, q, lab, 0);
|
|
GenNative(m_sbc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_lda_long, longabsolute, q+2, lab, 0);
|
|
GenImplied(m_dea);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
GenLab(lab1);
|
|
end; {else if}
|
|
end; {else}
|
|
end; {DoGIncDec}
|
|
|
|
|
|
begin {GenGilGliGdlGld}
|
|
opcode := op^.opcode;
|
|
q := op^.q;
|
|
lab := op^.lab;
|
|
case op^.optype of
|
|
cgWord, cgUWord: begin
|
|
if opcode = pc_gil then
|
|
GenNative(m_inc_abs, absolute, q, lab, 0)
|
|
else if opcode = pc_gdl then
|
|
GenNative(m_dec_abs, absolute, q, lab, 0);
|
|
if not skipLoad then
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
if opcode = pc_gli then
|
|
GenNative(m_inc_abs, absolute, q, lab, 0)
|
|
else if opcode = pc_gld then
|
|
GenNative(m_dec_abs, absolute, q, lab, 0);
|
|
end;
|
|
|
|
cgByte, cgUByte: begin
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if opcode = pc_gil then
|
|
GenNative(m_inc_abs, absolute, q, lab, 0)
|
|
else if opcode = pc_gdl then
|
|
GenNative(m_dec_abs, absolute, q, lab, 0);
|
|
if not skipLoad then
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
if opcode = pc_gli then
|
|
GenNative(m_inc_abs, absolute, q, lab, 0)
|
|
else if opcode = pc_gld then
|
|
GenNative(m_dec_abs, absolute, q, lab, 0);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
if not skipLoad then begin
|
|
GenNative(m_and_imm, immediate, 255, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end; {if}
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if (A_X & gLong.preference) <> 0 then
|
|
gLong.where := A_X
|
|
else
|
|
gLong.where := onStack;
|
|
if opcode in [pc_gil,pc_gdl] then
|
|
DoGIncDec(opcode, lab, op^.r, q);
|
|
if not skipLoad then
|
|
if smallMemoryModel then begin
|
|
GenNative(m_ldx_abs, absolute, q+2, lab, 0);
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
if (opcode in [pc_gli,pc_gld]) and (op^.r <> 1) then
|
|
gLong.where := onStack;
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
if opcode in [pc_gli,pc_gld] then
|
|
gLong.where := onStack;
|
|
GenNative(m_lda_long, longabsolute, q+2, lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha)
|
|
else
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_long, longabsolute, q, lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
if opcode in [pc_gli,pc_gld] then
|
|
DoGIncDec(opcode, lab, op^.r, q);
|
|
end; {case cgLong,cgULong}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenGilGliGdlGld}
|
|
|
|
|
|
procedure GenIilIliIdlIld (op: icptr);
|
|
|
|
{ Generate code for a pc_iil, pc_ili, pc_idl or pc_ild }
|
|
|
|
var
|
|
i: integer; {index variable}
|
|
lab1: integer; {label}
|
|
lSkipLoad: boolean; {copy of skipLoad}
|
|
opcode: pcodes; {op^.opcode}
|
|
short: boolean; {doing a one byte operand?}
|
|
|
|
begin {GenIilIliIdlIld}
|
|
opcode := op^.opcode;
|
|
case op^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
short := op^.optype in [cgByte,cgUByte];
|
|
lSkipLoad := skipLoad;
|
|
skipLoad := false;
|
|
GetPointer(op^.left);
|
|
skipLoad := lSkipLoad;
|
|
if gLong.where = inPointer then begin
|
|
if short then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if gLong.fixedDisp then
|
|
GenNative(m_lda_indl, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenImplied(m_ina)
|
|
else
|
|
GenImplied(m_dea);
|
|
if gLong.fixedDisp then
|
|
GenNative(m_sta_indl, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_sta_indly, direct, gLong.disp, nil, 0);
|
|
if not skipLoad then
|
|
if opcode = pc_ili then
|
|
GenImplied(m_dea)
|
|
else if opcode = pc_ild then
|
|
GenImplied(m_ina);
|
|
if short then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end {if}
|
|
else if gLong.where = localAddress then begin
|
|
gLong.disp := gLong.disp+op^.q;
|
|
if gLong.fixedDisp then begin
|
|
if short then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if (gLong.disp < 256) and (gLong.disp >= 0) then begin
|
|
if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenNative(m_inc_dir, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_dec_dir, direct, gLong.disp, nil, 0);
|
|
if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenNative(m_inc_dirX, direct, 0, nil, 0)
|
|
else
|
|
GenNative(m_dec_dirX, direct, 0, nil, 0);
|
|
if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
end; {else}
|
|
if short then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end
|
|
else begin
|
|
if (gLong.disp > 255) or (gLong.disp < 0) then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
if short then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then
|
|
GenNative(m_lda_dirX, direct, gLong.disp, nil, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenNative(m_inc_dirX, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_dec_dirX, direct, gLong.disp, nil, 0);
|
|
if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then
|
|
GenNative(m_lda_dirX, direct, gLong.disp, nil, 0);
|
|
if short then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {else}
|
|
end {else if}
|
|
else {if gLong.where = globalLabel then} begin
|
|
gLong.disp := gLong.disp+op^.q;
|
|
if short then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then begin
|
|
if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then
|
|
GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenNative(m_inc_abs, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_dec_abs, absolute, gLong.disp, gLong.lab, 0);
|
|
if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then
|
|
GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenImplied(m_ina)
|
|
else
|
|
GenImplied(m_dea);
|
|
GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0);
|
|
if not skipLoad then
|
|
if opcode = pc_ili then
|
|
GenImplied(m_dea)
|
|
else if opcode = pc_ild then
|
|
GenImplied(m_ina);
|
|
end {else}
|
|
else
|
|
if smallMemoryModel then begin
|
|
if (not skipLoad) and (opcode in [pc_ili,pc_ild]) then
|
|
GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenNative(m_inc_absX, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_dec_absX, absolute, gLong.disp, gLong.lab, 0);
|
|
if (not skipLoad) and (opcode in [pc_iil,pc_idl]) then
|
|
GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
if opcode in [pc_ili,pc_iil] then
|
|
GenImplied(m_ina)
|
|
else
|
|
GenImplied(m_dea);
|
|
GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
if not skipLoad then
|
|
if opcode = pc_ili then
|
|
GenImplied(m_dea)
|
|
else if opcode = pc_ild then
|
|
GenImplied(m_ina);
|
|
end; {else}
|
|
if short then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {else}
|
|
if not skipLoad then
|
|
if short then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {if}
|
|
end; {case cgByte,cgUByte,cgWord,cgUWord}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenIilIliIdlIld}
|
|
|
|
|
|
procedure GenIncDec (op, save: icptr);
|
|
|
|
{ generate code for pc_inc, pc_dec }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - pc_inc or pc_dec operation }
|
|
{ save - save location (pc_str or pc_sro) or nil }
|
|
|
|
var
|
|
disp: integer; {disp in stack frame}
|
|
lab1: integer; {branch point}
|
|
opcode: pcodes; {temp storage for op code}
|
|
size: integer; {number to increment by}
|
|
clc,ina,adc: integer; {instructions to generate}
|
|
|
|
begin {GenIncDec}
|
|
{set up local variables}
|
|
opcode := op^.opcode;
|
|
size := op^.q;
|
|
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
GenTree(op^.left);
|
|
if opcode = pc_inc then begin
|
|
clc := m_clc;
|
|
ina := m_ina;
|
|
adc := m_adc_imm;
|
|
end {if}
|
|
else begin
|
|
clc := m_sec;
|
|
ina := m_dea;
|
|
adc := m_sbc_imm;
|
|
end; {else}
|
|
if size = 1 then
|
|
GenImplied(ina)
|
|
else if size = 2 then begin
|
|
GenImplied(ina);
|
|
GenImplied(ina);
|
|
end {else if}
|
|
else if size <> 0 then begin
|
|
GenImplied(clc);
|
|
GenNative(adc, immediate, size, nil, 0);
|
|
end; {else if}
|
|
end {if}
|
|
else if op^.optype in [cgLong,cgULong] then begin
|
|
if SameLoc(op^.left, save) then begin
|
|
lab1 := GenLabel;
|
|
if size = 1 then begin
|
|
if opcode = pc_inc 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_dec then} begin
|
|
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2);
|
|
GenLab(lab1);
|
|
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0);
|
|
end; {else}
|
|
end {if}
|
|
else if opcode = pc_inc then begin
|
|
GenImplied(m_clc);
|
|
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
|
|
GenNative(m_adc_imm, immediate, size, nil, 0);
|
|
DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2);
|
|
GenLab(lab1);
|
|
end {else if}
|
|
else begin
|
|
GenImplied(m_sec);
|
|
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
|
|
GenNative(m_sbc_imm, immediate, size, nil, 0);
|
|
DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
if save <> nil then
|
|
gLong.preference := A_X
|
|
else
|
|
gLong.preference := gLong.preference & (A_X | inpointer);
|
|
if opcode = pc_dec then
|
|
gLong.preference := gLong.preference & A_X;
|
|
GenTree(op^.left);
|
|
if opcode = pc_inc then
|
|
IncAddr(size)
|
|
else begin
|
|
lab1 := GenLabel;
|
|
if gLong.where = A_X then begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_imm, immediate, size, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenImplied(m_dex);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sbc_imm, immediate, size, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenImplied(m_dea);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end; {else}
|
|
GenLab(lab1);
|
|
end; {else}
|
|
if save <> nil then
|
|
if save^.opcode = pc_str then begin
|
|
disp := LabelToDisp(save^.r) + save^.q;
|
|
if disp < 254 then begin
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_plx);
|
|
GenNative(m_stx_dir, direct, disp+2, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
if gLong.where = A_X then
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pla)
|
|
else
|
|
GenImplied(m_tya);
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
end {else if}
|
|
else {if save^.opcode = pc_sro then} begin
|
|
if gLong.where = onStack then
|
|
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);
|
|
if smallMemoryModel then begin
|
|
if gLong.where = onStack then
|
|
GenImplied(m_plx);
|
|
GenNative(m_stx_abs, absolute, save^.q+2, save^.lab, 0)
|
|
end {if}
|
|
else begin
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pla)
|
|
else
|
|
GenImplied(m_txa);
|
|
GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end; {else}
|
|
end {else if}
|
|
else
|
|
Error(cge1);
|
|
end; {GenIncDec}
|
|
|
|
|
|
procedure GenInd (op: icptr);
|
|
|
|
{ Generate code for a pc_ind }
|
|
|
|
var
|
|
lab1: integer; {label}
|
|
lLong: longType; {requested address type}
|
|
lQuad: quadType; {requested quad address type}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
q: integer; {op^.q}
|
|
volatileByte: boolean; {is this a volatile byte access?}
|
|
|
|
begin {GenInd}
|
|
optype := op^.optype;
|
|
q := op^.q;
|
|
case optype of
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
if q <> 0 then
|
|
IncAddr(q);
|
|
if optype = cgReal then
|
|
GenCall(21)
|
|
else if optype = cgDouble then
|
|
GenCall(22)
|
|
else if optype = cgComp then
|
|
GenCall(70)
|
|
else if optype = cgExtended then
|
|
GenCall(71);
|
|
end; {case cgReal,cgDouble,cgComp,cgExtended}
|
|
|
|
cgLong,cgULong: begin
|
|
lLong := gLong;
|
|
GetPointer(op^.left);
|
|
if gLong.where = inPointer then begin
|
|
if q = 0 then begin
|
|
if gLong.fixedDisp then begin
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if (A_X & lLong.preference) <> 0 then
|
|
GenImplied(m_tax)
|
|
else
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_indl, direct, gLong.disp, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_iny);
|
|
GenImplied(m_iny);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if (A_X & lLong.preference) <> 0 then
|
|
GenImplied(m_tax)
|
|
else
|
|
GenImplied(m_pha);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
end; {else}
|
|
if (A_X & lLong.preference) = 0 then
|
|
GenImplied(m_pha);
|
|
end {if q = 0}
|
|
else begin
|
|
if gLong.fixedDisp then begin
|
|
GenNative(m_ldy_imm, immediate, q+2, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if (A_X & lLong.preference) <> 0 then
|
|
GenImplied(m_tax)
|
|
else
|
|
GenImplied(m_pha);
|
|
GenNative(m_ldy_imm, immediate, q, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, q+2, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if (A_X & lLong.preference) <> 0 then
|
|
GenImplied(m_tax)
|
|
else
|
|
GenImplied(m_pha);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
end; {else}
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if (A_X & lLong.preference) = 0 then
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end {if glong.where = inPointer}
|
|
else if gLong.where = localAddress then begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if (gLong.disp < 254) and (gLong.disp >= 0) then begin
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
GenNative(m_ldy_dirX, direct, 2, nil, 0);
|
|
GenImplied(m_tyx);
|
|
end {else}
|
|
else begin
|
|
if (gLong.disp >= 254) or (gLong.disp < 0) then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
GenNative(m_ldy_dirX, direct, gLong.disp+2, nil, 0);
|
|
GenNative(m_lda_dirX, direct, gLong.disp, nil, 0);
|
|
GenImplied(m_tyx);
|
|
end; {else}
|
|
if (A_X & lLong.preference) = 0 then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
end {else if gLong.where = localAddress}
|
|
else {if gLong.where = globalLabel then} begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then begin
|
|
GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_ldx_abs, absolute, gLong.disp+2, gLong.lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longAbs, gLong.disp+2, gLong.lab, 0);
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0);
|
|
end {else}
|
|
else
|
|
if smallMemoryModel then begin
|
|
GenNative(m_ldy_absX, absolute, gLong.disp+2, gLong.lab, 0);
|
|
GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0);
|
|
GenImplied(m_tyx);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_longX, longAbs, gLong.disp+2, gLong.lab, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
GenImplied(m_tyx);
|
|
end; {else}
|
|
if (A_X & lLong.preference) = 0 then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
end; {else}
|
|
if (A_X & lLong.preference) <> 0 then
|
|
gLong.where := A_X
|
|
else
|
|
gLong.where := onStack;
|
|
end; {cgLong,cgULong}
|
|
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
GetPointer(op^.left);
|
|
if gLong.where = inPointer then begin
|
|
volatileByte := (op^.r <> 0) and (optype in [cgByte,cgUByte]);
|
|
if q = 0 then begin
|
|
if volatileByte then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if gLong.fixedDisp then
|
|
GenNative(m_lda_indl, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if volatileByte then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end {if}
|
|
else
|
|
if gLong.fixedDisp then begin
|
|
if volatileByte then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, q, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if volatileByte then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, q, nil, 0);
|
|
GenImplied(m_tay);
|
|
if volatileByte then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
if volatileByte then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {else}
|
|
end {if}
|
|
else if gLong.where = localAddress then begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if (gLong.disp & $FF00) = 0 then
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
end {else}
|
|
else
|
|
if (gLong.disp & $FF00) = 0 then
|
|
GenNative(m_lda_dirX, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
end {else}
|
|
end {else if}
|
|
else {if gLong.where = globalLabel then} begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0)
|
|
else
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0)
|
|
end; {else}
|
|
if optype in [cgByte,cgUByte] then begin
|
|
GenNative(m_and_imm, immediate, 255, nil, 0);
|
|
if optype = cgByte then begin
|
|
GenNative(m_cmp_imm, immediate, 128, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {if}
|
|
end; {case cgByte,cgUByte,cgWord,cgUWord}
|
|
|
|
cgQuad,cgUQuad: begin
|
|
lQuad := gQuad;
|
|
GetPointer(op^.left);
|
|
gQuad := lQuad;
|
|
gQuad.where := gQuad.preference; {unless overridden later}
|
|
if gLong.where = inPointer then begin
|
|
if q = 0 then begin
|
|
if gLong.fixedDisp then begin
|
|
GenNative(m_ldy_imm, immediate, 6, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_indl, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 6, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
end {if q = 0}
|
|
else begin
|
|
if gLong.fixedDisp then begin
|
|
GenNative(m_ldy_imm, immediate, q+6, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, q+6, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
end; {else}
|
|
end {if glong.where = inPointer}
|
|
else if gLong.where = localAddress then begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if (gLong.disp < 250) and (gLong.disp >= 0) then begin
|
|
if gQuad.preference = onStack then begin
|
|
GenNative(m_pei_dir, direct, gLong.disp+6, nil, 0);
|
|
GenNative(m_pei_dir, direct, gLong.disp+4, nil, 0);
|
|
GenNative(m_pei_dir, direct, gLong.disp+2, nil, 0);
|
|
GenNative(m_pei_dir, direct, gLong.disp, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_dir, direct, gLong.disp+6, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_dir, direct, gLong.disp+4, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
gQuad.where := onStack;
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_lda_dirX, direct, 6, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, 4, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, 2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {else}
|
|
else begin
|
|
gQuad.where := onStack;
|
|
if (gLong.disp >= 250) or (gLong.disp < 0) then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
GenNative(m_lda_dirX, direct, gLong.disp+6, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, gLong.disp+4, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, gLong.disp+2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirX, direct, gLong.disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end {else if gLong.where = localAddress}
|
|
else {if gLong.where = globalLabel then} begin
|
|
gLong.disp := gLong.disp+q;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then begin
|
|
GenNative(m_lda_abs, absolute, gLong.disp+6, gLong.lab, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_abs, absolute, gLong.disp+4, gLong.lab, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_abs, absolute, gLong.disp+2, gLong.lab, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_abs, absolute, gLong.disp, gLong.lab, 0);
|
|
StoreWordOfQuad(0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longAbs, gLong.disp+6, gLong.lab, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_long, longAbs, gLong.disp+4, gLong.lab, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_long, longAbs, gLong.disp+2, gLong.lab, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_long, longAbs, gLong.disp, gLong.lab, 0);
|
|
StoreWordOfQuad(6);
|
|
end {else}
|
|
else
|
|
if smallMemoryModel then begin
|
|
gQuad.where := onStack;
|
|
GenNative(m_lda_absX, absolute, gLong.disp+6, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_absX, absolute, gLong.disp+4, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_absX, absolute, gLong.disp+2, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_absX, absolute, gLong.disp, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
gQuad.where := onStack;
|
|
GenNative(m_lda_longX, longAbs, gLong.disp+6, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_longX, longAbs, gLong.disp+4, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_longX, longAbs, gLong.disp+2, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {else}
|
|
end; {case cgQuad,cgUQuad}
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
end; {GenInd}
|
|
|
|
|
|
|
|
procedure GenIxa (op: icptr);
|
|
|
|
{ Generate code for a pc_ixa }
|
|
|
|
var
|
|
lab1: integer; {branch label}
|
|
lLong: longType; {type of address}
|
|
zero: boolean; {is the index 0?}
|
|
|
|
|
|
procedure Index;
|
|
|
|
{ Get the index size }
|
|
|
|
var
|
|
lLong: longType; {temp for preserving left node info}
|
|
|
|
begin {Index}
|
|
zero := false;
|
|
with op^.right^ do begin
|
|
if opcode = pc_ldc then begin
|
|
if q = 0 then
|
|
zero := true
|
|
else
|
|
GenNative(m_lda_imm, immediate, q, nil, 0);
|
|
end {if}
|
|
else begin
|
|
lLong := gLong;
|
|
GenTree(op^.right);
|
|
gLong := lLong;
|
|
end; {else}
|
|
end; {with}
|
|
end; {Index}
|
|
|
|
|
|
function IndexCanBeNegative: boolean;
|
|
|
|
{ Check if the index value (right argument) of a pc_ixa }
|
|
{ can validly be negative. Returns false if this is }
|
|
{ precluded by the type of the operation or other available }
|
|
{ information, or if any use of a negative index would be }
|
|
{ undefined behavior. Otherwise, returns true. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - pc_ixa operation }
|
|
|
|
begin {IndexCanBeNegative}
|
|
IndexCanBeNegative := true;
|
|
if op^.optype in [cgUByte,cgUWord] then
|
|
IndexCanBeNegative := false
|
|
else if (op^.right^.opcode = pc_ldc) and (op^.right^.q >= 0) then
|
|
IndexCanBeNegative := false
|
|
else if (op^.left^.opcode in [pc_lao,pc_lda]) and (op^.left^.q = 0) then
|
|
{Can't index before start of array, so using a negative index would be UB}
|
|
IndexCanBeNegative := false;
|
|
end; {IndexCanBeNegative}
|
|
|
|
|
|
begin {GenIxa}
|
|
if smallMemoryModel then begin
|
|
lLong := gLong;
|
|
gLong.preference := inPointer+localAddress+globalLabel;
|
|
GenTree(op^.left);
|
|
case gLong.where of
|
|
|
|
onStack: begin
|
|
Index;
|
|
if not zero then begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenImplied(m_ina);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {case onStack}
|
|
|
|
inPointer: begin
|
|
if not gLong.fixedDisp then begin
|
|
if Complex(op^.right) then begin
|
|
GenImplied(m_phy);
|
|
Index;
|
|
if not zero then begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
end; {if}
|
|
GenImplied(m_ply);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
OperA(m_adc_imm, op^.right);
|
|
GenImplied(m_tay);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
Index;
|
|
if not zero then begin
|
|
GenImplied(m_tay);
|
|
gLong.fixedDisp := false;
|
|
end; {if}
|
|
end; {else}
|
|
if (inPointer & lLong.preference) = 0 then begin
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_dir, direct, gLong.disp, nil, 0);
|
|
GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0);
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
end; {else}
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
gLong.where := onStack;
|
|
end; {if}
|
|
end; {case inPointer}
|
|
|
|
localAddress,globalLabel: begin
|
|
if not gLong.fixedDisp then begin
|
|
if Complex(op^.right) then begin
|
|
GenImplied(m_phx);
|
|
Index;
|
|
if not zero then begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
end; {if}
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
OperA(m_adc_imm, op^.right);
|
|
GenImplied(m_tax);
|
|
end; {else}
|
|
end {if}
|
|
else if Complex(op^.right) then begin
|
|
Index;
|
|
if not zero then begin
|
|
GenImplied(m_tax);
|
|
gLong.fixedDisp := false;
|
|
end; {if}
|
|
end {else if}
|
|
else begin
|
|
LoadX(op^.right);
|
|
gLong.fixedDisp := false;
|
|
end; {else}
|
|
if gLong.where = globalLabel then
|
|
if IndexCanBeNegative then begin
|
|
if (gLong.disp >= 0) and (gLong.disp <= 2) then begin
|
|
while gLong.disp > 0 do begin
|
|
GenImplied(m_inx);
|
|
gLong.disp := gLong.disp - 1;
|
|
end; {while}
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
gLong.disp := 0;
|
|
end; {else}
|
|
end; {if}
|
|
if (lLong.preference & gLong.where) = 0 then begin
|
|
if (lLong.preference & inPointer) <> 0 then begin
|
|
if gLong.where = localAddress then begin
|
|
if not gLong.fixedDisp then begin
|
|
GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0);
|
|
GenImplied(m_phx);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
if gLong.disp <> 0 then
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_stz_dir, direct, dworkLoc+2, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0);
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
gLong.where := inPointer;
|
|
gLong.fixedDisp := true;
|
|
gLong.disp := dworkLoc;
|
|
end {if}
|
|
else begin
|
|
if gLong.where = localAddress then begin
|
|
if not gLong.fixedDisp then begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_phx);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
if gLong.disp <> 0 then
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, gLong.disp, gLong.lab, shift16);
|
|
GenNative(m_pea, immediate, gLong.disp, gLong.lab, 0);
|
|
end; {else}
|
|
end; {else}
|
|
gLong.where := onStack;
|
|
end; {else}
|
|
end; {if}
|
|
end; {case localAddress,globalLabel}
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end {if smallMemoryModel}
|
|
else begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
if IndexCanBeNegative then begin
|
|
lab1 := GenLabel;
|
|
GenNative(m_ldx_imm, immediate, $0000, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
GenImplied(m_dex);
|
|
GenLab(lab1);
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end {else if}
|
|
else begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
GenImplied(m_clc);
|
|
GenImplied(m_pla);
|
|
GenNative(m_adc_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_adc_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
gLong.where := onStack;
|
|
end; {else}
|
|
end; {GenIxa}
|
|
|
|
|
|
procedure GenLilLliLdlLld (op: icptr);
|
|
|
|
{ Generate code for a pc_lil, pc_lli, pc_ldl or pc_lld }
|
|
|
|
var
|
|
disp: integer; {load location}
|
|
lab1: integer; {branch point}
|
|
opcode: pcodes; {op^.opcode}
|
|
|
|
|
|
procedure DoXIncDec (op: pcodes; p: integer);
|
|
|
|
{ Do a decrement or increment on a local four byte value X }
|
|
{ bytes into the stack frame }
|
|
{ }
|
|
{ parameters }
|
|
{ op - operation code }
|
|
{ p - number to ind/dec by }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {DoXIncDec}
|
|
if op in [pc_lil,pc_lli] then begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_inc_dirx, direct, 0, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenNative(m_adc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
end; {else}
|
|
GenNative(m_inc_dirx, direct, 2, nil, 0);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else {if op in [pc_gdl,pc_gld] then} begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenNative(m_dec_dirx, direct, 2, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_dec_dirx, direct, 0, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenNative(m_sbc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_dec_dirx, direct, 2, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end; {else}
|
|
end; {DoXIncDec}
|
|
|
|
|
|
procedure DoLIncDec (op: pcodes; disp, p: integer);
|
|
|
|
{ Do a decrement or increment on a local four byte value }
|
|
{ }
|
|
{ parameters }
|
|
{ op - operation code }
|
|
{ disp - disp in stack frame to value }
|
|
{ p - number to ind/dec by }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {DoLIncDec}
|
|
if op in [pc_lil,pc_lli] then begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_inc_dir, direct, disp, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
GenNative(m_adc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
end; {else}
|
|
GenNative(m_inc_dir, direct, disp+2, nil, 0);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else {if op in [pc_ldl,pc_lld] then} begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenNative(m_dec_dir, direct, disp+2, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_dec_dir, direct, disp, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
GenNative(m_sbc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_dec_dir, direct, disp+2, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end; {else}
|
|
end; {DoLIncDec}
|
|
|
|
|
|
begin {GenLilLliLdlLld}
|
|
disp := LabelToDisp(op^.r);
|
|
opcode := op^.opcode;
|
|
case op^.optype of
|
|
cgLong, cgULong: begin
|
|
gLong.where := onStack;
|
|
if disp >= 254 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if opcode in [pc_lil,pc_ldl] then
|
|
DoXIncDec(opcode, op^.q);
|
|
if not skipLoad then begin
|
|
GenNative(m_lda_dirx, direct, 2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else
|
|
gLong.where := A_X;
|
|
if opcode in [pc_lli,pc_lld] then
|
|
DoXIncDec(opcode, op^.q);
|
|
end {if}
|
|
else begin
|
|
if opcode in [pc_lil,pc_ldl] then
|
|
DoLIncDec(opcode, disp, op^.q);
|
|
if not skipLoad then begin
|
|
GenNative(m_pei_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp, nil, 0);
|
|
end {if}
|
|
else
|
|
gLong.where := A_X;
|
|
if opcode in [pc_lli,pc_lld] then
|
|
DoLIncDec(opcode, disp, op^.q);
|
|
end; {else}
|
|
end;
|
|
|
|
cgByte, cgUByte, cgWord, cgUWord: begin
|
|
if op^.optype in [cgByte,cgUByte] then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if disp >= 256 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if opcode = pc_lil then
|
|
GenNative(m_inc_dirx, direct, 0, nil, 0)
|
|
else if opcode = pc_ldl then
|
|
GenNative(m_dec_dirx, direct, 0, nil, 0);
|
|
if not skipLoad then
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
if opcode = pc_lli then
|
|
GenNative(m_inc_dirx, direct, 0, nil, 0)
|
|
else if opcode = pc_lld then
|
|
GenNative(m_dec_dirx, direct, 0, nil, 0);
|
|
end
|
|
else begin
|
|
if opcode = pc_lil then
|
|
GenNative(m_inc_dir, direct, disp, nil, 0)
|
|
else if opcode = pc_ldl then
|
|
GenNative(m_dec_dir, direct, disp, nil, 0);
|
|
if not skipLoad then
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
if opcode = pc_lli then
|
|
GenNative(m_inc_dir, direct, disp, nil, 0)
|
|
else if opcode = pc_lld then
|
|
GenNative(m_dec_dir, direct, disp, nil, 0);
|
|
end; {else}
|
|
if op^.optype in [cgByte,cgUByte] then begin
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
if not skipLoad then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
end;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
|
|
end; {case}
|
|
end; {GenLilLliLdlLld}
|
|
|
|
|
|
procedure GenLogic (op: icptr);
|
|
|
|
{ generate a pc_and, pc_ior, pc_bnd, pc_bor or pc_bxr }
|
|
|
|
var
|
|
lab1,lab2,lab3: integer; {label}
|
|
nd: icptr; {temp node pointer}
|
|
opcode: pcodes; {operation code}
|
|
|
|
begin {GenLogic}
|
|
opcode := op^.opcode;
|
|
if opcode in [pc_and,pc_ior] then begin
|
|
lab1 := GenLabel;
|
|
GenTree(op^.left);
|
|
GenImpliedForFlags(m_tax);
|
|
lab2 := GenLabel;
|
|
if opcode = pc_and then begin
|
|
GenNative(m_bne, relative, lab2, nil, 0);
|
|
GenNative(m_brl, longrelative, lab1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
lab3 := GenLabel;
|
|
GenNative(m_beq, relative, lab2, nil, 0);
|
|
GenNative(m_brl, longrelative, lab3, nil, 0);
|
|
end; {else}
|
|
GenLab(lab2);
|
|
GenTree(op^.right);
|
|
GenImpliedForFlags(m_tax);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
if opcode = pc_ior then
|
|
GenLab(lab3);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else 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) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
case opcode of
|
|
pc_bnd: GenNative(m_and_s, direct, 1, nil, 0);
|
|
pc_bor: GenNative(m_ora_s, direct, 1, nil, 0);
|
|
pc_bxr: GenNative(m_eor_s, direct, 1, nil, 0);
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
GenImplied(m_plx);
|
|
GenImplied(m_tax);
|
|
end {if}
|
|
else
|
|
case opcode of
|
|
pc_bnd: OperA(m_and_imm, op^.right);
|
|
pc_bor: OperA(m_ora_imm, op^.right);
|
|
pc_bxr: OperA(m_eor_imm, op^.right);
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {else}
|
|
end; {GenLogic}
|
|
|
|
|
|
procedure GenSroCpo (op: icptr);
|
|
|
|
{ Generate code for a pc_sro or pc_cpo }
|
|
|
|
var
|
|
lab: stringPtr; {op^.lab}
|
|
lab1: integer; {branch point}
|
|
lval: longint; {op^.left^.lval}
|
|
opcode: pcodes; {op^.opcode}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
q: integer; {op^.q}
|
|
special: boolean; {special save?}
|
|
|
|
begin {GenSroCpo}
|
|
opcode := op^.opcode;
|
|
optype := op^.optype;
|
|
q := op^.q;
|
|
lab := op^.lab;
|
|
case optype of
|
|
cgByte, cgUByte: begin
|
|
if smallMemoryModel and (op^.left^.opcode = pc_ldc)
|
|
and (op^.left^.q = 0) and (opcode = pc_sro) then begin
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_stz_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
if op^.opcode = pc_sro then
|
|
if op^.left^.opcode = pc_cnv then
|
|
if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then
|
|
op^.left := op^.left^.left;
|
|
if op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod] then begin
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
end; {else}
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end; {else}
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end;
|
|
|
|
cgWord, cgUWord:
|
|
if smallMemoryModel and (op^.left^.opcode = pc_ldc)
|
|
and (op^.left^.q = 0) and (opcode = pc_sro) then
|
|
GenNative(m_stz_abs, absolute, q, lab, 0)
|
|
else begin
|
|
GenTree(op^.left);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end; {else}
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
if opcode = pc_sro then begin
|
|
if optype = cgReal then
|
|
GenCall(9)
|
|
else if optype = cgDouble then
|
|
GenCall(10)
|
|
else if optype = cgComp then
|
|
GenCall(66)
|
|
else {if optype = cgExtended then}
|
|
GenCall(67);
|
|
end {if}
|
|
else {if opcode = pc_cpo then} begin
|
|
if optype = cgReal then begin
|
|
GenCall(9);
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
GenCall(21);
|
|
end {if}
|
|
else if optype = cgDouble then begin
|
|
GenCall(10);
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
GenCall(22);
|
|
end {else if}
|
|
else if optype = cgComp then begin
|
|
GenCall(66);
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
GenCall(70);
|
|
end {else if}
|
|
else {if optype = cgExtended then}
|
|
GenCall(69);
|
|
end; {else}
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if (opcode = pc_sro) and (op^.left^.opcode in [pc_adl,pc_sbl]) then
|
|
GenAdlSbl(op^.left, op)
|
|
else if (opcode = pc_sro) and (op^.left^.opcode in [pc_inc,pc_dec]) then
|
|
GenIncDec(op^.left, op)
|
|
else if smallMemoryModel and (op^.left^.opcode = pc_ldc) then begin
|
|
lval := op^.left^.lval;
|
|
if long(lval).lsw = 0 then
|
|
GenNative(m_stz_abs, absolute, q, lab, 0)
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, long(lval).lsw, nil, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
end; {else}
|
|
if long(lval).msw = 0 then
|
|
GenNative(m_stz_abs, absolute, q+2, lab, 0)
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, long(lval).msw, nil, 0);
|
|
GenNative(m_stx_abs, absolute, q+2, lab, 0)
|
|
end; {else}
|
|
if op^.opcode = pc_cpo then
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else begin
|
|
if op^.opcode = pc_sro then
|
|
gLong.preference := A_X | inPointer | localAddress | globalLabel | constant
|
|
else
|
|
gLong.preference := gLong.preference &
|
|
(A_X | inPointer | localAddress | globalLabel | constant);
|
|
GenTree(op^.left);
|
|
case gLong.where of
|
|
|
|
A_X: begin
|
|
if smallMemoryModel then begin
|
|
GenNative(m_stx_abs, absolute, q+2, lab, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
if opcode = pc_cpo then
|
|
GenImplied(m_pha);
|
|
GenImplied(m_txa);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
if opcode = pc_cpo then
|
|
GenImplied(m_pla);
|
|
end; {else}
|
|
end;
|
|
|
|
onStack: begin
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q+2, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
end;
|
|
|
|
inPointer: begin
|
|
GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0);
|
|
if gLong.fixedDisp then
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_dir, direct, gLong.disp, nil, 0);
|
|
if not smallMemoryModel then begin
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {else}
|
|
if smallMemoryModel then begin
|
|
GenNative(m_stx_abs, absolute, q+2, lab, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
if opcode = pc_cpo then
|
|
GenImplied(m_pha);
|
|
GenImplied(m_txa);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
if opcode = pc_cpo then
|
|
GenImplied(m_pla);
|
|
end; {else}
|
|
gLong.where := A_X;
|
|
end;
|
|
|
|
localAddress: begin
|
|
if smallMemoryModel then
|
|
GenNative(m_stz_abs, absolute, q+2, lab, 0)
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
end; {else}
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_phx);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end;
|
|
|
|
globalLabel:
|
|
if gLong.fixedDisp then begin
|
|
if smallMemoryModel then begin
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
GenNative(m_stx_abs, absolute, q+2, lab, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
if opcode = pc_cpo then
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end; {else}
|
|
gLong.where := A_X;
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
GenNative(m_adc_imm, immediate, 0, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q+2, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
end; {else}
|
|
|
|
constant: begin
|
|
if gLong.lval = 0 then begin
|
|
if smallMemoryModel then begin
|
|
GenNative(m_stz_abs, absolute, q+2, lab, 0);
|
|
GenNative(m_stz_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end; {else}
|
|
end {if}
|
|
else if not smallMemoryModel then begin
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
end {else if}
|
|
else begin
|
|
if long(gLong.lval).msw = 0 then
|
|
GenNative(m_stz_abs, absolute, q+2, lab, 0)
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_stx_abs, absolute, q+2, lab, 0);
|
|
end; {else}
|
|
if long(gLong.lval).lsw = 0 then
|
|
GenNative(m_stz_abs, absolute, q, lab, 0)
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
end; {else}
|
|
if (long(gLong.lval).lsw <> 0) and (long(gLong.lval).msw <> 0) then
|
|
gLong.where := A_X;
|
|
end; {else}
|
|
end; {case constant}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {else}
|
|
end; {case CGLong, cgULong}
|
|
|
|
cgQuad, cgUQuad: begin
|
|
if opcode = pc_sro then begin
|
|
gQuad.preference := globalLabel;
|
|
gQuad.lab := lab;
|
|
gQuad.disp := q;
|
|
end {if}
|
|
else {if opcode = pc_cpo then}
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
if gQuad.where = onStack then begin
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q, lab, 0);
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q+2, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q+2, lab, 0);
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q+4, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q+4, lab, 0);
|
|
if opcode = pc_sro then
|
|
GenImplied(m_pla)
|
|
else {if opcode = pc_cpo then}
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, q+6, lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longabsolute, q+6, lab, 0);
|
|
end; {if}
|
|
end; {case cgQuad, cgUQuad}
|
|
end; {case}
|
|
end; {GenSroCpo}
|
|
|
|
|
|
procedure GenStoCpi (op: icptr);
|
|
|
|
{ Generate code for a pc_sto or pc_cpi }
|
|
|
|
var
|
|
disp: integer; {disp in stack frame}
|
|
opcode: pcodes; {temp storage for op code}
|
|
optype: baseTypeEnum; {operand type}
|
|
short: boolean; {use short registers?}
|
|
simple: boolean; {is the load a simple load?}
|
|
lLong: longType; {address record for left node}
|
|
zero: boolean; {is the operand a constant zero?}
|
|
lab1: integer; {label}
|
|
|
|
|
|
procedure LoadLSW;
|
|
|
|
{ load the least significant word of a four byte value }
|
|
|
|
begin {LoadLSW}
|
|
if lLong.where = onStack then
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else
|
|
GenNative(m_lda_s, direct, 1, nil, 0)
|
|
else {if lLong.where = constant then}
|
|
GenNative(m_lda_imm, immediate, long(lLong.lval).lsw, nil, 0);
|
|
end; {LoadLSW}
|
|
|
|
|
|
procedure LoadMSW;
|
|
|
|
{ load the most significant word of a four byte value }
|
|
{ }
|
|
{ Note: LoadLSW MUST be called first! }
|
|
|
|
begin {LoadMSW}
|
|
if lLong.where = onStack then
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else
|
|
GenNative(m_lda_s, direct, 3, nil, 0)
|
|
else {if lLong.where = constant then}
|
|
GenNative(m_lda_imm, immediate, long(lLong.lval).msw, nil, 0);
|
|
end; {LoadMSW}
|
|
|
|
|
|
procedure LoadWord;
|
|
|
|
{ Get the operand for a cgByte, cgUByte, cgWord or cgUWord }
|
|
{ into the accumulator }
|
|
|
|
begin {LoadWord}
|
|
if simple then begin
|
|
with op^.right^ do
|
|
if opcode = pc_ldc then
|
|
GenNative(m_lda_imm, immediate, q, nil, 0)
|
|
else if opcode = pc_lod then
|
|
GenNative(m_lda_dir, direct, LabelToDisp(r) + q, nil, 0)
|
|
else {if opcode = pc_ldo then}
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, q, lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longabsolute, q, lab, 0);
|
|
if not short then
|
|
if op^.right^.optype in [cgByte,cgUByte] then
|
|
if op^.right^.opcode <> pc_ldc then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_pla);
|
|
if short then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
end {else}
|
|
end; {LoadWord}
|
|
|
|
|
|
begin {GenStoCpi}
|
|
opcode := op^.opcode;
|
|
optype := op^.optype;
|
|
case optype of
|
|
|
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
|
if opcode = pc_sto then begin
|
|
GenTree(op^.right);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
if optype = cgReal then
|
|
GenCall(9)
|
|
else if optype = cgDouble then
|
|
GenCall(10)
|
|
else if optype = cgComp then
|
|
GenCall(66)
|
|
else {if optype = cgExtended then}
|
|
GenCall(67);
|
|
end {if}
|
|
else {if opcode = pc_cpi then} begin
|
|
if optype = cgExtended then begin
|
|
GenTree(op^.right);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenCall(69);
|
|
end {if}
|
|
else begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
GenNative(m_lda_s, direct, 13, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_s, direct, 13, nil, 0);
|
|
GenImplied(m_pha);
|
|
if optype = cgReal then begin
|
|
GenCall(9);
|
|
GenCall(21);
|
|
end {if}
|
|
else if optype = cgDouble then begin
|
|
GenCall(10);
|
|
GenCall(22);
|
|
end {else if}
|
|
else {if optype = cgComp then} begin
|
|
GenCall(66);
|
|
GenCall(70);
|
|
end; {else}
|
|
end; {else}
|
|
end; {else}
|
|
end; {case cgReal,cgDouble,cgComp,cgExtended}
|
|
|
|
cgQuad,cgUQuad: begin
|
|
gQuad.preference := onStack;
|
|
if opcode = pc_sto then
|
|
if op^.left^.opcode = pc_lod then begin
|
|
disp := LabelToDisp(op^.left^.r) + op^.left^.q;
|
|
if disp <= 255 then begin
|
|
gQuad.preference := inPointer;
|
|
gQuad.disp := disp;
|
|
end; {if}
|
|
end; {if}
|
|
GenTree(op^.right);
|
|
if gQuad.where = onStack then begin
|
|
gLong.preference := A_X;
|
|
GenTree(op^.left);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0);
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cpi then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_indl, direct, dworkLoc, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cpi then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_indly, direct, dworkLoc, nil, 0);
|
|
GenImplied(m_iny);
|
|
GenImplied(m_iny);
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cpi then}
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
GenNative(m_sta_indly, direct, dworkLoc, nil, 0);
|
|
GenImplied(m_iny);
|
|
GenImplied(m_iny);
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cpi then}
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
GenNative(m_sta_indly, direct, dworkLoc, nil, 0);
|
|
if op^.opcode = pc_cpi then
|
|
gQuad.where := onStack;
|
|
end; {if}
|
|
end; {case cgQuad,cgUQuad}
|
|
|
|
cgLong,cgULong: begin
|
|
if opcode = pc_sto then
|
|
gLong.preference := onStack+constant
|
|
else
|
|
gLong.preference := (onStack+constant) & gLong.preference;
|
|
GenTree(op^.right);
|
|
lLong := gLong;
|
|
gLong.preference := localAddress+inPointer+globalLabel+A_X;
|
|
GenTree(op^.left);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, dworkLoc+2, nil, 0);
|
|
LoadLSW;
|
|
GenNative(m_sta_indl, direct, dworkLoc, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
LoadMSW;
|
|
GenNative(m_sta_indly, direct, dworkLoc, nil, 0);
|
|
end {if}
|
|
else if gLong.where = A_X then begin
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0);
|
|
LoadLSW;
|
|
GenNative(m_sta_indl, direct, dworkLoc, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
LoadMSW;
|
|
GenNative(m_sta_indly, direct, dworkLoc, nil, 0);
|
|
end {if}
|
|
else if gLong.where = localAddress then begin
|
|
LoadLSW;
|
|
if gLong.fixedDisp then
|
|
if (gLong.disp & $FF00) = 0 then
|
|
GenNative(m_sta_dir, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
end {else}
|
|
else begin
|
|
if (gLong.disp >= 254) or (gLong.disp < 0) then begin
|
|
GenImplied(m_tay);
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
GenImplied(m_tya);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
GenNative(m_sta_dirX, direct, gLong.disp, nil, 0);
|
|
end; {else}
|
|
LoadMSW;
|
|
if gLong.fixedDisp then
|
|
if ((gLong.disp+2) & $FF00) = 0 then
|
|
GenNative(m_sta_dir, direct, gLong.disp+2, nil, 0)
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp+2, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
end {else}
|
|
else begin
|
|
if (gLong.disp >= 254) or (gLong.disp < 0) then begin
|
|
GenImplied(m_tay);
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
GenImplied(m_tya);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
GenNative(m_sta_dirX, direct, gLong.disp+2, nil, 0);
|
|
end; {else}
|
|
end {else if}
|
|
else if gLong.where = globalLabel then begin
|
|
LoadLSW;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0)
|
|
else
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
LoadMSW;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, gLong.disp+2, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, gLong.disp+2, gLong.lab, 0)
|
|
else
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_absX, absolute, gLong.disp+2, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_longX, longAbs, gLong.disp+2, gLong.lab, 0);
|
|
end {else if}
|
|
else begin
|
|
LoadLSW;
|
|
if gLong.fixedDisp = true then begin
|
|
GenNative(m_sta_indl, direct, gLong.disp, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_sta_indlY, direct, gLong.disp, nil, 0);
|
|
GenImplied(m_iny);
|
|
GenImplied(m_iny);
|
|
end; {else}
|
|
LoadMSW;
|
|
GenNative(m_sta_indly, direct, gLong.Disp, nil, 0);
|
|
end; {else}
|
|
gLong := lLong;
|
|
end; {case cgLong,cgULong}
|
|
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
short := optype in [cgByte,cgUByte];
|
|
simple := false;
|
|
zero := false;
|
|
if op^.opcode = pc_sto then begin
|
|
if short then
|
|
if op^.right^.opcode = pc_cnv then
|
|
if (op^.right^.q >> 4) in [ord(cgWord),ord(cgUWord)] then
|
|
op^.right := op^.right^.left;
|
|
with op^.right^ do begin
|
|
if opcode = pc_ldo then
|
|
simple := true
|
|
else if opcode = pc_lod then
|
|
simple := LabelToDisp(r) + q < 256
|
|
else if opcode = pc_ldc then begin
|
|
simple := true;
|
|
zero := q = 0;
|
|
end; {else if}
|
|
end; {with}
|
|
end; {if}
|
|
if not (zero or simple) then begin
|
|
GenTree(op^.right);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
GetPointer(op^.left);
|
|
if gLong.where = inPointer then begin
|
|
if short and simple then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if zero then
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0)
|
|
else
|
|
LoadWord;
|
|
if gLong.fixedDisp then
|
|
GenNative(m_sta_indl, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_sta_indlY, direct, gLong.disp, nil, 0);
|
|
end {if}
|
|
else if gLong.where = localAddress then begin
|
|
if gLong.fixedDisp then begin
|
|
if short and simple then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if (gLong.disp & $FF00) = 0 then
|
|
if zero then
|
|
GenNative(m_stz_dir, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
LoadWord;
|
|
GenNative(m_sta_dir, direct, gLong.disp, nil, 0);
|
|
end {else}
|
|
else begin
|
|
if zero then begin
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_stz_dirX, direct, 0, nil, 0);
|
|
end {if}
|
|
else begin
|
|
LoadWord;
|
|
GenNative(m_ldx_imm, immediate, gLong.disp, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
end; {else}
|
|
end {else}
|
|
end {if}
|
|
else begin
|
|
if (gLong.disp & $FF00) <> 0 then begin
|
|
GenImplied(m_txa);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, glong.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
gLong.disp := 0;
|
|
end; {if}
|
|
if short and simple then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if zero then
|
|
GenNative(m_stz_dirX, direct, gLong.disp, nil, 0)
|
|
else begin
|
|
LoadWord;
|
|
GenNative(m_sta_dirX, direct, gLong.disp, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end {else if}
|
|
else {if gLong.where = globalLabel then} begin
|
|
if short and simple then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if zero then begin
|
|
if not smallMemoryModel then
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
end {if}
|
|
else
|
|
LoadWord;
|
|
if gLong.fixedDisp then
|
|
if smallMemoryModel then
|
|
if zero then
|
|
GenNative(m_stz_abs, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_abs, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, gLong.disp, gLong.lab, 0)
|
|
else
|
|
if smallMemoryModel then
|
|
if zero then
|
|
GenNative(m_stz_absX, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_absX, absolute, gLong.disp, gLong.lab, 0)
|
|
else
|
|
GenNative(m_sta_longX, longAbs, gLong.disp, gLong.lab, 0);
|
|
end; {else}
|
|
if short then begin
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
if opcode = pc_cpi then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
end; {case cgByte,cgUByte,cgWord,cgUWord}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenStoCpi}
|
|
|
|
|
|
procedure GenStrCop (op: icptr);
|
|
|
|
{ Generate code for a pc_str or pc_cop }
|
|
|
|
var
|
|
disp: integer; {store location}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
special: boolean; {use special processing?}
|
|
zero: boolean; {is the operand a constant zero?}
|
|
|
|
begin {GenStrCop}
|
|
disp := LabelToDisp(op^.r) + op^.q;
|
|
optype := op^.optype;
|
|
case optype of
|
|
cgByte, cgUByte, cgWord, cgUWord: begin
|
|
zero := false;
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.opcode = pc_str then
|
|
if op^.left^.q = 0 then
|
|
zero := true;
|
|
if not zero then begin
|
|
if optype in [cgByte,cgUByte] then begin
|
|
if op^.opcode = pc_str then
|
|
if op^.left^.opcode = pc_cnv then
|
|
if (op^.left^.q >> 4) in [ord(cgWord),ord(cgUWord)] then
|
|
op^.left := op^.left^.left;
|
|
if (op^.left^.opcode in [pc_ldc,pc_ldc,pc_lod])
|
|
and (op^.opcode = pc_str) then begin
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
end; {else}
|
|
end {if}
|
|
else
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else
|
|
if optype in [cgByte,cgUByte] then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if disp > 255 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if zero then
|
|
GenNative(m_stz_dirx, direct, 0, nil, 0)
|
|
else
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
end {if}
|
|
else
|
|
if zero then
|
|
GenNative(m_stz_dir, direct, disp, nil, 0)
|
|
else
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
if optype in [cgByte,cgUByte] then
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end;
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
if op^.opcode = pc_str then begin
|
|
if optype = cgReal then
|
|
GenCall(9)
|
|
else if optype = cgDouble then
|
|
GenCall(10)
|
|
else if optype = cgComp then
|
|
GenCall(66)
|
|
else {if optype = cgExtended then}
|
|
GenCall(67);
|
|
end {if}
|
|
else begin
|
|
if optype = cgReal then begin
|
|
GenCall(9);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenCall(21);
|
|
end {if}
|
|
else if optype = cgDouble then begin
|
|
GenCall(10);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenCall(22);
|
|
end {else if}
|
|
else if optype = cgComp then begin
|
|
GenCall(66);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenCall(70);
|
|
end {else if}
|
|
else {if optype = cgExtended then}
|
|
GenCall(69);
|
|
end; {else}
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_adl,pc_sbl]) then
|
|
GenAdlSbl(op^.left, op)
|
|
else if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_inc,pc_dec]) then
|
|
GenIncDec(op^.left, op)
|
|
else begin
|
|
if op^.opcode = pc_str then
|
|
gLong.preference :=
|
|
A_X+onStack+inPointer+localAddress+globalLabel+constant
|
|
else
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
case gLong.where of
|
|
|
|
A_X:
|
|
if disp < 254 then begin
|
|
GenNative(m_stx_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_sty_dirX, direct, 2, nil, 0);
|
|
if op^.opcode = pc_cop then
|
|
GenImplied(m_tyx);
|
|
end; {else}
|
|
|
|
onStack:
|
|
if disp < 254 then begin
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+2, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
|
|
inPointer: begin
|
|
if (disp < 254) and (gLong.disp < 254) and gLong.fixedDisp
|
|
and (disp >= 0) and (gLong.disp >= 0) then begin
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
GenNative(m_ldx_dir, direct, gLong.disp+2, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
GenNative(m_stx_dir, direct, disp+2, nil, 0);
|
|
end {if}
|
|
else if (disp < 254) and (gLong.disp < 254)
|
|
and (disp >= 0) and (gLong.disp >= 0)
|
|
and (op^.opcode = pc_str) then begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_dir, direct, gLong.disp, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0);
|
|
GenNative(m_adc_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+2, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_dir, direct, gLong.disp, nil, 0);
|
|
end {if}
|
|
else
|
|
GenNative(m_lda_dir, direct, gLong.disp, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_lda_dir, direct, gLong.disp+2, nil, 0);
|
|
if not gLong.fixedDisp then
|
|
GenNative(m_adc_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
end;
|
|
|
|
localAddress:
|
|
if disp < 254 then begin
|
|
GenNative(m_stz_dir, direct, disp+2, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
if not gLong.fixedDisp then begin
|
|
GenImplied(m_phx);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
end {else if disp < 254}
|
|
else begin
|
|
if not gLong.fixedDisp then
|
|
GenImplied(m_phx);
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, nil, 0);
|
|
if not gLong.fixedDisp then
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_stz_dirX, direct, 2, nil, 0);
|
|
if not gLong.fixedDisp then
|
|
GenImplied(m_plx);
|
|
end; {else}
|
|
|
|
globalLabel: begin
|
|
if not gLong.fixedDisp then
|
|
GenImplied(m_txa);
|
|
if disp > 253 then begin
|
|
if op^.opcode = pc_cop then
|
|
if not gLong.fixedDisp then
|
|
GenImplied(m_tay)
|
|
else
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
end; {if}
|
|
if gLong.fixedDisp then
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, 0)
|
|
else begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gLong.disp, gLong.lab, 0);
|
|
end; {else}
|
|
if disp < 254 then
|
|
GenNative(m_sta_dir, direct, disp, nil, 0)
|
|
else
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_lda_imm, immediate, gLong.disp, gLong.lab, shift16);
|
|
if not gLong.fixedDisp then
|
|
GenNative(m_adc_imm, immediate, 0, nil, 0);
|
|
if disp < 254 then
|
|
GenNative(m_sta_dir, direct, disp+2, nil, 0)
|
|
else begin
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
if op^.opcode = pc_cop then
|
|
GenImplied(m_tyx);
|
|
end; {else}
|
|
end;
|
|
|
|
constant:
|
|
if disp < 254 then begin
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+2, nil, 0);
|
|
end {else}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {else}
|
|
end;
|
|
|
|
cgQuad, cgUQuad: begin
|
|
if op^.opcode = pc_str then begin
|
|
gQuad.preference := localAddress;
|
|
gQuad.disp := disp;
|
|
end {if}
|
|
else {if op^.opcode = pc_cop then}
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
if gQuad.where = onStack then begin
|
|
if disp < 250 then begin
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+2, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+4, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
GenNative(m_sta_dir, direct, disp+6, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 4, nil, 0);
|
|
if op^.opcode = pc_str then
|
|
GenImplied(m_pla)
|
|
else {if op^.opcode = pc_cop then}
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
GenNative(m_sta_dirX, direct, 6, nil, 0);
|
|
end; {else}
|
|
end; {if}
|
|
end;
|
|
|
|
otherwise: Error(cge1);
|
|
|
|
end; {case}
|
|
end; {GenStrCop}
|
|
|
|
|
|
procedure GenUnaryLong (op: icptr);
|
|
|
|
{ generate a pc_bnl or pc_ngl }
|
|
|
|
begin {GenUnaryLong}
|
|
gLong.preference := onStack; {get the operand}
|
|
GenTree(op^.left);
|
|
case op^.opcode of {do the operation}
|
|
|
|
pc_bnl: begin
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end; {case pc_bnl}
|
|
|
|
pc_ngl: begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sbc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
GenNative(m_sbc_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end; {case pc_ngl}
|
|
end; {case}
|
|
gLong.where := onStack; {the result is on the stack}
|
|
end; {GenUnaryLong}
|
|
|
|
|
|
procedure GenUnaryQuad (op: icptr);
|
|
|
|
{ generate a pc_bnq or pc_ngq }
|
|
|
|
begin {GenUnaryQuad}
|
|
case op^.opcode of {do the operation}
|
|
|
|
pc_bnq: begin
|
|
if SimpleQuadLoad(op^.left) then begin
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
gQuad.where := gQuad.preference;
|
|
end {if}
|
|
else begin
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 5, nil, 0);
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
gQuad.where := onStack;
|
|
end; {else}
|
|
end; {case pc_bnq}
|
|
|
|
pc_ngq: begin
|
|
if SimpleQuadLoad(op^.left) 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);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
OpOnWordOfQuad(m_sbc_imm, op^.left, 0);
|
|
StoreWordOfQuad(0);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
OpOnWordOfQuad(m_sbc_imm, op^.left, 2);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
OpOnWordOfQuad(m_sbc_imm, op^.left, 4);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
OpOnWordOfQuad(m_sbc_imm, op^.left, 6);
|
|
StoreWordOfQuad(6);
|
|
end {if}
|
|
else begin
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenImplied(m_sec);
|
|
GenNative(m_ldy_imm, immediate, 0, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_sbc_s, direct, 1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_sbc_s, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_sbc_s, direct, 5, nil, 0);
|
|
GenNative(m_sta_s, direct, 5, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_sbc_s, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
gQuad.where := onStack;
|
|
end; {else}
|
|
end; {case pc_ngq}
|
|
end; {case}
|
|
end; {GenUnaryQuad}
|
|
|
|
|
|
{$segment 'gen2'}
|
|
|
|
procedure GenDebugSourceFile (debugFile: gsosOutStringPtr);
|
|
|
|
{ generate debug code indicating the specified source file name }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
len: integer; {length of the file name}
|
|
|
|
begin {GenDebugSourceFile}
|
|
GenNative(m_cop, immediate, 6, nil, 0);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16);
|
|
len := debugFile^.theString.size;
|
|
if len > 255 then
|
|
len := 255;
|
|
if maxString-stringSize >= len+1 then begin
|
|
stringSpace^[stringSize+1] := chr(len);
|
|
for i := 1 to len do
|
|
stringSpace^[i+stringSize+1] :=
|
|
debugFile^.theString.theString[i];
|
|
stringSize := stringSize + len + 1;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
end; {GenDebugSourceFile}
|
|
|
|
|
|
procedure GenTree {op: icptr};
|
|
|
|
{ generate code for op and its children }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - opcode for which to generate code }
|
|
|
|
|
|
procedure GenAdi (op: icptr);
|
|
|
|
{ generate a pc_adi }
|
|
|
|
var
|
|
nd: icptr;
|
|
|
|
begin {GenAdi}
|
|
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) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_clc);
|
|
OperA(m_adc_imm, op^.right);
|
|
end; {else}
|
|
end; {GenAdi}
|
|
|
|
|
|
procedure GenBinLong (op: icptr);
|
|
|
|
{ generate one of: pc_blr, pc_blx, pc_bal, pc_dvl, pc_mdl, }
|
|
{ pc_mpl, pc_sll, pc_slr, pc_udl, pc_ulm, pc_uml, pc_vsr }
|
|
|
|
var
|
|
nd: icptr; {for swapping left/right children}
|
|
lab1,lab2: integer; {label numbers}
|
|
|
|
|
|
procedure GenOp (ops, opi: integer);
|
|
|
|
{ generate a binary operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ ops - stack version of operation }
|
|
{ opi - immediate version of operation }
|
|
|
|
begin {GenOp}
|
|
if gLong.where = A_X then
|
|
GenImplied(m_phx)
|
|
else
|
|
GenImplied(m_pla);
|
|
if gLong.where = constant then begin
|
|
GenNative(opi, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(opi, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(ops, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(ops, direct, 3, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end; {else}
|
|
end; {GenOp}
|
|
|
|
|
|
begin {GenBinLong}
|
|
if (op^.left^.opcode = pc_ldc) and
|
|
(op^.opcode in [pc_blr,pc_blx,pc_bal]) then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
if op^.opcode = pc_mdl then
|
|
GenImplied(m_phd); {reserve stack space}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
if op^.opcode in [pc_blr,pc_blx,pc_bal] then begin
|
|
gLong.preference := constant;
|
|
GenTree(op^.right);
|
|
end {if}
|
|
else if op^.opcode in [pc_uml,pc_udl,pc_ulm] then begin
|
|
gLong.preference := A_X;
|
|
GenTree(op^.right);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
end {else if}
|
|
else begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
end; {else}
|
|
case op^.opcode of
|
|
|
|
pc_blr: GenOp(m_ora_s, m_ora_imm);
|
|
|
|
pc_blx: GenOp(m_eor_s, m_eor_imm);
|
|
|
|
pc_bal: GenOp(m_and_s, m_and_imm);
|
|
|
|
pc_dvl: GenCall(43);
|
|
|
|
pc_mdl: begin
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
{stash high word of dividend (for sign)}
|
|
GenNative(m_lda_s, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 9, nil, 0);
|
|
GenCall(78); {call ~DIV4}
|
|
GenImplied(m_ply); {ignore quotient}
|
|
GenImplied(m_ply);
|
|
GenImplied(m_pla); {get remainder (always positive or 0)}
|
|
GenImplied(m_plx);
|
|
GenImplied(m_ply); {if dividend was negative...}
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
GenImplied(m_clc); { negate remainder}
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenNative(m_adc_imm, immediate, 1, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenImplied(m_txa);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenNative(m_adc_imm, immediate, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenImplied(m_phy);
|
|
GenNative(m_bra, relative, lab2, nil, 0);
|
|
GenLab(lab1);
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
GenLab(lab2);
|
|
end;
|
|
|
|
pc_mpl: GenCall(42);
|
|
|
|
pc_sll: GenCall(45);
|
|
|
|
pc_slr: GenCall(47);
|
|
|
|
pc_udl: GenCall(49);
|
|
|
|
pc_ulm: GenCall(50);
|
|
|
|
pc_uml: GenCall(48);
|
|
|
|
pc_vsr: GenCall(46);
|
|
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
gLong.where := onStack;
|
|
end; {GenBinLong}
|
|
|
|
|
|
procedure GenBinQuad (op: icptr);
|
|
|
|
{ generate one of: pc_bqr, pc_bqx, pc_baq, pc_mpq, pc_umq, }
|
|
{ pc_dvq, pc_udq, pc_mdq, pc_uqm }
|
|
|
|
procedure GenBitwiseOp;
|
|
|
|
{ generate a 64-bit binary bitwise operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ ops - stack version of operation }
|
|
|
|
var
|
|
mop: integer; {machine opcode}
|
|
|
|
begin {GenBitwiseOp}
|
|
if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right) then begin
|
|
case op^.opcode of
|
|
pc_bqr: mop := m_ora_imm;
|
|
pc_bqx: mop := m_eor_imm;
|
|
pc_baq: mop := m_and_imm;
|
|
end; {case}
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
|
|
OpOnWordOfQuad(mop, op^.right, 6);
|
|
StoreWordOfQuad(6);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
|
|
OpOnWordOfQuad(mop, op^.right, 4);
|
|
StoreWordOfQuad(4);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
|
|
OpOnWordOfQuad(mop, op^.right, 2);
|
|
StoreWordOfQuad(2);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
|
|
OpOnWordOfQuad(mop, op^.right, 0);
|
|
StoreWordOfQuad(0);
|
|
gQuad.where := gQuad.preference;
|
|
end {if}
|
|
else begin
|
|
case op^.opcode of
|
|
pc_bqr: mop := m_ora_s;
|
|
pc_bqx: mop := m_eor_s;
|
|
pc_baq: mop := m_and_s;
|
|
end; {case}
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.right);
|
|
GenImplied(m_pla);
|
|
GenNative(mop, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(mop, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(mop, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(mop, direct, 7, nil, 0);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
gQuad.where := onStack;
|
|
end; {else}
|
|
end; {GenBitwiseOp}
|
|
|
|
begin {GenBinQuad}
|
|
if op^.opcode in [pc_bqr,pc_bqx,pc_baq] then
|
|
GenBitwiseOp
|
|
else begin
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.right);
|
|
case op^.opcode of
|
|
pc_mpq: GenCall(79);
|
|
|
|
pc_umq: GenCall(80);
|
|
|
|
pc_dvq: begin
|
|
GenCall(81); {do division}
|
|
GenImplied(m_pla); {get quotient, discarding remainder}
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
end;
|
|
|
|
pc_udq: begin
|
|
GenCall(82); {do division}
|
|
GenImplied(m_pla); {get quotient, discarding remainder}
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_s, direct, 7, nil, 0);
|
|
end;
|
|
|
|
pc_mdq: begin
|
|
GenCall(81); {do division}
|
|
GenImplied(m_tsc); {discard quotient, leaving remainder}
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 8, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end;
|
|
|
|
pc_uqm: begin
|
|
GenCall(82); {do division}
|
|
GenImplied(m_tsc); {discard quotient, leaving remainder}
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 8, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end;
|
|
|
|
pc_slq: GenCall(85);
|
|
|
|
pc_sqr: GenCall(86);
|
|
|
|
pc_wsr: GenCall(87);
|
|
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
gQuad.where := onStack;
|
|
end; {else}
|
|
end; {GenBinQuad}
|
|
|
|
|
|
procedure GenBno (op: icptr);
|
|
|
|
{ Generate code for a pc_bno }
|
|
|
|
var
|
|
lLong: longType; {requested address type}
|
|
lQuad: quadType;
|
|
|
|
begin {GenBno}
|
|
lLong := gLong;
|
|
lQuad := gQuad;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
gQuad := lQuad;
|
|
GenTree(op^.right);
|
|
end; {GenBno}
|
|
|
|
|
|
procedure GenBntNgiNot (op: icptr);
|
|
|
|
{ Generate code for a pc_bnt, pc_ngi or pc_not }
|
|
|
|
var
|
|
lab1: integer;
|
|
operandIsBoolean: boolean;
|
|
|
|
begin {GenntNgiNot}
|
|
if op^.opcode = pc_not then
|
|
operandIsBoolean := op^.left^.opcode in
|
|
[pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not];
|
|
GenTree(op^.left);
|
|
case op^.opcode of
|
|
pc_bnt:
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
|
|
pc_ngi: begin
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_ina);
|
|
end; {case pc_ngi}
|
|
|
|
pc_not: begin
|
|
if not operandIsBoolean then begin
|
|
lab1 := GenLabel;
|
|
GenImpliedForFlags(m_tax);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
GenNative(m_eor_imm, immediate, 1, nil, 0);
|
|
end; {if}
|
|
end; {case}
|
|
end; {GenBntNgiNot}
|
|
|
|
|
|
procedure GenCui (op: icptr);
|
|
|
|
{ Generate code for a pc_cui }
|
|
|
|
var
|
|
lab1: integer; {return point}
|
|
lLong: longType; {used to reserve gLong}
|
|
lQuad: quadType; {saved copy of gQuad}
|
|
lArgsSize: integer; {saved copy of argsSize}
|
|
extraStackSize: integer; {size of extra stuff pushed on stack}
|
|
|
|
begin {GenCui}
|
|
lArgsSize := argsSize;
|
|
argsSize := 0;
|
|
extraStackSize := 0;
|
|
|
|
{For functions returning cg(U)Quad, make space for result}
|
|
if op^.optype in [cgQuad,cgUQuad] then
|
|
if gQuad.preference <> localAddress then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_imm, immediate, 8, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end; {if}
|
|
|
|
{save the stack register}
|
|
if ((saveStack or checkStack) and (op^.q >= 0)) or (op^.q > 0) then begin
|
|
if stackSaveDepth <> 0 then begin
|
|
GenNative(m_pei_dir, direct, stackLoc, nil, 0);
|
|
extraStackSize := 2;
|
|
end; {if}
|
|
GenImplied(m_tsx);
|
|
GenNative(m_stx_dir, direct, stackLoc, nil, 0);
|
|
stackSaveDepth := stackSaveDepth + 1;
|
|
end; {if}
|
|
|
|
{generate parameters}
|
|
{place the operands on the stack}
|
|
lQuad := gQuad;
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
|
|
{get the address to call}
|
|
gLong.preference := A_X;
|
|
GenTree(op^.right);
|
|
|
|
{create a return label}
|
|
lab1 := GenLabel;
|
|
|
|
{place the call/return addrs on stack}
|
|
if gLong.where = A_X then begin
|
|
GenImplied(m_tay);
|
|
GenImplied(m_txa);
|
|
end {if}
|
|
else {if gLong.where = onStack then} begin
|
|
GenImplied(m_ply);
|
|
GenImplied(m_pla);
|
|
end; {else}
|
|
GenNative(m_and_imm, immediate, $00ff, nil, 0);
|
|
GenNative(m_ora_imm, genAddress, lab1, nil, subtract1+shiftLeft8);
|
|
GenNative(m_pea, genAddress, lab1, nil, subtract1+shift8);
|
|
GenImplied(m_pha);
|
|
GenImplied(m_dey);
|
|
GenImplied(m_phy);
|
|
|
|
{For functions returning cg(U)Quad, x = address to store result in}
|
|
if op^.optype in [cgQuad,cgUQuad] then
|
|
if lQuad.preference = localAddress then begin
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, lQuad.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, argsSize+extraStackSize+6+1, nil, 0);
|
|
GenImplied(m_tax);
|
|
end; {else}
|
|
|
|
{indirect call}
|
|
GenImplied(m_rtl);
|
|
GenLab(lab1);
|
|
|
|
if checkStack and (op^.q >= 0) then begin
|
|
{check the stack for errors}
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
GenNative(m_ldy_dir, direct, stackLoc, nil, 0);
|
|
GenCall(76);
|
|
if stackSaveDepth <> 0 then begin
|
|
GenImplied(m_ply);
|
|
GenNative(m_sty_dir, direct, stackLoc, nil, 0);
|
|
end; {if}
|
|
end {if}
|
|
else if (saveStack and (op^.q >= 0)) or (op^.q > 0) then begin
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
|
|
then
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
|
|
GenImplied(m_txs);
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
|
|
then
|
|
GenImplied(m_tyx);
|
|
if stackSaveDepth <> 0 then begin
|
|
GenImplied(m_ply);
|
|
GenNative(m_sty_dir, direct, stackLoc, nil, 0);
|
|
end; {if}
|
|
end; {else}
|
|
|
|
{save the returned value}
|
|
gLong := lLong;
|
|
gQuad := lQuad;
|
|
gLong.where := A_X;
|
|
if gQuad.preference = localAddress then
|
|
gQuad.where := localAddress
|
|
else
|
|
gQuad.where := onStack;
|
|
SaveRetValue(op^.optype);
|
|
argsSize := lArgsSize;
|
|
end; {GenCui}
|
|
|
|
|
|
procedure GenCup (op: icptr);
|
|
|
|
{ Generate code for a pc_cup }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
lQuad: quadType; {saved copy of gQuad}
|
|
lArgsSize: integer; {saved copy of argsSize}
|
|
extraStackSize: integer; {size of extra stuff pushed on stack}
|
|
|
|
begin {GenCup}
|
|
lArgsSize := argsSize;
|
|
argsSize := 0;
|
|
extraStackSize := 0;
|
|
|
|
{For functions returning cg(U)Quad, make space for result}
|
|
if op^.optype in [cgQuad,cgUQuad] then
|
|
if gQuad.preference <> localAddress then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_imm, immediate, 8, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end; {if}
|
|
|
|
{save the stack register}
|
|
if ((saveStack or checkStack) and (op^.q >= 0)) or (op^.q > 0) then begin
|
|
if stackSaveDepth <> 0 then begin
|
|
GenNative(m_pei_dir, direct, stackLoc, nil, 0);
|
|
extraStackSize := 2;
|
|
end; {if}
|
|
GenImplied(m_tsx);
|
|
GenNative(m_stx_dir, direct, stackLoc, nil, 0);
|
|
stackSaveDepth := stackSaveDepth + 1;
|
|
end; {if}
|
|
|
|
{generate parameters}
|
|
lQuad := gQuad;
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
gQuad := lQuad;
|
|
|
|
{For functions returning cg(U)Quad, x = address to store result in}
|
|
if op^.optype in [cgQuad,cgUQuad] then
|
|
if gQuad.preference = localAddress then begin
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, gQuad.disp, nil, 0);
|
|
GenImplied(m_tax);
|
|
end {if}
|
|
else if argsSize + extraStackSize in [0,1,2] then begin
|
|
GenImplied(m_tsx);
|
|
GenImplied(m_inx);
|
|
if argsSize + extraStackSize in [1,2] then begin
|
|
GenImplied(m_inx);
|
|
if argsSize + extraStackSize = 2 then
|
|
GenImplied(m_inx);
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, argsSize+extraStackSize+1, nil, 0);
|
|
GenImplied(m_tax);
|
|
end; {else}
|
|
|
|
{generate the jsl}
|
|
GenNative(m_jsl, longAbs, 0, op^.lab, 0);
|
|
|
|
{check the stack for errors}
|
|
if checkStack and (op^.q >= 0) then begin
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
GenNative(m_ldy_dir, direct, stackLoc, nil, 0);
|
|
GenCall(76);
|
|
if stackSaveDepth <> 0 then begin
|
|
GenImplied(m_ply);
|
|
GenNative(m_sty_dir, direct, stackLoc, nil, 0);
|
|
end; {if}
|
|
GenImplied(m_tay);
|
|
end {if}
|
|
else if (saveStack and (op^.q >= 0)) or (op^.q > 0) then begin
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
|
|
then
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
|
|
GenImplied(m_txs);
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord,cgQuad,cgUQuad])
|
|
then
|
|
GenImplied(m_tyx);
|
|
if stackSaveDepth <> 0 then begin
|
|
GenImplied(m_ply);
|
|
GenNative(m_sty_dir, direct, stackLoc, nil, 0);
|
|
end; {if}
|
|
end; {else}
|
|
|
|
{save the returned value}
|
|
gLong.where := A_X;
|
|
if gQuad.preference = localAddress then
|
|
gQuad.where := localAddress
|
|
else
|
|
gQuad.where := onStack;
|
|
SaveRetValue(op^.optype);
|
|
argsSize := lArgsSize;
|
|
end; {GenCup}
|
|
|
|
|
|
procedure GenDviMod (op: icptr);
|
|
|
|
{ Generate code for a pc_dvi, pc_mod, pc_udi or pc_uim }
|
|
|
|
var
|
|
opcode: pcodes; {temp storage}
|
|
lab1,lab2,lab3: integer; {label numbers}
|
|
val: integer;
|
|
power: integer;
|
|
|
|
begin {GenDviMod}
|
|
opcode := op^.opcode;
|
|
if (op^.right^.opcode = pc_ldc) and not rangeCheck then begin
|
|
val := op^.right^.q;
|
|
if opcode = pc_udi then begin
|
|
case val of
|
|
1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384: begin
|
|
GenTree(op^.left);
|
|
if val >= 256 then begin
|
|
GenNative(m_and_imm, immediate, $FF00, nil, 0);
|
|
GenImplied(m_xba);
|
|
val := val >> 8;
|
|
end; {if}
|
|
while not odd(val) do begin
|
|
GenImplied(m_lsr_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
otherwise:
|
|
if (val >= 1000) or (val < 0) then begin {1000..65535}
|
|
GenTree(op^.left);
|
|
lab1 := GenLabel;
|
|
GenNative(m_ldy_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_sec);
|
|
GenLab(lab1);
|
|
GenImplied(m_iny);
|
|
GenNative(m_sbc_imm, immediate, val, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenImplied(m_tya);
|
|
opcode := pc_nop;
|
|
end; {if}
|
|
end; {case}
|
|
end {if}
|
|
else if opcode = pc_uim then begin
|
|
case val of
|
|
1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_and_imm, immediate, val-1, nil, 0);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
otherwise:
|
|
if (val >= 750) or (val < 0) then begin {750..65535}
|
|
GenTree(op^.left);
|
|
lab1 := GenLabel;
|
|
GenImplied(m_sec);
|
|
GenLab(lab1);
|
|
GenNative(m_sbc_imm, immediate, val, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_adc_imm, immediate, val, nil, 0);
|
|
opcode := pc_nop;
|
|
end; {if}
|
|
end; {case}
|
|
end {else if}
|
|
else if opcode = pc_dvi then begin
|
|
case val of
|
|
-1: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_ina);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
1: begin
|
|
GenTree(op^.left);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384: begin
|
|
GenTree(op^.left);
|
|
power := 0;
|
|
while not odd(val) do begin
|
|
power := power + 1;
|
|
val := val >> 1;
|
|
end; {while}
|
|
if power <> 1 then begin
|
|
GenNative(m_ldy_imm, immediate, power, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenLab(lab1);
|
|
end; {if}
|
|
lab2 := GenLabel;
|
|
lab3 := GenLabel;
|
|
GenImpliedForFlags(m_tax);
|
|
GenImplied(m_clc);
|
|
GenNative(m_bpl, relative, lab2, nil, 0);
|
|
GenImplied(m_ina);
|
|
GenNative(m_beq, relative, lab3, nil, 0);
|
|
GenImplied(m_sec);
|
|
GenLab(lab2);
|
|
GenImplied(m_ror_a);
|
|
if power <> 1 then begin
|
|
GenImplied(m_dey);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
end; {if}
|
|
GenLab(lab3);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
otherwise: ;
|
|
end; {case}
|
|
end {else if}
|
|
else {if opcode = pc_mod then} begin
|
|
case val of
|
|
-1,1: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
2: begin
|
|
GenTree(op^.left);
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
GenImplied(m_asl_a);
|
|
GenNative(m_and_imm, immediate, 2, nil, 0);
|
|
GenNative(m_beq, relative, lab2, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenImplied(m_dea);
|
|
GenImplied(m_dea);
|
|
GenLab(lab1);
|
|
GenImplied(m_dea);
|
|
GenLab(lab2);
|
|
opcode := pc_nop;
|
|
end;
|
|
|
|
otherwise: ;
|
|
end; {case}
|
|
end; {else}
|
|
end; {if}
|
|
if opcode = pc_nop then
|
|
{nothing to do - optimized above}
|
|
else if Complex(op^.right) then begin
|
|
GenTree(op^.right);
|
|
if Complex(op^.left) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.left);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tax);
|
|
GenTree(op^.left);
|
|
end; {else}
|
|
end {else if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
LoadX(op^.right);
|
|
end; {else}
|
|
if opcode = pc_mod then begin
|
|
lab1 := GenLabel;
|
|
GenImplied(m_pha); {stash away dividend (for sign)}
|
|
GenCall(26); {call ~DIV2}
|
|
GenImplied(m_txa); {get remainder (always positive or 0)}
|
|
GenImplied(m_ply); {if dividend was negative...}
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0); {...negate remainder}
|
|
GenImplied(m_ina);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else if opcode = pc_dvi then
|
|
GenCall(26)
|
|
else if opcode in [pc_udi,pc_uim] then begin
|
|
GenCall(40);
|
|
if opcode = pc_uim then
|
|
GenImplied(m_txa);
|
|
end; {else}
|
|
if rangeCheck then
|
|
GenCall(25);
|
|
end; {GenDviMod}
|
|
|
|
|
|
procedure GenEnt(op: icptr);
|
|
|
|
{ Generate code for a pc_ent }
|
|
|
|
var
|
|
i: integer;
|
|
len: integer;
|
|
|
|
begin {GenEnt}
|
|
|
|
if debugStrFlag then begin {gsbug/niftylist debug string}
|
|
len := length(op^.lab^);
|
|
CnOut(m_brl);
|
|
CnOut2(len + 3);
|
|
CnOut2($7771);
|
|
CnOut(len);
|
|
for i := 1 to len do
|
|
CnOut(ord(op^.lab^[i]));
|
|
end;
|
|
|
|
if rangeCheck then begin {if range checking is on, check for a stack overflow}
|
|
GenNative(m_pea, immediate, localSize - returnSize - 1, nil, 0);
|
|
GenCall(1);
|
|
end; {if}
|
|
|
|
if localSize = 0 then begin {create the stack frame}
|
|
if parameterSize <> 0 then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end; {if}
|
|
end {if}
|
|
else if localSize = 2 then begin
|
|
GenImplied(m_pha);
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end {else if}
|
|
else begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_imm, immediate, localSize, nil, 0);
|
|
GenImplied(m_tcs);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end; {if}
|
|
|
|
if isQuadFunction then begin {save return location for cg(U)Quad}
|
|
GenNative(m_stx_dir, direct, funloc, nil, 0);
|
|
GenNative(m_stz_dir, direct, funloc+2, nil, 0);
|
|
end; {if}
|
|
|
|
if dataBank then begin {preserve and set data bank}
|
|
GenImplied(m_phb);
|
|
GenImplied(m_phb);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, bankLoc, nil, 0);
|
|
GenNative(m_pea, immediate, 0, @'~GLOBALS', shift8);
|
|
GenImplied(m_plb);
|
|
GenImplied(m_plb);
|
|
end; {if}
|
|
|
|
{no pc_nam (yet)}
|
|
namePushed := false;
|
|
end; {GenEnt}
|
|
|
|
|
|
procedure GenFix (op: icptr);
|
|
|
|
{ Generate code for a pc_fix }
|
|
|
|
begin {GenFix}
|
|
GenNative(m_pea, immediate, localLabel[op^.q], nil, 0);
|
|
if op^.optype = cgReal then
|
|
GenCall(95)
|
|
else if op^.optype = cgDouble then
|
|
GenCall(96)
|
|
else if op^.optype = cgComp then
|
|
GenCall(97);
|
|
end; {GenFix}
|
|
|
|
|
|
procedure GenFjpTjp (op: icptr);
|
|
|
|
{ Generate code for a pc_fjp or pc_tjp }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
opcode: pcodes; {op^.left^.opcode}
|
|
|
|
begin {GenFjpTjp}
|
|
if op^.left^.opcode in [pc_equ,pc_geq,pc_grt,pc_les,pc_leq,pc_neq] then
|
|
if op^.left^.opcode in [pc_equ,pc_neq] then
|
|
GenEquNeq(op^.left, op^.opcode, op^.q)
|
|
else
|
|
GenCmp(op^.left, op^.opcode, op^.q)
|
|
else begin
|
|
lab1 := GenLabel;
|
|
GenTree(op^.left);
|
|
opcode := op^.left^.opcode;
|
|
if NeedsCondition(opcode) then
|
|
GenImpliedForFlags(m_tax)
|
|
else if opcode = pc_ind then
|
|
if op^.left^.optype in [cgByte,cgUByte] then
|
|
GenImpliedForFlags(m_tax);
|
|
if op^.opcode = pc_fjp then
|
|
GenNative(m_bne, relative, lab1, nil, 0)
|
|
else {if op^.opcode = pc_tjp then}
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_brl, longrelative, op^.q, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end; {GenFjpTjp}
|
|
|
|
|
|
procedure GenLaoLad (op: icptr);
|
|
|
|
{ Generate code for a pc_lao, pc_lad }
|
|
|
|
var
|
|
q: integer; {displacement}
|
|
|
|
begin {GenLaoLad}
|
|
if op^.opcode = pc_lad then
|
|
q := 0
|
|
else
|
|
q := op^.q;
|
|
if (globalLabel & gLong.preference) <> 0 then begin
|
|
gLong.fixedDisp := true;
|
|
gLong.where := globalLabel;
|
|
gLong.disp := q;
|
|
gLong.lab := op^.lab;
|
|
end {if}
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_ldx_imm, immediate, q, op^.lab, shift16);
|
|
GenNative(m_lda_imm, immediate, q, op^.lab, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, q, op^.lab, shift16);
|
|
GenNative(m_pea, immediate, q, op^.lab, 0);
|
|
end; {else}
|
|
end; {GenLaoLad}
|
|
|
|
|
|
procedure GenLbfLbu (op: icptr);
|
|
|
|
{ Generate code for a pc_lbf or pc_lbu }
|
|
|
|
var
|
|
lLong: longType; {requested address type}
|
|
|
|
begin {GenLbfLbu}
|
|
lLong := gLong;
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, op^.r, nil, 0);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
if op^.opcode = pc_lbf then
|
|
GenCall(73)
|
|
else
|
|
GenCall(72);
|
|
if op^.optype in [cgLong,cgULong] then begin
|
|
if (A_X & lLong.preference) <> 0 then
|
|
gLong.where := A_X
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {if}
|
|
end; {GenLbfLbu}
|
|
|
|
|
|
procedure GenLca (op: icptr);
|
|
|
|
{ Generate code for a pc_lca }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
|
|
begin {GenLca}
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16);
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference);
|
|
if maxString-stringSize >= op^.q then begin
|
|
for i := 1 to op^.q do
|
|
stringSpace^[i+stringSize] := op^.str^.str[i];
|
|
stringSize := stringSize+op^.q;
|
|
end
|
|
else
|
|
Error(cge3);
|
|
op^.optype := cgULong;
|
|
end; {GenLca}
|
|
|
|
|
|
procedure GenLda (op: icptr);
|
|
|
|
{ Generate code for a pc_lda }
|
|
|
|
begin {GenLda}
|
|
if (localAddress & gLong.preference) <> 0 then begin
|
|
gLong.fixedDisp := true;
|
|
gLong.where := localAddress;
|
|
gLong.disp := LabelToDisp(op^.r) + op^.q;
|
|
end {if}
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {GenLda}
|
|
|
|
|
|
procedure GenLdc (op: icptr);
|
|
|
|
{ Generate code for a pc_ldc }
|
|
|
|
type
|
|
kind = (vint, vbyte); {kinds of equivalenced data}
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
rec: realrec; {conversion record}
|
|
switch: packed record {used for type conversion}
|
|
case rkind: kind of
|
|
vint: (i: integer);
|
|
vbyte: (b1, b2, b3, b4, b5, b6, b7, b8: byte);
|
|
end;
|
|
|
|
begin {GenLdc}
|
|
case op^.optype of
|
|
cgByte: begin
|
|
if op^.q > 127 then
|
|
op^.q := op^.q | $FF00;
|
|
GenNative(m_lda_imm, immediate, op^.q, nil, 0);
|
|
end;
|
|
|
|
cgUByte, cgWord, cgUWord:
|
|
GenNative(m_lda_imm, immediate, op^.q, nil, 0);
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
rec.itsReal := op^.rval;
|
|
CnvSX(rec);
|
|
i := 9;
|
|
while i >= 0 do begin
|
|
switch.b1 := rec.inSANE[i];
|
|
switch.b2 := rec.inSANE[i+1];
|
|
GenNative(m_pea, immediate, switch.i, nil, 0);
|
|
i := i-2;
|
|
end; {while}
|
|
end;
|
|
|
|
cgLong, cgULong:
|
|
if (constant & gLong.preference) <> 0 then begin
|
|
gLong.where := constant;
|
|
gLong.lval := op^.lval;
|
|
end
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_lda_imm, immediate, long(op^.lval).lsw, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, long(op^.lval).msw, nil, 0);
|
|
end
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, long(op^.lval).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0);
|
|
end;
|
|
|
|
cgQuad,cgUQuad: begin
|
|
if gQuad.preference = onStack then begin
|
|
GenNative(m_pea, immediate, long(op^.qval.hi).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.qval.hi).lsw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.qval.lo).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.qval.lo).lsw, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_imm, immediate, long(op^.qval.hi).msw, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_imm, immediate, long(op^.qval.hi).lsw, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_imm, immediate, long(op^.qval.lo).msw, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_imm, immediate, long(op^.qval.lo).lsw, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
gQuad.where := gQuad.preference;
|
|
end;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenLdc}
|
|
|
|
|
|
procedure GenLdo (op: icptr);
|
|
|
|
{ Generate code for a pc_ldo }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {GenLdo}
|
|
case op^.optype of
|
|
cgWord, cgUWord:
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0);
|
|
|
|
cgByte, cgUByte: begin
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0);
|
|
GenNative(m_and_imm, immediate, 255, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end;
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenNative(m_pea, immediate, op^.q, op^.lab, shift16);
|
|
GenNative(m_pea, immediate, op^.q, op^.lab, 0);
|
|
if op^.optype = cgReal then
|
|
GenCall(21)
|
|
else if op^.optype = cgDouble then
|
|
GenCall(22)
|
|
else if op^.optype = cgComp then
|
|
GenCall(70)
|
|
else {if op^.optype = cgExtended then}
|
|
GenCall(71);
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if (A_X & gLong.preference) <> 0 then
|
|
gLong.where := A_X
|
|
else
|
|
gLong.where := onStack;
|
|
if smallMemoryModel then begin
|
|
GenNative(m_ldx_abs, absolute, op^.q+2, op^.lab, 0);
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longabsolute, op^.q+2, op^.lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha)
|
|
else
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_long, longabsolute, op^.q, op^.lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {case cgLong,cgULong}
|
|
|
|
cgQuad, cgUQuad: begin
|
|
if smallMemoryModel then begin
|
|
GenNative(m_lda_abs, absolute, op^.q+6, op^.lab, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_abs, absolute, op^.q+4, op^.lab, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_abs, absolute, op^.q+2, op^.lab, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0);
|
|
StoreWordOfQuad(0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longabsolute, op^.q+6, op^.lab, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_long, longabsolute, op^.q+4, op^.lab, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_long, longabsolute, op^.q+2, op^.lab, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_long, longabsolute, op^.q, op^.lab, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
gQuad.where := gQuad.preference;
|
|
end; {case cgQuad,cgUQuad}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenLdo}
|
|
|
|
|
|
procedure GenLnm (op: icptr);
|
|
|
|
{ Generate code for a pc_lnm }
|
|
|
|
begin {GenLnm}
|
|
if op^.left <> nil then
|
|
GenTree(op^.left);
|
|
if traceBack then begin
|
|
GenNative(m_pea, immediate, op^.r, nil, 0);
|
|
GenCall(6);
|
|
end; {if}
|
|
if debugFlag then begin
|
|
if op^.lab <> nil then
|
|
GenDebugSourceFile(op^.lab);
|
|
GenNative(m_cop, immediate, op^.q, nil, 0);
|
|
GenNative(d_wrd, special, op^.r, nil, 0);
|
|
end; {if}
|
|
end; {GenLnm}
|
|
|
|
|
|
procedure GenLod (op: icptr);
|
|
|
|
{ Generate code for a pc_lod }
|
|
|
|
var
|
|
disp: integer; {load location}
|
|
lab1: integer; {branch point}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
|
|
begin {GenLod}
|
|
disp := LabelToDisp(op^.r) + op^.q;
|
|
optype := op^.optype;
|
|
case optype of
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
if optype = cgReal then
|
|
GenCall(21)
|
|
else if optype = cgDouble then
|
|
GenCall(22)
|
|
else if optype = cgComp then
|
|
GenCall(70)
|
|
else {if optype = cgExtended then}
|
|
GenCall(71);
|
|
end;
|
|
|
|
cgQuad, cgUQuad: begin
|
|
if disp >= 250 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 6, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 4, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
gQuad.where := onStack;
|
|
end {if}
|
|
else begin
|
|
if gQuad.preference = onStack then begin
|
|
GenNative(m_pei_dir, direct, disp+6, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp+4, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_dir, direct, disp+6, nil, 0);
|
|
StoreWordOfQuad(6);
|
|
GenNative(m_lda_dir, direct, disp+4, nil, 0);
|
|
StoreWordOfQuad(4);
|
|
GenNative(m_lda_dir, direct, disp+2, nil, 0);
|
|
StoreWordOfQuad(2);
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
StoreWordOfQuad(0);
|
|
end; {else}
|
|
gQuad.where := gQuad.preference;
|
|
end; {else}
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if ((inPointer & gLong.preference) <> 0) and (disp < 254) then
|
|
begin
|
|
gLong.where := inPointer;
|
|
gLong.fixedDisp := true;
|
|
gLong.disp := disp;
|
|
end {if}
|
|
else if ((A_X & gLong.preference) <> 0) and (disp < 254) then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_ldx_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
if disp >= 254 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pei_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end;
|
|
|
|
cgByte, cgUByte, cgWord, cgUWord: begin
|
|
if disp >= 256 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
end
|
|
else
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
if optype in [cgByte,cgUByte] then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end;
|
|
end;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
|
|
end; {case}
|
|
end; {GenLod}
|
|
|
|
|
|
procedure GenLorLnd (op: icptr);
|
|
|
|
{ Generate code for a pc_lor or pc_lnd }
|
|
|
|
var
|
|
lab1,lab2: integer; {label}
|
|
nd: icptr; {temp node pointer}
|
|
opc: pcodes; {operation code}
|
|
|
|
|
|
procedure DoOra;
|
|
|
|
{ do some common oring operations to reduce space }
|
|
|
|
begin {DoOra}
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
|
|
GenImplied(m_pla);
|
|
end {if}
|
|
else
|
|
GenNative(m_stx_dir, direct, dworkLoc, nil, 0);
|
|
GenNative(m_ora_dir, direct, dworkLoc, nil, 0);
|
|
end; {DoOra}
|
|
|
|
|
|
begin {GenLorLnd}
|
|
opc := op^.opcode;
|
|
lab1 := GenLabel;
|
|
gLong.preference := A_X;
|
|
GenTree(op^.left);
|
|
DoOra;
|
|
|
|
lab2 := GenLabel;
|
|
if opc = pc_lnd then
|
|
GenNative(m_bne, relative, lab2, nil, 0)
|
|
else begin
|
|
GenNative(m_beq, relative, lab2, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
end; {else}
|
|
GenNative(m_brl, longrelative, lab1, nil, 0);
|
|
GenLab(lab2);
|
|
|
|
gLong.preference := A_X;
|
|
GenTree(op^.right);
|
|
DoOra;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
end; {GenLorLnd}
|
|
|
|
|
|
procedure GenMov (op: icptr; duplicate: boolean);
|
|
|
|
{ Generate code for a pc_mov }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - pc_mov instruction }
|
|
{ duplicate - should the dest address be left on the }
|
|
{ stack? }
|
|
|
|
var
|
|
banks: integer; {number of banks to move}
|
|
|
|
|
|
procedure Load (opcode: integer; op: icptr);
|
|
|
|
{ generate a load immediate based on instruction type }
|
|
{ }
|
|
{ parameters: }
|
|
{ opcode - native code load operation }
|
|
{ op - node to load }
|
|
|
|
var
|
|
i: integer;
|
|
|
|
begin {Load}
|
|
if op^.opcode = pc_lao then
|
|
GenNative(opcode, immediate, op^.q, op^.lab, 0)
|
|
else if op^.opcode = pc_lca then begin
|
|
GenNative(opcode, immediate, stringsize, nil, StringReference);
|
|
if maxstring-stringsize >= op^.q then begin
|
|
for i := 1 to op^.q do
|
|
stringspace^[i+stringsize] := op^.str^.str[i];
|
|
stringsize := stringsize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
end {else if}
|
|
else {if op^.opcode = pc_lda then} begin
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, LabelToDisp(op^.r) + op^.q, nil, 0);
|
|
if opcode = m_ldy_imm then
|
|
GenImplied(m_tay)
|
|
else
|
|
GenImplied(m_tax);
|
|
end; {else}
|
|
end; {Load}
|
|
|
|
|
|
begin {GenMov}
|
|
banks := op^.r;
|
|
{determine if the destination address must be left on the stack}
|
|
if (banks = 0)
|
|
and (op^.q <> 0)
|
|
and (not duplicate)
|
|
and ((op^.left^.opcode in [pc_lca,pc_lda])
|
|
or ((op^.left^.opcode = pc_lao) and smallMemoryModel))
|
|
and ((op^.right^.opcode in [pc_lca,pc_lda])
|
|
or ((op^.right^.opcode = pc_lao) and smallMemoryModel)) then begin
|
|
|
|
{take advantage of any available short cuts}
|
|
Load(m_ldy_imm, op^.left);
|
|
Load(m_ldx_imm, op^.right);
|
|
GenNative(m_lda_imm, immediate, op^.q-1, nil, 0);
|
|
GenImplied(m_phb);
|
|
GenImplied(m_mvn);
|
|
with op^.left^ do
|
|
if opcode = pc_lao then
|
|
GenNative(d_bmov, immediate, q, lab, shift16)
|
|
else if opcode = pc_lca then
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16)
|
|
else {if opcode = pc_lda then}
|
|
GenNative(d_bmov, immediate, 0, nil, 0);
|
|
with op^.right^ do
|
|
if opcode = pc_lao then
|
|
GenNative(d_bmov, immediate, q, lab, shift16)
|
|
else if opcode = pc_lca then
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16)
|
|
else {if opcode = pc_lda then}
|
|
GenNative(d_bmov, immediate, 0, nil, 0);
|
|
GenImplied(m_plb);
|
|
end {if}
|
|
else begin
|
|
|
|
{no short cuts are available - do it the hard way}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
if banks <> 0 then
|
|
GenNative(m_pea, immediate, banks, nil, 0);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
if banks = 0 then begin
|
|
if duplicate then
|
|
GenCall(55)
|
|
else
|
|
GenCall(54);
|
|
end {if}
|
|
else
|
|
if duplicate then
|
|
GenCall(63)
|
|
else
|
|
GenCall(62);
|
|
end; {else}
|
|
end; {GenMov}
|
|
|
|
|
|
procedure GenMpi (op: icptr);
|
|
|
|
{ Generate code for a pc_mpi or pc_umi }
|
|
|
|
var
|
|
nd: icptr;
|
|
val: integer;
|
|
|
|
begin {GenMpi}
|
|
if ((op^.left^.opcode = pc_ldc) or (op^.right^.opcode = pc_ldc))
|
|
and ((op^.opcode = pc_umi) or (not rangeCheck)) then begin
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
val := op^.left^.q;
|
|
nd := op^.right;
|
|
end {if}
|
|
else begin
|
|
val := op^.right^.q;
|
|
nd := op^.left;
|
|
end; {else}
|
|
if nd^.opcode = pc_ldc then
|
|
GenNative(m_lda_imm, immediate, ord(ord4(val) * ord4(nd^.q)), nil, 0)
|
|
else begin
|
|
GenTree(nd);
|
|
case val of
|
|
0: GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
|
|
1,2,4,8,16,32,64,128:
|
|
while not odd(val) do begin
|
|
GenImplied(m_asl_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
|
|
256,512,1024,2048,4096,8192,16384: begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
GenImplied(m_xba);
|
|
val := val >> 8;
|
|
while not odd(val) do begin
|
|
GenImplied(m_asl_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
end;
|
|
|
|
3,5,6,9,10,12,17,18,20,24,33,34,36,40,48,65,66,68,72,80,96: begin
|
|
if odd(val) then {prevent lda+pha -> pei optimization}
|
|
GenLab(GenLabel);
|
|
while not odd(val) do begin
|
|
GenImplied(m_asl_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
GenImplied(m_pha);
|
|
val := val - 1;
|
|
while not odd(val) do begin
|
|
GenImplied(m_asl_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end;
|
|
|
|
-1,-2,-4,-8,-16,-32,-64,-128: begin
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_ina);
|
|
val := -val;
|
|
while not odd(val) do begin
|
|
GenImplied(m_asl_a);
|
|
val := val >> 1;
|
|
end; {while}
|
|
end;
|
|
|
|
-256: begin
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_ina);
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
GenImplied(m_xba);
|
|
end;
|
|
|
|
otherwise: begin
|
|
if val = $8000 then begin
|
|
GenImplied(m_lsr_a);
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0);
|
|
GenImplied(m_ror_a);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, val, nil, 0);
|
|
if op^.opcode = pc_mpi then
|
|
GenCall(28)
|
|
else {pc_umi}
|
|
GenCall(94);
|
|
end; {else}
|
|
end;
|
|
end; {case}
|
|
end; {else}
|
|
end {if}
|
|
else 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) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else
|
|
LoadX(op^.right);
|
|
if op^.opcode = pc_mpi then begin
|
|
GenCall(28);
|
|
if rangeCheck then
|
|
GenCall(25);
|
|
end {if}
|
|
else {pc_umi}
|
|
GenCall(94);
|
|
end; {else}
|
|
end; {GenMpi}
|
|
|
|
|
|
procedure GenNam (op: icptr);
|
|
|
|
{ Generate code for a pc_nam }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
|
|
begin {GenNam}
|
|
{generate a call to install the name in the traceback facility}
|
|
if traceBack then begin
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16);
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference);
|
|
GenCall(5);
|
|
namePushed := true;
|
|
end; {if}
|
|
|
|
{send the name to the profiler}
|
|
if profileFlag then begin
|
|
GenNative(m_cop, immediate, 3, nil, 0);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16);
|
|
end; {if}
|
|
|
|
{place the name in the string buffer}
|
|
if maxString-stringSize >= op^.q+1 then begin
|
|
stringSpace^[stringSize+1] := chr(op^.q);
|
|
for i := 1 to op^.q do
|
|
stringSpace^[i+stringSize+1] := op^.str^.str[i];
|
|
stringSize := stringSize + op^.q + 1;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
|
|
{send the file name to the debugger}
|
|
if debugFlag then
|
|
GenDebugSourceFile(@debugSourceFileGS);
|
|
end; {GenNam}
|
|
|
|
|
|
procedure GenNat (op: icptr);
|
|
|
|
{ Generate code for a pc_nat }
|
|
|
|
var
|
|
flags: integer; {work var for flags}
|
|
mode: addressingmode; {work var for addressing mode}
|
|
pval: longint; {temp pointer}
|
|
val: longint; {constant operand}
|
|
opcode: integer; {opcode}
|
|
|
|
begin {GenNat}
|
|
val := op^.opnd;
|
|
flags := op^.q;
|
|
pval := op^.llab;
|
|
mode := addressingMode(op^.r);
|
|
opcode := op^.s;
|
|
if opcode < 256 then
|
|
opcode := opcode | asmFlag;
|
|
if op^.slab <> 0 then
|
|
val := val+LabelToDisp(op^.slab);
|
|
if mode in [relative,longrelative] then
|
|
GenNative(opcode, mode, op^.llab, op^.lab, op^.q)
|
|
else if (mode = longabsolute) and (op^.llab <> 0) then
|
|
GenNative(opcode, mode, long(val).lsw, pointer(pval),
|
|
flags | localLab)
|
|
else if (mode = longabsolute) and (op^.llab = 0)
|
|
and (op^.lab = nil) then
|
|
GenNative(opcode, mode, 0, pointer(val), flags | constantOpnd)
|
|
else begin
|
|
if (mode = absolute) and (op^.llab = 0) then
|
|
flags := flags | constantOpnd;
|
|
if op^.llab <> 0 then
|
|
GenNative(opcode, mode, long(val).lsw, pointer(pval),
|
|
flags | localLab)
|
|
else
|
|
GenNative(opcode, mode, long(val).lsw, op^.lab, flags);
|
|
end; {else}
|
|
end; {GenNat}
|
|
|
|
|
|
procedure GenNgr (op: icptr);
|
|
|
|
{ Generate code for a pc_ngr }
|
|
|
|
begin {GenNgr}
|
|
GenTree(op^.left);
|
|
GenNative(m_lda_s, direct, 9, nil, 0);
|
|
GenNative(m_eor_imm, immediate, -32767-1, nil, 0);
|
|
GenNative(m_sta_s, direct, 9, nil, 0);
|
|
end; {GenNgr}
|
|
|
|
|
|
procedure GenPop (op: icptr);
|
|
|
|
{ Generate code for a pc_pop }
|
|
|
|
var
|
|
isIncLoad: boolean; {is the operand one of the inc/dec & load commands?}
|
|
|
|
begin {GenPop}
|
|
glong.preference := A_X; {generate the operand}
|
|
gQuad.preference := nowhere;
|
|
isIncLoad := op^.left^.opcode in
|
|
[pc_lil,pc_lli,pc_ldl,pc_lld,pc_gil,pc_gli,pc_gdl,pc_gld,
|
|
pc_iil,pc_ili,pc_idl,pc_ild];
|
|
if isIncLoad then
|
|
skipLoad := true;
|
|
if op^.left^.opcode = pc_mov then
|
|
GenMov(op^.left, false)
|
|
else if op^.left^.opcode in [pc_cop,pc_cpo,pc_cpi,pc_cbf] then begin
|
|
if op^.left^.opcode = pc_cop then
|
|
op^.left^.opcode := pc_str
|
|
else if op^.left^.opcode = pc_cpo then
|
|
op^.left^.opcode := pc_sro
|
|
else if op^.left^.opcode = pc_cpi then
|
|
op^.left^.opcode := pc_sto
|
|
else {if op^.left^.opcode = pc_cbf then}
|
|
op^.left^.opcode := pc_sbf;
|
|
GenTree(op^.left);
|
|
end {else if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
if isIncLoad then
|
|
skipLoad := false;
|
|
case op^.optype of {do the pop}
|
|
otherwise: Error(cge1);
|
|
|
|
cgByte, cgUByte, cgWord, cgUWord, cgVoid: ;
|
|
|
|
cgLong, cgULong:
|
|
if not isIncLoad then
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_pla);
|
|
end; {if}
|
|
{else do nothing}
|
|
|
|
cgQuad, cgUQuad: 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;
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 10, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end;
|
|
end; {case}
|
|
end; {else}
|
|
end; {GenPop}
|
|
|
|
|
|
procedure GenPsh (op: icptr);
|
|
|
|
{ Generate code for a pc_psh }
|
|
|
|
begin {GenPsh}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
GenImplied(m_pha);
|
|
GenCall(77);
|
|
end; {GenPsh}
|
|
|
|
|
|
procedure GenRbo (op: icptr);
|
|
|
|
{ Generate code for a pc_rbo }
|
|
|
|
begin {GenRbo}
|
|
GenTree(op^.left);
|
|
GenImplied(m_xba);
|
|
end; {GenRbo}
|
|
|
|
|
|
procedure GenRealBinOp (op: icptr);
|
|
|
|
{ Generate code for a pc_adr, pc_dvr, pc_mpr or pc_sbr }
|
|
|
|
var
|
|
nd: icptr; {temp pointer}
|
|
snum: integer; {library subroutine numbers}
|
|
ss,sd,sc,se: integer; {sane call numbers}
|
|
|
|
begin {GenRealBinOp}
|
|
case op^.opcode of
|
|
pc_adr: begin
|
|
snum := 56;
|
|
ss := $0200;
|
|
sd := $0100;
|
|
sc := $0500;
|
|
se := $0000;
|
|
end;
|
|
|
|
pc_dvr: begin
|
|
snum := 57;
|
|
ss := $0206;
|
|
sd := $0106;
|
|
sc := $0506;
|
|
se := $0006;
|
|
end;
|
|
|
|
pc_mpr: begin
|
|
snum := 58;
|
|
ss := $0204;
|
|
sd := $0104;
|
|
sc := $0504;
|
|
se := $0004;
|
|
end;
|
|
|
|
pc_sbr: begin
|
|
snum := 59;
|
|
ss := $0202;
|
|
sd := $0102;
|
|
sc := $0502;
|
|
se := $0002;
|
|
end;
|
|
end; {case}
|
|
|
|
if op^.opcode in [pc_mpr,pc_adr] then
|
|
if op^.left^.opcode in [pc_lod,pc_ldo] then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
GenTree(op^.left);
|
|
if (op^.right^.opcode in [pc_lod,pc_ldo]) and (floatCard = 0) then
|
|
with op^.right^ do begin
|
|
if opcode = pc_lod then begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, LabelToDisp(r) + q, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
end; {else}
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 7, nil, 0);
|
|
GenImplied(m_pha);
|
|
if optype = cgReal then
|
|
sd := ss
|
|
else if optype = cgExtended then
|
|
sd := se
|
|
else if optype = cgComp then
|
|
sd := sc;
|
|
GenNative(m_pea, immediate, sd, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, $090A, nil, 0);
|
|
GenNative(m_jsl, longAbs, 0, nil, toolCall);
|
|
end {with}
|
|
else begin
|
|
GenTree(op^.right);
|
|
GenCall(snum);
|
|
end; {else}
|
|
end; {GenRealBinOp}
|
|
|
|
|
|
procedure GenRetRev (op: icptr);
|
|
|
|
{ Generate code for a pc_ret or pc_rev }
|
|
|
|
var
|
|
size: integer; {localSize + parameterSize}
|
|
lab1: integer; {label}
|
|
valuePushed: boolean; {return value pushed on stack?}
|
|
evaluateAtEnd: boolean; {evaluate return val right before rtl?}
|
|
|
|
begin {GenRetRev}
|
|
size := localSize + parameterSize;
|
|
evaluateAtEnd := false;
|
|
|
|
{calculate return value, if necessary}
|
|
if op^.opcode = pc_rev then begin
|
|
if op^.left^.opcode in [pc_ldc,pc_lca,pc_lao,pc_lad] then begin
|
|
evaluateAtEnd := true;
|
|
valuePushed := false;
|
|
end {if}
|
|
else begin
|
|
valuePushed := namePushed or debugFlag or profileFlag
|
|
or ((parameterSize <> 0) and (size > 253));
|
|
if valuePushed then
|
|
gLong.preference := onStack
|
|
else
|
|
gLong.preference := A_X;
|
|
GenTree(op^.left);
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
if valuePushed then
|
|
GenImplied(m_pha)
|
|
else
|
|
GenImplied(m_tay);
|
|
end {if}
|
|
else {if op^.optype in [cgLong,cgULong] then} begin
|
|
valuePushed := gLong.where = onStack;
|
|
if not valuePushed then
|
|
GenImplied(m_tay);
|
|
end; {else}
|
|
end; {else}
|
|
end;
|
|
|
|
{pop the name record}
|
|
if namePushed then
|
|
GenCall(2);
|
|
|
|
{generate an exit code for the debugger/profiler's benefit}
|
|
if debugFlag or profileFlag then
|
|
GenNative(m_cop, immediate, 4, nil, 0);
|
|
|
|
{if anything needs to be removed from the stack, move the return address}
|
|
if parameterSize <> 0 then begin
|
|
if localSize > 253 then begin
|
|
GenNative(m_ldx_imm, immediate, localSize+1, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenNative(m_ldy_dirx, direct, 1, nil, 0);
|
|
GenNative(m_ldx_imm, immediate,
|
|
localSize+parameterSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
GenNative(m_sty_dirx, direct, 1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_dir, direct, localSize+2, nil, 0);
|
|
if localSize+parameterSize > 253 then begin
|
|
GenNative(m_ldx_imm, immediate,
|
|
localSize+parameterSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 1, nil, 0);
|
|
GenNative(m_lda_dir, direct, localSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_sta_dir, direct,
|
|
localSize+parameterSize+2, nil, 0);
|
|
GenNative(m_lda_dir, direct, localSize+1, nil, 0);
|
|
GenNative(m_sta_dir, direct,
|
|
localSize+parameterSize+1, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end; {if}
|
|
|
|
if op^.opcode = pc_rev then begin
|
|
if valuePushed then begin
|
|
if size = 2 then
|
|
GenImplied(m_pla)
|
|
else
|
|
GenImplied(m_ply);
|
|
if op^.optype in [cgLong,cgULong] then
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else if not evaluateAtEnd then
|
|
if size = 2 then
|
|
GenImplied(m_tya);
|
|
end {if}
|
|
else
|
|
case op^.optype of {load the value to return}
|
|
|
|
cgVoid: ;
|
|
|
|
cgByte,cgUByte: begin
|
|
GenNative(m_lda_dir, direct, funLoc, nil, 0);
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
end; {if}
|
|
if size <> 2 then
|
|
GenImplied(m_tay);
|
|
end;
|
|
|
|
cgWord,cgUWord:
|
|
if size = 2 then
|
|
GenNative(m_lda_dir, direct, funLoc, nil, 0)
|
|
else
|
|
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
|
|
|
|
cgReal:
|
|
GenCall(3);
|
|
|
|
cgDouble:
|
|
GenCall(4);
|
|
|
|
cgComp:
|
|
GenCall(64);
|
|
|
|
cgExtended:
|
|
GenCall(65);
|
|
|
|
cgLong,cgULong: begin
|
|
GenNative(m_ldx_dir, direct, funLoc+2, nil, 0);
|
|
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
|
|
end;
|
|
|
|
cgQuad,cgUQuad: ; {return value was already written}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{restore data bank reg}
|
|
if dataBank then begin
|
|
GenNative(m_pei_dir, direct, bankLoc, nil, 0);
|
|
GenImplied(m_plb);
|
|
GenImplied(m_plb);
|
|
end; {if}
|
|
|
|
{get rid of the stack frame space}
|
|
if size <> 0 then
|
|
GenImplied(m_pld);
|
|
if size = 2 then
|
|
GenImplied(m_ply)
|
|
else if size <> 0 then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, size, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end; {if}
|
|
|
|
{put return value in correct place}
|
|
case op^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
if evaluateAtEnd then
|
|
GenTree(op^.left)
|
|
else if size <> 2 then
|
|
GenImplied(m_tya);
|
|
if toolParms then {save value on stack for tools}
|
|
GenNative(m_sta_s, direct, returnSize+1, nil, 0);
|
|
end;
|
|
|
|
cgLong,cgULong,cgReal,cgDouble,cgComp,cgExtended: begin
|
|
if evaluateAtEnd then begin
|
|
gLong.preference := A_X;
|
|
GenTree(op^.left);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
end {if}
|
|
else if size <> 2 then
|
|
GenImplied(m_tya);
|
|
if toolParms then begin {save value on stack for tools}
|
|
GenNative(m_sta_s, direct, returnSize+1, nil, 0);
|
|
GenImplied(m_txa);
|
|
GenNative(m_sta_s, direct, returnSize+3, nil, 0);
|
|
end; {if}
|
|
end;
|
|
|
|
cgVoid,cgQuad,cgUQuad: ;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{return to the caller}
|
|
GenImplied(m_rtl);
|
|
end; {GenRetRev}
|
|
|
|
|
|
procedure GenSbfCbf (op: icptr);
|
|
|
|
{ Generate code for a pc_sbf or pc_cbf }
|
|
|
|
begin {GenSbfCbf}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, op^.r, nil, 0);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
if op^.optype in [cgLong,cgULong] then begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenTree(op^.right);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
if op^.opcode = pc_sbf then
|
|
GenCall(74)
|
|
else begin
|
|
GenCall(75);
|
|
if not (op^.optype in [cgLong,cgULong]) then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
end; {else}
|
|
end; {GenSbfCbf}
|
|
|
|
|
|
procedure GenSbi (op: icptr);
|
|
|
|
{ Generate code for a pc_sbi }
|
|
|
|
begin {GenSbi}
|
|
if Complex(op^.right) then begin
|
|
GenTree(op^.right);
|
|
if Complex(op^.left) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.left);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenImplied(m_sec);
|
|
OperA(m_adc_imm, op^.left);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
GenImplied(m_sec);
|
|
OperA(m_sbc_imm, op^.right);
|
|
end; {else}
|
|
end; {GenSbi}
|
|
|
|
|
|
procedure GenStk (op: icptr);
|
|
|
|
{ Generate code for a pc_stk }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {GenStk}
|
|
if op^.left^.opcode = pc_psh then begin
|
|
if (op^.left^.right^.opcode = pc_ldc) and
|
|
(op^.left^.right^.optype in [cgWord,cgUWord]) then
|
|
argsSize := argsSize + op^.left^.right^.q
|
|
else
|
|
Error(cge1);
|
|
end {if}
|
|
else
|
|
case op^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord:
|
|
argsSize := argsSize + cgWordSize;
|
|
cgReal,cgDouble,cgComp,cgExtended:
|
|
argsSize := argsSize + cgExtendedSize;
|
|
cgLong,cgULong:
|
|
argsSize := argsSize + cgLongSize;
|
|
cgQuad,cgUQuad:
|
|
argsSize := argsSize + cgQuadSize;
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
glong.preference := onStack; {generate the operand}
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
if op^.optype in {do the stk}
|
|
[cgByte, cgUByte, cgWord, cgUWord] then
|
|
GenImplied(m_pha);
|
|
end; {GenStk}
|
|
|
|
|
|
procedure GenShlShrUsr (op: icptr);
|
|
|
|
{ Generate code for a pc_shl, pc_shr or pc_usr }
|
|
|
|
var
|
|
i,op1,op2,op3,num: integer; {temp variables}
|
|
|
|
begin {GenShlShrUsr}
|
|
{get the standard native operations}
|
|
if op^.opcode = pc_shl then begin
|
|
op1 := m_asl_a;
|
|
op2 := m_lsr_a;
|
|
op3 := m_ror_a;
|
|
end {if}
|
|
else begin
|
|
op1 := m_lsr_a;
|
|
op2 := m_asl_a;
|
|
op3 := m_rol_a;
|
|
end; {else}
|
|
|
|
{take short cuts if they are legal}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.opcode <> pc_shr) then begin
|
|
num := op^.right^.q;
|
|
if (num > 16) or (num < -16) then
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0)
|
|
else if num > 0 then begin
|
|
GenTree(op^.left);
|
|
if num in [13..15] then begin
|
|
for i := 1 to 17-num do
|
|
GenImplied(op3);
|
|
if op^.opcode = pc_shl then
|
|
i := $ffff << num
|
|
else
|
|
i := $7fff >> (num-1);
|
|
GenNative(m_and_imm, immediate, i, nil, 0);
|
|
end {if}
|
|
else begin
|
|
if num >= 8 then begin
|
|
GenImplied(m_xba);
|
|
if op1 = m_lsr_a then
|
|
i := $00FF
|
|
else
|
|
i := $FF00;
|
|
GenNative(m_and_imm, immediate, i, nil, 0);
|
|
num := num-8;
|
|
end; {if}
|
|
for i := 1 to num do
|
|
GenImplied(op1);
|
|
end; {else}
|
|
end {else if}
|
|
else if num < 0 then begin
|
|
GenTree(op^.left);
|
|
if num <= -8 then begin
|
|
GenImplied(m_xba);
|
|
if op2 = m_lsr_a then
|
|
i := $00FF
|
|
else
|
|
i := $FF00;
|
|
GenNative(m_and_imm, immediate, i, nil, 0);
|
|
num := num+8;
|
|
end; {if}
|
|
for i := 1 to -num do
|
|
GenImplied(op2);
|
|
end {else if}
|
|
else
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
if Complex(op^.right) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_tax);
|
|
GenImplied(m_pla);
|
|
end {if}
|
|
else
|
|
LoadX(op^.right);
|
|
if op^.opcode = pc_shl then
|
|
GenCall(23)
|
|
else if op^.opcode = pc_shr then
|
|
GenCall(24)
|
|
else {if op^.opcode = pc_usr then}
|
|
GenCall(41);
|
|
end; {else}
|
|
end; {GenShlShrUsr}
|
|
|
|
|
|
procedure GenTl1 (op: icptr);
|
|
|
|
{ Generate code for a pc_tl1 }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
tp: baseTypeEnum; {operand type}
|
|
|
|
begin {GenTl1}
|
|
if op^.r in [2,4] then begin
|
|
GenImplied(m_pha);
|
|
if op^.r = 4 then
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
GenNative(m_ldx_imm, immediate, op^.q, nil, 0);
|
|
GenNative(m_jsl, longAbs, 0, pointer(op^.lval), toolCall);
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, 0, @'~TOOLERROR', 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, 0, @'~TOOLERROR', 0);
|
|
if op^.r in [2,4] then begin
|
|
if op^.r = 2 then begin
|
|
GenImplied(m_pla);
|
|
tp := cgWord;
|
|
end {if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
tp := cgLong;
|
|
end; {else}
|
|
end; {if}
|
|
end; {GenTl1}
|
|
|
|
|
|
procedure GenTri (op: icptr);
|
|
|
|
{ Generate code for a pc_tri }
|
|
|
|
var
|
|
lab1,lab2,lab3: integer; {label for branches}
|
|
|
|
begin {GenTri}
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
lab3 := GenLabel;
|
|
GenTree(op^.left);
|
|
if NeedsCondition(op^.left^.opcode) then
|
|
GenImpliedForFlags(m_tax);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_brl, longrelative, lab2, nil, 0);
|
|
GenLab(lab1);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right^.right);
|
|
GenNative(m_brl, longrelative, lab3, nil, 0);
|
|
GenLab(lab2);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right^.left);
|
|
GenLab(lab3);
|
|
gLong.where := onStack;
|
|
end; {GenTri}
|
|
|
|
|
|
procedure GenXjp (op: icptr);
|
|
|
|
{ Generate code for a pc_xjp }
|
|
|
|
var
|
|
lab1,lab2: integer;
|
|
q: integer;
|
|
|
|
begin {GenXjp}
|
|
q := op^.q;
|
|
GenTree(op^.left);
|
|
GenNative(m_cmp_imm, immediate, q, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, q, nil, 0);
|
|
GenLab(lab1);
|
|
GenImplied(m_asl_a);
|
|
GenImplied(m_tax);
|
|
lab1 := GenLabel;
|
|
GenNative(m_jmp_indX, absolute, lab1, nil, 0);
|
|
GenLab(lab1);
|
|
end; {GenXjp}
|
|
|
|
|
|
procedure DirEnp;
|
|
|
|
{ Generate code for a dc_enp }
|
|
|
|
begin {DirEnp}
|
|
GenImplied(d_end);
|
|
EndSeg;
|
|
InitLabels;
|
|
end; {DirEnp}
|
|
|
|
|
|
procedure DirStr (op: icptr);
|
|
|
|
{ Generate code for a dc_str }
|
|
|
|
begin {DirStr}
|
|
skipLoad := false;
|
|
InitNative;
|
|
Header(op^.lab, op^.r, op^.q);
|
|
end; {DirStr}
|
|
|
|
|
|
procedure DirSym (op: icptr);
|
|
|
|
{ Generate code for a dc_sym }
|
|
|
|
begin {DirSym}
|
|
if debugFlag then
|
|
GenNative(d_sym, special, op^.q, pointer(op^.lab), 0);
|
|
end; {DirSym}
|
|
|
|
|
|
begin {GenTree}
|
|
{write('GEN: '); WriteCode(op); {debug}
|
|
Spin;
|
|
case op^.opcode of
|
|
dc_cns: GenNative(d_cns, gnrConstant, op^.q, pointer(op), 0);
|
|
dc_dst: GenNative(d_lab, gnrSpace, op^.q, nil, 0);
|
|
dc_enp: DirEnp;
|
|
dc_lab: GenLab(op^.q);
|
|
dc_loc,dc_prm: ;
|
|
dc_glb: GenNative(d_lab, gnrLabel, op^.r, op^.lab, isPrivate*op^.q);
|
|
dc_pin: GenNative(d_pin, special, 0, nil, 0);
|
|
dc_str: DirStr(op);
|
|
dc_sym: DirSym(op);
|
|
pc_add: GenNative(d_add, genaddress, op^.q, nil, 0);
|
|
pc_adi: GenAdi(op);
|
|
pc_adl,pc_sbl: GenAdlSbl(op, nil);
|
|
pc_adq,pc_sbq: GenAdqSbq(op);
|
|
pc_adr,pc_dvr,pc_mpr,pc_sbr: GenRealBinOp(op);
|
|
pc_and,pc_bnd,pc_bor,pc_bxr,pc_ior: GenLogic(op);
|
|
pc_blr,pc_blx,pc_bal,pc_dvl,pc_mdl,pc_mpl,pc_sll,pc_slr,pc_udl,pc_ulm,
|
|
pc_uml,pc_vsr: GenBinLong(op);
|
|
pc_bqr,pc_bqx,pc_baq,pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm,pc_slq,
|
|
pc_sqr,pc_wsr: GenBinQuad(op);
|
|
pc_bnl,pc_ngl: GenUnaryLong(op);
|
|
pc_bnq,pc_ngq: GenUnaryQuad(op);
|
|
pc_bno: GenBno(op);
|
|
pc_bnt,pc_ngi,pc_not: GenBntNgiNot(op);
|
|
pc_cnv: GenCnv(op);
|
|
pc_cui: GenCui(op);
|
|
pc_cup: GenCup(op);
|
|
pc_dec,pc_inc: GenIncDec(op, nil);
|
|
pc_dvi,pc_mod,pc_udi,pc_uim: GenDviMod(op);
|
|
pc_ent: GenEnt(op);
|
|
pc_equ,pc_neq: GenEquNeq(op, op^.opcode, 0);
|
|
pc_fix: GenFix(op);
|
|
pc_fjp,pc_tjp: GenFjpTjp(op);
|
|
pc_geq,pc_grt,pc_leq,pc_les: GenCmp(op, op^.opcode, 0);
|
|
pc_gil,pc_gli,pc_gdl,pc_gld: GenGilGliGdlGld(op);
|
|
pc_iil,pc_ili,pc_idl,pc_ild: GenIilIliIdlIld(op);
|
|
pc_ind: GenInd(op);
|
|
pc_ixa: GenIxa(op);
|
|
pc_lao,pc_lad: GenLaoLad(op);
|
|
pc_lbf,pc_lbu: GenLbfLbu(op);
|
|
pc_lca: GenLca(op);
|
|
pc_lda: GenLda(op);
|
|
pc_ldc: GenLdc(op);
|
|
pc_ldo: GenLdo(op);
|
|
pc_lil,pc_lli,pc_ldl,pc_lld: GenLilLliLdlLld(op);
|
|
pc_lnm: GenLnm(op);
|
|
pc_lod: GenLod(op);
|
|
pc_lor,pc_lnd: GenLorLnd(op);
|
|
pc_mov: GenMov(op, true);
|
|
pc_mpi,pc_umi: GenMpi(op);
|
|
pc_nam: GenNam(op);
|
|
pc_nat: GenNat(op);
|
|
pc_ngr: GenNgr(op);
|
|
pc_nop: ;
|
|
pc_pop: GenPop(op);
|
|
pc_psh: GenPsh(op);
|
|
pc_rbo: GenRbo(op);
|
|
pc_ret,pc_rev: GenRetRev(op);
|
|
pc_sbf,pc_cbf: GenSbfCbf(op);
|
|
pc_sbi: GenSbi(op);
|
|
pc_shl,pc_shr,pc_usr: GenShlShrUsr(op);
|
|
pc_stk: GenStk(op);
|
|
pc_sro,pc_cpo: GenSroCpo(op);
|
|
pc_sto,pc_cpi: GenStoCpi(op);
|
|
pc_str,pc_cop: GenStrCop(op);
|
|
pc_tl1: GenTl1(op);
|
|
pc_tri: GenTri(op);
|
|
pc_ujp: GenNative(m_brl, longrelative, op^.q, nil, 0);
|
|
pc_xjp: GenXjp(op);
|
|
|
|
otherwise: Error(cge1);
|
|
end; {case}
|
|
end; {GenTree}
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure Gen {blk: blockPtr};
|
|
|
|
{ Generates native code for a list of blocks }
|
|
{ }
|
|
{ parameters: }
|
|
{ blk - first of the list of blocks }
|
|
|
|
const
|
|
locSize = 4; {variables <= this size allocated first}
|
|
|
|
var
|
|
bk: blockPtr; {used to trace block lists}
|
|
minSize: integer; {location for the next local label}
|
|
op: icptr; {used to trace code lists}
|
|
|
|
|
|
procedure DirLoc1 (op: icptr);
|
|
|
|
{ allocates stack frame locations for small dc_loc }
|
|
|
|
begin {DirLoc1}
|
|
if op^.q <= locSize then begin
|
|
if op^.r < maxLocalLabel then begin
|
|
localLabel[op^.r] := minSize;
|
|
minSize := minSize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge2);
|
|
end; {if}
|
|
end; {DirLoc1}
|
|
|
|
|
|
procedure DirLoc2 (op: icptr);
|
|
|
|
{ allocates stack frame locations for large dc_loc }
|
|
|
|
begin {DirLoc2}
|
|
if op^.q > locSize then begin
|
|
if op^.r < maxLocalLabel then begin
|
|
localLabel[op^.r] := minSize;
|
|
minSize := minSize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge2);
|
|
end; {if}
|
|
end; {DirLoc2}
|
|
|
|
|
|
procedure DirPrm (op: icptr);
|
|
|
|
{ allocates stack frame locations for parameters }
|
|
|
|
begin {DirPrm}
|
|
if op^.s < maxLocalLabel then
|
|
localLabel[op^.s] := localSize + returnSize + 1 + op^.r
|
|
else
|
|
Error(cge2);
|
|
end; {DirPrm}
|
|
|
|
|
|
procedure Scan (op: icptr);
|
|
|
|
{ scans the code stream for instructions that effect the }
|
|
{ size of the stack frame }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - scan this opcode and its children }
|
|
|
|
var
|
|
opcode: pcodes; {op^.opcode}
|
|
size: integer; {function return value size}
|
|
|
|
begin {Scan}
|
|
if op^.left <> nil then
|
|
Scan(op^.left);
|
|
if op^.right <> nil then
|
|
Scan(op^.right);
|
|
opcode := op^.opcode;
|
|
if opcode = dc_loc then
|
|
localSize := localSize + op^.q
|
|
else if opcode = dc_prm then
|
|
parameterSize := parameterSize + op^.q
|
|
else if opcode = pc_ret then begin
|
|
case op^.optype of
|
|
otherwise: size := 0;
|
|
cgByte,cgUByte,cgWord,cgUWord: size := cgWordSize;
|
|
cgReal: size := cgRealSize;
|
|
cgDouble: size := cgDoubleSize;
|
|
cgComp: size := cgCompSize;
|
|
cgExtended: size := cgExtendedSize;
|
|
cgLong,cgULong: size := cgLongSize;
|
|
cgQuad,cgUQuad: begin
|
|
size := cgLongSize; {pointer}
|
|
isQuadFunction := true;
|
|
end;
|
|
end; {case}
|
|
funLoc := 1;
|
|
if dworkLoc <> 0 then
|
|
dworkLoc := dworkLoc + size;
|
|
minSize := minSize + size;
|
|
localSize := localSize + size;
|
|
end {else if}
|
|
else if opcode in
|
|
[pc_les,pc_leq,pc_grt,pc_geq,pc_sto,pc_cpi,pc_ind,pc_lor,pc_lnd,
|
|
pc_ili,pc_iil,pc_idl,pc_ild,pc_ixa]
|
|
then begin
|
|
if dworkLoc = 0 then begin
|
|
dworkLoc := minSize;
|
|
minSize := minSize + 4;
|
|
localSize := localSize + 4;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {Scan}
|
|
|
|
|
|
begin {Gen}
|
|
bk := blk; {determine the size of the stack frame}
|
|
localSize := 0;
|
|
parameterSize := 0;
|
|
funLoc := 0;
|
|
dworkLoc := 0;
|
|
minSize := 1;
|
|
stackSaveDepth := 0;
|
|
isQuadFunction := false;
|
|
while bk <> nil do begin
|
|
op := bk^.code;
|
|
while op <> nil do begin
|
|
Scan(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
bk := bk^.next;
|
|
end; {while}
|
|
if saveStack or checkStack then begin
|
|
stackLoc := minSize;
|
|
minSize := minSize + 2;
|
|
localSize := localSize + 2;
|
|
end; {if}
|
|
if dataBank then begin
|
|
bankLoc := minSize;
|
|
minSize := minSize + 2;
|
|
localSize := localSize + 2;
|
|
end; {if}
|
|
bk := blk; {allocate locations for the values}
|
|
while bk <> nil do begin
|
|
op := bk^.code;
|
|
while op <> nil do begin
|
|
if op^.opcode = dc_loc then
|
|
DirLoc1(op)
|
|
else if op^.opcode = dc_prm then
|
|
DirPrm(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
bk := bk^.next;
|
|
end; {while}
|
|
bk := blk;
|
|
while bk <> nil do begin
|
|
op := bk^.code;
|
|
while op <> nil do begin
|
|
if op^.opcode = dc_loc then
|
|
DirLoc2(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
bk := bk^.next;
|
|
end; {while}
|
|
while blk <> nil do begin {generate code for the block}
|
|
op := blk^.code;
|
|
while op <> nil do begin
|
|
GenTree(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
blk := blk^.next;
|
|
end; {while}
|
|
end; {Gen}
|
|
|
|
|
|
function LabelToDisp {lab: integer): integer};
|
|
|
|
{ convert a local label number to a stack frame displacement }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label number }
|
|
|
|
begin {LabelToDisp}
|
|
if lab = 0 then
|
|
LabelToDisp := funLoc
|
|
else
|
|
LabelToDisp := localLabel[lab];
|
|
end; {LabelToDisp}
|
|
|
|
end.
|