5979 lines
163 KiB
ObjectPascal
5979 lines
163 KiB
ObjectPascal
{$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;
|
|
pc_uni: snum := 40;
|
|
end; {case}
|
|
GenCall(snum);
|
|
end; {GenDifIntUni}
|
|
|
|
|
|
procedure GenDviMod (op: icptr);
|
|
|
|
{ Generate code for a pc_dvi, pc_mod, pc_udi or pc_uim }
|
|
|
|
var
|
|
opcode: pcodes; {temp storage}
|
|
|
|
begin {GenDviMod}
|
|
if Complex(op^.right) then begin
|
|
GenTree(op^.right);
|
|
if Complex(op^.left) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.left);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_tax);
|
|
GenTree(op^.left);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
LoadX(op^.right);
|
|
end; {else}
|
|
opcode := op^.opcode;
|
|
if opcode = pc_mod then
|
|
GenCall(124)
|
|
else if opcode = pc_dvi then
|
|
GenCall(41)
|
|
else {if opcode in [pc_udi,pc_uim] then} begin
|
|
GenCall(165);
|
|
if opcode = pc_uim then
|
|
GenImplied(m_txa);
|
|
end; {else}
|
|
if rangeCheck then
|
|
GenCall(147);
|
|
end; {GenDviMod}
|
|
|
|
|
|
{ Generate code for a pc_ent }
|
|
procedure GenEnt(op: icptr);
|
|
var
|
|
i: integer;
|
|
len: integer;
|
|
|
|
begin {GenEnt}
|
|
|
|
if debugStrFlag then begin
|
|
len := length(op^.lab^);
|
|
CnOut(m_brl);
|
|
CnOut2(len + 3);
|
|
CnOut2($7771);
|
|
CnOut(len);
|
|
for i := 1 to len do
|
|
CnOut(ord(op^.lab^[i]));
|
|
end;
|
|
|
|
if rangeCheck then begin {if range checking is on, check for a stack overflow}
|
|
GenNative(m_pea, immediate, localSize - returnSize - 1, nil, 0);
|
|
GenCall(129);
|
|
end; {if}
|
|
|
|
if localSize = 0 then begin {create the stack frame}
|
|
if parameterSize <> 0 then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end; {if}
|
|
end {if}
|
|
else if localSize = 2 then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end {else if}
|
|
else begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_imm, immediate, localSize, nil, 0);
|
|
GenImplied(m_tcs);
|
|
GenImplied(m_phd);
|
|
GenImplied(m_tcd);
|
|
end; {if}
|
|
|
|
if staticLoc <> 0 then {set up the static link}
|
|
if localSize <> 2 then
|
|
GenNative(m_stx_dir, direct, staticLoc, nil, 0);
|
|
|
|
if dataBank then begin {preserve and set data bank}
|
|
GenImplied(m_phb);
|
|
GenImplied(m_phb);
|
|
GenImplied(m_pla);
|
|
GenNative(m_sta_dir, direct, bankLoc, nil, 0);
|
|
GenNative(m_pea, immediate, 0, @'~GLOBALS', shift8);
|
|
GenImplied(m_plb);
|
|
GenImplied(m_plb);
|
|
end; {if}
|
|
|
|
{no pc_nam (yet)}
|
|
namePushed := false;
|
|
end; {GenEnt}
|
|
|
|
|
|
procedure GenFix (op: icptr);
|
|
|
|
{ Generate code for a pc_fix }
|
|
|
|
begin {GenFix}
|
|
GenNative(m_pea, immediate, localLabel[op^.q], nil, 0);
|
|
if op^.optype = cgReal then
|
|
GenCall(83)
|
|
else if op^.optype = cgDouble then
|
|
GenCall(86)
|
|
else if op^.optype = cgComp then
|
|
GenCall(178)
|
|
end; {GenFix}
|
|
|
|
|
|
procedure GenFjpTjp (op: icptr);
|
|
|
|
{ Generate code for a pc_fjp or pc_tjp }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
opcode: pcodes; {op^.left^.opcode}
|
|
|
|
begin {GenFjpTjp}
|
|
if op^.left^.opcode in [pc_equ,pc_geq,pc_grt,pc_les,pc_leq,pc_neq] then
|
|
if op^.left^.opcode in [pc_equ,pc_neq] then
|
|
GenEquNeq(op^.left, op^.opcode, op^.q)
|
|
else
|
|
GenCmp(op^.left, op^.opcode, op^.q)
|
|
else begin
|
|
lab1 := GenLabel;
|
|
GenTree(op^.left);
|
|
opcode := op^.left^.opcode;
|
|
if NeedsCondition(opcode) then
|
|
GenImplied(m_tax)
|
|
else if opcode = pc_ind then
|
|
if op^.left^.optype in [cgByte,cgUByte] then
|
|
GenImplied(m_tax);
|
|
if op^.opcode = pc_fjp then
|
|
GenNative(m_bne, relative, lab1, nil, 0)
|
|
else {if op^.opcode = pc_tjp then}
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_brl, longrelative, op^.q, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else}
|
|
end; {GenFjpTjp}
|
|
|
|
|
|
procedure GenInn (op: icptr);
|
|
|
|
{ Generate code for a pc_inn }
|
|
|
|
label 1;
|
|
|
|
const
|
|
maxCard = 8; {largest constant set cardinality to
|
|
use branches on}
|
|
|
|
var
|
|
lab1: integer; {branch label}
|
|
i,j: integer; {loop counters}
|
|
byte: integer; {one byte of the set array}
|
|
card: integer; {cardinality of the set}
|
|
constants: array[1..maxCard] of integer; {ord of set elements}
|
|
done: boolean; {used to see if the operation is done}
|
|
lop: pcodes; {op code of top of set tree}
|
|
|
|
begin {GenInn}
|
|
done := false;
|
|
GenTree(op^.left);
|
|
lop := op^.right^.opcode;
|
|
if lop = pc_ldc then
|
|
with op^.right^.setp^ do begin
|
|
card := 0;
|
|
for i := 1 to smax do begin
|
|
byte := ord(sval[i]);
|
|
if byte <> 0 then
|
|
for j := 0 to 7 do begin
|
|
if odd(byte) then begin
|
|
if card = maxCard then
|
|
goto 1;
|
|
card := card+1;
|
|
constants[card] := (i-1)*8+j;
|
|
end; {if}
|
|
byte := byte >> 1;
|
|
end; {for}
|
|
end; {for}
|
|
lab1 := GenLabel;
|
|
GenNative(m_ldx_imm, immediate, 1, nil, 0);
|
|
for i := 1 to card do begin
|
|
GenNative(m_cmp_imm, immediate, constants[i], nil, 0);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
end; {for}
|
|
GenImplied(m_dex);
|
|
GenLab(lab1);
|
|
GenImplied(m_txa);
|
|
done := true;
|
|
end; {with}
|
|
1: if not done then begin
|
|
GenImplied(m_pha);
|
|
if lop = pc_ldo then begin
|
|
with op^.right^ do begin
|
|
GenNative(m_pea, immediate, r, lab, shift16);
|
|
GenNative(m_pea, immediate, r, lab, 0);
|
|
GenNative(m_pea, immediate, q, nil, 0);
|
|
GenCall(130);
|
|
end; {with}
|
|
end {if}
|
|
else if lop = pc_lod then begin
|
|
with op^.right^ do begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
if p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(p, false, true);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, localLabel[r]+q, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_pea, immediate, s, nil, 0);
|
|
GenCall(130);
|
|
end; {with}
|
|
end{else if}
|
|
else begin
|
|
GenTree(op^.right);
|
|
GenCall(42);
|
|
end; {else}
|
|
end; {if}
|
|
end; {GenInn}
|
|
|
|
|
|
procedure GenLaoLad (op: icptr);
|
|
|
|
{ Generate code for a pc_lao, pc_lad }
|
|
|
|
var
|
|
q: integer; {displacement}
|
|
|
|
begin {GenLaoLad}
|
|
if op^.opcode = pc_lad then
|
|
q := 0
|
|
else
|
|
q := op^.q;
|
|
if (globalLabel & gLong.preference) <> 0 then begin
|
|
gLong.fixedDisp := true;
|
|
gLong.where := globalLabel;
|
|
gLong.disp := q;
|
|
gLong.lab := op^.lab;
|
|
end {if}
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_ldx_imm, immediate, q, op^.lab, shift16);
|
|
GenNative(m_lda_imm, immediate, q, op^.lab, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, q, op^.lab, shift16);
|
|
GenNative(m_pea, immediate, q, op^.lab, 0);
|
|
end; {else}
|
|
end; {GenLaoLad}
|
|
|
|
|
|
procedure GenLca (op: icptr);
|
|
|
|
{ Generate code for a pc_lca }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
len: unsigned; {string length}
|
|
|
|
begin {GenLca}
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16);
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference);
|
|
len := op^.q;
|
|
if maxString-stringSize >= len then begin
|
|
for i := 1 to op^.q do
|
|
stringSpace[i+stringSize] := op^.str^[i];
|
|
stringSize := stringSize+len;
|
|
end
|
|
else
|
|
Error(cge3);
|
|
op^.optype := cgULong;
|
|
end; {GenLca}
|
|
|
|
|
|
procedure GenLda (op: icptr);
|
|
|
|
{ Generate code for a pc_lda }
|
|
|
|
begin {GenLda}
|
|
if ((localAddress & gLong.preference) <> 0) and (op^.p = 0) then begin
|
|
gLong.fixedDisp := true;
|
|
gLong.where := localAddress;
|
|
gLong.disp := localLabel[op^.s] + op^.q;
|
|
end {if}
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
if op^.p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(op^.p, false, true);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, localLabel[op^.s] + op^.q, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
if op^.p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(op^.p, false, true);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, localLabel[op^.s] + op^.q, nil, 0);
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {GenLda}
|
|
|
|
|
|
procedure GenLdc (op: icptr);
|
|
|
|
{ Generate code for a pc_ldc }
|
|
|
|
type
|
|
kind = (vint, vbyte, vreal); {kinds of equivalenced data}
|
|
|
|
var
|
|
i: unsigned; {loop/index variable}
|
|
rec: realrec; {conversion record}
|
|
switch: packed record {used for type conversion}
|
|
case rkind: kind of
|
|
vint: (i: integer);
|
|
vbyte: (b1, b2, b3, b4, b5, b6, b7, b8: byte);
|
|
vreal: (r: double);
|
|
end;
|
|
|
|
begin {GenLdc}
|
|
case op^.optype of
|
|
cgByte: begin
|
|
if op^.q > 127 then
|
|
op^.q := op^.q | $FF00;
|
|
GenNative(m_lda_imm, immediate, op^.q, nil, 0);
|
|
end;
|
|
|
|
cgUByte, cgWord, cgUWord:
|
|
GenNative(m_lda_imm, immediate, op^.q, nil, 0);
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
rec.itsReal := op^.rval;
|
|
CnvSX(rec);
|
|
i := 10;
|
|
while i <> 0 do begin
|
|
switch.b1 := rec.inSANE[i-1];
|
|
switch.b2 := rec.inSANE[i];
|
|
GenNative(m_pea, immediate, switch.i, nil, 0);
|
|
i := i-2;
|
|
end; {while}
|
|
end;
|
|
|
|
cgLong, cgULong:
|
|
if (constant & gLong.preference) <> 0 then begin
|
|
gLong.where := constant;
|
|
gLong.lval := op^.lval;
|
|
end
|
|
else if (A_X & gLong.preference) <> 0 then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_lda_imm, immediate, long(op^.lval).lsw, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, long(op^.lval).msw, nil, 0);
|
|
end
|
|
else begin
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, immediate, long(op^.lval).msw, nil, 0);
|
|
GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0);
|
|
end;
|
|
|
|
cgSet: begin
|
|
with op^.setp^ do begin
|
|
if odd(smax) then begin
|
|
smax := smax+1;
|
|
sval[smax] := chr(0);
|
|
end; {if}
|
|
i := smax;
|
|
while i <> 0 do begin
|
|
switch.b1 := ord(sval[i-1]);
|
|
switch.b2 := ord(sval[i]);
|
|
GenNative(m_pea, immediate, switch.i, nil, 0);
|
|
i := i-2;
|
|
end; {while}
|
|
GenNative(m_pea, immediate, smax, nil, 0);
|
|
end; {with}
|
|
end;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenLdc}
|
|
|
|
|
|
procedure GenLdo (op: icptr);
|
|
|
|
{ Generate code for a pc_ldo }
|
|
|
|
var
|
|
i: unsigned; {set size}
|
|
lab1: unsigned; {branch point}
|
|
|
|
begin {GenLdo}
|
|
case op^.optype of
|
|
cgWord, cgUWord:
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0);
|
|
|
|
cgByte, cgUByte: begin
|
|
if smallMemoryModel then
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0)
|
|
else
|
|
GenNative(m_lda_long, longAbs, op^.q, op^.lab, 0);
|
|
GenNative(m_and_imm, immediate, 255, nil, 0);
|
|
if op^.optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end;
|
|
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
GenNative(m_pea, immediate, op^.q, op^.lab, shift16);
|
|
GenNative(m_pea, immediate, op^.q, op^.lab, 0);
|
|
if op^.optype = cgReal then
|
|
GenCall(25)
|
|
else if op^.optype = cgDouble then
|
|
GenCall(18)
|
|
else if op^.optype = cgComp then
|
|
GenCall(163)
|
|
else {if op^.optype = cgExtended then}
|
|
GenCall(164);
|
|
end;
|
|
|
|
cgLong, cgULong: begin
|
|
if (A_X & gLong.preference) <> 0 then
|
|
gLong.where := A_X
|
|
else
|
|
gLong.where := onStack;
|
|
if smallMemoryModel then begin
|
|
GenNative(m_ldx_abs, absolute, op^.q+2, op^.lab, 0);
|
|
GenNative(m_lda_abs, absolute, op^.q, op^.lab, 0);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_phx);
|
|
GenImplied(m_pha);
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_long, longabsolute, op^.q+2, op^.lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha)
|
|
else
|
|
GenImplied(m_tax);
|
|
GenNative(m_lda_long, longabsolute, op^.q, op^.lab, 0);
|
|
if gLong.where = onStack then
|
|
GenImplied(m_pha);
|
|
end; {else}
|
|
end; {case cgLong,cgULong}
|
|
|
|
cgSet: begin
|
|
if op^.q <= 8 then begin
|
|
i := op^.q;
|
|
if odd(i) then begin
|
|
i := i-1;
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_abs, absolute, op^.r+i, op^.lab, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {if}
|
|
while i <> 0 do begin
|
|
i := i-2;
|
|
GenNative(m_lda_abs, absolute, op^.r+i, op^.lab, 0);
|
|
GenImplied(m_pha);
|
|
end; {while}
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, op^.r, op^.lab, shift16);
|
|
GenNative(m_pea, immediate, op^.r, op^.lab, 0);
|
|
GenNative(m_pea, immediate, op^.q, nil,0);
|
|
GenCall(28);
|
|
end; {else}
|
|
end; {case cgSet}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenLdo}
|
|
|
|
|
|
procedure GenLla (op: icptr);
|
|
|
|
{ Generate code for a pc_lla }
|
|
|
|
begin {GenLla}
|
|
gLong.where := onStack;
|
|
GenNative(m_pea, genAddress, op^.q, nil, shift16);
|
|
GenNative(m_pea, genAddress, op^.q, nil, 0);
|
|
end; {GenLla}
|
|
|
|
|
|
procedure GenLnm (op: icptr);
|
|
|
|
{ Generate code for a pc_lnm }
|
|
|
|
begin {GenLnm}
|
|
if op^.left <> nil then
|
|
GenTree(op^.left);
|
|
if traceBack then begin
|
|
GenNative(m_pea, immediate, op^.r, nil, 0);
|
|
GenCall(75);
|
|
end; {if}
|
|
if debugFlag then begin
|
|
GenNative(m_cop, immediate, op^.q, nil, 0);
|
|
GenNative(d_wrd, special, op^.r, nil, 0);
|
|
end; {if}
|
|
end; {GenLnm}
|
|
|
|
|
|
procedure GenLod (op: icptr);
|
|
|
|
{ Generate code for a pc_lod }
|
|
|
|
var
|
|
disp: integer; {load location}
|
|
i: unsigned; {loop/index variable}
|
|
lab1: unsigned; {branch point}
|
|
optype: baseTypeEnum; {op^.optype}
|
|
|
|
begin {GenLod}
|
|
disp := localLabel[op^.r] + op^.q;
|
|
optype := op^.optype;
|
|
case optype of
|
|
cgReal, cgDouble, cgComp, cgExtended: begin
|
|
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 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;
|
|
|
|
cgLong, cgULong: begin
|
|
if op^.p <> 0 then begin
|
|
gLong.where := onStack;
|
|
StaticLink(op^.p, false, false);
|
|
GenNative(m_lda_longx, longabsolute, disp+2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_longx, longabsolute, disp, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else if ((inPointer & gLong.preference) <> 0) and (disp < 254) then
|
|
begin
|
|
gLong.where := inPointer;
|
|
gLong.fixedDisp := true;
|
|
gLong.disp := disp;
|
|
end {else if}
|
|
else if ((A_X & gLong.preference) <> 0) and (disp < 254) then begin
|
|
gLong.where := A_X;
|
|
GenNative(m_ldx_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
end {else if}
|
|
else begin
|
|
gLong.where := onStack;
|
|
if disp >= 254 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 2, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pei_dir, direct, disp+2, nil, 0);
|
|
GenNative(m_pei_dir, direct, disp, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end;
|
|
|
|
cgByte, cgUByte, cgWord, cgUWord: begin
|
|
if op^.p <> 0 then begin
|
|
StaticLink(op^.p, false, false);
|
|
GenNative(m_lda_longx, longabsolute, disp, nil, 0);
|
|
end {if}
|
|
else if disp >= 256 then begin
|
|
GenNative(m_ldx_imm, immediate, disp, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
end {else if}
|
|
else
|
|
GenNative(m_lda_dir, direct, disp, nil, 0);
|
|
if optype in [cgByte,cgUByte] then begin
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if optype = cgByte then begin
|
|
GenNative(m_bit_imm, immediate, $0080, nil, 0);
|
|
lab1 := GenLabel;
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_cmp_imm, immediate, $0000, nil, 0);
|
|
end; {if}
|
|
end;
|
|
end;
|
|
|
|
cgSet:
|
|
if (op^.p = 0) and (disp < 248) and (op^.s <= 8) then begin
|
|
i := op^.s;
|
|
if odd(i) then begin
|
|
i := i-1;
|
|
GenNative(m_sep, immediate, 32, nil, 0);
|
|
GenNative(m_lda_dir, direct, disp+i, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenNative(m_rep, immediate, 32, nil, 0);
|
|
end; {if}
|
|
while i <> 0 do begin
|
|
i := i-2;
|
|
GenNative(m_pei_dir, direct, disp+i, nil, 0);
|
|
end; {end}
|
|
GenNative(m_pea, immediate, op^.s, nil, 0);
|
|
end {if}
|
|
else begin
|
|
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(28);
|
|
end; {else}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
|
|
end; {case}
|
|
end; {GenLod}
|
|
|
|
|
|
procedure GenLsl (op: icptr);
|
|
|
|
{ Generate code for a pc_lsl }
|
|
|
|
begin {GenLsl}
|
|
if op^.q = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(op^.q, false, true);
|
|
end; {GenLsl}
|
|
|
|
|
|
procedure GenMov (op: icptr; duplicate: boolean);
|
|
|
|
{ Generate code for a pc_mov }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - pc_mov instruction }
|
|
{ duplicate - should the source address be left on the }
|
|
{ stack? }
|
|
|
|
var
|
|
banks: integer; {number of banks to move}
|
|
|
|
|
|
procedure Load (opcode: integer; op: icptr);
|
|
|
|
{ generate a load immediate based on instruction type }
|
|
{ }
|
|
{ parameters: }
|
|
{ opcode - native code load operation }
|
|
{ op - node to load }
|
|
|
|
var
|
|
i: integer;
|
|
|
|
begin {Load}
|
|
if op^.opcode = pc_lao then
|
|
GenNative(opcode, immediate, op^.q, op^.lab, 0)
|
|
else begin
|
|
GenNative(opcode, immediate, stringsize, nil, StringReference);
|
|
if maxstring-stringsize >= op^.q then begin
|
|
for i := 1 to op^.q do
|
|
stringspace[i+stringsize] := op^.str^[i];
|
|
stringsize := stringsize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
end; {else}
|
|
end; {Load}
|
|
|
|
|
|
begin {GenMov}
|
|
{determine if the destination address must be left on the stack}
|
|
if smallMemoryModel
|
|
and (not duplicate)
|
|
and (op^.left^.opcode in [pc_lao,pc_lca])
|
|
and (op^.right^.opcode in [pc_lao,pc_lca]) then begin
|
|
|
|
{take advantage of any available short cuts}
|
|
Load(m_ldy_imm, op^.left);
|
|
Load(m_ldx_imm, op^.right);
|
|
GenNative(m_lda_imm, immediate, op^.q-1, nil, 0);
|
|
GenImplied(m_phb);
|
|
GenImplied(m_mvn);
|
|
with op^.left^ do
|
|
if opcode = pc_lao then
|
|
GenNative(d_bmov, immediate, q, lab, shift16)
|
|
else
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16);
|
|
with op^.right^ do
|
|
if opcode = pc_lao then
|
|
GenNative(d_bmov, immediate, q, lab, shift16)
|
|
else
|
|
GenNative(d_bmov, immediate, 0, nil, stringReference+shift16);
|
|
GenImplied(m_plb);
|
|
end {if}
|
|
else begin
|
|
|
|
{no short cuts are available - do it the hard way}
|
|
gLong.preference := onStack;
|
|
GenTree(op^.left);
|
|
gLong.preference := onStack;
|
|
GenTree(op^.right);
|
|
banks := op^.r;
|
|
if banks <> 0 then
|
|
GenNative(m_pea, immediate, banks, nil, 0);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
if banks = 0 then begin
|
|
if duplicate then
|
|
GenCall(167)
|
|
else
|
|
GenCall(80);
|
|
end {if}
|
|
else
|
|
if duplicate then
|
|
GenCall(169)
|
|
else
|
|
GenCall(168);
|
|
end; {else}
|
|
end; {GenMov}
|
|
|
|
|
|
procedure GenMpi (op: icptr);
|
|
|
|
{ Generate code for a pc_mpi or pc_umi }
|
|
|
|
var
|
|
nd: icptr;
|
|
|
|
begin {GenMpi}
|
|
if not Complex(op^.left) then
|
|
if Complex(op^.right) then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
GenTree(op^.left);
|
|
if Complex(op^.right) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else
|
|
LoadX(op^.right);
|
|
if op^.opcode = pc_mpi then
|
|
GenCall(32)
|
|
else {pc_umi}
|
|
GenCall(142);
|
|
if rangeCheck then
|
|
GenCall(147);
|
|
end; {GenMpi}
|
|
|
|
|
|
procedure GenNam (op: icptr);
|
|
|
|
{ Generate code for a pc_nam }
|
|
|
|
var
|
|
i: integer; {loop/index variable}
|
|
len: integer; {length of the file name}
|
|
|
|
|
|
function ToUpper (ch: char): char;
|
|
|
|
{ Return the uppercase equivalent of the input character }
|
|
|
|
begin {ToUpper}
|
|
if (ch >= 'a') and (ch <= 'z') then
|
|
ch := chr(ord(ch)-ord('a')+ord('A'));
|
|
ToUpper := ch;
|
|
end; {ToUpper}
|
|
|
|
|
|
begin {GenNam}
|
|
{generate a call to install the name in the traceback facility}
|
|
if traceBack then begin
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference+shift16);
|
|
GenNative(m_pea, immediate, stringSize, nil, stringReference);
|
|
GenCall(76);
|
|
namePushed := true;
|
|
end; {if}
|
|
|
|
{send the name to the profiler}
|
|
if profileFlag then begin
|
|
GenNative(m_cop, immediate, 3, nil, 0);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16);
|
|
end; {if}
|
|
|
|
{place the name in the string buffer}
|
|
len := length(op^.str^);
|
|
if maxString-stringSize >= len+1 then begin
|
|
stringSpace[stringSize+1] := chr(len);
|
|
for i := 1 to len do
|
|
stringSpace[i+stringSize+1] := op^.str^[i];
|
|
stringSize := stringSize + len + 1;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
|
|
{send the file name to the debugger}
|
|
if debugFlag then begin
|
|
GenNative(m_cop, immediate, 6, nil, 0);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference);
|
|
GenNative(d_add, genaddress, stringSize, nil, stringReference+shift16);
|
|
len := fNameGS.theString.size;
|
|
if len > 255 then
|
|
len := 255;
|
|
if maxString-stringSize >= len+1 then begin
|
|
stringSpace[stringSize+1] := chr(len);
|
|
for i := 1 to len do
|
|
stringSpace[i+stringSize+1] :=
|
|
ToUpper(fNameGS.theString.theString[i]);
|
|
stringSize := stringSize + len + 1;
|
|
end {if}
|
|
else
|
|
Error(cge3);
|
|
end; {if}
|
|
end; {GenNam}
|
|
|
|
|
|
procedure GenPds (op: icptr);
|
|
|
|
{ Generate code for a pc_pds }
|
|
|
|
begin {GenPds}
|
|
gLong.preference := A_X;
|
|
GenTree(op^.left);
|
|
if gLong.where = onStack then begin
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
end; {if}
|
|
GenNative(m_ldy_imm, immediate, op^.q, nil, 0);
|
|
GenCall(47);
|
|
end; {GenPds}
|
|
|
|
|
|
procedure GenPrs (op: icptr);
|
|
|
|
{ Generate code for a pc_prs }
|
|
|
|
begin {GenPrs}
|
|
GenNative(m_lda_dir, direct, staticLoc, nil, 0);
|
|
GenImplied(m_tcd);
|
|
GenImplied(m_dea);
|
|
GenImplied(m_dea);
|
|
GenImplied(m_tcs);
|
|
end; {GenPrs}
|
|
|
|
|
|
procedure GenPwr (op: icptr);
|
|
|
|
{ Generate code for a pc_pwr }
|
|
|
|
begin {GenPwr}
|
|
GenTree(op^.left);
|
|
GenTree(op^.right);
|
|
GenCall(90);
|
|
end; {GenPwr}
|
|
|
|
|
|
procedure GenRealBinOp (op: icptr);
|
|
|
|
{ Generate code for a pc_adr, pc_dvr, pc_mpr, pc_sbr }
|
|
|
|
var
|
|
nd: icptr; {temp pointer}
|
|
snum: integer; {library subroutine numbers}
|
|
ss,sd,sc,se: integer; {sane call numbers}
|
|
|
|
begin {GenRealBinOp}
|
|
case op^.opcode of
|
|
pc_adr: begin
|
|
snum := 50;
|
|
ss := $0200;
|
|
sd := $0100;
|
|
sc := $0500;
|
|
se := $0000;
|
|
end;
|
|
|
|
pc_dvr: begin
|
|
snum := 51;
|
|
ss := $0206;
|
|
sd := $0106;
|
|
sc := $0506;
|
|
se := $0006;
|
|
end;
|
|
|
|
pc_mpr: begin
|
|
snum := 52;
|
|
ss := $0204;
|
|
sd := $0104;
|
|
sc := $0504;
|
|
se := $0004;
|
|
end;
|
|
|
|
pc_sbr: begin
|
|
snum := 53;
|
|
ss := $0202;
|
|
sd := $0102;
|
|
sc := $0502;
|
|
se := $0002;
|
|
end;
|
|
end; {case}
|
|
|
|
if op^.opcode in [pc_mpr,pc_adr] then
|
|
if op^.left^.opcode in [pc_lod,pc_ldo] then begin
|
|
nd := op^.left;
|
|
op^.left := op^.right;
|
|
op^.right := nd;
|
|
end; {if}
|
|
GenTree(op^.left);
|
|
if (op^.right^.opcode in [pc_lod,pc_ldo]) and (floatCard = 0) then
|
|
with op^.right^ do begin
|
|
if opcode = pc_lod then begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
if p = 0 then
|
|
GenImplied(m_tdc)
|
|
else
|
|
StaticLink(p, false, true);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, localLabel[r] + q, nil, 0);
|
|
GenImplied(m_pha);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_pea, immediate, q, lab, shift16);
|
|
GenNative(m_pea, immediate, q, lab, 0);
|
|
end; {else}
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 7, nil, 0);
|
|
GenImplied(m_pha);
|
|
if optype = cgReal then
|
|
sd := ss
|
|
else if optype = cgExtended then
|
|
sd := se
|
|
else if optype = cgComp then
|
|
sd := sc;
|
|
GenNative(m_pea, immediate, sd, nil, 0);
|
|
GenNative(m_ldx_imm, immediate, $090A, nil, 0);
|
|
GenNative(m_jsl, longAbs, 0, nil, toolCall);
|
|
end {with}
|
|
else begin
|
|
GenTree(op^.right);
|
|
GenCall(snum);
|
|
end; {else}
|
|
end; {GenRealBinOp}
|
|
|
|
|
|
procedure GenRealUnOp (op: icptr);
|
|
|
|
{ Generate code for a pc_sqr, pc_sqt, pc_sin, pc_cos, }
|
|
{ pc_atn, pc_log, pc_exp, pc_tan, pc_acs, pc_asn }
|
|
|
|
var
|
|
snum: integer;
|
|
|
|
begin {GenRealUnOp}
|
|
GenTree(op^.left);
|
|
case op^.opcode of
|
|
pc_sqr: snum := 54;
|
|
pc_sqt: snum := 55;
|
|
pc_sin: snum := 63;
|
|
pc_cos: snum := 64;
|
|
pc_atn: snum := 65;
|
|
pc_log: snum := 66;
|
|
pc_exp: snum := 67;
|
|
pc_tan: snum := 120;
|
|
pc_acs: snum := 121;
|
|
pc_asn: snum := 122;
|
|
end; {case}
|
|
GenCall(snum);
|
|
end; {GenRealUnOp}
|
|
|
|
|
|
procedure GenRet (op: icptr);
|
|
|
|
{ Generate code for a pc_ret }
|
|
|
|
var
|
|
size: integer; {localSize + parameterSize}
|
|
|
|
begin {GenRet}
|
|
{pop the name record}
|
|
if namePushed then
|
|
GenCall(77);
|
|
|
|
{generate an exit code for the debugger's benefit}
|
|
if debugFlag then
|
|
GenNative(m_cop, immediate, 4, nil, 0);
|
|
|
|
{if anything needs to be removed from the stack, move the return val}
|
|
size := localSize + parameterSize;
|
|
if parameterSize <> 0 then begin
|
|
if localSize > 254 then begin
|
|
GenNative(m_ldx_imm, immediate, localSize+1, nil, 0);
|
|
GenNative(m_lda_dirx, direct, 0, nil, 0);
|
|
GenNative(m_ldy_dirx, direct, 1, nil, 0);
|
|
GenNative(m_ldx_imm, immediate,
|
|
localSize+parameterSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
GenNative(m_sty_dirx, direct, 1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_lda_dir, direct, localSize+2, nil, 0);
|
|
if localSize+parameterSize > 254 then begin
|
|
GenNative(m_ldx_imm, immediate,
|
|
localSize+parameterSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 1, nil, 0);
|
|
GenNative(m_lda_dir, direct, localSize+1, nil, 0);
|
|
GenNative(m_sta_dirx, direct, 0, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_sta_dir, direct,
|
|
localSize+parameterSize+2, nil, 0);
|
|
GenNative(m_lda_dir, direct, localSize+1, nil, 0);
|
|
GenNative(m_sta_dir, direct,
|
|
localSize+parameterSize+1, nil, 0);
|
|
end; {else}
|
|
end; {else}
|
|
end; {if}
|
|
|
|
{load the value to return}
|
|
case op^.optype of
|
|
|
|
cgVoid: ;
|
|
|
|
cgByte,cgUByte: begin
|
|
GenNative(m_lda_dir, direct, funLoc, nil, 0);
|
|
GenNative(m_and_imm, immediate, $00FF, nil, 0);
|
|
if size <> 2 then
|
|
GenImplied(m_tay);
|
|
end;
|
|
|
|
cgWord,cgUWord:
|
|
if size = 2 then
|
|
GenNative(m_lda_dir, direct, funLoc, nil, 0)
|
|
else
|
|
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
|
|
|
|
cgReal,cgDouble,cgExtended,cgComp: begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_tdc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, funLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
if op^.optype = cgReal then
|
|
GenCall(81)
|
|
else if op^.optype = cgDouble then
|
|
GenCall(84)
|
|
else if op^.optype = cgExtended then
|
|
GenCall(176)
|
|
else {if op^.optype = cgComp then}
|
|
GenCall(177);
|
|
end;
|
|
|
|
cgLong,cgULong: begin
|
|
GenNative(m_ldx_dir, direct, funLoc+2, nil, 0);
|
|
GenNative(m_ldy_dir, direct, funLoc, nil, 0);
|
|
end;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{restore data bank reg}
|
|
if dataBank then begin
|
|
GenNative(m_lda_dir, direct, bankLoc, nil, 0);
|
|
GenImplied(m_pha);
|
|
GenImplied(m_plb);
|
|
GenImplied(m_plb);
|
|
end; {if}
|
|
|
|
{get rid of the stack frame space}
|
|
if size <> 0 then
|
|
GenImplied(m_pld);
|
|
if size = 2 then
|
|
GenImplied(m_ply)
|
|
else if size <> 0 then begin
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, size, nil, 0);
|
|
GenImplied(m_tcs);
|
|
end; {if}
|
|
|
|
{put return value in correct place}
|
|
case op^.optype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
if size <> 2 then
|
|
GenImplied(m_tya);
|
|
if toolParms then {save value on stack for tools}
|
|
GenNative(m_sta_s, direct, returnSize+1, nil, 0);
|
|
end;
|
|
|
|
cgLong,cgULong,cgReal,cgDouble,cgComp,cgExtended: begin
|
|
GenImplied(m_tya);
|
|
if toolParms then begin {save value on stack for tools}
|
|
GenNative(m_sta_s, direct, returnSize+1, nil, 0);
|
|
GenImplied(m_txa);
|
|
GenNative(m_sta_s, direct, returnSize+3, nil, 0);
|
|
end; {if}
|
|
end;
|
|
|
|
cgVoid: ;
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
|
|
{return to the caller}
|
|
GenImplied(m_rtl);
|
|
end; {GenRet}
|
|
|
|
|
|
procedure GenRnd (op: icptr);
|
|
|
|
{ Generate code for a pc_rnd }
|
|
|
|
begin {GenRnd}
|
|
GenTree(op^.left);
|
|
GenCall(68);
|
|
end; {GenRnd}
|
|
|
|
|
|
procedure GenRn4 (op: icptr);
|
|
|
|
{ Generate code for a pc_rn4 }
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
|
|
begin {GenRn4}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
GenCall(149);
|
|
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; {GenRn4}
|
|
|
|
|
|
procedure GenSbi (op: icptr);
|
|
|
|
{ Generate code for a pc_sbi }
|
|
|
|
begin {GenSbi}
|
|
if Complex(op^.left) or Complex(op^.right) then begin
|
|
GenTree(op^.right);
|
|
if Complex(op^.left) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.left);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_s, direct, 1, nil, 0);
|
|
GenImplied(m_plx);
|
|
end {if}
|
|
else begin
|
|
GenNative(m_eor_imm, immediate, $FFFF, nil, 0);
|
|
GenImplied(m_sec);
|
|
OperA(m_adc_imm, op^.left);
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
GenImplied(m_sec);
|
|
OperA(m_sbc_imm, op^.right);
|
|
end; {else}
|
|
if rangeCheck then
|
|
GenCall(147);
|
|
end; {GenSbi}
|
|
|
|
|
|
procedure GenShlShrUsr (op: icptr);
|
|
|
|
{ Generate code for a pc_shl, pc_shr or pc_usr }
|
|
|
|
var
|
|
i,op1,op2,num: integer; {temp variables}
|
|
|
|
begin {GenShlShrUsr}
|
|
{get the standard native operations}
|
|
if op^.opcode = pc_shl then begin
|
|
op1 := m_asl_a;
|
|
op2 := m_lsr_a;
|
|
end {if}
|
|
else begin
|
|
op1 := m_lsr_a;
|
|
op2 := m_asl_a;
|
|
end; {else}
|
|
|
|
{take short cuts if they are legal}
|
|
if (op^.right^.opcode = pc_ldc) and (op^.opcode <> pc_shr) then begin
|
|
num := op^.right^.q;
|
|
if (num > 16) or (num < -16) then
|
|
GenNative(m_lda_imm, immediate, 0, nil, 0)
|
|
else if num > 0 then begin
|
|
GenTree(op^.left);
|
|
if num >= 8 then begin
|
|
GenImplied(m_xba);
|
|
if op1 = m_lsr_a then
|
|
i := $00FF
|
|
else
|
|
i := $FF00;
|
|
GenNative(m_and_imm, immediate, i, nil, 0);
|
|
num := num-8;
|
|
end; {if}
|
|
for i := 1 to num do
|
|
GenImplied(op1);
|
|
end {else if}
|
|
else if num < 0 then begin
|
|
GenTree(op^.left);
|
|
if num <= -8 then begin
|
|
GenImplied(m_xba);
|
|
if op2 = m_lsr_a then
|
|
i := $00FF
|
|
else
|
|
i := $FF00;
|
|
GenNative(m_and_imm, immediate, i, nil, 0);
|
|
num := num+8;
|
|
end; {if}
|
|
for i := 1 to -num do
|
|
GenImplied(op2);
|
|
end {else if}
|
|
else
|
|
GenTree(op^.left);
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
if Complex(op^.right) then begin
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_tax);
|
|
GenImplied(m_pla);
|
|
end {if}
|
|
else
|
|
LoadX(op^.right);
|
|
if op^.opcode = pc_shl then
|
|
GenCall(88)
|
|
else if op^.opcode = pc_shr then
|
|
GenCall(89)
|
|
else {if op^.opcode = pc_usr then}
|
|
GenCall(175);
|
|
end; {else}
|
|
end; {GenShlShrUsr}
|
|
|
|
|
|
procedure GenSiz (op: icptr);
|
|
|
|
{ Generate code for a pc_siz }
|
|
|
|
const
|
|
unknownSize = 999; {used to indicate an unknown set size}
|
|
|
|
var
|
|
size: integer; {size of the set being passed}
|
|
|
|
|
|
function SetSize (op: icptr): unsigned;
|
|
|
|
{ find the size of the set generated by the tree passed }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - tree to examine }
|
|
{ }
|
|
{ returns: Size of set }
|
|
|
|
var
|
|
ls, rs: unsigned; {temp set sizes}
|
|
|
|
begin {SetSize}
|
|
case op^.opcode of
|
|
pc_uni,pc_int,pc_dif: begin
|
|
ls := SetSize(op^.left);
|
|
rs := SetSize(op^.right);
|
|
if ls < rs then
|
|
SetSize := rs
|
|
else
|
|
SetSize := ls;
|
|
end;
|
|
pc_sgs,pc_ixa,pc_ind:
|
|
SetSize := unknownSize;
|
|
pc_ldo:
|
|
SetSize := op^.q;
|
|
pc_ldc: begin
|
|
ls := op^.setp^.smax;
|
|
if odd(ls) then
|
|
ls := ls+1;
|
|
SetSize := ls;
|
|
end;
|
|
pc_lod:
|
|
SetSize := op^.s;
|
|
otherwise: begin
|
|
SetSize := unknownSize;
|
|
Error(cge1);
|
|
end;
|
|
end; {case}
|
|
end; {SetSize}
|
|
|
|
|
|
begin {GenSiz}
|
|
size := SetSize(op^.left);
|
|
if (size <> unknownSize) and (size <= op^.q) then begin
|
|
if odd(size-op^.q) then begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
GenImplied(m_phb);
|
|
GenImplied(m_pla);
|
|
size := size+1;
|
|
end; {if}
|
|
while size < op^.q do begin
|
|
GenNative(m_pea, immediate, 0, nil, 0);
|
|
size := size+2;
|
|
end; {while}
|
|
GenTree(op^.left);
|
|
GenImplied(m_pla);
|
|
end {if}
|
|
else begin
|
|
GenTree(op^.left);
|
|
GenNative(m_pea, immediate, op^.q, nil, 0);
|
|
GenCall(78);
|
|
end; {else}
|
|
end; {GenSiz}
|
|
|
|
|
|
procedure GenSgs (op: icptr);
|
|
|
|
{ Generate code for a pc_sgs }
|
|
{ }
|
|
{ (Convert an integer range into a set) }
|
|
|
|
begin {GenSgs}
|
|
GenTree(op^.left);
|
|
GenImplied(m_pha);
|
|
GenTree(op^.right);
|
|
GenImplied(m_pha);
|
|
GenCall(16);
|
|
end; {GenSgs}
|
|
|
|
|
|
procedure GenStk (op: icptr);
|
|
|
|
{ Generate code for a pc_stk }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {GenStk}
|
|
glong.preference := onStack; {generate the operand}
|
|
GenTree(op^.left);
|
|
if op^.optype in {do the stk}
|
|
[cgByte, cgUByte, cgWord, cgUWord] then
|
|
GenImplied(m_pha);
|
|
end; {GenStk}
|
|
|
|
|
|
procedure GenTl1 (op: icptr);
|
|
|
|
{ Generate code for a pc_tl1, pc_tl2 }
|
|
|
|
type
|
|
kind = (vint, vbyte); {kinds of equivalenced data}
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
str: pStringPtr; {string constant pointer}
|
|
switch: packed record {used for type conversion}
|
|
case rkind: kind of
|
|
vint: (i: integer);
|
|
vbyte: (b1, b2: byte);
|
|
end;
|
|
|
|
begin {GenTl1}
|
|
{push space for the return value}
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
GenImplied(m_pha)
|
|
else if op^.optype in [cgLong,cgULong] then begin
|
|
GenImplied(m_pha);
|
|
GenImplied(m_pha);
|
|
end; {else if}
|
|
|
|
{generate parameters}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
|
|
{generate the tool call}
|
|
switch.b2 := op^.q;
|
|
switch.b1 := op^.r;
|
|
GenNative(m_ldx_imm,immediate,switch.i,nil,0);
|
|
if op^.opcode = pc_tl1 then
|
|
GenNative(m_jsl, longAbs, 0, nil, toolCall)
|
|
else
|
|
GenNative(m_jsl, longAbs, 0, nil, usertoolCall);
|
|
str := @'~TOOLERROR';
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, 0, str, 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, 0, str, 0);
|
|
|
|
{save the returned value}
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
GenImplied(m_pla)
|
|
else if op^.optype in [cgLong,cgULong] then
|
|
gLong.where := onStack;
|
|
end; {GenTl1}
|
|
|
|
|
|
procedure GenUjp (op: icptr);
|
|
|
|
{ Generate code for a pc_ujp }
|
|
|
|
begin {GenUjp}
|
|
if op^.lab = nil then
|
|
GenNative(m_brl, longrelative, op^.q, nil, 0)
|
|
else
|
|
GenNative(m_jml, longAbs, 0, op^.lab, 0);
|
|
end; {GenUjp}
|
|
|
|
|
|
procedure GenVct (op: icptr);
|
|
|
|
{ Generate code for a pc_vct }
|
|
|
|
type
|
|
kind = (vint, vbyte); {kinds of equivalenced data}
|
|
|
|
var
|
|
lLong: longType; {used to reserve gLong}
|
|
str: pStringPtr; {string constant pointer}
|
|
|
|
begin {GenVct}
|
|
{push space for the return value}
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
GenImplied(m_pha)
|
|
else if op^.optype in [cgLong,cgULong] then begin
|
|
GenImplied(m_pha);
|
|
GenImplied(m_pha);
|
|
end; {else if}
|
|
|
|
{generate parameters}
|
|
lLong := gLong;
|
|
GenTree(op^.left);
|
|
gLong := lLong;
|
|
|
|
{generate the tool call}
|
|
GenNative(m_ldx_imm,immediate,op^.q,nil,0);
|
|
if op^.opcode = pc_tl1 then
|
|
GenNative(m_jsl, longAbsolute, 0, op^.lval, constantOpnd)
|
|
else
|
|
GenNative(m_jsl, longAbsolute, 0, op^.lval, constantOpnd);
|
|
str := @'~TOOLERROR';
|
|
if smallMemoryModel then
|
|
GenNative(m_sta_abs, absolute, 0, str, 0)
|
|
else
|
|
GenNative(m_sta_long, longAbs, 0, str, 0);
|
|
|
|
{save the returned value}
|
|
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then
|
|
GenImplied(m_pla)
|
|
else if op^.optype in [cgLong,cgULong] then
|
|
gLong.where := onStack;
|
|
end; {GenVct}
|
|
|
|
|
|
procedure GenXjp (op: icptr);
|
|
|
|
{ Generate code for a pc_xjp }
|
|
|
|
var
|
|
lab1,lab2: integer;
|
|
q: integer;
|
|
|
|
begin {GenXjp}
|
|
q := op^.q;
|
|
lab1 := GenLabel;
|
|
GenTree(op^.left);
|
|
GenNative(m_cmp_imm, immediate, q, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, q, nil, 0);
|
|
GenLab(lab1);
|
|
GenImplied(m_asl_a);
|
|
GenImplied(m_tax);
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
GenNative(m_lda_longx, longAbs, lab2, nil, 0);
|
|
GenNative(m_beq,relative,lab1,nil,0);
|
|
GenImplied(m_pha);
|
|
GenImplied(m_rts);
|
|
GenLab(lab1);
|
|
GenCall(12);
|
|
GenLab(lab2);
|
|
end; {GenXjp}
|
|
|
|
|
|
procedure DirLab (op: icptr);
|
|
|
|
{ Generate code for a dc_lab }
|
|
|
|
begin {DirLab}
|
|
if op^.lab = nil then
|
|
GenLab(op^.q)
|
|
else
|
|
GenNative(d_lab, gnrLabel, 0, op^.lab, isPrivate);
|
|
end; {DirLab}
|
|
|
|
|
|
procedure DirStr (op: icptr);
|
|
|
|
{ Generate code for a dc_str }
|
|
|
|
begin {DirStr}
|
|
skipLoad := false;
|
|
InitNative;
|
|
Header(op^.lab, op^.r, op^.q);
|
|
end; {DirStr}
|
|
|
|
|
|
procedure DirSym (op: icptr);
|
|
|
|
{ Generate code for a dc_sym }
|
|
|
|
begin {DirSym}
|
|
if debugFlag then
|
|
GenNative(d_sym, special, op^.q, pointer(op^.lab), 0);
|
|
end; {DirSym}
|
|
|
|
|
|
begin {GenTree}
|
|
{if printSymbols then begin write('GEN: '); WriteCode(op); end; {debug}
|
|
Spin;
|
|
case op^.opcode of
|
|
dc_dst: GenNative(d_lab, gnrSpace, op^.q, nil, 0);
|
|
dc_enp: DirEnp;
|
|
dc_glb: GenNative(d_lab, gnrLabel, op^.r, op^.lab, isPrivate*op^.q);
|
|
dc_lab: DirLab(op);
|
|
dc_fun,dc_loc,dc_prm: ;
|
|
dc_pin: GenNative(d_pin, special, 0, nil, 0);
|
|
dc_str: DirStr(op);
|
|
dc_sym: DirSym(op);
|
|
|
|
pc_abi,pc_bnt,pc_ngi,pc_not,pc_odd,pc_sqi: GenAbiBntNgiNotOddSqi(op);
|
|
pc_abl,pc_bnl,pc_ngl,pc_odl,pc_sql: GenAblBnlNglOdlSql(op);
|
|
pc_abr,pc_ngr: GenAbrNgr(op);
|
|
pc_add: GenNative(d_add, genaddress, op^.q, nil, sub1);
|
|
pc_adi: GenAdi(op);
|
|
pc_adl,pc_sbl: GenAdlSbl(op, nil);
|
|
pc_adr,pc_dvr,pc_mpr,pc_sbr: GenRealBinOp(op);
|
|
pc_and,pc_bnd,pc_bor,pc_bxr,pc_ior: GenLogic(op);
|
|
pc_atn,pc_cos,pc_exp,pc_log,pc_sin,pc_sqr,pc_sqt,pc_tan,pc_acs,pc_asn:
|
|
GenRealUnOp(op);
|
|
pc_at2: GenAt2(op);
|
|
pc_blr,pc_blx,pc_bal,pc_dvl,pc_mdl,pc_mpl,pc_sll,pc_slr,pc_udl,pc_ulm,
|
|
pc_uml,pc_vsr: GenBinLong(op);
|
|
pc_bno: GenBno(op);
|
|
pc_chk: GenChk(op);
|
|
pc_cnv: GenCnv(op);
|
|
pc_csp: GenCsp(op);
|
|
pc_cui: GenCui(op);
|
|
pc_cum: GenCum(op);
|
|
pc_cup: GenCup(op);
|
|
pc_dec,pc_inc: GenIncDec(op, nil);
|
|
pc_dif,pc_int,pc_uni: GenDifIntUni(op);
|
|
pc_dvi,pc_mod,pc_udi,pc_uim: GenDviMod(op);
|
|
pc_ent: GenEnt(op);
|
|
pc_equ,pc_neq: GenEquNeq(op, op^.opcode, 0);
|
|
pc_fix: GenFix(op);
|
|
pc_fjp,pc_tjp: GenFjpTjp(op);
|
|
pc_geq,pc_grt,pc_leq,pc_les: GenCmp(op, op^.opcode, 0);
|
|
pc_ind: GenInd(op);
|
|
pc_inn: GenInn(op);
|
|
pc_ixa: GenIxa(op);
|
|
pc_lao,pc_lad: GenLaoLad(op);
|
|
pc_lca: GenLca(op);
|
|
pc_lda: GenLda(op);
|
|
pc_ldc: GenLdc(op);
|
|
pc_ldo: GenLdo(op);
|
|
pc_lod: GenLod(op);
|
|
pc_lla: GenLla(op);
|
|
pc_lnm: GenLnm(op);
|
|
pc_lsl: GenLsl(op);
|
|
pc_mov: GenMov(op, false);
|
|
pc_mpi,pc_umi: GenMpi(op);
|
|
pc_nam: GenNam(op);
|
|
pc_nop: ;
|
|
pc_pds: GenPds(op);
|
|
pc_prs: GenPrs(op);
|
|
pc_pwr: GenPwr(op);
|
|
pc_ret: GenRet(op);
|
|
pc_rnd: GenRnd(op);
|
|
pc_rn4: GenRn4(op);
|
|
pc_sbi: GenSbi(op);
|
|
pc_shl,pc_shr,pc_usr: GenShlShrUsr(op);
|
|
pc_siz: GenSiz(op);
|
|
pc_sgs: GenSgs(op);
|
|
pc_sro,pc_cpo: GenSroCpo(op);
|
|
pc_stk: GenStk(op);
|
|
pc_sto: GenSto(op);
|
|
pc_str,pc_cop: GenStrCop(op);
|
|
pc_tl1,pc_tl2: GenTl1(op);
|
|
pc_ujp: GenUjp(op);
|
|
pc_vct: GenVct(op);
|
|
pc_xjp: GenXjp(op);
|
|
|
|
otherwise: begin
|
|
Error(cge1);
|
|
writeln('Undefined in GenTree: ', ord(op^.opcode):1);
|
|
end;
|
|
end; {case}
|
|
end; {GenTree}
|
|
|
|
{$optimize -1}
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure Gen {blk: blockPtr};
|
|
|
|
{ Generates native code for a list of blocks }
|
|
{ }
|
|
{ parameters: }
|
|
{ blk - first of the list of blocks }
|
|
|
|
type
|
|
sfPtr = ^sfRecord; {stack frame record}
|
|
sfRecord = record
|
|
next: sfPtr; {next record}
|
|
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}
|
|
end;
|
|
|
|
var
|
|
gop: icptr; {used to trace code lists}
|
|
sfList: sfPtr; {stack frame list}
|
|
sfLast: sfPtr; {stack frame temp variable}
|
|
|
|
|
|
procedure StackFrame (blk: blockPtr; gop: icptr);
|
|
|
|
{ Set up a stack frame for a new pc_ent }
|
|
{ }
|
|
{ parameters: }
|
|
{ blk - starting block }
|
|
{ gop - starting pc_ent }
|
|
|
|
label 1, 2, 3;
|
|
|
|
const
|
|
locSize = 4; {variables <= this size allocated first}
|
|
|
|
var
|
|
bk: blockPtr; {used to trace block lists}
|
|
minSize: integer; {location for the next local label}
|
|
needScan2: boolean; {do we need the 2nd dc_loc scan?}
|
|
op: icptr; {used to trace code lists}
|
|
sf: sfPtr; {new stack frame record}
|
|
|
|
|
|
procedure DirLoc1 (op: icptr);
|
|
|
|
{ allocates stack frame locations for small dc_loc }
|
|
|
|
begin {DirLoc1}
|
|
if op^.q <= locSize then begin
|
|
if op^.r < maxLocalLabel then begin
|
|
localLabel[op^.r] := minSize;
|
|
minSize := minSize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge2);
|
|
end {if}
|
|
else
|
|
needScan2 := true;
|
|
end; {DirLoc1}
|
|
|
|
|
|
procedure DirLoc2 (op: icptr);
|
|
|
|
{ allocates stack frame locations for large dc_loc }
|
|
|
|
begin {DirLoc2}
|
|
if op^.q > locSize then begin
|
|
if op^.r < maxLocalLabel then begin
|
|
localLabel[op^.r] := minSize;
|
|
minSize := minSize + op^.q;
|
|
end {if}
|
|
else
|
|
Error(cge2);
|
|
end; {if}
|
|
end; {DirLoc2}
|
|
|
|
|
|
procedure DirPrm (op: icptr);
|
|
|
|
{ allocates stack frame locations for parameters }
|
|
|
|
begin {DirPrm}
|
|
if op^.s < maxLocalLabel then
|
|
localLabel[op^.s] := localSize + returnSize + 1 + op^.r
|
|
else
|
|
Error(cge2);
|
|
end; {DirPrm}
|
|
|
|
|
|
procedure Scan (op: icptr);
|
|
|
|
{ scans the code stream for instructions that effect the }
|
|
{ size of the stack frame }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - scan this opcode and its children }
|
|
|
|
var
|
|
opcode: pcodes; {op^.opcode}
|
|
size: integer; {function return value size}
|
|
|
|
begin {Scan}
|
|
if op^.left <> nil then
|
|
Scan(op^.left);
|
|
if op^.right <> nil then
|
|
Scan(op^.right);
|
|
opcode := op^.opcode;
|
|
if ((opcode = pc_cup) and ((op^.lab = nil) or (not noGlobalLabels)))
|
|
or (opcode = pc_prs)
|
|
or (op^.p <> 0) then begin
|
|
if staticLoc = 0 then begin
|
|
staticLoc := 1;
|
|
if dworkLoc <> 0 then
|
|
dworkLoc := dworkLoc + 2;
|
|
minSize := minSize + 2;
|
|
localSize := localSize + 2;
|
|
end; {if}
|
|
end; {if}
|
|
if opcode = dc_loc then
|
|
localSize := localSize + op^.q
|
|
else if opcode = dc_fun then
|
|
localSize := localSize + op^.q
|
|
else if opcode = dc_prm then
|
|
parameterSize := parameterSize + op^.q
|
|
else if opcode in [pc_les,pc_leq,pc_grt,pc_geq] then begin
|
|
if op^.optype in [cgByte,cgWord,cgUByte,cgUWord] then
|
|
if Complex(op^.left) or Complex(op^.right) then
|
|
if dworkLoc = 0 then begin
|
|
dworkLoc := minSize;
|
|
minSize := minSize + 4;
|
|
localSize := localSize + 4;
|
|
end; {if}
|
|
end {else if}
|
|
else if opcode in [pc_sto,pc_ind,pc_lor,pc_lnd,pc_ixa,pc_cum]
|
|
then begin
|
|
if dworkLoc = 0 then begin
|
|
dworkLoc := minSize;
|
|
minSize := minSize + 4;
|
|
localSize := localSize + 4;
|
|
end; {if}
|
|
end; {else if}
|
|
end; {Scan}
|
|
|
|
|
|
begin {StackFrame}
|
|
while blk <> nil do begin
|
|
new(sf); {allocate a new stack frame}
|
|
if sfList = nil then
|
|
sfList := sf
|
|
else
|
|
sfLast^.next := sf;
|
|
sfLast := sf;
|
|
sf^.next := nil;
|
|
localSize := 0; {determine the size of the stack frame}
|
|
parameterSize := 0;
|
|
staticLoc := 0;
|
|
funLoc := 0;
|
|
dworkLoc := 0;
|
|
minSize := 1;
|
|
bk := blk;
|
|
op := gop^.next;
|
|
repeat
|
|
while op <> nil do begin
|
|
if op^.opcode = pc_ent then
|
|
goto 1;
|
|
Scan(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
while (op = nil) and (bk <> nil) do begin
|
|
bk := bk^.next;
|
|
if bk <> nil then
|
|
op := bk^.code;
|
|
end; {while}
|
|
until op = nil;
|
|
1: if dataBank then begin
|
|
bankLoc := minSize;
|
|
minSize := minSize + 2;
|
|
localSize := localSize + 2;
|
|
end; {if}
|
|
needScan2 := false; {allocate locations for the values}
|
|
bk := blk;
|
|
op := gop^.next;
|
|
repeat
|
|
while op <> nil do begin
|
|
if op^.opcode = pc_ent then
|
|
goto 2
|
|
else if op^.opcode = dc_loc then
|
|
DirLoc1(op)
|
|
else if op^.opcode = dc_fun then begin
|
|
DirLoc1(op);
|
|
funLoc := localLabel[op^.r];
|
|
end {else if}
|
|
else if op^.opcode = dc_prm then
|
|
DirPrm(op);
|
|
op := op^.next;
|
|
end; {while}
|
|
while (op = nil) and (bk <> nil) do begin
|
|
bk := bk^.next;
|
|
if bk <> nil then
|
|
op := bk^.code;
|
|
end; {while}
|
|
until op = nil;
|
|
2: if needScan2 then begin
|
|
bk := blk;
|
|
op := gop^.next;
|
|
repeat
|
|
while op <> nil do begin
|
|
if op^.opcode = pc_ent then
|
|
goto 3
|
|
else if op^.opcode = dc_loc then
|
|
DirLoc2(op)
|
|
else if op^.opcode = dc_fun then begin
|
|
DirLoc2(op);
|
|
funLoc := localLabel[op^.r];
|
|
end; {else if}
|
|
op := op^.next;
|
|
end; {while}
|
|
while (op = nil) and (bk <> nil) do begin
|
|
bk := bk^.next;
|
|
if bk <> nil then
|
|
op := bk^.code;
|
|
end; {while}
|
|
until op = nil;
|
|
end; {if}
|
|
3: blk := bk; {get ready for next scan}
|
|
gop := op;
|
|
sf^.localSize := localSize; {record the stack frame info}
|
|
sf^.parameterSize := parameterSize;
|
|
sf^.staticLoc := staticLoc;
|
|
sf^.funLoc := funLoc;
|
|
sf^.dworkLoc := dworkLoc;
|
|
sf^.bankLoc := bankLoc;
|
|
end; {while}
|
|
end; {StackFrame}
|
|
|
|
|
|
begin {Gen}
|
|
enpFound := false; {dc_enp not found, yet}
|
|
sfList := nil; {no stack frame list}
|
|
while blk <> nil do begin {generate code for the block}
|
|
gop := blk^.code;
|
|
while gop <> nil do begin
|
|
if gop^.opcode = pc_ent then begin
|
|
if sfList = nil then
|
|
StackFrame(blk, gop);
|
|
localSize := sfList^.localSize;
|
|
parameterSize := sfList^.parameterSize;
|
|
staticLoc := sfList^.staticLoc;
|
|
funLoc := sfList^.funLoc;
|
|
dworkLoc := sfList^.dworkLoc;
|
|
bankLoc := sfList^.bankLoc;
|
|
sfLast := sfList;
|
|
sfList := sfList^.next;
|
|
dispose(sfLast);
|
|
end; {if}
|
|
GenTree(gop);
|
|
gop := gop^.next;
|
|
end; {while}
|
|
blk := blk^.next;
|
|
end; {while}
|
|
if not enpFound then {if dc_enp was optimized out, fake one}
|
|
DirEnp;
|
|
end; {Gen}
|
|
|
|
end.
|