paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 01:39:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed procedure entry/exit code

Browse Source 
* started to fix reference handling
This commit is contained in:
florian 2003-08-29 21:36:28 +00:00
parent 04501b6fff
commit 301df6dab9
4 changed files with 317 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
compiler/arm/aasmcpu.pas
View File

@ -42,6 +42,7 @@ uses
oppostfix : TOpPostfix;
roundingmode : troundingmode;
procedure loadshifterop(opidx:longint;const so:tshifterop);
procedure loadregset(opidx:longint;const s:tsupregset);
constructor op_none(op : tasmop);
constructor op_reg(op : tasmop;_op1 : tregister);
@ -50,6 +51,7 @@ uses
constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
constructor op_reg_regset(op:tasmop; _op1: tregister; _op2: tsupregset);
constructor op_const_const(op : tasmop;_op1,_op2 : longint);
@ -108,13 +110,30 @@ implementation
with oper[opidx] do
begin
if typ<>top_shifterop then
new(shifterop);
begin
clearop(opidx);
new(shifterop);
end;
shifterop^:=so;
typ:=top_shifterop;
end;
end;
procedure taicpu.loadregset(opidx:longint;const s:tsupregset);
begin
if opidx>=ops then
ops:=opidx+1;
with oper[opidx] do
begin
if typ<>top_regset then
clearop(opidx);
regset:=s;
typ:=top_regset;
end;
end;
{*****************************************************************************
taicpu Constructors
*****************************************************************************}
@ -167,6 +186,17 @@ implementation
end;
constructor taicpu.op_reg_regset(op:tasmop; _op1: tregister; _op2: tsupregset);
begin
inherited create(op);
if (_op1.enum = R_INTREGISTER) and (_op1.number = NR_NO) then
internalerror(2003031208);
ops:=2;
loadreg(0,_op1);
loadregset(1,_op2);
end;
constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
begin
inherited create(op);
@ -693,7 +723,11 @@ implementation
end.
{
$Log$
Revision 1.6 2003-08-28 00:05:29 florian
Revision 1.7 2003-08-29 21:36:28 florian
* fixed procedure entry/exit code
* started to fix reference handling
Revision 1.6 2003/08/28 00:05:29 florian
* today's arm patches
Revision 1.5 2003/08/27 00:27:56 florian

126
compiler/arm/agarmgas.pas
View File

@ -43,6 +43,10 @@ unit agarmgas;
var
gas_reg2str : reg2strtable;
const
gas_shiftmode2str : array[tshiftmode] of string[3] = (
'','lsl','lsr','asr','ror','rrx');
function gas_regnum_search(const s:string):Tnewregister;
function gas_regname(const r:Tnewregister):string;
@ -77,50 +81,62 @@ unit agarmgas;
);
function getreferencestring(var ref : treference) : string;
var
s : string;
begin
with ref do
begin
inc(offset,offsetfixup);
var
s : string;
nobase,noindex : boolean;
begin
with ref do
begin
inc(offset,offsetfixup);
if not assigned(symbol) then
s := '['
else
s:='['+symbol.name;
noindex:=(index.enum=R_NO) or ((index.enum=R_INTREGISTER) and (index.number=NR_NO));
{$ifdef extdebug}
nobase:=(base.enum=R_NO) or ((base.enum=R_INTREGISTER) and (base.number=NR_NO));
//!!!! if nobase then
//!!!! internalerror(200308292);
if offset<0 then
s:=s+tostr(offset)
else
if (offset>0) then
begin
if assigned(symbol) then
s:=s+'+'+tostr(offset)
else
s:=s+tostr(offset);
end;
// !!! if (not(noindex) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then
// !!! internalerror(200308293);
{$endif extdebug}
if base.enum=R_INTREGISTER then
s:='['+gas_regname(base.number)
else
s:='['+gas_reg2str[base.enum];
if addressmode=AM_POSTINDEXED then
s:=s+']';
if (index.enum=R_NO) and (base.enum<>R_NO) then
begin
if offset=0 then
begin
if assigned(symbol) then
s:=s+'+0'
else
s:=s+'0';
end;
if base.enum=R_INTREGISTER then
s:=s+'('+gas_regname(base.number)+')'
else
s:=s+'('+gas_reg2str[base.enum]+')';
end
else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then
s:=s+std_reg2str[base.enum]+','+std_reg2str[index.enum]
else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then
internalerror(19992);
end;
getreferencestring:=s;
end;
if not(noindex) then
begin
if signindex<0 then
s:=s+', -'
else
s:=s+', ';
if index.enum=R_INTREGISTER then
s:=s+gas_regname(index.number)
else
s:=s+gas_reg2str[index.enum];
if shiftmode<>SM_None then
s:=s+' ,'+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm);
end
else
begin
{ handle symbol and index }
if offset<>0 then
s:=s+', #'+tostr(offset);
{ !!!!!}
end;
case addressmode of
AM_OFFSET:
s:=s+']';
AM_PREINDEXED:
s:=s+']!';
end;
end;
getreferencestring:=s;
end;
function getopstr_jmp(const o:toper) : string;
@ -170,6 +186,8 @@ unit agarmgas;
function getopstr(const o:toper) : string;
var
hs : string;
first : boolean;
r : tnewregister;
begin
case o.typ of
top_reg:
@ -194,6 +212,20 @@ unit agarmgas;
end;
top_const:
getopstr:='#'+tostr(longint(o.val));
top_regset:
begin
getopstr:='{';
first:=true;
for r:=RS_R0 to RS_R15 do
if r in o.regset then
begin
if not(first) then
getopstr:=getopstr+',';
getopstr:=getopstr+'r'+tostr(r-RS_R0);
first:=false;
end;
getopstr:=getopstr+'}';
end;
top_ref:
getopstr:=getreferencestring(o.ref^);
top_symbol:
@ -225,9 +257,9 @@ unit agarmgas;
sep: string[3];
begin
op:=taicpu(hp).opcode;
{
if is_calljmp(op) then
begin
{
{ direct BO/BI in op[0] and op[1] not supported, put them in condition! }
case op of
A_B,A_BA,A_BL,A_BLA:
@ -240,12 +272,12 @@ unit agarmgas;
if (taicpu(hp).oper[0].typ <> top_none) then
s:=s+getopstr_jmp(taicpu(hp).oper[0]);
}
end
else
}
{ process operands }
begin
s:=#9+std_op2str[op];
s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
if taicpu(hp).ops<>0 then
begin
{
@ -292,7 +324,11 @@ begin
end.
{
$Log$
Revision 1.5 2003-08-28 13:26:10 florian
Revision 1.6 2003-08-29 21:36:28 florian
* fixed procedure entry/exit code
* started to fix reference handling
Revision 1.5 2003/08/28 13:26:10 florian
* another couple of arm fixes
Revision 1.4 2003/08/28 00:05:29 florian

189
compiler/arm/cgcpu.pas
View File

@ -54,6 +54,7 @@ unit cgcpu;
size: tcgsize; src1, src2, dst: tregister); override;
{ move instructions }
procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
@ -267,7 +268,7 @@ unit cgcpu;
tmpreg : tregister;
so : tshifterop;
begin
if is_shifter_const(a,shift) and (op<>OP_MUL) then
if is_shifter_const(a,shift) and (not(op in [OP_IMUL,OP_MUL])) then
case op of
OP_NEG,OP_NOT,
OP_DIV,OP_IDIV:
@ -316,6 +317,7 @@ unit cgcpu;
size: tcgsize; src1, src2, dst: tregister);
var
so : tshifterop;
tmpreg : tregister;
begin
case op of
OP_NEG:
@ -345,6 +347,23 @@ unit cgcpu;
so.shiftertype:=SO_LSL;
list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src1,so));
end;
OP_IMUL,
OP_MUL:
begin
{ the arm doesn't allow that rd and rm are the same }
if dst.number=src2.number then
begin
if src1.number<>src2.number then
list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
else
begin
writeln('Warning: Fix MUL');
list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
end;
end
else
list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
end;
else
list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
end;
@ -398,13 +417,128 @@ unit cgcpu;
end;
procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
var
tmpreg : tregister;
tmpref : treference;
instr : taicpu;
begin
tmpreg.enum:=R_INTREGISTER;
tmpreg.number:=NR_NO;
{ Be sure to have a base register }
if (ref.base.number=NR_NO) then
begin
if ref.shiftmode<>SM_None then
internalerror(200308294);
ref.base:=ref.index;
ref.index.number:=NR_NO;
end;
{ When need to use SETHI, do it first }
if assigned(ref.symbol) or
(ref.offset<-4095) or
(ref.offset>4095) then
begin
{
tmpreg:=rg.getregisterint(list,OS_INT);
reference_reset(tmpref);
tmpref.symbol:=ref.symbol;
tmpref.offset:=ref.offset;
tmpref.symaddr:=refs_hi;
list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,tmpreg));
{ Load the low part is left }
{$warning TODO Maybe not needed to load symbol}
tmpref.symaddr:=refs_lo;
list.concat(taicpu.op_reg_ref_reg(A_OR,tmpreg,tmpref,tmpreg));
{ The offset and symbol are loaded, reset in reference }
ref.offset:=0;
ref.symbol:=nil;
{ Only an index register or offset is allowed }
if tmpreg.number<>NR_NO then
begin
if (ref.index.number<>NR_NO) then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg));
ref.index:=tmpreg;
end
else
begin
if ref.base.number<>NR_NO then
ref.index:=tmpreg
else
ref.base:=tmpreg;
end;
end;
}
end;
{
if (ref.base.number<>NR_NO) then
begin
if (ref.index.number<>NR_NO) and
((ref.offset<>0) or assigned(ref.symbol)) then
begin
if tmpreg.number=NR_NO then
tmpreg:=rg.getregisterint(list,OS_INT);
if (ref.index.number<>NR_NO) then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg));
ref.index.number:=NR_NO;
end;
end;
end;
}
instr:=taicpu.op_reg_ref(op,reg,ref);
instr.oppostfix:=oppostfix;
list.concat(instr);
if (tmpreg.number<>NR_NO) then
rg.ungetregisterint(list,tmpreg);
end;
procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
var
oppostfix:toppostfix;
begin
case ToSize of
{ signed integer registers }
OS_8,
OS_S8:
oppostfix:=PF_B;
OS_16,
OS_S16:
oppostfix:=PF_H;
OS_32,
OS_S32:
oppostfix:=PF_None;
else
InternalError(200308295);
end;
handle_load_store(list,A_STR,oppostfix,reg,ref);
end;
procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
var
oppostfix:toppostfix;
begin
case ToSize of
{ signed integer registers }
OS_8:
oppostfix:=PF_B;
OS_S8:
oppostfix:=PF_SB;
OS_16:
oppostfix:=PF_H;
OS_S16:
oppostfix:=PF_SH;
OS_32,
OS_S32:
oppostfix:=PF_None;
else
InternalError(200308291);
end;
handle_load_store(list,A_LDR,oppostfix,reg,ref);
end;
@ -522,12 +656,59 @@ unit cgcpu;
procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
var
rip,rsp,rfp : tregister;
instr : taicpu;
begin
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_STACK_POINTER_REG;
a_reg_alloc(list,rsp);
rfp.enum:=R_INTREGISTER;
rfp.number:=NR_FRAME_POINTER_REG;
a_reg_alloc(list,rfp);
rip.enum:=R_INTREGISTER;
rip.number:=NR_R12;
a_reg_alloc(list,rip);
list.concat(taicpu.op_reg_reg(A_MOV,rip,rsp));
{ restore int registers and return }
instr:=taicpu.op_reg_regset(A_STM,rsp,rg.used_in_proc_int-[RS_R0..RS_R4]+[RS_R11,RS_R12,RS_R15]);
instr.oppostfix:=PF_FD;
list.concat(instr);
list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4));
a_reg_alloc(list,rip);
{ allocate necessary stack size }
list.concat(taicpu.op_reg_reg_const(A_SUB,rsp,rsp,4));
end;
procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword);
var
r1,r2 : tregister;
instr : taicpu;
begin
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin
r1.enum:=R_INTREGISTER;
r1.number:=NR_R15;
r2.enum:=R_INTREGISTER;
r2.number:=NR_R14;
list.concat(taicpu.op_reg_reg(A_MOV,r1,r2));
end
else
begin
r1.enum:=R_INTREGISTER;
r1.number:=NR_R11;
{ restore int registers and return }
instr:=taicpu.op_reg_regset(A_LDM,r1,rg.used_in_proc_int-[RS_R0..RS_R4]+[RS_R11,RS_R13,RS_R15]);
instr.oppostfix:=PF_EA;
list.concat(instr);
end;
end;
@ -617,7 +798,11 @@ begin
end.
{
$Log$
Revision 1.7 2003-08-28 13:26:10 florian
Revision 1.8 2003-08-29 21:36:28 florian
* fixed procedure entry/exit code
* started to fix reference handling
Revision 1.7 2003/08/28 13:26:10 florian
* another couple of arm fixes
Revision 1.6 2003/08/28 00:05:29 florian

21
compiler/arm/cpubase.pas
View File

@ -134,7 +134,7 @@ uses
last_supreg = RS_R15;
{ registers which may be destroyed by calls }
VOLATILE_INTREGISTERS = [RS_R0..RS_R3];
VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15];
VOLATILE_FPUREGISTERS = [R_F0..R_F3];
{ Number of first and last imaginary register. }
@ -201,7 +201,7 @@ uses
{ load/store }
PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
{ multiple load/store address modes }
PF_IA,PF_IB,PF_DA,PF_DB,PF_DF,PF_FA,PF_ED,PF_EA
PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA
);
TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
@ -211,7 +211,7 @@ uses
's',
'd','e','p','ep',
'b','sb','bt','h','sh','t',
'ia','ib','da','db','df','fa','ed','ea');
'ia','ib','da','db','fd','fa','ed','ea');
roundingmode2str : array[TRoundingMode] of string[1] = ('',
'p','m','z');
@ -253,14 +253,15 @@ uses
trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED);
tshiftmode = (SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
{ reference record }
preference = ^treference;
treference = packed record
base,
index : tregister;
scalefactor : byte;
shiftimm : byte;
signindex : shortint;
offset : longint;
symbol : tasmsymbol;
offsetfixup : longint;
@ -483,8 +484,8 @@ uses
Constants
*****************************************************************************}
firstsaveintreg = R_R4;
lastsaveintreg = R_R10;
firstsaveintreg = RS_R4;
lastsaveintreg = RS_R10;
firstsavefpureg = R_F4;
lastsavefpureg = R_F7;
firstsavemmreg = R_S16;
@ -690,7 +691,11 @@ uses
end.
{
$Log$
Revision 1.8 2003-08-28 00:05:29 florian
Revision 1.9 2003-08-29 21:36:28 florian
* fixed procedure entry/exit code
* started to fix reference handling
Revision 1.8 2003/08/28 00:05:29 florian
* today's arm patches
Revision 1.7 2003/08/25 23:20:38 florian