5979 lines
163 KiB
Plaintext
5979 lines
163 KiB
Plaintext
{$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,pc_dec]) then
|
|
GenIncDec(op^.left, op)
|
|
else begin
|
|
if smallMemoryModel and (op^.left^.opcode = pc_ldc)
|
|
and (op^.left^.q = 0) 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])
|
|
and (op^.left^.p = 0) 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; {else}
|
|
end;
|
|
|
|
cgWord, cgUWord:
|
|
if (opcode = pc_sro) and (op^.left^.opcode in [pc_inc,pc_dec]) then
|
|
GenIncDec(op^.left, op)
|
|
else begin
|
|
if smallMemoryModel and (op^.left^.opcode = pc_ldc)
|
|
and (op^.left^.q = 0) 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}
|
|
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(23)
|
|
else if optype = cgDouble then
|
|
GenCall(87)
|
|
else if optype = cgComp then
|
|
GenCall(157)
|
|
else {if optype = cgExtended then}
|
|
GenCall(158);
|
|
end {if}
|
|
else {if opcode = pc_cpo then} begin
|
|
if optype = cgReal then
|
|
GenCall(159)
|
|
else if optype = cgDouble then
|
|
GenCall(160)
|
|
else if optype = cgComp then
|
|
GenCall(161)
|
|
else {if optype = cgExtended then}
|
|
GenCall(162);
|
|
end; {else}
|
|
end;
|
|
|
|
cgSet: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, op^.r, lab, shift16);
|
|
GenNative(m_pea, immediate, op^.r, lab, 0);
|
|
GenNative(m_pea, immediate, q, nil, 0);
|
|
GenCall(24);
|
|
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 GenSto (op: icptr);
|
|
|
|
{ Generate code for a pc_sto }
|
|
|
|
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?}
|
|
preference: integer; {old preference}
|
|
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 <> A_X 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}
|
|
gLong.where := A_X;
|
|
if lLong.where = onStack then
|
|
if opcode = pc_sto then
|
|
GenImplied(m_pla)
|
|
else begin
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
gLong.where := onStack;
|
|
end {else}
|
|
else if lLong.where = A_X then
|
|
GenImplied(m_txa)
|
|
else
|
|
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, localLabel[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, longAbs, 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 {GenSto}
|
|
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(23)
|
|
else
|
|
GenCall(159);
|
|
end {if}
|
|
else if optype = cgDouble then begin
|
|
if opcode = pc_sto then
|
|
GenCall(87)
|
|
else
|
|
GenCall(160);
|
|
end {else if}
|
|
else if optype = cgComp then begin
|
|
if opcode = pc_sto then
|
|
GenCall(157)
|
|
else
|
|
GenCall(161);
|
|
end {else if}
|
|
else {if optype = cgExtended then} begin
|
|
if opcode = pc_sto then
|
|
GenCall(158)
|
|
else
|
|
GenCall(162);
|
|
end; {else}
|
|
end; {case cgReal,cgDouble,cgComp,cgExtended}
|
|
|
|
cgSet: begin
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
GenCall(24);
|
|
end;
|
|
|
|
cgLong,cgULong: begin
|
|
preference := gLong.preference;
|
|
gLong.preference := onStack+constant;
|
|
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}
|
|
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 := (localLabel[r] + q < 256) and (p = 0)
|
|
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 short then
|
|
if simple then
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
if gLong.where = inPointer then begin
|
|
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
|
|
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}
|
|
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 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 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
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {case cgByte,cgUByte,cgWord,cgUWord}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenSto}
|
|
|
|
|
|
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 := localLabel[op^.r] + op^.q;
|
|
optype := op^.optype;
|
|
case optype of
|
|
cgByte, cgUByte, cgWord, cgUWord: begin
|
|
if (op^.opcode = pc_str) and (op^.left^.opcode in [pc_inc,pc_dec]) then
|
|
GenIncDec(op^.left, op)
|
|
else begin
|
|
zero := false;
|
|
if op^.left^.opcode = pc_ldc then
|
|
if op^.opcode = pc_str then
|
|
if op^.p = 0 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)
|
|
and (op^.left^.p = 0) 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 op^.p <> 0 then begin
|
|
StaticLink(op^.p, true, false);
|
|
GenNative(m_sta_longx, longabsolute, disp, nil, 0);
|
|
end {if}
|
|
else 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 {else 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; {else}
|
|
end;
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
if op^.p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(op^.p, false, true);
|
|
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(23)
|
|
else if optype = cgDouble then
|
|
GenCall(87)
|
|
else if optype = cgComp then
|
|
GenCall(157)
|
|
else {if optype = cgExtended then}
|
|
GenCall(158);
|
|
end {if}
|
|
else begin
|
|
if optype = cgReal then
|
|
GenCall(159)
|
|
else if optype = cgDouble then
|
|
GenCall(160)
|
|
else if optype = cgComp then
|
|
GenCall(161)
|
|
else {if optype = cgExtended then}
|
|
GenCall(162);
|
|
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
|
|
if op^.p = 0 then
|
|
gLong.preference :=
|
|
A_X+onStack+inPointer+localAddress+globalLabel+constant
|
|
else
|
|
gLong.preference :=
|
|
onStack+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 op^.p <> 0 then begin
|
|
StaticLink(op^.p, false, false);
|
|
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_longX, longAbsolute, 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_longX, longAbsolute, disp+2, nil, 0);
|
|
end {if}
|
|
else 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 begin
|
|
GenNative(m_adc_s, direct, 1, nil, 0);
|
|
GenImplied(m_ply);
|
|
end; {if}
|
|
GenNative(m_sta_dirX, direct, 0, nil, 0);
|
|
GenNative(m_stz_dirX, direct, 2, nil, 0);
|
|
end; {else}
|
|
|
|
globalLabel: begin
|
|
if not gLong.fixedDisp then
|
|
GenImplied(m_txa)
|
|
else if disp > 253 then
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
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
|
|
GenNative(m_sta_dirX, direct, 2, nil, 0);
|
|
end;
|
|
|
|
constant:
|
|
if op^.p <> 0 then begin
|
|
StaticLink(op^.p, false, false);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
|
|
GenNative(m_sta_longX, longAbsolute, disp, nil, 0);
|
|
GenNative(m_lda_imm, immediate, long(gLong.lval).msw, nil, 0);
|
|
GenNative(m_sta_longX, longAbsolute, disp+2, nil, 0);
|
|
end {if}
|
|
else 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;
|
|
|
|
cgSet: begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
if op^.p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(op^.p, false, true);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_pea, immediate, op^.s, nil, 0);
|
|
GenCall(24);
|
|
end;
|
|
|
|
otherwise: ;
|
|
|
|
end; {case}
|
|
end; {GenStrCop}
|
|
|
|
|
|
procedure DirEnp;
|
|
|
|
{ Generate code for a dc_enp }
|
|
|
|
begin {DirEnp}
|
|
enpFound := true;
|
|
GenImplied(d_end);
|
|
EndSeg;
|
|
InitLabels;
|
|
end; {DirEnp}
|
|
|
|
|
|
{$optimize 15}
|
|
|
|
procedure GenTree {op: icptr};
|
|
|
|
{ generate code for op and its children }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - opcode for which to generate code }
|
|
|
|
|
|
procedure GenAbiBntNgiNotOddSqi (op: icptr);
|
|
|
|
{ Generate code for a pc_abi, pc_bnt, pc_ngi pc_not, pc_odd, pc_sqi }
|
|
|
|
var
|
|
lab1: integer;
|
|
|
|
begin {GenAbiBntNgiNotOddSqi}
|
|
GenTree(op^.left);
|
|
case op^.opcode of
|
|
pc_abi: begin
|
|
lab1 := GenLabel;
|
|
GenImplied(m_tax);
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenImplied(m_ina);
|
|
GenLab(lab1);
|
|
end;
|
|
|
|
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:
|
|
GenNative(m_eor_imm, immediate, 1, nil, 0);
|
|
|
|
pc_odd:
|
|
GenNative(m_and_imm, immediate, 1, nil, 0);
|
|
|
|
pc_sqi: begin
|
|
GenImplied(m_tax);
|
|
GenCall(32);
|
|
if rangeCheck then
|
|
GenCall(147);
|
|
end;
|
|
end; {case}
|
|
end; {GenAbiBntNgiNotOddSqi}
|
|
|
|
|
|
procedure GenAblBnlNglOdlSql (op: icptr);
|
|
|
|
{ Generate code for a pc_abl, pc_bnl, pc_ngl, pc_odl, pc_sql }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {GenAblBnlNglOdlSql}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
case op^.opcode of
|
|
pc_abl: begin
|
|
lab1 := GenLabel;
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
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);
|
|
GenLab(lab1);
|
|
end;
|
|
|
|
pc_bnl: begin
|
|
GenNative(m_lda_s, direct, 1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenNative(m_sta_s, direct, 1, nil, 0);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenNative(m_eor_imm, immediate, -1, nil, 0);
|
|
GenNative(m_sta_s, direct, 3, nil, 0);
|
|
end;
|
|
|
|
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;
|
|
|
|
pc_odl: begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
GenNative(m_and_imm, immediate, 1, nil, 0);
|
|
end;
|
|
|
|
pc_sql: begin
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_s, direct, 3, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenCall(133);
|
|
end;
|
|
end; {case}
|
|
gLong.where := onStack;
|
|
end; {GenAblBnlNglOdlSql}
|
|
|
|
|
|
procedure GenAbrNgr (op: icptr);
|
|
|
|
{ generate a pc_abr or pc_ngr }
|
|
|
|
begin {GenAbrNgr}
|
|
GenTree(op^.left);
|
|
GenNative(m_lda_s, direct, 9, nil, 0);
|
|
if op^.opcode = pc_abr then
|
|
GenNative(m_and_imm, immediate, $7FFF, nil, 0)
|
|
else {op^.opcode = pc_ngr}
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenNative(m_sta_s, direct, 9, nil, 0);
|
|
end; {GenAbrNgr}
|
|
|
|
|
|
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}
|
|
if rangeCheck then
|
|
GenCall(147);
|
|
end; {GenAdi}
|
|
|
|
|
|
procedure GenAt2 (op: icptr);
|
|
|
|
{ Generate code for a pc_at2 }
|
|
|
|
begin {GenAt2}
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
GenCall(123);
|
|
end; {GenAt2}
|
|
|
|
|
|
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}
|
|
|
|
|
|
procedure GenOp (ops, opi: integer);
|
|
|
|
{ generate a binary operation }
|
|
{ }
|
|
{ parameters: }
|
|
{ ops - stack version of operation }
|
|
{ opi - immediate version of operation }
|
|
|
|
var
|
|
lab1: integer; {label number}
|
|
|
|
begin {GenOp}
|
|
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}
|
|
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_mdl,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(134);
|
|
|
|
pc_mdl: GenCall(135);
|
|
|
|
pc_mpl: GenCall(133);
|
|
|
|
pc_sll: GenCall(136);
|
|
|
|
pc_slr: GenCall(171);
|
|
|
|
pc_udl: GenCall(173);
|
|
|
|
pc_ulm: GenCall(174);
|
|
|
|
pc_uml: GenCall(172);
|
|
|
|
pc_vsr: GenCall(170);
|
|
|
|
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 GenChk (op: icptr);
|
|
|
|
{ Generate code for a pc_chk }
|
|
|
|
begin {GenChk}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
case op^.optype of
|
|
otherwise:
|
|
Error(cge1);
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
GenNative(m_ldx_imm, immediate, op^.r, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, op^.q, nil, 0);
|
|
GenCall(33);
|
|
end;
|
|
cgLong,cgULong:
|
|
if (op^.lval = 1) and (op^.lval2 = maxaddr) then
|
|
GenCall(34)
|
|
else begin
|
|
GenNative(m_pea, immediate, long(op^.lval).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.lval2).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.lval2).lsw, nil, 0);
|
|
GenCall(179);
|
|
end; {else}
|
|
end; {case}
|
|
end; {GenChk}
|
|
|
|
|
|
procedure GenCsp (op: icptr);
|
|
|
|
{ Generate code for a pc_csp }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
|
|
begin {GenCsp}
|
|
lLong := gLong;
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
case op^.q of
|
|
otherwise:
|
|
Error(cge1);
|
|
1, {get from a file}
|
|
2, {put to a file}
|
|
3, {open}
|
|
4, {close}
|
|
5, {read an integer}
|
|
6, {read a real}
|
|
7, {read a character from a file}
|
|
8, {write a character to a file}
|
|
9, {write an integer to a file}
|
|
10, {write real to a file}
|
|
11, {new}
|
|
13, {readln}
|
|
14, {write an end of line}
|
|
15, {write a form feed}
|
|
17, {dispose}
|
|
26, {writeln to stout}
|
|
27, {writeln to errout}
|
|
35, {clear an area of memory}
|
|
44, {seek a file record}
|
|
45, {write a string}
|
|
46, {write a boolean}
|
|
48, {eof(f)}
|
|
49, {eoln(f)}
|
|
58, {read character from input}
|
|
59, {read int from input}
|
|
60, {readln(input)}
|
|
61, {read real from input}
|
|
62, {write real to output}
|
|
185, {eof(input)}
|
|
186: {eoln(input)}
|
|
GenCall(op^.q);
|
|
12: {writeln string}
|
|
GenCall(155);
|
|
19: {write string}
|
|
GenCall(153);
|
|
22: {writeln string to error out}
|
|
GenCall(156);
|
|
23: {write string to error out}
|
|
GenCall(154);
|
|
16,34,42,43: begin {variations on write integer}
|
|
GenNative(m_pea, immediate, ord((op^.q=34) or (op^.q=43)), nil, 0);
|
|
GenNative(m_pea, immediate, ord(op^.q>=42), nil, 0);
|
|
GenCall(21);
|
|
end;
|
|
20,21,24,25: begin {variations on write constant string}
|
|
GenNative(m_pea, immediate, ord(not odd(op^.q)), nil, 0);
|
|
GenNative(m_pea, immediate, ord(op^.q>=24), nil, 0);
|
|
GenCall(19);
|
|
end;
|
|
28,29,30,31: begin {variations on write boolean}
|
|
GenNative(m_pea, immediate, ord(not odd(op^.q)), nil, 0);
|
|
GenNative(m_pea, immediate, ord(op^.q>=30), nil, 0);
|
|
GenCall(20);
|
|
end;
|
|
32: begin {form feed to standard out}
|
|
GenNative(m_pea, immediate, 12, nil, 0);
|
|
GenCall(151);
|
|
end;
|
|
33: begin {form feed to error out}
|
|
GenNative(m_pea, immediate, 12, nil, 0);
|
|
GenCall(152);
|
|
end;
|
|
36,37,38,39: begin {variations on write character}
|
|
GenNative(m_pea, immediate, ord(not odd(op^.q)), nil, 0);
|
|
GenNative(m_pea, immediate, ord(op^.q>=38), nil, 0);
|
|
GenCall(22);
|
|
end;
|
|
40,41: {write a single character}
|
|
GenCall(151+op^.q-40);
|
|
50:
|
|
GenCall(109);
|
|
51, {pack}
|
|
52: {unpack}
|
|
GenCall(op^.q+74);
|
|
53: {write real to error out}
|
|
GenCall(128);
|
|
66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,82,85,
|
|
86,87,88,90,91,92,93:
|
|
GenCall(op^.q+25);
|
|
81, {cnvsl}
|
|
83: {random int and longint} begin
|
|
GenCall(op^.q+25);
|
|
if op^.optype = cgLong then
|
|
if (gLong.preference & A_X) = 0 then begin
|
|
gLong.where := onStack;
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end
|
|
else
|
|
gLong.where := A_X;
|
|
end;
|
|
84:
|
|
GenCall(79);
|
|
95: {nop};
|
|
96, {new open record}
|
|
97: {dispose open record}
|
|
GenCall(op^.q+35);
|
|
98, {read long from stin}
|
|
99: {read long from file} begin
|
|
GenCall(op^.q+42);
|
|
gLong.where := onStack;
|
|
end;
|
|
102: {write long to file}
|
|
GenCall(144);
|
|
100, {write long to stout}
|
|
101: {write long to errout} begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenNative(m_pea, immediate, ord(odd(op^.q)), nil, 0);
|
|
GenCall(143);
|
|
end;
|
|
115: {redirect input/output}
|
|
GenCall(148);
|
|
116: {four-byte new}
|
|
GenCall(180);
|
|
117: {Member}
|
|
GenCall(181);
|
|
118: {NewObject}
|
|
GenCall(182);
|
|
119,120: begin {FixString}
|
|
GenCall(op^.q + 64);
|
|
gLong.where := onStack;
|
|
end;
|
|
end; {case}
|
|
end; {GenCsp}
|
|
|
|
|
|
procedure GenCui (op: icptr);
|
|
|
|
{ Generate code for a pc_cui }
|
|
|
|
var
|
|
lab1: integer; {return point}
|
|
lLong: longType; {used to reserve gLong}
|
|
|
|
begin {GenCui}
|
|
{generate parameters}
|
|
lLong := gLong; {place the operands on the stack}
|
|
GenTree(op^.right);
|
|
gLong.preference := onStack; {get the address to call}
|
|
GenTree(op^.left^.left);
|
|
gLong := lLong;
|
|
|
|
lab1 := GenLabel; {create a return label}
|
|
GenNative(m_lda_s, direct, 1, nil, 0); {place the call/return addrs on stack}
|
|
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, sub1);
|
|
GenNative(m_sta_s, direct, 4, nil, 0);
|
|
|
|
GenTree(op^.left^.right); {get the static level}
|
|
GenImplied(m_tax);
|
|
|
|
GenImplied(m_rtl); {indirect call}
|
|
GenLab(lab1);
|
|
|
|
gLong.where := A_X; {save the returned value}
|
|
SaveRetValue(op^.optype);
|
|
end; {GenCui}
|
|
|
|
|
|
procedure GenCum (op: icptr);
|
|
|
|
{ Generate code for a pc_cum }
|
|
|
|
var
|
|
lab1, lab2: integer; {return point; jsl patch location}
|
|
sDisp: unsigned; {size of the parameters}
|
|
|
|
|
|
function Size (op: icptr): unsigned;
|
|
|
|
{ Find the length of the parameters in the tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to scan }
|
|
{ }
|
|
{ returns: Length of the parameters }
|
|
|
|
begin {Size}
|
|
if op^.opcode = pc_bno then
|
|
Size := Size(op^.left) + Size(op^.right)
|
|
else if op^.opcode = pc_stk then
|
|
case op^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: Size := cgWordSize;
|
|
cgLong,cgULong,cgString,cgVoid: Size := cgLongSize;
|
|
cgReal,cgDouble,cgComp,cgExtended: Size := cgExtendedSize;
|
|
cgSet: Size := op^.left^.q;
|
|
end {case}
|
|
else
|
|
Size := 0;
|
|
end; {Size}
|
|
|
|
|
|
begin {GenCum}
|
|
{generate parameters}
|
|
sDisp := Size(op^.left); {find the disp of the SELF parm}
|
|
GenTree(op^.left); {place the operands on the stack}
|
|
|
|
lab1 := GenLabel; {create a return/jsl label}
|
|
if jslOptimizations then begin
|
|
|
|
{use self-modifying code for an indirect call}
|
|
lab2 := GenLabel;
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_tcd);
|
|
GenNative(m_ldy_imm, immediate, long(op^.lval).lsw + 1, nil, 0);
|
|
GenNative(m_lda_indly, direct, sDisp - 1, nil, 0);
|
|
GenNative(m_sta_long, longAbs, lab2, nil, 0);
|
|
GenImplied(m_dey);
|
|
GenNative(m_lda_indly, direct, sDisp - 1, nil, 0);
|
|
GenNative(m_sta_long, longAbs, lab1, nil, 0);
|
|
GenImplied(m_pld);
|
|
GenImplied(m_jsl);
|
|
GenLab(lab1);
|
|
GenImplied(m_jsl);
|
|
GenLab(lab2);
|
|
GenImplied(m_jsl);
|
|
GenImplied(m_jsl);
|
|
end {if}
|
|
else begin
|
|
|
|
{do a ROMable indirect call}
|
|
|
|
{place the return addr on the stack}
|
|
GenImplied(m_phk);
|
|
GenNative(m_lda_imm, genAddress, lab1, nil, sub1);
|
|
GenImplied(m_pha);
|
|
|
|
{get the address to call}
|
|
if op^.lval < maxint-2 then begin
|
|
GenNative(m_lda_s, direct, sDisp+2, nil, 0);
|
|
GenNative(m_sta_dir, direct, dWorkLoc+2, nil, 0);
|
|
GenNative(m_lda_s, direct, sDisp, nil, 0);
|
|
GenNative(m_sta_dir, direct, dWorkLoc, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, long(op^.lval).lsw+2, nil, 0);
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_indly, direct, dWorkLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, long(op^.lval).lsw, nil, 0);
|
|
GenNative(m_lda_indly, direct, dWorkLoc, nil, 0);
|
|
GenImplied(m_dea);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_lda_s, direct, sDisp, nil, 0);
|
|
GenNative(m_adc_imm, immediate, long(op^.lval).lsw, nil, 0);
|
|
GenNative(m_sta_dir, direct, dWorkLoc, nil, 0);
|
|
GenNative(m_lda_s, direct, sDisp+2, nil, 0);
|
|
GenNative(m_adc_imm, immediate, long(op^.lval).msw, nil, 0);
|
|
GenNative(m_sta_dir, direct, dWorkLoc+2, nil, 0);
|
|
GenNative(m_ldy_imm, immediate, 2, nil, 0);
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_indly, direct, dWorkLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_indl, direct, dWorkLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
|
|
{indirect call}
|
|
GenImplied(m_rtl);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
|
|
gLong.where := A_X; {save the returned value}
|
|
SaveRetValue(op^.optype);
|
|
end; {GenCum}
|
|
|
|
|
|
procedure GenCup (op: icptr);
|
|
|
|
{ Generate code for a pc_cup }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
|
|
begin {GenCup}
|
|
{generate parameters}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
|
|
{create the static link}
|
|
if (op^.lab = nil) or (not noGlobalLabels) then begin
|
|
if op^.q = 0 then begin
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_tax);
|
|
end {if}
|
|
else
|
|
StaticLink(op^.q, false, false);
|
|
end; {if}
|
|
|
|
{generate the jsl}
|
|
if op^.lab = nil then
|
|
GenNative(m_jsl, longAbs, op^.r, nil, 0)
|
|
else
|
|
GenNative(m_jsl, longAbs, 0, op^.lab, 0);
|
|
|
|
{save the returned value}
|
|
gLong.where := A_X;
|
|
SaveRetValue(op^.optype);
|
|
end; {GenCup}
|
|
|
|
|
|
procedure GenDifIntUni (op: icptr);
|
|
|
|
{ Generate code for a pc_dif, pc_int, pc_uni }
|
|
|
|
var
|
|
snum: integer; {call number}
|
|
|
|
begin {GenDifIntUni}
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
case op^.opcode of
|
|
pc_dif: snum := 38;
|
|
pc_int: snum := 39;
|
|
|