1 line
163 KiB
ObjectPascal
1 line
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 b
|