Apple-2gs-SW/ORCA-Pascal
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-Pascal.git synced 2024-12-10 12:50:03 +00:00
Code Issues Projects Releases Wiki Activity
master
ORCA-Pascal/gen.pas
Kelvin Sherlock 386d7e2f74 support for gsbug / nifty list inline debug names
2018-03-25 21:49:31 -04:00

5979 lines
163 KiB
ObjectPascal
Raw Permalink Blame History

{$optimize -1}
{---------------------------------------------------------------}
{ }
{ Gen }
{ }
{ Generates native code from intermediate code instructions. }
{ }
{---------------------------------------------------------------}
unit Gen;
interface
{$segment 'gen'}
{$LibPrefix '0/obj/'}
uses PCommon, CGI, CGC, ObjOut, Native;
{---------------------------------------------------------------}
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: pStringPtr; {global label name}
end;
var
enpFound: boolean; {was the dc_enp found?}
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?}
{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}
staticLoc: integer; {loc of static link}
{---------------------------------------------------------------}
procedure GenTree (op: icptr); forward;
{---------------------------------------------------------------}
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 = pc_lod then
if op^.p = 0 then
if localLabel[op^.r] + op^.q < 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, localLabel[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: pStringPtr;
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_lod:
GenNative(m_ldx_dir, direct, localLabel[r] + q, nil, 0);
otherwise:
Error(cge1);
end; {case}
end; {LoadX}
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: begin
{this shortcut is valid for cmp, adc, and, ora, sbc, eor}
mop := mop+4;
if smallMemoryModel then
GenNative(mop, absolute, op^.q, op^.lab, 0)
else
GenNative(mop+2, longAbs, op^.q, op^.lab, 0);
end; {case pc_ldo}
pc_lod: begin
{this shortcut is valid for cmp, adc, and, ora, sbc, eor}
mop := mop-4;
loc := localLabel[op^.r];
loc := loc + op^.q;
GenNative(mop, direct, loc, nil, 0);
end; {case pc_lod}
pc_ldc:
GenNative(mop, immediate, op^.q, nil, 0);
otherwise:
Error(cge1);
end; {case}
end; {OperA}
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_cop,pc_cpo,pc_dvi,pc_mpi,pc_adi,pc_sbi,pc_mod,pc_bno];
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 localLabel[load^.r] + load^.q < 254 then
if save^.opcode = pc_str then
if save^.q = load^.q then
if save^.r = load^.r then
if save^.p = load^.p 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(85);
end; {SaveRetValue}
procedure StaticLink (levels: integer; guardA: boolean; inA: boolean);
{ Returns the start of the needed stack frame in X. }
{ }
{ parameters: }
{ levels - number of static levels to traverse }
{ guardA - if true, A is preserved }
{ inA - if true, the result is returned in A, rather than X }
{ }
{ Note: gardA and inA should not both be true }
var
i: integer; {loop variable}
begin {StaticLink}
if inA and (levels = 1) then
GenNative(m_lda_dir, direct, staticLoc, nil, 0)
else
GenNative(m_ldx_dir, direct, staticLoc, nil, 0);
if levels > 1 then begin
if guardA then
GenImplied(m_tay);
for i := 2 to levels do begin
GenNative(m_lda_longX, longAbsolute, staticLoc, nil, 0);
if not (inA and (levels = i)) then
GenImplied(m_tax);
end; {for}
if guardA then
GenImplied(m_tya);
end; {if}
end; {StaticLink}
{---------------------------------------------------------------}
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 localLabel[icode^.r] + icode^.q < 254 then
if icode^.p = 0 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 (save^.p = 0) 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 Simple(op^.right) and (save = nil) 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 := localLabel[save^.r] + save^.q;
if save^.p <> 0 then begin
StaticLink(save^.p, false, false);
GenImplied(m_pla);
GenNative(m_sta_longX, longAbsolute, disp, nil, 0);
GenImplied(m_pla);
GenNative(m_sta_longX, longAbsolute, disp+2, nil, 0);
end {if}
else 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}
nop: icptr; {new opcode}
procedure Switch;
{ switch the operands }
var
nd: icptr; {used to switch nodes}
t: integer; {used to switch string lengths}
begin {Switch}
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
if op^.optype = cgString then begin
t := op^.r;
op^.r := op^.q;
op^.q := t;
end; {if}
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 begin
if op^.left^.opcode = pc_ldc then begin
if rOpcode in [pc_tjp,pc_fjp] then begin
if op^.opcode = pc_geq then
op^.opcode := pc_grt
else
op^.opcode := pc_geq;
if rOpcode = pc_tjp then
rOpcode := pc_fjp
else
rOpcode := pc_tjp;
Switch;
end; {if}
end; {if}
{If constant operands are involved, change > to >= }
if op^.opcode = pc_grt then begin
if op^.left^.opcode = pc_ldc then begin
if (op^.left^.q > 0) or
((op^.optype in [cgWord, cgByte]) and (op^.left^.q > -maxint)) then
begin
nop := pointer(malloc(sizeof(intermediate_code)));
nop^ := op^.left^;
op^.left := nop;
nop^.q := nop^.q - 1;
op^.opcode := pc_geq;
end; {if}
end {if}
else if op^.right^.opcode = pc_ldc then
if op^.right^.q < maxint then begin
nop := pointer(malloc(sizeof(intermediate_code)));
nop^ := op^.right^;
op^.right := nop;
nop^.q := nop^.q + 1;
op^.opcode := pc_geq;
end; {if}
end; {if}
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);
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,cgSet: begin
GenTree(op^.left);
GenTree(op^.right);
if op^.opType = cgSet then
GenCall(74)
else {if op^.opType in [cgReal,cgDouble,cgComp,cgExtended] then}
if op^.opcode = pc_geq then
GenCall(71)
else
GenCall(70);
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,cgSet}
cgString: begin
gLong.preference := onStack;
GenTree(op^.left);
if op^.left^.opcode <> pc_csp then begin
if op^.r = -1 then begin
GenImplied(m_pha);
GenImplied(m_pha);
end; {if}
GenNative(m_pea, immediate, op^.r, nil, 0);
end; {if}
gLong.preference := onStack;
GenTree(op^.right);
if op^.right^.opcode <> pc_csp then begin
if op^.q = -1 then begin
GenImplied(m_pha);
GenImplied(m_pha);
end; {if}
GenNative(m_pea, immediate, op^.q, nil, 0);
end; {if}
if op^.opcode = pc_geq then
GenCall(73)
else
GenCall(72);
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 cgString}
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 := 139;
end {if}
else begin
gLong.preference := onStack;
GenTree(op^.right);
num := 138;
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;
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;
ulongTobyte = $50;
ulongToUbyte = $51;
ulongToWord = $52;
ulongToUword = $53;
ulongToReal = $56;
ulongToDouble = $57;
realTobyte = $60;
realToUbyte = $61;
realToWord = $62;
realToUword = $63;
realToLong = $64;
realToUlong = $65;
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,uWordToReal] then
GenCall(36)
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}
GenCall(166);
end {else}
else if op^.q in [realToByte,realToUbyte,realToWord,realToUWord] then begin
GenCall(37);
if (op^.q & $00FF) in [0,1] then
GenNative(m_and_imm, immediate, $00FF, nil, 0);
end {else if}
else if op^.q in [realToLong,realToUlong] then begin
GenCall(150);
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 (lLong.preference & gLong.where = 0)
and ((op^.q & $000F) <> ord(cgVoid)) 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
GenNative(m_lda_abs, absolute, q, lab, 0);
GenNative(m_ora_abs, absolute, q+2, lab, 0);
end {if}
else begin
disp := localLabel[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 {else 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 := localLabel[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^.optype <> cgString then begin
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}
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 = pc_ldo) or ((leftOp = pc_lod) and (op^.left^.p = 0)))
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 = pc_ldo) or ((rightOp = pc_lod) and (op^.right^.p = 0)))
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,cgSet: begin
gLong.preference := onStack;
GenTree(op^.left);
gLong.preference := onStack;
GenTree(op^.right);
if op^.optype = cgSet then
GenCall(30)
else
GenCall(31);
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: begin
gLong.preference := onStack;
GenTree(op^.left);
if op^.left^.opcode <> pc_csp then begin
if op^.r = -1 then begin
GenImplied(m_pha);
GenImplied(m_pha);
end; {if}
GenNative(m_pea, immediate, op^.r, nil, 0);
end; {if}
gLong.preference := onStack;
GenTree(op^.right);
if op^.right^.opcode <> pc_csp then begin
if op^.q = -1 then begin
GenImplied(m_pha);
GenImplied(m_pha);
end; {if}
GenNative(m_pea, immediate, op^.q, nil, 0);
end; {if}
GenCall(69);
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 cgString}
otherwise:
Error(cge1);
end; {case}
end; {GenEquNeq}
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}
short: boolean; {doing a one-byte save?}
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
if SameLoc(op^.left, save) and (save^.p = 0) and (size = 1) then begin
if opcode = pc_inc then
DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0)
else {if opcode = pc_dec then}
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0);
end {if}
else 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);
if rangeCheck then
GenCall(147);
end; {else if}
if save <> nil then begin
short := save^.optype in [cgByte,cgUByte];
if save^.opcode = pc_str then begin
disp := localLabel[save^.r] + save^.q;
if save^.p <> 0 then begin
StaticLink(save^.p, true, false);
if short then
GenNative(m_sep, immediate, 32, nil, 0);
GenNative(m_sta_longX, longAbsolute, disp, nil, 0);
end {if}
else if disp < 254 then begin
if short then
GenNative(m_sep, immediate, 32, nil, 0);
GenNative(m_sta_dir, direct, disp, nil, 0);
end {else if}
else begin
if short then
GenNative(m_sep, immediate, 32, nil, 0);
GenNative(m_ldx_imm, immediate, disp, nil, 0);
GenNative(m_sta_dirX, direct, 0, nil, 0);
end; {else}
end {else if}
else {if save^.opcode = pc_sro then} begin
if short then
GenNative(m_sep, immediate, 32, nil, 0);
if smallMemoryModel then
GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0)
else
GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0);
end; {else}
if short then
GenNative(m_rep, immediate, 32, nil, 0);
end; {if}
end {else}
end {if}
else if op^.optype in [cgLong,cgULong] then begin
if SameLoc(op^.left, save) and (save^.p = 0) 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 := localLabel[save^.r] + save^.q;
if save^.p <> 0 then begin
if gLong.where = A_X then begin
GenImplied(m_phx);
GenImplied(m_pha);
end; {if}
StaticLink(save^.p, false, false);
GenImplied(m_pla);
GenNative(m_sta_longX, longAbsolute, disp, nil, 0);
GenImplied(m_pla);
GenNative(m_sta_longX, longAbsolute, disp+2, nil, 0);
end {if}
else 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(25)
else if optype = cgDouble then
GenCall(18)
else if optype = cgComp then
GenCall(163)
else if optype = cgExtended then
GenCall(164);
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}
cgSet: begin
gLong.preference := onStack;
GenTree(op^.left);
if op^.r <> 0 then
IncAddr(op^.r);
GenNative(m_pea, immediate, q, nil, 0);
GenCall(28);
end; {case cgSet}
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}
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 (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 or (op^.right^.opcode = pc_ldc)}
else begin
gLong.preference := onStack;
GenTree(op^.left);
GenTree(op^.right);
if op^.optype in [cgByte,cgWord] 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 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 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; {GenLogic}
procedure GenSroCpo (op: icptr);
{ Generate code for a pc_sro or pc_cpo }
var
lab: pStringPtr; {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 (opcode = pc_sro) and (op^.left^.opcode in [pc_inc