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

* fixed arm concatcopy

Browse Source 
+ 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

174
compiler/aasmtai.pas
View File

@ -442,12 +442,11 @@ interface
procedure loadref(opidx:longint;const r:treference);
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
procedure clearop(opidx:longint);
function is_nop:boolean;virtual;abstract;
function is_move:boolean;virtual;abstract;
{$ifdef NEWRA}
{ 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;
rgget:Trggetproc;
rgunget:Trgungetproc;
@ -491,7 +490,6 @@ interface
resourcesection,rttilist,
resourcestringlist : taasmoutput;
function ppuloadai(ppufile:tcompilerppufile):tai;
procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
@ -1491,6 +1489,10 @@ implementation
case oper[i].typ of
top_ref:
dispose(oper[i].ref);
{$ifdef ARM}
top_shifterop:
dispose(oper[i].shifterop);
{$endif ARM}
end;
inherited destroy;
end;
@ -1506,8 +1508,8 @@ implementation
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
dispose(ref);
if typ<>top_const then
clearop(opidx);
val:=l;
typ:=top_const;
end;
@ -1522,8 +1524,8 @@ implementation
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
dispose(ref);
if typ<>top_symbol then
clearop(opidx);
sym:=s;
symofs:=sofs;
typ:=top_symbol;
@ -1541,7 +1543,11 @@ implementation
with oper[opidx] do
begin
if typ<>top_ref then
new(ref);
begin
clearop(opidx);
new(ref);
end;
ref^:=r;
{$ifdef i386}
{ We allow this exception for i386, since overloading this would be
@ -1569,8 +1575,8 @@ implementation
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
dispose(ref);
if typ<>top_reg then
clearop(opidx);
reg:=r;
typ:=top_reg;
end;
@ -1581,73 +1587,39 @@ implementation
begin
if opidx>=ops then
ops:=opidx+1;
if oper[opidx].typ=top_ref then
dispose(oper[opidx].ref);
clearop(opidx);
oper[opidx]:=o;
{ copy also the reference }
if oper[opidx].typ=top_ref then
begin
new(oper[opidx].ref);
oper[opidx].ref^:=o.ref^;
case oper[opidx].typ of
top_ref:
begin
new(oper[opidx].ref);
oper[opidx].ref^:=o.ref^;
end;
{$ifdef ARM}
top_shifterop:
begin
new(oper[opidx].shifterop);
oper[opidx].shifterop^:=o.shifterop^;
end;
{$endif ARM}
end;
end;
{$ifdef NEWRA}
{ ---------------------------------------------------------------------
Register allocator methods.
---------------------------------------------------------------------}
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
var
back:Tsupregset;
procedure taicpu_abstract.clearop(opidx:longint);
begin
back:=unusedregsint;
get_insert_pos:=p;
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;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
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;
procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset);
begin
{Forward the register allocation again.}
while (p<>self) do
begin
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
p:=Tai(p.next);
with oper[opidx] do
case typ of
top_ref:
dispose(ref);
{$ifdef ARM}
top_shifterop:
dispose(shifterop);
{$endif ARM}
end;
end;
{$endif NEWRA}
{ ---------------------------------------------------------------------
Miscellaneous methods.
@ -1798,7 +1770,7 @@ implementation
begin
{ find the last file information record }
if not (tai(last).typ in SkipLineInfo) then
getlasttaifilepos:=@tailineinfo(last).fileinfo
getlasttaifilepos:=@tailineinfo(last).fileinfo
else
{ go through list backwards to find the first entry
with line information
@ -1809,7 +1781,7 @@ implementation
hp:=hp.Previous;
{ found entry }
if assigned(hp) then
getlasttaifilepos:=@tailineinfo(hp).fileinfo
getlasttaifilepos:=@tailineinfo(hp).fileinfo
end;
end;
end;
@ -1819,6 +1791,10 @@ implementation
var p,q:Tai;
i:shortint;
r:Preference;
{$ifdef arm}
so:pshifterop;
{$endif arm}
begin
p:=Tai(first);
@ -1831,26 +1807,37 @@ implementation
ait_instruction:
begin
for i:=0 to Taicpu_abstract(p).ops-1 do
if Taicpu_abstract(p).oper[i].typ=Top_reg then
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)
else if Taicpu_abstract(p).oper[i].typ=Top_ref then
begin
r:=Taicpu_abstract(p).oper[i].ref;
if r^.base.number<>NR_NO then
r^.base.number:=(r^.base.number and $ff) or
(table[r^.base.number shr 8] shl 8);
if r^.index.number<>NR_NO then
r^.index.number:=(r^.index.number and $ff) or
(table[r^.index.number shr 8] shl 8);
end;
if Taicpu_abstract(p).is_nop then
begin
q:=p;
p:=Tai(p.next);
remove(q);
continue;
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
(table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8);
Top_ref:
begin
r:=Taicpu_abstract(p).oper[i].ref;
if r^.base.number<>NR_NO then
r^.base.number:=(r^.base.number and $ff) or
(table[r^.base.number shr 8] shl 8);
if r^.index.number<>NR_NO then
r^.index.number:=(r^.index.number and $ff) or
(table[r^.index.number shr 8] shl 8);
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
begin
q:=p;
p:=Tai(p.next);
remove(q);
continue;
end;
end;
end;
p:=Tai(p.next);
@ -1860,7 +1847,14 @@ implementation
end.
{
$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
Revision 1.34 2003/08/20 20:29:06 daniel

13
compiler/aggas.pas
View File

@ -83,6 +83,9 @@ implementation
{$ifdef i386}
,itx86att
{$endif}
{$ifdef arm}
,agarmgas
{$endif}
{$ifdef powerpc}
,agppcgas
{$endif}
@ -832,7 +835,14 @@ var
end.
{
$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
Revision 1.28 2003/08/18 11:49:47 daniel
@ -949,4 +959,3 @@ end.
+ basic GNU assembler writer class
}

35
compiler/arm/aasmcpu.pas
View File

@ -93,6 +93,10 @@ uses
{ nothing to add }
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 DoneAsm;
@ -720,10 +724,39 @@ implementation
begin
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.
{
$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
* started to fix reference handling

315
compiler/arm/cgcpu.pas
View File

@ -417,7 +417,6 @@ unit cgcpu;
var
tmpreg : tregister;
tmpref : treference;
instr : taicpu;
l : tasmlabel;
begin
tmpreg.enum:=R_INTREGISTER;
@ -473,6 +472,7 @@ unit cgcpu;
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
@ -488,9 +488,7 @@ unit cgcpu;
ref.offset:=0;
ref.symbol:=nil;
end;
instr:=taicpu.op_reg_ref(op,reg,ref);
instr.oppostfix:=oppostfix;
list.concat(instr);
list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
if (tmpreg.number<>NR_NO) then
rg.ungetregisterint(list,tmpreg);
end;
@ -602,22 +600,44 @@ unit cgcpu;
procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
var
instr : taicpu;
begin
instr:=taicpu.op_reg_reg(A_MVF,reg2,reg1);
instr.oppostfix:=cgsize2fpuoppostfix[size];
list.concat(instr);
list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
end;
procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
var
oppostfix:toppostfix;
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;
procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
var
oppostfix:toppostfix;
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;
@ -695,7 +715,6 @@ unit cgcpu;
procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
var
rip,rsp,rfp : tregister;
instr : taicpu;
begin
LocalSize:=align(LocalSize,4);
@ -713,9 +732,7 @@ unit cgcpu;
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_R3]+[RS_R11,RS_R12,RS_R15]);
instr.oppostfix:=PF_FD;
list.concat(instr);
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));
list.concat(taicpu.op_reg_reg_const(A_SUB,rfp,rip,4));
a_reg_alloc(list,rip);
@ -728,7 +745,6 @@ unit cgcpu;
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
@ -744,9 +760,7 @@ unit cgcpu;
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_R3]+[RS_R11,RS_R13,RS_R15]);
instr.oppostfix:=PF_EA;
list.concat(instr);
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));
end;
end;
@ -758,12 +772,199 @@ unit cgcpu;
procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
tmpreg : tregister;
tmpref : treference;
instr : taicpu;
l : tasmlabel;
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;
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
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;
@ -810,14 +1011,11 @@ unit cgcpu;
procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
var
tmpreg : tregister;
instr : taicpu;
begin
case op of
OP_NEG:
begin
instr:=taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0);
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
end;
else
@ -833,13 +1031,67 @@ unit cgcpu;
procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
var
tmpreg : tregister;
b : byte;
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;
procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
var
instr : taicpu;
begin
case op of
OP_AND,OP_OR,OP_XOR:
@ -849,16 +1101,12 @@ unit cgcpu;
end;
OP_ADD:
begin
instr:=taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo);
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
end;
OP_SUB:
begin
instr:=taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo);
instr.oppostfix:=PF_S;
list.concat(instr);
list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
end;
else
@ -873,7 +1121,14 @@ begin
end.
{
$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 operand postfix for floating point instructions
* fixed wrong shifter constant handling

97
compiler/cgobj.pas
View File

@ -369,7 +369,8 @@ unit cgobj;
{# Generates overflow checking code for a node }
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
a routine declared as @var(interrupt). The default
behavior does nothing, should be overriden as required.
@ -1812,6 +1813,91 @@ unit cgobj;
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);
begin
end;
@ -1879,7 +1965,14 @@ finalization
end.
{
$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 some volatile register bugs
+ -dnotranslation option for -dnewra, which causes the registers not to

17
compiler/compiler.pas
View File

@ -90,6 +90,14 @@ unit compiler;
{$endif}
{$endif}
{$ifdef ARM}
{$ifndef CPUOK}
{$DEFINE CPUOK}
{$else}
{$fatal cannot define two CPU switches}
{$endif ARM}
{$endif ARM}
{$ifndef CPUOK}
{$fatal One of the switches I386, iA64, Alpha, PowerPC or M68K must be defined}
@ -391,7 +399,14 @@ end;
end.
{
$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
Revision 1.37 2003/03/23 23:20:38 hajny

10
compiler/fpcdefs.inc
View File

@ -70,6 +70,7 @@
{$ifdef arm}
{$define callparatemp}
{$define cpuneedsdiv32helper}
{$endif arm}
{ FPU Emulator support }
@ -84,7 +85,14 @@
{
$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
Revision 1.21 2003/07/21 11:52:57 florian

23
compiler/globals.pas
View File

@ -175,6 +175,7 @@ interface
initalignment : talignmentinfo;
initoptprocessor,
initspecificoptprocessor : tprocessors;
initfputype : tfputype;
initasmmode : tasmmode;
initinterfacetype : tinterfacetypes;
initoutputformat : tasm;
@ -196,6 +197,7 @@ interface
aktalignment : talignmentinfo;
aktoptprocessor,
aktspecificoptprocessor : tprocessors;
aktfputype : tfputype;
aktasmmode : tasmmode;
aktinterfacetype : tinterfacetypes;
aktoutputformat : tasm;
@ -1538,6 +1540,9 @@ implementation
{$ifdef i386}
initoptprocessor:=Class386;
initspecificoptprocessor:=Class386;
initfputype:=fpu_x87;
initpackenum:=4;
{$IFDEF testvarsets}
initsetalloc:=0;
@ -1559,6 +1564,7 @@ implementation
initsetalloc:=0;
{$ENDIF}
initasmmode:=asmmode_direct;
initfputype:=fpu_standard;
{$endif powerpc}
{$ifdef sparc}
initoptprocessor:=SPARC_V8;
@ -1568,6 +1574,14 @@ implementation
{$ENDIF}
initasmmode:=asmmode_direct;
{$endif sparc}
{$ifdef arm}
initpackenum:=4;
{$IFDEF testvarsets}
initsetalloc:=0;
{$ENDIF}
initasmmode:=asmmode_direct;
initfputype:=fpu_fpa;
{$endif arm}
initinterfacetype:=it_interfacecom;
initdefproccall:=pocall_none;
initdefines:=TStringList.Create;
@ -1583,7 +1597,14 @@ implementation
end.
{
$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
* some reformatting done

11
compiler/i386/cpubase.inc
View File

@ -95,6 +95,8 @@
maxfpuvarregs = 8;
maxmmvarregs = 8;
{# Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks.
}
@ -208,7 +210,14 @@
{
$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
* parent framepointer code more generic

17
compiler/i386/cpuinfo.pas
View File

@ -54,6 +54,14 @@ Type
ClassP6
);
tfputype =
(no_fpuprocessor,
fpu_soft,
fpu_x87,
fpu_sse,
fpu_sse2
);
Const
{# Size of native extended floating point type }
@ -77,7 +85,14 @@ Implementation
end.
{
$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
Revision 1.15 2002/09/07 20:48:43 carl

17
compiler/ncgadd.pas
View File

@ -55,7 +55,7 @@ interface
procedure second_add64bit;virtual;
procedure second_addordinal;virtual;
procedure second_cmpfloat;virtual;abstract;
procedure second_cmpboolean;virtual;abstract;
procedure second_cmpboolean;virtual;
procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual;abstract;
procedure second_cmpordinal;virtual;abstract;
@ -702,6 +702,12 @@ interface
end;
procedure tcgaddnode.second_cmpboolean;
begin
second_cmpordinal;
end;
{*****************************************************************************
pass_2
*****************************************************************************}
@ -754,7 +760,14 @@ begin
end.
{
$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
Revision 1.14 2003/07/06 17:44:12 peter

10
compiler/ncgflw.pas
View File

@ -918,7 +918,6 @@ implementation
end;
{ does the necessary things to clean up the object stack }
{ in the except block }
procedure cleanupobjectstack;
@ -1544,7 +1543,14 @@ begin
end.
{
$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
Revision 1.75 2003/08/10 17:25:23 peter

11
compiler/ncgld.pas
View File

@ -672,7 +672,7 @@ implementation
end;
if releaseright then
location_release(exprasmlist,right.location);
location_release(exprasmlist,right.location);
location_release(exprasmlist,left.location);
truelabel:=otlabel;
@ -938,7 +938,14 @@ begin
end.
{
$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
Revision 1.76 2003/08/20 20:11:24 daniel

205
compiler/ncgmat.pas
View File

@ -97,6 +97,8 @@ type
end;
tcgshlshrnode = class(tshlshrnode)
procedure second_64bit;virtual;
procedure second_integer;virtual;
procedure pass_2;override;
end;
@ -354,117 +356,125 @@ implementation
*****************************************************************************}
procedure tcgshlshrnode.pass_2;
procedure tcgshlshrnode.second_64bit;
var
hcountreg : tregister;
op : topcg;
pushedregs : tmaybesave;
freescratch : boolean;
op : topcg;
begin
freescratch:=false;
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}
{$ifdef cpu64bit}
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
freescratch:=false;
location_reset(location,LOC_REGISTER,OS_64);
if is_64bit(left.resulttype.def) then
{ load left operator in a register }
location_force_reg(exprasmlist,left.location,OS_64,false);
location_copy(location,left.location);
if (right.nodetype=ordconstn) 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);
{ load left operator in a register }
location_force_reg(exprasmlist,left.location,OS_64,false);
location_copy(location,left.location);
if (right.nodetype=ordconstn) then
begin
cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
joinreg64(location.registerlow,location.registerhigh));
end
else
begin
{ this should be handled in pass_1 }
internalerror(2002081501);
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
freescratch := true;
end
else
hcountreg:=right.location.register;
cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
joinreg64(location.registerlow,location.registerhigh));
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;*)
cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
joinreg64(location.registerlow,location.registerhigh));
end
else
begin
{ load left operators in a register }
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false);
{ this should be handled in pass_1 }
internalerror(2002081501);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
if right.location.loc<>LOC_REGISTER then
begin
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
if right.value<=31 then
}
cg.a_op_const_reg(exprasmlist,op,location.size,
tordconstnode(right).value and 31,location.register);
{
else
emit_reg_reg(A_XOR,S_L,hregister1,
hregister1);
}
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
freescratch := true;
end
else
begin
{ load right operators in a register - this
is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec)
}
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
{$ifdef newra}
hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
freescratch := true;
cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
end
else
hcountreg:=right.location.register;
cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
{$ifdef newra}
if freescratch then
rg.ungetregisterint(exprasmlist,hcountreg);
{$else}
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
{$endif}
end;
hcountreg:=right.location.register;
cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
joinreg64(location.registerlow,location.registerhigh));
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;
{$else cpu64bit}
{ already hanled in 1st pass }
internalerror(2002081501);
{$endif cpu64bit}
end;
procedure tcgshlshrnode.second_integer;
var
freescratch : boolean;
op : topcg;
hcountreg : tregister;
begin
freescratch:=false;
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
{ load left operators in a register }
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
begin
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
if right.value<=31 then
}
cg.a_op_const_reg(exprasmlist,op,location.size,
tordconstnode(right).value and 31,location.register);
{
else
emit_reg_reg(A_XOR,S_L,hregister1,
hregister1);
}
end
else
begin
{ load right operators in a register - this
is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec)
}
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
{$ifdef newra}
hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
freescratch := true;
cg.a_load_loc_reg(exprasmlist,right.location.size,right.location,hcountreg);
end
else
hcountreg:=right.location.register;
cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
{$ifdef newra}
if freescratch then
rg.ungetregisterint(exprasmlist,hcountreg);
{$else}
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
{$endif}
end;
end;
procedure tcgshlshrnode.pass_2;
begin
secondpass(left);
secondpass(right);
if is_64bit(left.resulttype.def) then
second_64bit
else
second_integer;
end;
@ -514,7 +524,14 @@ begin
end.
{
$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
* sparc calling convention updates

13
compiler/ncgutil.pas
View File

@ -214,6 +214,8 @@ implementation
location_release(list,p.location);
cg.a_jmp_always(list,falselabel);
end;
LOC_JUMP:
;
{$ifdef cpuflags}
LOC_FLAGS :
begin
@ -222,6 +224,8 @@ implementation
cg.a_jmp_always(list,falselabel);
end;
{$endif cpuflags}
else
internalerror(200308241);
end;
end;
end
@ -2079,7 +2083,14 @@ implementation
end.
{
$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
* Preventive code to loadref added

45
compiler/nmat.pas
View File

@ -38,6 +38,7 @@ interface
{ parts explicitely in the code generator (JM) }
function first_moddiv64bitint: tnode; virtual;
function firstoptimize: tnode; virtual;
function first_moddivint: tnode; virtual;
end;
tmoddivnodeclass = class of tmoddivnode;
@ -236,6 +237,38 @@ implementation
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;
var
procname: string[31];
@ -351,6 +384,9 @@ implementation
end
else
begin
result := first_moddivint;
if assigned(result) then
exit;
left_right_max;
if left.registers32<=right.registers32 then
inc(registers32);
@ -795,7 +831,14 @@ begin
end.
{
$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
Revision 1.48 2003/05/09 17:47:02 peter

10
compiler/nmem.pas
View File

@ -382,6 +382,7 @@ implementation
if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
begin
aktfilepos:=left.fileinfo;
printnode(output,left);
CGMessage(cg_e_illegal_expression);
end;
@ -854,7 +855,14 @@ begin
end.
{
$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
Revision 1.59 2003/06/17 19:24:08 jonas

12
compiler/node.pas
View File

@ -619,7 +619,8 @@ implementation
else
write(t,' ,resulttype = <nil>');
writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
', loc = ',tcgloc2str[location.loc],
// ', loc = ',tcgloc2str[location.loc],
', expectloc = ',tcgloc2str[expectloc],
', intregs = ',registers32,
', fpuregs = ',registersfpu);
end;
@ -980,7 +981,14 @@ implementation
end.
{
$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
Revision 1.62 2003/05/26 21:17:17 peter

36
compiler/options.pas
View File

@ -370,6 +370,7 @@ var
j,l : longint;
d : DirStr;
e : ExtStr;
s : string;
forceasm : tasm;
begin
if opt='' then
@ -483,6 +484,26 @@ begin
include(initmoduleswitches,cs_fp_emulation);
end;
{$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' :
begin
val(copy(more,j+1,length(more)-j),heapsize,code);
@ -1700,6 +1721,12 @@ begin
def_symbol('CPUVIS');
def_symbol('CPU32');
{$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 }
{$ifdef Delphi}
@ -1925,7 +1952,14 @@ finalization
end.
{
$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
* inherited result code check moven to pexpr

13
compiler/parser.pas
View File

@ -281,6 +281,7 @@ implementation
oldaktoutputformat : tasm;
oldaktspecificoptprocessor,
oldaktoptprocessor : tprocessors;
oldaktfputype : tfputype;
oldaktasmmode : tasmmode;
oldaktinterfacetype: tinterfacetypes;
oldaktmodeswitches : tmodeswitches;
@ -355,6 +356,7 @@ implementation
oldaktmoduleswitches:=aktmoduleswitches;
oldaktalignment:=aktalignment;
oldaktpackenum:=aktpackenum;
oldaktfputype:=aktfputype;
oldaktmaxfpuregisters:=aktmaxfpuregisters;
oldaktoutputformat:=aktoutputformat;
oldaktoptprocessor:=aktoptprocessor;
@ -409,6 +411,7 @@ implementation
aktsetalloc:=initsetalloc;
{$ENDIF}
aktalignment:=initalignment;
aktfputype:=initfputype;
aktpackenum:=initpackenum;
aktoutputformat:=initoutputformat;
set_target_asm(aktoutputformat);
@ -542,6 +545,7 @@ implementation
set_target_asm(aktoutputformat);
aktoptprocessor:=oldaktoptprocessor;
aktspecificoptprocessor:=oldaktspecificoptprocessor;
aktfputype:=oldaktfputype;
aktasmmode:=oldaktasmmode;
aktinterfacetype:=oldaktinterfacetype;
aktfilepos:=oldaktfilepos;
@ -619,7 +623,14 @@ implementation
end.
{
$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
Revision 1.54 2003/06/12 16:41:51 peter

10
compiler/pdecsub.pas
View File

@ -181,6 +181,7 @@ implementation
end;
vs:=tvarsym.create('$self',vsp,tt);
include(vs.varoptions,vo_is_self);
include(vs.varoptions,vo_regable);
{ Insert as hidden parameter }
pd.parast.insert(vs);
pd.insertpara(vs.vartype,vs,nil,true);
@ -2167,7 +2168,14 @@ const
end.
{
$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
* sparc calling convention updates

10
compiler/powerpc/cpubase.pas
View File

@ -384,7 +384,6 @@ uses
toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool);
toper=record
ot : longint;
case typ : toptype of
top_none : ();
top_reg : (reg:tregister);
@ -861,7 +860,14 @@ implementation
end.
{
$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 some volatile register bugs
+ -dnotranslation option for -dnewra, which causes the registers not to

16
compiler/powerpc/cpuinfo.pas
View File

@ -46,6 +46,13 @@ Type
ppc604
);
tfputype =
(no_fpuprocessor,
fpu_soft,
fpu_standard
);
Const
{# Size of native extended floating point type }
extended_size = 8;
@ -67,7 +74,14 @@ Implementation
end.
{
$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
Revision 1.12 2002/09/07 20:57:08 carl

15
compiler/pp.pas
View File

@ -112,6 +112,12 @@ program pp;
{$endif CPUDEFINED}
{$define CPUDEFINED}
{$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}
{$fatal A CPU type switch must be defined}
{$endif CPUDEFINED}
@ -190,7 +196,14 @@ begin
end.
{
$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
Revision 1.23 2003/07/06 15:31:21 daniel

21
compiler/psub.pas
View File

@ -726,9 +726,15 @@ implementation
if assigned(aktlocaldata) and
(not aktlocaldata.empty) then
begin
aktproccode.concat(Tai_section.Create(sec_data));
aktproccode.concatlist(aktlocaldata);
aktproccode.concat(Tai_section.Create(sec_code));
{ 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
aktproccode.concat(Tai_section.Create(sec_data));
aktproccode.concatlist(aktlocaldata);
aktproccode.concat(Tai_section.Create(sec_code));
end;
end;
{ add the procedure to the codesegment }
@ -1306,7 +1312,14 @@ begin
end.
{
$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
* order of stackalloc code fixed for implicit init/final

21
compiler/psystem.pas
View File

@ -273,6 +273,10 @@ implementation
ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype;
{$endif}
{$ifdef arm}
ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype;
{$endif arm}
end;
@ -344,6 +348,14 @@ implementation
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$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 }
voidpointertype.setdef(tpointerdef.create(voidtype));
charpointertype.setdef(tpointerdef.create(cchartype));
@ -492,7 +504,14 @@ implementation
end.
{
$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
Revision 1.52 2003/05/26 21:17:18 peter

18
compiler/rgobj.pas
View File

@ -2445,7 +2445,10 @@ unit rgobj;
ref.index.enum:=R_INTREGISTER;
{$ifdef i386}
ref.segment.enum:=R_INTREGISTER;
{$endif}
{$endif i386}
{$ifdef arm}
ref.signindex:=1;
{$endif arm}
end;
procedure reference_reset_old(var ref : treference);
@ -2489,7 +2492,6 @@ unit rgobj;
end;
{****************************************************************************
TLocation
****************************************************************************}
@ -2512,6 +2514,9 @@ unit rgobj;
{$ifdef i386}
l.reference.segment.enum:=R_INTREGISTER;
{$endif}
{$ifdef arm}
l.reference.signindex:=1;
{$endif arm}
end;
end;
end;
@ -2565,7 +2570,14 @@ end.
{
$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
Revision 1.66 2003/08/17 16:59:20 jonas

13
compiler/scanner.pas
View File

@ -2720,8 +2720,12 @@ exit_label:
end;
repeat
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;
{$endif arm}
'/' :
begin
readchar;
@ -2808,7 +2812,14 @@ exit_label:
end.
{
$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
Revision 1.59 2003/05/25 10:26:43 peter

11
compiler/sparc/ncpumat.pas
View File

@ -2,7 +2,7 @@
$Id$
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
it under the terms of the GNU General Public License as published by
@ -353,7 +353,14 @@ begin
end.
{
$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
Revision 1.11 2003/06/12 16:43:07 peter

12
compiler/symdef.pas
View File

@ -739,6 +739,9 @@ interface
{$ifdef vis}
pbestrealtype : ^ttype = @s64floattype;
{$endif vis}
{$ifdef ARM}
pbestrealtype : ^ttype = @s64floattype;
{$endif ARM}
function mangledname_prefix(typeprefix:string;st:tsymtable):string;
@ -5838,7 +5841,14 @@ implementation
end.
{
$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
Revision 1.157 2003/07/08 15:20:56 peter

11
compiler/symsym.pas
View File

@ -1,4 +1,4 @@
{
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
@ -2669,7 +2669,14 @@ implementation
end.
{
$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
* Preventive code to loadref added

13
compiler/systems/i_linux.pas
View File

@ -420,7 +420,7 @@ unit i_linux;
name : 'Linux for ARM';
shortname : 'linux';
flags : [];
cpu : cpu_SPARC;
cpu : cpu_arm;
unit_env : 'LINUXUNITS';
extradefines : 'UNIX;HASUNIX';
sourceext : '.pp';
@ -454,7 +454,7 @@ unit i_linux;
ar : ar_gnu_ar;
res : res_none;
script : script_unix;
endian : endian_big;
endian : endian_little;
alignment :
(
procalign : 4;
@ -522,7 +522,14 @@ initialization
end.
{
$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
Revision 1.9 2003/07/06 17:58:22 peter

15
compiler/x86/cpubase.pas
View File

@ -57,13 +57,13 @@ uses
TAsmOp={$i i386op.inc}
{$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];
const
{# First value of opcode enumeration }
{ First value of opcode enumeration }
firstop = low(tasmop);
{# Last value of opcode enumeration }
{ Last value of opcode enumeration }
lastop = high(tasmop);
{*****************************************************************************
@ -723,7 +723,14 @@ implementation
end.
{
$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
Revision 1.12 2003/08/17 16:59:20 jonas