mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-22 07:30:54 +00:00
8b4213cd5a
This could happen in certain cases where the condition codes might not be set at expected. The following program gives an example:
#pragma optimize 1
#include <stdio.h>
int one(void) {return 1;}
int negative_one(void) {return -1;}
int main(void) {
puts((one() + negative_one()) ? "A" : "B");
}
This could also occur if the condition used the % operator, particularly after the recent changes to it.
Also, add unsigned multiplication, division, and modulo operations to the list of those that may not set the condition codes based on the result value, both in this and other contexts.
Detected based on several programs from FizzBuzz-C.
5784 lines
180 KiB
ObjectPascal
5784 lines
180 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
|
|
A_X = 1; {longword locations}
|
|
onStack = 2;
|
|
inPointer = 4;
|
|
localAddress = 8;
|
|
globalLabel = 16;
|
|
constant = 32;
|
|
|
|
{stack frame locations}
|
|
{---------------------}
|
|
returnSize = 3; {size of return address}
|
|
|
|
type
|
|
{possible locations for 4 byte values}
|
|
longType = record {desciption of current four byte value}
|
|
preference: integer; {where you want the value}
|
|
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;
|
|
|
|
var
|
|
gLong: longType; {info about last long 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}
|
|
|
|
{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 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];
|
|
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 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}
|
|
|
|
|
|
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;
|
|
lab1 := GenLabel;
|
|
if rOpcode = pc_fjp then begin
|
|
if op^.optype in [cgByte,cgWord] then begin
|
|
if NeedsCondition(op^.left^.opcode) then
|
|
GenImplied(m_tax);
|
|
if (num >= 0) and (num < 4) then begin
|
|
if op^.opcode = pc_geq 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}
|
|
else {if opcode = pc_grt then} begin
|
|
lab2 := GenLabel;
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
for i := 0 to num do
|
|
GenImplied(m_dea);
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
GenLab(lab2);
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else if}
|
|
end {if (num >= 0) and (num < 4)}
|
|
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);
|
|
if op^.opcode = pc_grt then begin
|
|
lab3 := GenLabel;
|
|
GenNative(m_beq, relative, lab3, nil, 0);
|
|
GenNative(m_bcs, relative, lab2, nil, 0);
|
|
GenLab(lab3);
|
|
end
|
|
else
|
|
GenNative(m_bcs, relative, lab2, nil, 0);
|
|
if num > 0 then begin
|
|
GenLab(lab1);
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
GenLab(lab2);
|
|
end; {else if}
|
|
end {if}
|
|
else {if optype in [cgUByte,cgUWord] then} begin
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
if op^.opcode = pc_grt then begin
|
|
lab2 := GenLabel;
|
|
GenNative(m_beq, relative, lab2, nil, 0);
|
|
end; {if}
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
if op^.opcode = pc_grt then
|
|
GenLab(lab2);
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end {if rOpcode = pc_fjp}
|
|
else if rOpcode = pc_tjp then begin
|
|
if op^.optype in [cgByte,cgWord] then begin
|
|
if NeedsCondition(op^.left^.opcode) then
|
|
GenImplied(m_tax);
|
|
if (num >= 0) and (num < 4) then begin
|
|
lab2 := GenLabel;
|
|
if op^.opcode = pc_geq 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, lab2, nil, 0);
|
|
end; {if}
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
end {if}
|
|
else {if op^.opcode = pc_grt then} begin
|
|
if num > 0 then begin
|
|
GenNative(m_bmi, relative, lab1, nil, 0);
|
|
for i := 0 to num do
|
|
GenImplied(m_dea);
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
end; {else}
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
end; {else}
|
|
GenLab(lab2);
|
|
GenLab(lab1);
|
|
end {if (num >= 0) and (num < 4)}
|
|
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);
|
|
if op^.opcode = pc_grt then begin
|
|
lab3 := GenLabel;
|
|
GenNative(m_beq, relative, lab3, nil, 0);
|
|
end; {if}
|
|
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}
|
|
if op^.opcode = pc_grt then
|
|
GenLab(lab3);
|
|
end; {else}
|
|
end {if}
|
|
else {if optype in [cgUByte,cgUWord] then} begin
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
if op^.opcode = pc_grt then begin
|
|
lab2 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
end; {if}
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
if op^.opcode = pc_grt then
|
|
GenLab(lab2);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end {if rOpcode = pc_tjp}
|
|
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);
|
|
if op^.opcode = pc_grt then begin
|
|
lab3 := GenLabel;
|
|
GenNative(m_beq, relative, lab3, nil, 0);
|
|
end; {if}
|
|
GenNative(m_bvs, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
if op^.opcode = pc_grt then
|
|
GenLab(lab3);
|
|
GenImplied(m_dex);
|
|
GenLab(lab2);
|
|
GenImplied(m_txa);
|
|
end {else if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
if op^.opcode = pc_grt then
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
GenImplied(m_txa);
|
|
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);
|
|
if op^.opcode = pc_grt then
|
|
GenLab(lab3);
|
|
GenLab(lab2);
|
|
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}
|
|
|
|
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;
|
|
|
|
byteToWord = $02;
|
|
byteToUword = $03;
|
|
byteToLong = $04;
|
|
byteToUlong = $05;
|
|
byteToReal = $06;
|
|
byteToDouble = $07;
|
|
ubyteToLong = $14;
|
|
ubyteToUlong = $15;
|
|
ubyteToReal = $16;
|
|
ubyteToDouble = $17;
|
|
wordToByte = $20;
|
|
wordToUByte = $21;
|
|
wordToLong = $24;
|
|
wordToUlong = $25;
|
|
wordToReal = $26;
|
|
wordToDouble = $27;
|
|
uwordToByte = $30;
|
|
uwordToUByte = $31;
|
|
uwordToLong = $34;
|
|
uwordToUlong = $35;
|
|
uwordToReal = $36;
|
|
uwordToDouble = $37;
|
|
longTobyte = $40;
|
|
longToUbyte = $41;
|
|
longToWord = $42;
|
|
longToUword = $43;
|
|
longToReal = $46;
|
|
longToDouble = $47;
|
|
longToVoid = $4B;
|
|
ulongTobyte = $50;
|
|
ulongToUbyte = $51;
|
|
ulongToWord = $52;
|
|
ulongToUword = $53;
|
|
ulongToReal = $56;
|
|
ulongToDouble = $57;
|
|
ulongToVoid = $5B;
|
|
realTobyte = $60;
|
|
realToUbyte = $61;
|
|
realToWord = $62;
|
|
realToUword = $63;
|
|
realToLong = $64;
|
|
realToUlong = $65;
|
|
realToVoid = $6B;
|
|
doubleTobyte = $70;
|
|
doubleToUbyte = $71;
|
|
doubleToWord = $72;
|
|
doubleToUword = $73;
|
|
doubleToLong = $74;
|
|
doubleToUlong = $75;
|
|
|
|
var
|
|
fromReal: boolean; {are we converting from a real?}
|
|
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 & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin
|
|
op^.q := (op^.q & $000F) | (cReal * 16);
|
|
fromReal := true;
|
|
end {if}
|
|
else
|
|
fromReal := false;
|
|
if (op^.q & $000F) in [cDouble,cExtended,cComp] then
|
|
op^.q := (op^.q & $00F0) | cReal;
|
|
GenTree(op^.left);
|
|
if op^.q in [wordToLong,wordToUlong] then begin
|
|
lab1 := GenLabel;
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
GenImplied(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 {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 {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 [wordToByte,wordToUbyte,uwordToByte,uwordToUbyte] then
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0)
|
|
else if op^.q in [byteToReal,uByteToReal,wordToReal] then
|
|
GenCall(11)
|
|
else if op^.q = uwordToReal then begin
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
GenCall(12);
|
|
end {else if}
|
|
else if op^.q in [longToByte,longToUbyte,ulongToByte,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 [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);
|
|
end {else}
|
|
else if op^.q in [realToByte,realToUbyte,realToWord] then begin
|
|
GenCall(14);
|
|
if (op^.q & $00FF) in [0,1] then
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
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 & $000F) = cVoid then
|
|
{do nothing}
|
|
else 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; {else if}
|
|
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: integer; {label numbers}
|
|
bne: integer; {instruction for a pc_equ bne branch}
|
|
beq: integer; {instruction for a pc_equ beq branch}
|
|
lLong: longType; {local long value information}
|
|
leftOp,rightOp: pcodes; {opcode codes to left, right}
|
|
|
|
|
|
procedure DoOr (op: icptr);
|
|
|
|
{ or the two halves of a four byte value }
|
|
{ }
|
|
{ parameters: }
|
|
{ operand to or }
|
|
|
|
var
|
|
disp: integer; {disp of value on stack frame}
|
|
|
|
begin {DoOr}
|
|
with op^ do begin
|
|
if opcode = pc_ldo then begin
|
|
if smallMemoryModel then begin
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
GenNative(m_ora_abs, absolute, q+2, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longabsolute, q, lab, 0);
|
|
GenNative(m_ora_long, longabsolute, q+2, lab, 0);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
disp := LabelToDisp(r) + q;
|
|
if disp < 254 then begin
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
GenNative(m_ora_dir, direct, disp+2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirX, direct, 0, nil, 0);
|
|
GenNative(m_ora_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end; {with}
|
|
end; {DoOr}
|
|
|
|
|
|
procedure DoCmp (op: icPtr);
|
|
|
|
{ compare a long value in A_X to a local or global scalar }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - value to compare to }
|
|
|
|
var
|
|
disp: integer; {disp of value on stack frame}
|
|
lab1: integer; {label numbers}
|
|
|
|
begin {DoCmp}
|
|
lab1 := GenLabel;
|
|
with op^ do begin
|
|
if opcode = pc_ldo then begin
|
|
GenNative(m_cmp_abs, absolute, q, lab, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenNative(m_cpx_abs, absolute, q+2, lab, 0);
|
|
end {if}
|
|
else begin
|
|
disp := LabelToDisp(r) + q;
|
|
if disp < 254 then begin
|
|
GenNative(m_cmp_dir, direct, disp, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenNative(m_cpx_dir, direct, disp+2, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_txy);
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_cmp_dirX, direct, 0, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_cmp_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
GenLab(lab1);
|
|
end; {with}
|
|
end; {DoCmp}
|
|
|
|
|
|
begin {GenEquNeq}
|
|
if op^.opcode = pc_equ then begin
|
|
bne := m_bne;
|
|
beq := m_beq;
|
|
end {if}
|
|
else begin
|
|
bne := m_beq;
|
|
beq := m_bne;
|
|
end; {else}
|
|
if op^.left^.opcode in [pc_lod,pc_ldo] then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
if op^.left^.opcode = pc_ldc then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
leftOp := op^.left^.opcode; {set op codes for fast access}
|
|
rightOp := op^.right^.opcode;
|
|
if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and
|
|
(rightOp = pc_ldc) then begin
|
|
GenTree(op^.left);
|
|
num := op^.right^.q;
|
|
lab1 := GenLabel;
|
|
if opcode in [pc_fjp,pc_tjp] then begin
|
|
if num <> 0 then
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0)
|
|
else if NeedsCondition(leftOp) then
|
|
GenImplied(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,cgSet,cgString}
|
|
|
|
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
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
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}
|
|
end; {GenIncDec}
|
|
|
|
|
|
procedure GenInd (op: icptr);
|
|
|
|
{ Generate code for a pc_ind }
|
|
|
|
var
|
|
lab1: integer; {label}
|
|
lLong: longType; {requested address type}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
q: integer; {op^.q}
|
|
|
|
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
|
|
if q = 0 then
|
|
if gLong.fixedDisp then
|
|
GenNative(m_lda_indl, direct, gLong.disp, nil, 0)
|
|
else
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0)
|
|
else
|
|
if gLong.fixedDisp then begin
|
|
GenNative(m_ldy_imm, immediate, q, nil, 0);
|
|
GenNative(m_lda_indly, direct, gLong.disp, nil, 0)
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tya);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, q, nil, 0);
|
|
GenImplied(m_tay);
|
|
GenNative(m_lda_indly, direct, gLong.disp, 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}
|
|
|
|
otherwise: ;
|
|
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: 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);
|
|
GenNative(m_cmp_imm, immediate, 0, nil, 0);
|
|
lab2 := GenLabel;
|
|
if opcode = pc_and 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);
|
|
GenTree(op^.right);
|
|
GenNative(m_cmp_imm, immediate, 0, nil, 0);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
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_and,pc_bnd: GenNative(m_and_s, direct, 1, nil, 0);
|
|
pc_ior,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_and,pc_bnd: OperA(m_and_imm, op^.right);
|
|
pc_ior,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
|
|
GenCall(51)
|
|
else if optype = cgDouble then
|
|
GenCall(52)
|
|
else if optype = cgComp then
|
|
GenCall(68)
|
|
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}
|
|
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?}
|
|
|
|
|
|
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);
|
|
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
|
|
GenTree(op^.right);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
if optype = cgReal then begin
|
|
if opcode = pc_sto then
|
|
GenCall(9)
|
|
else
|
|
GenCall(51);
|
|
end {if}
|
|
else if optype = cgDouble then begin
|
|
if opcode = pc_sto then
|
|
GenCall(10)
|
|
else
|
|
GenCall(52);
|
|
end {else if}
|
|
else if optype = cgComp then begin
|
|
if opcode = pc_sto then
|
|
GenCall(66)
|
|
else
|
|
GenCall(68);
|
|
end {else if}
|
|
else {if optype = cgExtended then} begin
|
|
if opcode = pc_sto then
|
|
GenCall(67)
|
|
else
|
|
GenCall(69);
|
|
end; {else}
|
|
end; {case cgReal,cgDouble,cgComp,cgExtended}
|
|
|
|
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
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
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
|
|
GenCall(51)
|
|
else if optype = cgDouble then
|
|
GenCall(52)
|
|
else if optype = cgComp then
|
|
GenCall(68)
|
|
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;
|
|
|
|
otherwise: ;
|
|
|
|
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 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 GenBno (op: icptr);
|
|
|
|
{ Generate code for a pc_bno }
|
|
|
|
var
|
|
lLong: longType; {requested address type}
|
|
|
|
begin {GenBno}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
GenTree(op^.right);
|
|
end; {GenBno}
|
|
|
|
|
|
procedure GenBntNgiNot (op: icptr);
|
|
|
|
{ Generate code for a pc_bnt, pc_ngi or pc_not }
|
|
|
|
var
|
|
lab1: integer;
|
|
|
|
begin {GenntNgiNot}
|
|
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
|
|
lab1 := GenLabel;
|
|
GenImplied(m_tax);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
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}
|
|
|
|
begin {GenCui}
|
|
{save the stack register}
|
|
if saveStack or checkStack or (op^.q <> 0) then begin
|
|
if stackSaveDepth <> 0 then begin
|
|
GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
|
|
GenImplied(m_phx);
|
|
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}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
|
|
{get the address to call}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
gLong := lLong;
|
|
|
|
{create a return label}
|
|
lab1 := GenLabel;
|
|
|
|
{place the call/return addrs on stack}
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenImplied(m_dea);
|
|
GenImplied(m_pha);
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_s, direct, 5, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
GenNative(m_lda_imm, genAddress, lab1, nil, shift16);
|
|
GenNative(m_sta_s, direct, 6, nil, 0);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_imm, genAddress, lab1, nil, 0);
|
|
GenNative(m_sta_s, direct, 4, nil, 0);
|
|
|
|
{indirect call}
|
|
GenImplied(m_rtl);
|
|
GenLab(lab1);
|
|
|
|
if checkStack 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 or (op^.q <> 0) then begin
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord]) 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]) 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;
|
|
SaveRetValue(op^.optype);
|
|
end; {GenCui}
|
|
|
|
|
|
procedure GenCup (op: icptr);
|
|
|
|
{ Generate code for a pc_cup }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
|
|
begin {GenCup}
|
|
{save the stack register}
|
|
if saveStack or checkStack or (op^.q <> 0) then begin
|
|
if stackSaveDepth <> 0 then begin
|
|
GenNative(m_ldx_dir, direct, stackLoc, nil, 0);
|
|
GenImplied(m_phx);
|
|
end; {if}
|
|
GenImplied(m_tsx);
|
|
GenNative(m_stx_dir, direct, stackLoc, nil, 0);
|
|
stackSaveDepth := stackSaveDepth + 1;
|
|
end; {if}
|
|
|
|
{generate parameters}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
|
|
{generate the jsl}
|
|
GenNative(m_jsl, longAbs, 0, op^.lab, 0);
|
|
|
|
{check the stack for errors}
|
|
if checkStack 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 or (op^.q <> 0) then begin
|
|
stackSaveDepth := stackSaveDepth - 1;
|
|
if not (op^.optype in [cgVoid,cgByte,cgUByte,cgWord,cgUWord]) 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]) 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;
|
|
SaveRetValue(op^.optype);
|
|
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: integer; {label number}
|
|
|
|
begin {GenDviMod}
|
|
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 {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
LoadX(op^.right);
|
|
end; {else}
|
|
opcode := op^.opcode;
|
|
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 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 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
|
|
GenImplied(m_tax)
|
|
else if opcode = pc_ind then
|
|
if op^.left^.optype in [cgByte,cgUByte] then
|
|
GenImplied(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+1 then begin
|
|
for i := 1 to op^.q do
|
|
stringSpace[i+stringSize] := op^.str^.str[i];
|
|
stringSpace[stringSize+op^.q+1] := chr(0);
|
|
stringSize := stringSize+op^.q+1;
|
|
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, vreal); {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);
|
|
vreal: (r: double);
|
|
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;
|
|
|
|
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}
|
|
|
|
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
|
|
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;
|
|
|
|
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 source 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 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}
|
|
end; {Load}
|
|
|
|
|
|
begin {GenMov}
|
|
{determine if the destination address must be left on the stack}
|
|
if smallMemoryModel
|
|
and (not duplicate)
|
|
and (op^.left^.opcode in [pc_lao,pc_lca])
|
|
and (op^.right^.opcode in [pc_lao,pc_lca]) 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
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16);
|
|
with op^.right^ do
|
|
if opcode = pc_lao then
|
|
GenNative(d_bmov, immediate, q, lab, shift16)
|
|
else
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16);
|
|
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);
|
|
banks := op^.r;
|
|
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;
|
|
|
|
begin {GenMpi}
|
|
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
|
|
GenCall(28)
|
|
else {pc_umi}
|
|
GenCall(39);
|
|
if rangeCheck then
|
|
GenCall(25);
|
|
end; {GenMpi}
|
|
|
|
|
|
procedure GenNam (op: icptr);
|
|
|
|
{ Generate code for a pc_nam }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
len: integer; {length of the file name}
|
|
|
|
|
|
function ToUpper (ch: char): char;
|
|
|
|
{ Return the uppercase equivalent of the input character }
|
|
|
|
begin {ToUpper}
|
|
if (ch >= 'a') and (ch <= 'z') then
|
|
ch := chr(ord(ch)-ord('a')+ord('A'));
|
|
ToUpper := ch;
|
|
end; {ToUpper}
|
|
|
|
|
|
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 begin
|
|
GenNative(m_cop, immediate, 6, nil, 0);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16);
|
|
len := sourceFileGS.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] :=
|
|
ToUpper(sourceFileGS.theString.theString[i]);
|
|
stringSize := stringSize + len + 1;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
end; {if}
|
|
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}
|
|
|
|
begin {GenNat}
|
|
val := op^.opnd;
|
|
flags := op^.q;
|
|
pval := op^.llab;
|
|
mode := addressingMode(op^.r);
|
|
if op^.slab <> 0 then
|
|
val := val+LabelToDisp(op^.slab);
|
|
if mode in [relative,longrelative] then
|
|
GenNative(op^.s, mode, op^.llab, op^.lab, op^.q)
|
|
else if (mode = longabsolute) and (op^.llab <> 0) then
|
|
GenNative(op^.s, mode, long(val).lsw, pointer(pval),
|
|
flags | localLab)
|
|
else if (mode = longabsolute) and (op^.llab = 0)
|
|
and (op^.lab = nil) then
|
|
GenNative(op^.s, 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(op^.s, mode, long(val).lsw, pointer(pval),
|
|
flags | localLab)
|
|
else
|
|
GenNative(op^.s, 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}
|
|
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 begin
|
|
GenTree(op^.left);
|
|
if isIncLoad then
|
|
skipLoad := false;
|
|
case op^.optype of {do the pop}
|
|
otherwise: ;
|
|
|
|
cgLong, cgULong:
|
|
if not isIncLoad then
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_pla);
|
|
end; {if}
|
|
{else do nothing}
|
|
|
|
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 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 GenRet (op: icptr);
|
|
|
|
{ Generate code for a pc_ret }
|
|
|
|
var
|
|
size: integer; {localSize + parameterSize}
|
|
|
|
begin {GenRet}
|
|
{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 val}
|
|
size := localSize + parameterSize;
|
|
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}
|
|
|
|
{load the value to return}
|
|
case op^.optype of
|
|
|
|
cgVoid: ;
|
|
|
|
cgByte,cgUByte: begin
|
|
GenNative(m_lda_dir, direct, funLoc, nil, 0);
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
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;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{restore data bank reg}
|
|
if dataBank then begin
|
|
GenNative(m_lda_dir, direct, bankLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
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 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
|
|
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: ;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{return to the caller}
|
|
GenImplied(m_rtl);
|
|
end; {GenRet}
|
|
|
|
|
|
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^.left) or 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}
|
|
glong.preference := onStack; {generate the operand}
|
|
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,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;
|
|
end {if}
|
|
else begin
|
|
op1 := m_lsr_a;
|
|
op2 := m_asl_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 >= 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 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
|
|
GenImplied(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_lda_longx, longAbs, lab1, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenImplied(m_rts);
|
|
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_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_bnl,pc_ngl: GenUnaryLong(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_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_ret: GenRet(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;
|
|
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;
|
|
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 or (strictVararg and hasVarargsCall) 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.
|