* fixed arm concatcopy

+ arm support in the common compiler sources added
  * moved some generic cg code around
  + tfputype added
  * ...
This commit is contained in:
florian 2003-09-03 11:18:36 +00:00
parent e47ffaa0ac
commit 220e05dd5e
33 changed files with 1007 additions and 263 deletions

View File

@ -442,12 +442,11 @@ interface
procedure loadref(opidx:longint;const r:treference); procedure loadref(opidx:longint;const r:treference);
procedure loadreg(opidx:longint;r:tregister); procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper); procedure loadoper(opidx:longint;o:toper);
procedure clearop(opidx:longint);
function is_nop:boolean;virtual;abstract; function is_nop:boolean;virtual;abstract;
function is_move:boolean;virtual;abstract; function is_move:boolean;virtual;abstract;
{$ifdef NEWRA} {$ifdef NEWRA}
{ register allocator } { register allocator }
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
procedure forward_allocation(p:Tai;var unusedregsint:Tsupregset);
function spill_registers(list:Taasmoutput; function spill_registers(list:Taasmoutput;
rgget:Trggetproc; rgget:Trggetproc;
rgunget:Trgungetproc; rgunget:Trgungetproc;
@ -491,7 +490,6 @@ interface
resourcesection,rttilist, resourcesection,rttilist,
resourcestringlist : taasmoutput; resourcestringlist : taasmoutput;
function ppuloadai(ppufile:tcompilerppufile):tai; function ppuloadai(ppufile:tcompilerppufile):tai;
procedure ppuwriteai(ppufile:tcompilerppufile;n:tai); procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
@ -1491,6 +1489,10 @@ implementation
case oper[i].typ of case oper[i].typ of
top_ref: top_ref:
dispose(oper[i].ref); dispose(oper[i].ref);
{$ifdef ARM}
top_shifterop:
dispose(oper[i].shifterop);
{$endif ARM}
end; end;
inherited destroy; inherited destroy;
end; end;
@ -1506,8 +1508,8 @@ implementation
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ<>top_const then
dispose(ref); clearop(opidx);
val:=l; val:=l;
typ:=top_const; typ:=top_const;
end; end;
@ -1522,8 +1524,8 @@ implementation
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ<>top_symbol then
dispose(ref); clearop(opidx);
sym:=s; sym:=s;
symofs:=sofs; symofs:=sofs;
typ:=top_symbol; typ:=top_symbol;
@ -1541,7 +1543,11 @@ implementation
with oper[opidx] do with oper[opidx] do
begin begin
if typ<>top_ref then if typ<>top_ref then
begin
clearop(opidx);
new(ref); new(ref);
end;
ref^:=r; ref^:=r;
{$ifdef i386} {$ifdef i386}
{ We allow this exception for i386, since overloading this would be { We allow this exception for i386, since overloading this would be
@ -1569,8 +1575,8 @@ implementation
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ<>top_reg then
dispose(ref); clearop(opidx);
reg:=r; reg:=r;
typ:=top_reg; typ:=top_reg;
end; end;
@ -1581,73 +1587,39 @@ implementation
begin begin
if opidx>=ops then if opidx>=ops then
ops:=opidx+1; ops:=opidx+1;
if oper[opidx].typ=top_ref then clearop(opidx);
dispose(oper[opidx].ref);
oper[opidx]:=o; oper[opidx]:=o;
{ copy also the reference } { copy also the reference }
if oper[opidx].typ=top_ref then case oper[opidx].typ of
top_ref:
begin begin
new(oper[opidx].ref); new(oper[opidx].ref);
oper[opidx].ref^:=o.ref^; oper[opidx].ref^:=o.ref^;
end; end;
end; {$ifdef ARM}
top_shifterop:
{$ifdef NEWRA}
{ ---------------------------------------------------------------------
Register allocator methods.
---------------------------------------------------------------------}
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
var
back:Tsupregset;
begin begin
back:=unusedregsint; new(oper[opidx].shifterop);
get_insert_pos:=p; oper[opidx].shifterop^:=o.shifterop^;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
begin
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
if Tai_regalloc(p).reg.number shr 8=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end; end;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then {$endif ARM}
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end; end;
if Tai_regalloc(p).reg.number shr 8=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
end;
p:=Tai(p.previous);
end;
unusedregsint:=back;
end; end;
procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset); procedure taicpu_abstract.clearop(opidx:longint);
begin begin
{Forward the register allocation again.} with oper[opidx] do
while (p<>self) do case typ of
begin top_ref:
if p.typ<>ait_regalloc then dispose(ref);
internalerror(200305311); {$ifdef ARM}
if Tai_regalloc(p).allocation then top_shifterop:
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8) dispose(shifterop);
else {$endif ARM}
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
p:=Tai(p.next);
end; end;
end; end;
{$endif NEWRA}
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Miscellaneous methods. Miscellaneous methods.
@ -1819,6 +1791,10 @@ implementation
var p,q:Tai; var p,q:Tai;
i:shortint; i:shortint;
r:Preference; r:Preference;
{$ifdef arm}
so:pshifterop;
{$endif arm}
begin begin
p:=Tai(first); p:=Tai(first);
@ -1831,10 +1807,11 @@ implementation
ait_instruction: ait_instruction:
begin begin
for i:=0 to Taicpu_abstract(p).ops-1 do for i:=0 to Taicpu_abstract(p).ops-1 do
if Taicpu_abstract(p).oper[i].typ=Top_reg then case Taicpu_abstract(p).oper[i].typ of
Top_reg:
Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
(table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8) (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8);
else if Taicpu_abstract(p).oper[i].typ=Top_ref then Top_ref:
begin begin
r:=Taicpu_abstract(p).oper[i].ref; r:=Taicpu_abstract(p).oper[i].ref;
if r^.base.number<>NR_NO then if r^.base.number<>NR_NO then
@ -1844,6 +1821,16 @@ implementation
r^.index.number:=(r^.index.number and $ff) or r^.index.number:=(r^.index.number and $ff) or
(table[r^.index.number shr 8] shl 8); (table[r^.index.number shr 8] shl 8);
end; end;
{$ifdef arm}
Top_shifterop:
begin
so:=Taicpu_abstract(p).oper[i].shifterop;
if so^.rs.number<>NR_NO then
so^.rs.number:=(so^.rs.number and $ff) or
(table[so^.rs.number shr 8] shl 8);
end;
{$endif arm}
end;
if Taicpu_abstract(p).is_nop then if Taicpu_abstract(p).is_nop then
begin begin
q:=p; q:=p;
@ -1860,7 +1847,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.35 2003-08-21 14:47:41 peter Revision 1.36 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.35 2003/08/21 14:47:41 peter
* remove convert_registers * remove convert_registers
Revision 1.34 2003/08/20 20:29:06 daniel Revision 1.34 2003/08/20 20:29:06 daniel

View File

@ -83,6 +83,9 @@ implementation
{$ifdef i386} {$ifdef i386}
,itx86att ,itx86att
{$endif} {$endif}
{$ifdef arm}
,agarmgas
{$endif}
{$ifdef powerpc} {$ifdef powerpc}
,agppcgas ,agppcgas
{$endif} {$endif}
@ -832,7 +835,14 @@ var
end. end.
{ {
$Log$ $Log$
Revision 1.29 2003-08-19 11:53:03 daniel Revision 1.30 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.29 2003/08/19 11:53:03 daniel
* Fixed PowerPC compilation * Fixed PowerPC compilation
Revision 1.28 2003/08/18 11:49:47 daniel Revision 1.28 2003/08/18 11:49:47 daniel
@ -949,4 +959,3 @@ end.
+ basic GNU assembler writer class + basic GNU assembler writer class
} }

View File

@ -93,6 +93,10 @@ uses
{ nothing to add } { nothing to add }
end; end;
function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
function setcondition(i : taicpu;c : tasmcond) : taicpu;
procedure InitAsm; procedure InitAsm;
procedure DoneAsm; procedure DoneAsm;
@ -720,10 +724,39 @@ implementation
begin begin
end; end;
function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
begin
i.oppostfix:=pf;
result:=i;
end;
function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
begin
i.roundingmode:=rm;
result:=i;
end;
function setcondition(i : taicpu;c : tasmcond) : taicpu;
begin
i.condition:=c;
result:=i;
end;
end. end.
{ {
$Log$ $Log$
Revision 1.7 2003-08-29 21:36:28 florian Revision 1.8 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.7 2003/08/29 21:36:28 florian
* fixed procedure entry/exit code * fixed procedure entry/exit code
* started to fix reference handling * started to fix reference handling

View File

@ -417,7 +417,6 @@ unit cgcpu;
var var
tmpreg : tregister; tmpreg : tregister;
tmpref : treference; tmpref : treference;
instr : taicpu;
l : tasmlabel; l : tasmlabel;
begin begin
tmpreg.enum:=R_INTREGISTER; tmpreg.enum:=R_INTREGISTER;
@ -473,6 +472,7 @@ unit cgcpu;
if ref.index.number<>NR_NO then if ref.index.number<>NR_NO then
begin begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
rg.ungetregister(list,ref.base);
ref.base:=tmpreg; ref.base:=tmpreg;
end end
else else
@ -488,9 +488,7 @@ unit cgcpu;
ref.offset:=0; ref.offset:=0;
ref.symbol:=nil; ref.symbol:=nil;
end; end;
instr:=taicpu.op_reg_ref(op,reg,ref); list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
instr.oppostfix:=oppostfix;
list.concat(instr);
if (tmpreg.number<>NR_NO) then if (tmpreg.number<>NR_NO) then
rg.ungetregisterint(list,tmpreg); rg.ungetregisterint(list,tmpreg);
end; end;
@ -602,22 +600,44 @@ unit cgcpu;
procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
var
instr : taicpu;
begin begin
instr:=taicpu.op_reg_reg(A_MVF,reg2,reg1); list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
instr.oppostfix:=cgsize2fpuoppostfix[size];
list.concat(instr);
end; end;
procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
var
oppostfix:toppostfix;
begin begin
case size of
OS_F32:
oppostfix:=PF_S;
OS_F64:
oppostfix:=PF_D;
OS_F80:
oppostfix:=PF_E;
else
InternalError(200309021);
end;
handle_load_store(list,A_LDF,oppostfix,reg,ref);
end; end;
procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
var
oppostfix:toppostfix;
begin begin
case size of
OS_F32:
oppostfix:=PF_S;
OS_F64:
oppostfix:=PF_D;
OS_F80:
oppostfix:=PF_E;
else
InternalError(200309021);
end;
handle_load_store(list,A_STF,oppostfix,reg,ref);
end; end;
@ -695,7 +715,6 @@ unit cgcpu;
procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint); procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
var var
rip,rsp,rfp : tregister; rip,rsp,rfp : tregister;
instr : taicpu;
begin begin
LocalSize:=align(LocalSize,4); LocalSize:=align(LocalSize,4);
@ -713,9 +732,7 @@ unit cgcpu;
list.concat(taicpu.op_reg_reg(A_MOV,rip,rsp)); list.concat(taicpu.op_reg_reg(A_MOV,rip,rsp));
{ restore int registers and return } { restore int registers and return }
instr:=taicpu.op_reg_regset(A_STM,rsp,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R12,RS_R15]); list.concat(setoppostfix(taicpu.op_reg_regset(A_STM,rsp,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R12,RS_R15]),PF_FD));
instr.oppostfix:=PF_FD;
list.concat(instr);
list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4)); list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4));
a_reg_alloc(list,rip); a_reg_alloc(list,rip);
@ -728,7 +745,6 @@ unit cgcpu;
procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword); procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword);
var var
r1,r2 : tregister; r1,r2 : tregister;
instr : taicpu;
begin begin
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin begin
@ -744,9 +760,7 @@ unit cgcpu;
r1.enum:=R_INTREGISTER; r1.enum:=R_INTREGISTER;
r1.number:=NR_R11; r1.number:=NR_R11;
{ restore int registers and return } { restore int registers and return }
instr:=taicpu.op_reg_regset(A_LDM,r1,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R13,RS_R15]); list.concat(setoppostfix(taicpu.op_reg_regset(A_LDM,r1,rg.used_in_proc_int-[RS_R0..RS_R3]+[RS_R11,RS_R13,RS_R15]),PF_EA));
instr.oppostfix:=PF_EA;
list.concat(instr);
end; end;
end; end;
@ -758,12 +772,199 @@ unit cgcpu;
procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
tmpreg : tregister;
tmpref : treference;
instr : taicpu;
l : tasmlabel;
begin 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;
{ absolute symbols can't be handled directly, we've to store the symbol reference
in the text segment and access it pc relative
For now, we assume that references where base or index equals to PC are already
relative, all other references are assumed to be absolute and thus they need
to be handled extra.
A proper solution would be to change refoptions to a set and store the information
if the symbol is absolute or relative there.
}
if (assigned(ref.symbol) and
not(is_pc(ref.base)) and
not(is_pc(ref.index))
) or
(ref.offset<-4095) or
(ref.offset>4095) then
begin
{ check consts distance }
{ create consts entry }
objectlibrary.getdatalabel(l);
current_procinfo.aktlocaldata.concat(Tai_symbol.Create(l,0));
if assigned(ref.symbol) then
current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
else
current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
{ load consts entry }
tmpreg:=rg.getregisterint(list,OS_INT);
reference_reset(tmpref);
tmpref.symbol:=l;
tmpref.base.enum:=R_INTREGISTER;
tmpref.base.number:=NR_R15;
list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
if (ref.base.number<>NR_NO) then
begin
if ref.index.number<>NR_NO then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
rg.ungetregister(list,ref.base);
ref.base:=tmpreg;
end
else
begin
ref.index:=tmpreg;
ref.shiftimm:=0;
ref.signindex:=1;
ref.shiftmode:=SM_None;
end;
end
else
ref.base:=tmpreg;
ref.offset:=0;
ref.symbol:=nil;
end;
list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix);
if (tmpreg.number<>NR_NO) then
rg.ungetregisterint(list,tmpreg);
}
end; end;
procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean); procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
var
srcref,dstref:treference;
srcreg,destreg,countreg,r:tregister;
helpsize:aword;
copysize:byte;
cgsize:Tcgsize;
procedure genloop(count : aword;size : byte);
const
size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
var
l : tasmlabel;
begin begin
objectlibrary.getdatalabel(l);
a_load_const_reg(list,OS_INT,count,countreg);
list.concat(Tai_symbol.Create(l,0));
srcref.addressmode:=AM_POSTINDEXED;
dstref.addressmode:=AM_POSTINDEXED;
srcref.offset:=size;
dstref.offset:=size;
r:=rg.getregisterint(list,size2opsize[size]);
a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
rg.ungetregisterint(list,r);
list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE));
end;
begin
helpsize:=12;
if cs_littlesize in aktglobalswitches then
helpsize:=8;
if not loadref and (len<=helpsize) then
begin
dstref:=dest;
srcref:=source;
copysize:=4;
cgsize:=OS_32;
while len<>0 do
begin
if len<2 then
begin
copysize:=1;
cgsize:=OS_8;
end
else if len<4 then
begin
copysize:=2;
cgsize:=OS_16;
end;
dec(len,copysize);
r:=rg.getregisterint(list,cgsize);
a_load_ref_reg(list,cgsize,cgsize,srcref,r);
if (len=0) and delsource then
reference_release(list,source);
a_load_reg_ref(list,cgsize,cgsize,r,dstref);
inc(srcref.offset,copysize);
inc(dstref.offset,copysize);
rg.ungetregisterint(list,r);
end;
end
else
begin
destreg:=rg.getregisterint(list,OS_ADDR);
a_loadaddr_ref_reg(list,dest,destreg);
srcreg:=rg.getregisterint(list,OS_ADDR);
if loadref then
a_load_ref_reg(list,OS_ADDR,OS_ADDR,source,srcreg)
else
begin
a_loadaddr_ref_reg(list,source,srcreg);
if delsource then
begin
srcref:=source;
reference_release(list,srcref);
end;
end;
countreg:=rg.getregisterint(list,OS_32);
// if cs_littlesize in aktglobalswitches then
genloop(len,1);
{
else
begin
helpsize:=len shr 2;
len:=len and 3;
if helpsize>1 then
begin
a_load_const_reg(list,OS_INT,helpsize,countreg);
list.concat(Taicpu.op_none(A_REP,S_NO));
end;
if helpsize>0 then
list.concat(Taicpu.op_none(A_MOVSD,S_NO));
if len>1 then
begin
dec(len,2);
list.concat(Taicpu.op_none(A_MOVSW,S_NO));
end;
if len=1 then
list.concat(Taicpu.op_none(A_MOVSB,S_NO));
end;
}
rg.ungetregisterint(list,countreg);
rg.ungetregisterint(list,srcreg);
rg.ungetregisterint(list,destreg);
end;
if delsource then
tg.ungetiftemp(list,source);
end; end;
@ -810,14 +1011,11 @@ unit cgcpu;
procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64); procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
var var
tmpreg : tregister; tmpreg : tregister;
instr : taicpu;
begin begin
case op of case op of
OP_NEG: OP_NEG:
begin begin
instr:=taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0); list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0)); list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
end; end;
else else
@ -833,13 +1031,67 @@ unit cgcpu;
procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64); procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
var
tmpreg : tregister;
b : byte;
begin begin
case op of
OP_AND,OP_OR,OP_XOR:
begin
cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
end;
OP_ADD:
begin
if is_shifter_const(lo(value),b) then
list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
else
begin
tmpreg:=rg.getregisterint(list,OS_32);
cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
rg.ungetregisterint(list,tmpreg);
end;
if is_shifter_const(hi(value),b) then
list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
else
begin
tmpreg:=rg.getregisterint(list,OS_32);
cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
end;
OP_SUB:
begin
if is_shifter_const(lo(value),b) then
list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
else
begin
tmpreg:=rg.getregisterint(list,OS_32);
cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
rg.ungetregisterint(list,tmpreg);
end;
if is_shifter_const(hi(value),b) then
list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
else
begin
tmpreg:=rg.getregisterint(list,OS_32);
cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
end;
else
internalerror(2003083101);
end;
end; end;
procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64); procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
var
instr : taicpu;
begin begin
case op of case op of
OP_AND,OP_OR,OP_XOR: OP_AND,OP_OR,OP_XOR:
@ -849,16 +1101,12 @@ unit cgcpu;
end; end;
OP_ADD: OP_ADD:
begin begin
instr:=taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo); list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi)); list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
end; end;
OP_SUB: OP_SUB:
begin begin
instr:=taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo); list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi)); list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
end; end;
else else
@ -873,7 +1121,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.10 2003-09-01 15:11:16 florian Revision 1.11 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.10 2003/09/01 15:11:16 florian
* fixed reference handling * fixed reference handling
* fixed operand postfix for floating point instructions * fixed operand postfix for floating point instructions
* fixed wrong shifter constant handling * fixed wrong shifter constant handling

View File

@ -369,7 +369,8 @@ unit cgobj;
{# Generates overflow checking code for a node } {# Generates overflow checking code for a node }
procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract; procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
procedure g_copyvaluepara_openarray(list : taasmoutput;const arrayref,lenref:treference;elesize:integer);virtual;abstract; procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);virtual;abstract;
// procedure g_copyvaluepara_openarray(list : taasmoutput;const arrayref,lenref:tparalocation;elesize:integer);virtual;
{# Emits instructions which should be emitted when entering {# Emits instructions which should be emitted when entering
a routine declared as @var(interrupt). The default a routine declared as @var(interrupt). The default
behavior does nothing, should be overriden as required. behavior does nothing, should be overriden as required.
@ -1812,6 +1813,91 @@ unit cgobj;
Entry/Exit Code Functions Entry/Exit Code Functions
*****************************************************************************} *****************************************************************************}
{ procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const arrayloc,lenloc : tparalocation;elesize:integer);
var
power,len : longint;
opsize : topsize;
r,r2,rsp:Tregister;
begin
{
{ get stack space }
r.enum:=R_INTREGISTER;
r.number:=NR_EDI;
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_ESP;
r2.enum:=R_INTREGISTER;
rg.getexplicitregisterint(list,NR_EDI);
list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
list.concat(Taicpu.op_reg(A_INC,S_L,r));
if (elesize<>1) then
begin
if ispowerof2(elesize, power) then
list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
else
list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
end;
list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
{ align stack on 4 bytes }
list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,rsp));
{ load destination }
a_load_reg_reg(list,OS_INT,OS_INT,rsp,r);
{ don't destroy the registers! }
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
r2.number:=NR_ESI;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
{ load count }
r2.number:=NR_ECX;
a_load_ref_reg(list,OS_INT,OS_INT,lenref,r2);
{ load source }
r2.number:=NR_ESI;
a_load_ref_reg(list,OS_INT,OS_INT,ref,r2);
{ scheduled .... }
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_INC,S_L,r2));
{ calculate size }
len:=elesize;
opsize:=S_B;
if (len and 3)=0 then
begin
opsize:=S_L;
len:=len shr 2;
end
else
if (len and 1)=0 then
begin
opsize:=S_W;
len:=len shr 1;
end;
if ispowerof2(len, power) then
list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r2))
else
list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,r2));
list.concat(Taicpu.op_none(A_REP,S_NO));
case opsize of
S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO));
S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO));
end;
rg.ungetregisterint(list,r);
r2.number:=NR_ESI;
list.concat(Taicpu.op_reg(A_POP,S_L,r2));
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_POP,S_L,r2));
{ patch the new address }
a_load_reg_ref(list,OS_INT,OS_INT,rsp,ref);
}
end;
}
procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput); procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
begin begin
end; end;
@ -1879,7 +1965,14 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.116 2003-08-17 16:59:20 jonas Revision 1.117 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.116 2003/08/17 16:59:20 jonas
* fixed regvars so they work with newra (at least for ppc) * fixed regvars so they work with newra (at least for ppc)
* fixed some volatile register bugs * fixed some volatile register bugs
+ -dnotranslation option for -dnewra, which causes the registers not to + -dnotranslation option for -dnewra, which causes the registers not to

View File

@ -90,6 +90,14 @@ unit compiler;
{$endif} {$endif}
{$endif} {$endif}
{$ifdef ARM}
{$ifndef CPUOK}
{$DEFINE CPUOK}
{$else}
{$fatal cannot define two CPU switches}
{$endif ARM}
{$endif ARM}
{$ifndef CPUOK} {$ifndef CPUOK}
{$fatal One of the switches I386, iA64, Alpha, PowerPC or M68K must be defined} {$fatal One of the switches I386, iA64, Alpha, PowerPC or M68K must be defined}
@ -391,7 +399,14 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.38 2003-05-22 21:39:51 peter Revision 1.39 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.38 2003/05/22 21:39:51 peter
* add cgcpu * add cgcpu
Revision 1.37 2003/03/23 23:20:38 hajny Revision 1.37 2003/03/23 23:20:38 hajny

View File

@ -70,6 +70,7 @@
{$ifdef arm} {$ifdef arm}
{$define callparatemp} {$define callparatemp}
{$define cpuneedsdiv32helper}
{$endif arm} {$endif arm}
{ FPU Emulator support } { FPU Emulator support }
@ -84,7 +85,14 @@
{ {
$Log$ $Log$
Revision 1.22 2003-08-11 21:18:20 peter Revision 1.23 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.22 2003/08/11 21:18:20 peter
* start of sparc support for newra * start of sparc support for newra
Revision 1.21 2003/07/21 11:52:57 florian Revision 1.21 2003/07/21 11:52:57 florian

View File

@ -175,6 +175,7 @@ interface
initalignment : talignmentinfo; initalignment : talignmentinfo;
initoptprocessor, initoptprocessor,
initspecificoptprocessor : tprocessors; initspecificoptprocessor : tprocessors;
initfputype : tfputype;
initasmmode : tasmmode; initasmmode : tasmmode;
initinterfacetype : tinterfacetypes; initinterfacetype : tinterfacetypes;
initoutputformat : tasm; initoutputformat : tasm;
@ -196,6 +197,7 @@ interface
aktalignment : talignmentinfo; aktalignment : talignmentinfo;
aktoptprocessor, aktoptprocessor,
aktspecificoptprocessor : tprocessors; aktspecificoptprocessor : tprocessors;
aktfputype : tfputype;
aktasmmode : tasmmode; aktasmmode : tasmmode;
aktinterfacetype : tinterfacetypes; aktinterfacetype : tinterfacetypes;
aktoutputformat : tasm; aktoutputformat : tasm;
@ -1538,6 +1540,9 @@ implementation
{$ifdef i386} {$ifdef i386}
initoptprocessor:=Class386; initoptprocessor:=Class386;
initspecificoptprocessor:=Class386; initspecificoptprocessor:=Class386;
initfputype:=fpu_x87;
initpackenum:=4; initpackenum:=4;
{$IFDEF testvarsets} {$IFDEF testvarsets}
initsetalloc:=0; initsetalloc:=0;
@ -1559,6 +1564,7 @@ implementation
initsetalloc:=0; initsetalloc:=0;
{$ENDIF} {$ENDIF}
initasmmode:=asmmode_direct; initasmmode:=asmmode_direct;
initfputype:=fpu_standard;
{$endif powerpc} {$endif powerpc}
{$ifdef sparc} {$ifdef sparc}
initoptprocessor:=SPARC_V8; initoptprocessor:=SPARC_V8;
@ -1568,6 +1574,14 @@ implementation
{$ENDIF} {$ENDIF}
initasmmode:=asmmode_direct; initasmmode:=asmmode_direct;
{$endif sparc} {$endif sparc}
{$ifdef arm}
initpackenum:=4;
{$IFDEF testvarsets}
initsetalloc:=0;
{$ENDIF}
initasmmode:=asmmode_direct;
initfputype:=fpu_fpa;
{$endif arm}
initinterfacetype:=it_interfacecom; initinterfacetype:=it_interfacecom;
initdefproccall:=pocall_none; initdefproccall:=pocall_none;
initdefines:=TStringList.Create; initdefines:=TStringList.Create;
@ -1583,7 +1597,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.92 2003-05-23 22:33:48 florian Revision 1.93 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.92 2003/05/23 22:33:48 florian
* fix some small flaws which prevent sparc linux system unit from compiling * fix some small flaws which prevent sparc linux system unit from compiling
* some reformatting done * some reformatting done

View File

@ -95,6 +95,8 @@
maxfpuvarregs = 8; maxfpuvarregs = 8;
maxmmvarregs = 8;
{# Registers which are defined as scratch and no need to save across {# Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks. routine calls or in assembler blocks.
} }
@ -208,7 +210,14 @@
{ {
$Log$ $Log$
Revision 1.7 2003-07-06 17:58:22 peter Revision 1.8 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.7 2003/07/06 17:58:22 peter
* framepointer fixes for sparc * framepointer fixes for sparc
* parent framepointer code more generic * parent framepointer code more generic

View File

@ -54,6 +54,14 @@ Type
ClassP6 ClassP6
); );
tfputype =
(no_fpuprocessor,
fpu_soft,
fpu_x87,
fpu_sse,
fpu_sse2
);
Const Const
{# Size of native extended floating point type } {# Size of native extended floating point type }
@ -77,7 +85,14 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.16 2002-12-05 14:18:09 florian Revision 1.17 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.16 2002/12/05 14:18:09 florian
* two comments fixed * two comments fixed
Revision 1.15 2002/09/07 20:48:43 carl Revision 1.15 2002/09/07 20:48:43 carl

View File

@ -55,7 +55,7 @@ interface
procedure second_add64bit;virtual; procedure second_add64bit;virtual;
procedure second_addordinal;virtual; procedure second_addordinal;virtual;
procedure second_cmpfloat;virtual;abstract; procedure second_cmpfloat;virtual;abstract;
procedure second_cmpboolean;virtual;abstract; procedure second_cmpboolean;virtual;
procedure second_cmpsmallset;virtual;abstract; procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual;abstract; procedure second_cmp64bit;virtual;abstract;
procedure second_cmpordinal;virtual;abstract; procedure second_cmpordinal;virtual;abstract;
@ -702,6 +702,12 @@ interface
end; end;
procedure tcgaddnode.second_cmpboolean;
begin
second_cmpordinal;
end;
{***************************************************************************** {*****************************************************************************
pass_2 pass_2
*****************************************************************************} *****************************************************************************}
@ -754,7 +760,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.15 2003-07-08 21:24:59 peter Revision 1.16 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.15 2003/07/08 21:24:59 peter
* sparc fixes * sparc fixes
Revision 1.14 2003/07/06 17:44:12 peter Revision 1.14 2003/07/06 17:44:12 peter

View File

@ -918,7 +918,6 @@ implementation
end; end;
{ does the necessary things to clean up the object stack } { does the necessary things to clean up the object stack }
{ in the except block } { in the except block }
procedure cleanupobjectstack; procedure cleanupobjectstack;
@ -1544,7 +1543,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.76 2003-08-24 21:38:43 olle Revision 1.77 2003-09-03 11:18:36 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.76 2003/08/24 21:38:43 olle
* made FPC_RAISEEXCEPTION compatible with MacOS * made FPC_RAISEEXCEPTION compatible with MacOS
Revision 1.75 2003/08/10 17:25:23 peter Revision 1.75 2003/08/10 17:25:23 peter

View File

@ -938,7 +938,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.77 2003-08-20 20:13:08 daniel Revision 1.78 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.77 2003/08/20 20:13:08 daniel
* Fixed the fixed trouble * Fixed the fixed trouble
Revision 1.76 2003/08/20 20:11:24 daniel Revision 1.76 2003/08/20 20:11:24 daniel

View File

@ -97,6 +97,8 @@ type
end; end;
tcgshlshrnode = class(tshlshrnode) tcgshlshrnode = class(tshlshrnode)
procedure second_64bit;virtual;
procedure second_integer;virtual;
procedure pass_2;override; procedure pass_2;override;
end; end;
@ -354,35 +356,18 @@ implementation
*****************************************************************************} *****************************************************************************}
procedure tcgshlshrnode.pass_2; procedure tcgshlshrnode.second_64bit;
var var
hcountreg : tregister;
op : topcg;
pushedregs : tmaybesave;
freescratch : boolean; freescratch : boolean;
op : topcg;
begin begin
freescratch:=false; {$ifdef cpu64bit}
secondpass(left);
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif newra}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
{ determine operator } { determine operator }
case nodetype of case nodetype of
shln: op:=OP_SHL; shln: op:=OP_SHL;
shrn: op:=OP_SHR; shrn: op:=OP_SHR;
end; end;
freescratch:=false;
if is_64bit(left.resulttype.def) then
begin
{ already hanled in 1st pass }
internalerror(2002081501);
(* Normally for 64-bit cpu's this here should be here,
and only pass_1 need to be overriden, but dunno how to
do that!
location_reset(location,LOC_REGISTER,OS_64); location_reset(location,LOC_REGISTER,OS_64);
{ load left operator in a register } { load left operator in a register }
@ -413,10 +398,25 @@ implementation
joinreg64(location.registerlow,location.registerhigh)); joinreg64(location.registerlow,location.registerhigh));
if freescratch then if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg); cg.free_scratch_reg(exprasmlist,hcountreg);
end;*) end;
end {$else cpu64bit}
else { already hanled in 1st pass }
internalerror(2002081501);
{$endif cpu64bit}
end;
procedure tcgshlshrnode.second_integer;
var
freescratch : boolean;
op : topcg;
hcountreg : tregister;
begin begin
freescratch:=false;
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
{ load left operators in a register } { load left operators in a register }
location_copy(location,left.location); location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false); location_force_reg(exprasmlist,location,OS_INT,false);
@ -465,6 +465,16 @@ implementation
{$endif} {$endif}
end; end;
end; end;
procedure tcgshlshrnode.pass_2;
begin
secondpass(left);
secondpass(right);
if is_64bit(left.resulttype.def) then
second_64bit
else
second_integer;
end; end;
@ -514,7 +524,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.15 2003-07-02 22:18:04 peter Revision 1.16 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.15 2003/07/02 22:18:04 peter
* paraloc splitted in callerparaloc,calleeparaloc * paraloc splitted in callerparaloc,calleeparaloc
* sparc calling convention updates * sparc calling convention updates

View File

@ -214,6 +214,8 @@ implementation
location_release(list,p.location); location_release(list,p.location);
cg.a_jmp_always(list,falselabel); cg.a_jmp_always(list,falselabel);
end; end;
LOC_JUMP:
;
{$ifdef cpuflags} {$ifdef cpuflags}
LOC_FLAGS : LOC_FLAGS :
begin begin
@ -222,6 +224,8 @@ implementation
cg.a_jmp_always(list,falselabel); cg.a_jmp_always(list,falselabel);
end; end;
{$endif cpuflags} {$endif cpuflags}
else
internalerror(200308241);
end; end;
end; end;
end end
@ -2079,7 +2083,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.137 2003-08-20 20:29:06 daniel Revision 1.138 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.137 2003/08/20 20:29:06 daniel
* Some more R_NO changes * Some more R_NO changes
* Preventive code to loadref added * Preventive code to loadref added

View File

@ -38,6 +38,7 @@ interface
{ parts explicitely in the code generator (JM) } { parts explicitely in the code generator (JM) }
function first_moddiv64bitint: tnode; virtual; function first_moddiv64bitint: tnode; virtual;
function firstoptimize: tnode; virtual; function firstoptimize: tnode; virtual;
function first_moddivint: tnode; virtual;
end; end;
tmoddivnodeclass = class of tmoddivnode; tmoddivnodeclass = class of tmoddivnode;
@ -236,6 +237,38 @@ implementation
end; end;
function tmoddivnode.first_moddivint: tnode;
var
procname: string[31];
begin
{$ifdef cpuneedsdiv32helper}
begin
result := nil;
{ otherwise create a call to a helper }
if nodetype = divn then
procname := 'fpc_div_'
else
procname := 'fpc_mod_';
{ only qword needs the unsigned code, the
signed code is also used for currency }
if is_signed(resulttype.def) then
procname := procname + 'longint'
else
procname := procname + 'dword';
result := ccallnode.createintern(procname,ccallparanode.create(left,
ccallparanode.create(right,nil)));
left := nil;
right := nil;
firstpass(result);
end;
{$else cpuneedsdiv32helper}
result:=nil;
{$endif cpuneedsdiv32helper}
end;
function tmoddivnode.first_moddiv64bitint: tnode; function tmoddivnode.first_moddiv64bitint: tnode;
var var
procname: string[31]; procname: string[31];
@ -351,6 +384,9 @@ implementation
end end
else else
begin begin
result := first_moddivint;
if assigned(result) then
exit;
left_right_max; left_right_max;
if left.registers32<=right.registers32 then if left.registers32<=right.registers32 then
inc(registers32); inc(registers32);
@ -795,7 +831,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.49 2003-05-24 16:32:34 jonas Revision 1.50 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.49 2003/05/24 16:32:34 jonas
* fixed expectloc of notnode for all processors that have flags * fixed expectloc of notnode for all processors that have flags
Revision 1.48 2003/05/09 17:47:02 peter Revision 1.48 2003/05/09 17:47:02 peter

View File

@ -382,6 +382,7 @@ implementation
if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
begin begin
aktfilepos:=left.fileinfo; aktfilepos:=left.fileinfo;
printnode(output,left);
CGMessage(cg_e_illegal_expression); CGMessage(cg_e_illegal_expression);
end; end;
@ -854,7 +855,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.60 2003-08-10 17:25:23 peter Revision 1.61 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.60 2003/08/10 17:25:23 peter
* fixed some reported bugs * fixed some reported bugs
Revision 1.59 2003/06/17 19:24:08 jonas Revision 1.59 2003/06/17 19:24:08 jonas

View File

@ -619,7 +619,8 @@ implementation
else else
write(t,' ,resulttype = <nil>'); write(t,' ,resulttype = <nil>');
writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')', writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
', loc = ',tcgloc2str[location.loc], // ', loc = ',tcgloc2str[location.loc],
', expectloc = ',tcgloc2str[expectloc],
', intregs = ',registers32, ', intregs = ',registers32,
', fpuregs = ',registersfpu); ', fpuregs = ',registersfpu);
end; end;
@ -980,7 +981,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.63 2003-08-10 17:25:23 peter Revision 1.64 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.63 2003/08/10 17:25:23 peter
* fixed some reported bugs * fixed some reported bugs
Revision 1.62 2003/05/26 21:17:17 peter Revision 1.62 2003/05/26 21:17:17 peter

View File

@ -370,6 +370,7 @@ var
j,l : longint; j,l : longint;
d : DirStr; d : DirStr;
e : ExtStr; e : ExtStr;
s : string;
forceasm : tasm; forceasm : tasm;
begin begin
if opt='' then if opt='' then
@ -483,6 +484,26 @@ begin
include(initmoduleswitches,cs_fp_emulation); include(initmoduleswitches,cs_fp_emulation);
end; end;
{$endif cpufpemu} {$endif cpufpemu}
{$ifdef arm}
'f' :
begin
s:=upper(copy(more,j+1,length(more)-j));
if s='SOFT' then
initfputype:=fpu_soft
else if s='FPA' then
initfputype:=fpu_fpa
else if s='FPA10' then
initfputype:=fpu_fpa10
else if s='FPA11' then
initfputype:=fpu_fpa11
else if s='VFP' then
initfputype:=fpu_vfp
else
IllegalPara(opt);
break;
end;
{$endif arm}
'h' : 'h' :
begin begin
val(copy(more,j+1,length(more)-j),heapsize,code); val(copy(more,j+1,length(more)-j),heapsize,code);
@ -1700,6 +1721,12 @@ begin
def_symbol('CPUVIS'); def_symbol('CPUVIS');
def_symbol('CPU32'); def_symbol('CPU32');
{$endif} {$endif}
{$ifdef arm}
def_symbol('CPUARM');
def_symbol('CPU32');
def_symbol('FPC_HAS_TYPE_DOUBLE');
def_symbol('FPC_HAS_TYPE_SINGLE');
{$endif arm}
{ get default messagefile } { get default messagefile }
{$ifdef Delphi} {$ifdef Delphi}
@ -1925,7 +1952,14 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.99 2003-05-13 19:14:41 peter Revision 1.100 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.99 2003/05/13 19:14:41 peter
* failn removed * failn removed
* inherited result code check moven to pexpr * inherited result code check moven to pexpr

View File

@ -281,6 +281,7 @@ implementation
oldaktoutputformat : tasm; oldaktoutputformat : tasm;
oldaktspecificoptprocessor, oldaktspecificoptprocessor,
oldaktoptprocessor : tprocessors; oldaktoptprocessor : tprocessors;
oldaktfputype : tfputype;
oldaktasmmode : tasmmode; oldaktasmmode : tasmmode;
oldaktinterfacetype: tinterfacetypes; oldaktinterfacetype: tinterfacetypes;
oldaktmodeswitches : tmodeswitches; oldaktmodeswitches : tmodeswitches;
@ -355,6 +356,7 @@ implementation
oldaktmoduleswitches:=aktmoduleswitches; oldaktmoduleswitches:=aktmoduleswitches;
oldaktalignment:=aktalignment; oldaktalignment:=aktalignment;
oldaktpackenum:=aktpackenum; oldaktpackenum:=aktpackenum;
oldaktfputype:=aktfputype;
oldaktmaxfpuregisters:=aktmaxfpuregisters; oldaktmaxfpuregisters:=aktmaxfpuregisters;
oldaktoutputformat:=aktoutputformat; oldaktoutputformat:=aktoutputformat;
oldaktoptprocessor:=aktoptprocessor; oldaktoptprocessor:=aktoptprocessor;
@ -409,6 +411,7 @@ implementation
aktsetalloc:=initsetalloc; aktsetalloc:=initsetalloc;
{$ENDIF} {$ENDIF}
aktalignment:=initalignment; aktalignment:=initalignment;
aktfputype:=initfputype;
aktpackenum:=initpackenum; aktpackenum:=initpackenum;
aktoutputformat:=initoutputformat; aktoutputformat:=initoutputformat;
set_target_asm(aktoutputformat); set_target_asm(aktoutputformat);
@ -542,6 +545,7 @@ implementation
set_target_asm(aktoutputformat); set_target_asm(aktoutputformat);
aktoptprocessor:=oldaktoptprocessor; aktoptprocessor:=oldaktoptprocessor;
aktspecificoptprocessor:=oldaktspecificoptprocessor; aktspecificoptprocessor:=oldaktspecificoptprocessor;
aktfputype:=oldaktfputype;
aktasmmode:=oldaktasmmode; aktasmmode:=oldaktasmmode;
aktinterfacetype:=oldaktinterfacetype; aktinterfacetype:=oldaktinterfacetype;
aktfilepos:=oldaktfilepos; aktfilepos:=oldaktfilepos;
@ -619,7 +623,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.55 2003-06-13 21:19:30 peter Revision 1.56 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.55 2003/06/13 21:19:30 peter
* current_procdef removed, use current_procinfo.procdef instead * current_procdef removed, use current_procinfo.procdef instead
Revision 1.54 2003/06/12 16:41:51 peter Revision 1.54 2003/06/12 16:41:51 peter

View File

@ -181,6 +181,7 @@ implementation
end; end;
vs:=tvarsym.create('$self',vsp,tt); vs:=tvarsym.create('$self',vsp,tt);
include(vs.varoptions,vo_is_self); include(vs.varoptions,vo_is_self);
include(vs.varoptions,vo_regable);
{ Insert as hidden parameter } { Insert as hidden parameter }
pd.parast.insert(vs); pd.parast.insert(vs);
pd.insertpara(vs.vartype,vs,nil,true); pd.insertpara(vs.vartype,vs,nil,true);
@ -2167,7 +2168,14 @@ const
end. end.
{ {
$Log$ $Log$
Revision 1.129 2003-07-02 22:18:04 peter Revision 1.130 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.129 2003/07/02 22:18:04 peter
* paraloc splitted in callerparaloc,calleeparaloc * paraloc splitted in callerparaloc,calleeparaloc
* sparc calling convention updates * sparc calling convention updates

View File

@ -384,7 +384,6 @@ uses
toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool); toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool);
toper=record toper=record
ot : longint;
case typ : toptype of case typ : toptype of
top_none : (); top_none : ();
top_reg : (reg:tregister); top_reg : (reg:tregister);
@ -861,7 +860,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.64 2003-08-17 16:59:20 jonas Revision 1.65 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.64 2003/08/17 16:59:20 jonas
* fixed regvars so they work with newra (at least for ppc) * fixed regvars so they work with newra (at least for ppc)
* fixed some volatile register bugs * fixed some volatile register bugs
+ -dnotranslation option for -dnewra, which causes the registers not to + -dnotranslation option for -dnewra, which causes the registers not to

View File

@ -46,6 +46,13 @@ Type
ppc604 ppc604
); );
tfputype =
(no_fpuprocessor,
fpu_soft,
fpu_standard
);
Const Const
{# Size of native extended floating point type } {# Size of native extended floating point type }
extended_size = 8; extended_size = 8;
@ -67,7 +74,14 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.13 2003-04-26 20:15:22 florian Revision 1.14 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.13 2003/04/26 20:15:22 florian
* fixed setjmp record size * fixed setjmp record size
Revision 1.12 2002/09/07 20:57:08 carl Revision 1.12 2002/09/07 20:57:08 carl

View File

@ -112,6 +112,12 @@ program pp;
{$endif CPUDEFINED} {$endif CPUDEFINED}
{$define CPUDEFINED} {$define CPUDEFINED}
{$endif SPARC} {$endif SPARC}
{$ifdef ARM}
{$ifdef CPUDEFINED}
{$fatal ONLY one of the switches for the CPU type must be defined}
{$endif CPUDEFINED}
{$define CPUDEFINED}
{$endif ARM}
{$ifndef CPUDEFINED} {$ifndef CPUDEFINED}
{$fatal A CPU type switch must be defined} {$fatal A CPU type switch must be defined}
{$endif CPUDEFINED} {$endif CPUDEFINED}
@ -190,7 +196,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.24 2003-07-07 19:59:41 peter Revision 1.25 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.24 2003/07/07 19:59:41 peter
* Fix halt() call * Fix halt() call
Revision 1.23 2003/07/06 15:31:21 daniel Revision 1.23 2003/07/06 15:31:21 daniel

View File

@ -725,11 +725,17 @@ implementation
{ save local data (casetable) also in the same file } { save local data (casetable) also in the same file }
if assigned(aktlocaldata) and if assigned(aktlocaldata) and
(not aktlocaldata.empty) then (not aktlocaldata.empty) then
begin
{ because of the limited constant size of the arm, all data access is done pc relative }
if target_info.cpu=cpu_arm then
aktproccode.concatlist(aktlocaldata)
else
begin begin
aktproccode.concat(Tai_section.Create(sec_data)); aktproccode.concat(Tai_section.Create(sec_data));
aktproccode.concatlist(aktlocaldata); aktproccode.concatlist(aktlocaldata);
aktproccode.concat(Tai_section.Create(sec_code)); aktproccode.concat(Tai_section.Create(sec_code));
end; end;
end;
{ add the procedure to the codesegment } { add the procedure to the codesegment }
if (cs_create_smart in aktmoduleswitches) then if (cs_create_smart in aktmoduleswitches) then
@ -1306,7 +1312,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.138 2003-08-20 17:48:49 peter Revision 1.139 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.138 2003/08/20 17:48:49 peter
* fixed stackalloc to not allocate localst.datasize twice * fixed stackalloc to not allocate localst.datasize twice
* order of stackalloc code fixed for implicit init/final * order of stackalloc code fixed for implicit init/final

View File

@ -273,6 +273,10 @@ implementation
ordpointertype:=u32bittype; ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype; defaultordconsttype:=s32bittype;
{$endif} {$endif}
{$ifdef arm}
ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype;
{$endif arm}
end; end;
@ -344,6 +348,14 @@ implementation
s80floattype.setdef(tfloatdef.create(s80real)); s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64))); s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif} {$endif}
{$ifdef arm}
ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif arm}
{ some other definitions } { some other definitions }
voidpointertype.setdef(tpointerdef.create(voidtype)); voidpointertype.setdef(tpointerdef.create(voidtype));
charpointertype.setdef(tpointerdef.create(cchartype)); charpointertype.setdef(tpointerdef.create(cchartype));
@ -492,7 +504,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.53 2003-08-10 17:25:23 peter Revision 1.54 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.53 2003/08/10 17:25:23 peter
* fixed some reported bugs * fixed some reported bugs
Revision 1.52 2003/05/26 21:17:18 peter Revision 1.52 2003/05/26 21:17:18 peter

View File

@ -2445,7 +2445,10 @@ unit rgobj;
ref.index.enum:=R_INTREGISTER; ref.index.enum:=R_INTREGISTER;
{$ifdef i386} {$ifdef i386}
ref.segment.enum:=R_INTREGISTER; ref.segment.enum:=R_INTREGISTER;
{$endif} {$endif i386}
{$ifdef arm}
ref.signindex:=1;
{$endif arm}
end; end;
procedure reference_reset_old(var ref : treference); procedure reference_reset_old(var ref : treference);
@ -2489,7 +2492,6 @@ unit rgobj;
end; end;
{**************************************************************************** {****************************************************************************
TLocation TLocation
****************************************************************************} ****************************************************************************}
@ -2512,6 +2514,9 @@ unit rgobj;
{$ifdef i386} {$ifdef i386}
l.reference.segment.enum:=R_INTREGISTER; l.reference.segment.enum:=R_INTREGISTER;
{$endif} {$endif}
{$ifdef arm}
l.reference.signindex:=1;
{$endif arm}
end; end;
end; end;
end; end;
@ -2565,7 +2570,14 @@ end.
{ {
$Log$ $Log$
Revision 1.67 2003-08-23 10:46:21 daniel Revision 1.68 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.67 2003/08/23 10:46:21 daniel
* Register allocator bugfix for h2pas * Register allocator bugfix for h2pas
Revision 1.66 2003/08/17 16:59:20 jonas Revision 1.66 2003/08/17 16:59:20 jonas

View File

@ -2720,8 +2720,12 @@ exit_label:
end; end;
repeat repeat
case c of case c of
{$ifndef arm}
// the { ... } is used in ARM assembler to define register sets, so we can't used
// it as comment, either (* ... *), /* ... */ or // ... should be used instead
'{' : '{' :
skipcomment; skipcomment;
{$endif arm}
'/' : '/' :
begin begin
readchar; readchar;
@ -2808,7 +2812,14 @@ exit_label:
end. end.
{ {
$Log$ $Log$
Revision 1.60 2003-08-10 17:25:23 peter Revision 1.61 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.60 2003/08/10 17:25:23 peter
* fixed some reported bugs * fixed some reported bugs
Revision 1.59 2003/05/25 10:26:43 peter Revision 1.59 2003/05/25 10:26:43 peter

View File

@ -2,7 +2,7 @@
$Id$ $Id$
Copyright (c) 1998-2002 by Florian Klaempfl Copyright (c) 1998-2002 by Florian Klaempfl
Generate PowerPC assembler for math nodes Generate SPARC assembler for math nodes
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
@ -353,7 +353,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.12 2003-07-06 22:09:32 peter Revision 1.13 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.12 2003/07/06 22:09:32 peter
* shr and div fixed * shr and div fixed
Revision 1.11 2003/06/12 16:43:07 peter Revision 1.11 2003/06/12 16:43:07 peter

View File

@ -739,6 +739,9 @@ interface
{$ifdef vis} {$ifdef vis}
pbestrealtype : ^ttype = @s64floattype; pbestrealtype : ^ttype = @s64floattype;
{$endif vis} {$endif vis}
{$ifdef ARM}
pbestrealtype : ^ttype = @s64floattype;
{$endif ARM}
function mangledname_prefix(typeprefix:string;st:tsymtable):string; function mangledname_prefix(typeprefix:string;st:tsymtable):string;
@ -5838,7 +5841,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.158 2003-08-11 21:18:20 peter Revision 1.159 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.158 2003/08/11 21:18:20 peter
* start of sparc support for newra * start of sparc support for newra
Revision 1.157 2003/07/08 15:20:56 peter Revision 1.157 2003/07/08 15:20:56 peter

View File

@ -1,4 +1,4 @@
{ {
$Id$ $Id$
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
@ -2669,7 +2669,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.113 2003-08-20 20:29:06 daniel Revision 1.114 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.113 2003/08/20 20:29:06 daniel
* Some more R_NO changes * Some more R_NO changes
* Preventive code to loadref added * Preventive code to loadref added

View File

@ -420,7 +420,7 @@ unit i_linux;
name : 'Linux for ARM'; name : 'Linux for ARM';
shortname : 'linux'; shortname : 'linux';
flags : []; flags : [];
cpu : cpu_SPARC; cpu : cpu_arm;
unit_env : 'LINUXUNITS'; unit_env : 'LINUXUNITS';
extradefines : 'UNIX;HASUNIX'; extradefines : 'UNIX;HASUNIX';
sourceext : '.pp'; sourceext : '.pp';
@ -454,7 +454,7 @@ unit i_linux;
ar : ar_gnu_ar; ar : ar_gnu_ar;
res : res_none; res : res_none;
script : script_unix; script : script_unix;
endian : endian_big; endian : endian_little;
alignment : alignment :
( (
procalign : 4; procalign : 4;
@ -522,7 +522,14 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.10 2003-07-21 11:52:57 florian Revision 1.11 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.10 2003/07/21 11:52:57 florian
* very basic stuff for the arm * very basic stuff for the arm
Revision 1.9 2003/07/06 17:58:22 peter Revision 1.9 2003/07/06 17:58:22 peter

View File

@ -57,13 +57,13 @@ uses
TAsmOp={$i i386op.inc} TAsmOp={$i i386op.inc}
{$endif x86_64} {$endif x86_64}
{# This should define the array of instructions as string } { This should define the array of instructions as string }
op2strtable=array[tasmop] of string[11]; op2strtable=array[tasmop] of string[11];
const const
{# First value of opcode enumeration } { First value of opcode enumeration }
firstop = low(tasmop); firstop = low(tasmop);
{# Last value of opcode enumeration } { Last value of opcode enumeration }
lastop = high(tasmop); lastop = high(tasmop);
{***************************************************************************** {*****************************************************************************
@ -723,7 +723,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.13 2003-08-20 07:48:04 daniel Revision 1.14 2003-09-03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.13 2003/08/20 07:48:04 daniel
* Made internal assembler use new register coding * Made internal assembler use new register coding
Revision 1.12 2003/08/17 16:59:20 jonas Revision 1.12 2003/08/17 16:59:20 jonas