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

* support > 32bit accesses for x86_64

Browse Source 
* rewrote array size checking to support 64bit
This commit is contained in:
peter 2004-11-01 23:30:11 +00:00
parent 0be40bde03
commit 9b00c7832e
10 changed files with 326 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/aasmbase.pas
View File

@ -198,7 +198,7 @@ interface
end;
TAsmObjectDataClass = class of TAsmObjectData;
tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))] of tasmsymbol;
tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))-1] of tasmsymbol;
pasmsymbolidxarr = ^tasmsymbolidxarr;
TAsmLibraryData = class(TLinkedListItem)
@ -941,7 +941,11 @@ implementation
end.
{
$Log$
Revision 1.23 2004-10-31 21:45:02 peter
Revision 1.24 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.23 2004/10/31 21:45:02 peter
* generic tlocation
* move tlocation to cgutils

10
compiler/defutil.pas
View File

@ -671,7 +671,7 @@ implementation
if error then
begin
{ Fix the value to fit in the allocated space for this type of variable }
case def.size of
case longint(def.size) of
1: l := l and $ff;
2: l := l and $ffff;
{ work around sign extension bug (to be fixed) (JM) }
@ -680,7 +680,7 @@ implementation
{ do sign extension if necessary (JM) }
if is_signed(def) then
begin
case def.size of
case longint(def.size) of
1: l := shortint(l);
2: l := smallint(l);
4: l := longint(l);
@ -888,7 +888,11 @@ implementation
end.
{
$Log$
Revision 1.20 2004-10-31 21:45:02 peter
Revision 1.21 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.20 2004/10/31 21:45:02 peter
* generic tlocation
* move tlocation to cgutils

27
compiler/ncgmem.pas
View File

@ -60,7 +60,7 @@ interface
private
procedure rangecheck_array;
protected
function get_mul_size : longint;
function get_mul_size : aint;
{# This routine is used to calculate the address of the reference.
On entry reg contains the index in the array,
and l contains the size of each element in the array.
@ -437,7 +437,7 @@ implementation
TCGVECNODE
*****************************************************************************}
function tcgvecnode.get_mul_size : longint;
function tcgvecnode.get_mul_size : aint;
begin
if nf_memindex in flags then
get_mul_size:=1
@ -557,14 +557,15 @@ implementation
var
offsetdec,
extraoffset : longint;
t : tnode;
href : treference;
otl,ofl : tasmlabel;
newsize : tcgsize;
mulsize: longint;
isjump : boolean;
paraloc1,paraloc2 : tcgpara;
extraoffset : aint;
t : tnode;
href : treference;
otl,ofl : tasmlabel;
newsize : tcgsize;
mulsize : aint;
isjump : boolean;
paraloc1,
paraloc2 : tcgpara;
begin
paraloc1.init;
paraloc2.init;
@ -877,7 +878,11 @@ begin
end.
{
$Log$
Revision 1.100 2004-11-01 17:15:47 peter
Revision 1.101 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.100 2004/11/01 17:15:47 peter
* no checkpointer code for dynarr to openarr
Revision 1.99 2004/11/01 15:31:57 peter

8
compiler/ncnv.pas
View File

@ -1327,7 +1327,7 @@ implementation
{ Insert typeconv for ordinal to the correct size first on left, after
that the other conversion can be done }
htype.reset;
case resulttype.def.size of
case longint(resulttype.def.size) of
1 :
htype:=s8inttype;
2 :
@ -2467,7 +2467,11 @@ begin
end.
{
$Log$
Revision 1.159 2004-11-01 17:15:47 peter
Revision 1.160 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.159 2004/11/01 17:15:47 peter
* no checkpointer code for dynarr to openarr
Revision 1.158 2004/11/01 15:31:58 peter

8
compiler/ptconst.pas
View File

@ -519,7 +519,7 @@ implementation
if equal_defs(p.resulttype.def,t.def) or
is_subequal(p.resulttype.def,t.def) then
begin
case p.resulttype.def.size of
case longint(p.resulttype.def.size) of
1 : curconstSegment.concat(Tai_const.Create_8bit(Byte(tordconstnode(p).value)));
2 : curconstSegment.concat(Tai_const.Create_16bit(Word(tordconstnode(p).value)));
4 : curconstSegment.concat(Tai_const.Create_32bit(Longint(tordconstnode(p).value)));
@ -1089,7 +1089,11 @@ implementation
end.
{
$Log$
Revision 1.93 2004-11-01 15:32:12 peter
Revision 1.94 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.93 2004/11/01 15:32:12 peter
* support @labelsym
Revision 1.92 2004/10/15 09:14:17 mazen

15
compiler/ptype.pas
View File

@ -341,7 +341,7 @@ implementation
procedure array_dec;
var
lowval,
highval : longint;
highval : aint;
arraytype : ttype;
ht : ttype;
@ -361,6 +361,9 @@ implementation
if torddef(t.def).typ in [uchar,
u8bit,u16bit,
s8bit,s16bit,s32bit,
{$ifdef cpu64bit}
u32bit,s64bit,
{$endif cpu64bit}
bool8bit,bool16bit,bool32bit,
uwidechar] then
begin
@ -384,8 +387,8 @@ implementation
consume(_LECKKLAMMER);
{ defaults }
arraytype:=generrortype;
lowval:=longint($80000000);
highval:=$7fffffff;
lowval:=low(aint);
highval:=high(aint);
tt.reset;
repeat
{ read the expression and check it, check apart if the
@ -656,7 +659,11 @@ implementation
end.
{
$Log$
Revision 1.68 2004-06-20 08:55:30 florian
Revision 1.69 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.68 2004/06/20 08:55:30 florian
* logs truncated
Revision 1.67 2004/06/16 20:07:09 florian

216
compiler/symdef.pas
View File

@ -77,7 +77,7 @@ interface
procedure buildderefimpl;override;
procedure deref;override;
procedure derefimpl;override;
function size:longint;override;
function size:aint;override;
function alignment:longint;override;
function is_publishable : boolean;override;
function needs_inittable : boolean;override;
@ -100,7 +100,7 @@ interface
function is_intregable : boolean;
function is_fpuregable : boolean;
private
savesize : longint;
savesize : aint;
end;
tparaitem = class(TLinkedListItem)
@ -241,7 +241,7 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
procedure deref;override;
function size:longint;override;
function size:aint;override;
function alignment : longint;override;
function padalignment: longint;
function gettypename:string;override;
@ -297,7 +297,7 @@ interface
procedure buildderef;override;
procedure deref;override;
function getparentdef:tdef;override;
function size : longint;override;
function size : aint;override;
function alignment:longint;override;
function vmtmethodoffset(index:longint):longint;
function members_need_inittable : boolean;
@ -372,7 +372,7 @@ interface
tarraydef = class(tstoreddef)
lowrange,
highrange : longint;
highrange : aint;
rangetype : ttype;
IsConvertedPointer,
IsDynamicArray,
@ -382,9 +382,10 @@ interface
protected
_elementtype : ttype;
public
function elesize : longint;
function elesize : aint;
function elecount : aint;
constructor create_from_pointer(const elemt : ttype);
constructor create(l,h : longint;const t : ttype);
constructor create(l,h : aint;const t : ttype);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
function gettypename:string;override;
@ -396,7 +397,7 @@ interface
{$endif GDB}
procedure buildderef;override;
procedure deref;override;
function size : longint;override;
function size : aint;override;
function alignment : longint;override;
{ returns the label of the range check string }
function needs_inittable : boolean;override;
@ -484,7 +485,7 @@ interface
procedure buildderef;override;
procedure deref;override;
function getsymtable(t:tgetsymtable):tsymtable;override;
function size : longint;override;
function size : aint;override;
function gettypename:string;override;
function is_publishable : boolean;override;
function is_methodpointer:boolean;override;
@ -626,19 +627,19 @@ interface
tstringdef = class(tstoreddef)
string_typ : tstringtype;
len : longint;
len : aint;
constructor createshort(l : byte);
constructor loadshort(ppufile:tcompilerppufile);
constructor createlong(l : longint);
constructor createlong(l : aint);
constructor loadlong(ppufile:tcompilerppufile);
{$ifdef ansistring_bits}
constructor createansi(l:longint;bits:Tstringbits);
constructor createansi(l:aint;bits:Tstringbits);
constructor loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
{$else}
constructor createansi(l : longint);
constructor createansi(l : aint);
constructor loadansi(ppufile:tcompilerppufile);
{$endif}
constructor createwide(l : longint);
constructor createwide(l : aint);
constructor loadwide(ppufile:tcompilerppufile);
function getcopy : tstoreddef;override;
function stringtypname:string;
@ -659,13 +660,13 @@ interface
tenumdef = class(tstoreddef)
minval,
maxval : longint;
maxval : aint;
has_jumps : boolean;
firstenum : tsym; {tenumsym}
basedef : tenumdef;
basedefderef : tderef;
constructor create;
constructor create_subrange(_basedef:tenumdef;_min,_max:longint);
constructor create_subrange(_basedef:tenumdef;_min,_max:aint);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -674,10 +675,10 @@ interface
function gettypename:string;override;
function is_publishable : boolean;override;
procedure calcsavesize;
procedure setmax(_max:longint);
procedure setmin(_min:longint);
function min:longint;
function max:longint;
procedure setmax(_max:aint);
procedure setmin(_min:aint);
function min:aint;
function max:aint;
{ debug }
{$ifdef GDB}
function stabstring : pchar;override;
@ -1050,7 +1051,7 @@ implementation
end;
function tstoreddef.size : longint;
function tstoreddef.size : aint;
begin
size:=savesize;
end;
@ -1307,7 +1308,7 @@ implementation
end;
constructor tstringdef.createlong(l : longint);
constructor tstringdef.createlong(l : aint);
begin
inherited create;
string_typ:=st_longstring;
@ -1322,12 +1323,12 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=stringdef;
string_typ:=st_longstring;
len:=ppufile.getlongint;
len:=ppufile.getaint;
savesize:=sizeof(aint);
end;
{$ifdef ansistring_bits}
constructor tstringdef.createansi(l:longint;bits:Tstringbits);
constructor tstringdef.createansi(l:aint;bits:Tstringbits);
begin
inherited create;
case bits of
@ -1355,11 +1356,11 @@ implementation
sb_64:
string_typ:=st_ansistring64;
end;
len:=ppufile.getlongint;
len:=ppufile.getaint;
savesize:=POINTER_SIZE;
end;
{$else}
constructor tstringdef.createansi(l:longint);
constructor tstringdef.createansi(l:aint);
begin
inherited create;
string_typ:=st_ansistring;
@ -1374,12 +1375,12 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=stringdef;
string_typ:=st_ansistring;
len:=ppufile.getlongint;
len:=ppufile.getaint;
savesize:=sizeof(aint);
end;
{$endif}
constructor tstringdef.createwide(l : longint);
constructor tstringdef.createwide(l : aint);
begin
inherited create;
string_typ:=st_widestring;
@ -1394,7 +1395,7 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=stringdef;
string_typ:=st_widestring;
len:=ppufile.getlongint;
len:=ppufile.getaint;
savesize:=sizeof(aint);
end;
@ -1437,7 +1438,7 @@ implementation
ppufile.putbyte(byte(len))
end
else
ppufile.putlongint(len);
ppufile.putaint(len);
case string_typ of
st_shortstring : ppufile.writeentry(ibshortstringdef);
st_longstring : ppufile.writeentry(iblongstringdef);
@ -1457,7 +1458,7 @@ implementation
function tstringdef.stabstring : pchar;
var
bytest,charst,longst : string;
slen : longint;
slen : aint;
begin
case string_typ of
st_shortstring:
@ -1645,7 +1646,7 @@ implementation
correct_owner_symtable;
end;
constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:longint);
constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:aint);
begin
inherited create;
deftype:=enumdef;
@ -1666,9 +1667,9 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=enumdef;
ppufile.getderef(basedefderef);
minval:=ppufile.getlongint;
maxval:=ppufile.getlongint;
savesize:=ppufile.getlongint;
minval:=ppufile.getaint;
maxval:=ppufile.getaint;
savesize:=ppufile.getaint;
has_jumps:=false;
firstenum:=Nil;
end;
@ -1676,37 +1677,40 @@ implementation
procedure tenumdef.calcsavesize;
begin
if (aktpackenum=4) or (min<0) or (max>65535) then
savesize:=4
if (aktpackenum=8) or (min<low(longint)) or (max>high(cardinal)) then
savesize:=8
else
if (aktpackenum=2) or (min<0) or (max>255) then
if (aktpackenum=4) or (min<low(smallint)) or (max>high(word)) then
savesize:=4
else
if (aktpackenum=2) or (min<low(shortint)) or (max>high(byte)) then
savesize:=2
else
savesize:=1;
end;
procedure tenumdef.setmax(_max:longint);
procedure tenumdef.setmax(_max:aint);
begin
maxval:=_max;
calcsavesize;
end;
procedure tenumdef.setmin(_min:longint);
procedure tenumdef.setmin(_min:aint);
begin
minval:=_min;
calcsavesize;
end;
function tenumdef.min:longint;
function tenumdef.min:aint;
begin
min:=minval;
end;
function tenumdef.max:longint;
function tenumdef.max:aint;
begin
max:=maxval;
end;
@ -1738,9 +1742,9 @@ implementation
begin
inherited ppuwritedef(ppufile);
ppufile.putderef(basedefderef);
ppufile.putlongint(min);
ppufile.putlongint(max);
ppufile.putlongint(savesize);
ppufile.putaint(min);
ppufile.putaint(max);
ppufile.putaint(savesize);
ppufile.writeentry(ibenumdef);
end;
@ -1816,7 +1820,7 @@ implementation
begin
rttiList.concat(Tai_const.Create_8bit(tkEnumeration));
write_rtti_name;
case savesize of
case longint(savesize) of
1:
rttiList.concat(Tai_const.Create_8bit(otUByte));
2:
@ -2794,7 +2798,7 @@ implementation
TARRAYDEF
***************************************************************************}
constructor tarraydef.create(l,h : longint;const t : ttype);
constructor tarraydef.create(l,h : aint;const t : ttype);
begin
inherited create;
deftype:=arraydef;
@ -2825,8 +2829,8 @@ implementation
{ the addresses are calculated later }
ppufile.gettype(_elementtype);
ppufile.gettype(rangetype);
lowrange:=ppufile.getlongint;
highrange:=ppufile.getlongint;
lowrange:=ppufile.getaint;
highrange:=ppufile.getaint;
IsArrayOfConst:=boolean(ppufile.getbyte);
IsDynamicArray:=boolean(ppufile.getbyte);
IsVariant:=false;
@ -2855,8 +2859,8 @@ implementation
inherited ppuwritedef(ppufile);
ppufile.puttype(_elementtype);
ppufile.puttype(rangetype);
ppufile.putlongint(lowrange);
ppufile.putlongint(highrange);
ppufile.putaint(lowrange);
ppufile.putaint(highrange);
ppufile.putbyte(byte(IsArrayOfConst));
ppufile.putbyte(byte(IsDynamicArray));
ppufile.writeentry(ibarraydef);
@ -2882,65 +2886,78 @@ implementation
{$endif GDB}
function tarraydef.elesize : longint;
function tarraydef.elesize : aint;
begin
elesize:=_elementtype.def.size;
end;
function tarraydef.size : longint;
function tarraydef.elecount : aint;
{$ifdef cpu64bit}
var
newsize : TConstExprInt;
qhigh,qlow : qword;
{$endif cpu64bit}
begin
if IsDynamicArray then
begin
result:=0;
exit;
end;
{$ifdef cpu64bit}
if (highrange>0) and (lowrange<0) then
begin
qhigh:=highrange;
qlow:=qword(-lowrange);
{ prevent overflow, return -1 to indicate overflow }
if qhigh+qlow>qword(high(aint)-1) then
result:=-1
else
result:=qhigh+qlow+1;
end
else
{$endif cpu64bit}
result:=int64(highrange)-lowrange+1;
end;
function tarraydef.size : aint;
var
cachedelecount,
cachedelesize : aint;
begin
if IsDynamicArray then
begin
size:=sizeof(aint);
exit;
end;
{Tarraydef.size may never be called for an open array!}
{ Tarraydef.size may never be called for an open array! }
if highrange<lowrange then
internalerror(99080501);
newsize:=(int64(highrange)-int64(lowrange)+1)*elesize;
{ prevent an overflow }
if newsize>high(longint) then
result:=high(longint)
internalerror(99080501);
cachedelesize:=elesize;
cachedelecount:=elecount;
{ prevent overflow, return -1 to indicate overflow }
if (cachedelesize <> 0) and
(
(cachedelecount < 0) or
((high(aint) div cachedelesize) < cachedelecount) or
{ also lowrange*elesize must be < high(aint) to prevent overflow when
accessing the array, see ncgmem (PFV) }
((high(aint) div cachedelesize) < abs(lowrange))
) then
result:=-1
else
result:=newsize;
result:=cachedelesize*cachedelecount;
end;
procedure tarraydef.setelementtype(t: ttype);
var
cachedsize : TConstExprInt;
begin
_elementtype:=t;
if not(IsDynamicArray or
IsConvertedPointer or
(highrange<lowrange)) then
begin
{ cache element size for performance on multidimensional arrays }
cachedsize := elesize;
if (cachedsize>0) and
(
{$ifdef cpu64bit}
{$ifdef VER1_0}
{ 1.0.x can't handle this and while bootstrapping with 1.0.x we can forget about it }
false
{$else}
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffffffffffff) or
{ () are needed around cachedsize-1 to avoid a possible
integer overflow for cachedsize=1 !! PM }
(($7fffffffffffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
{$endif VER1_0}
{$else cpu64bit}
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
{ () are needed around cachedsize-1 to avoid a possible
integer overflow for cachedsize=1 !! PM }
(($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
{$endif cpu64bit}
) Then
if (size=-1) then
Message(sym_e_segment_too_large);
end;
end;
@ -2980,9 +2997,8 @@ implementation
{$endif cpurequiresproperalignment}
{ size of elements }
rttiList.concat(Tai_const.Create_aint(elesize));
{ count of elements, prevent overflow for 0..maxlongint }
if not(IsDynamicArray) then
rttiList.concat(Tai_const.Create_aint(min(int64(highrange)-lowrange+1,maxlongint)));
rttiList.concat(Tai_const.Create_aint(elecount));
{ element type }
rttiList.concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt)));
{ variant type }
@ -3042,8 +3058,8 @@ implementation
var
newrec:Pchar;
spec:string[3];
varsize:longint;
state:^Trecord_stabgen_state;
varsize : aint;
state : ^Trecord_stabgen_state;
begin
state:=arg;
{ static variables from objects are like global objects }
@ -3136,7 +3152,7 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=recorddef;
symtable:=trecordsymtable.create(0);
trecordsymtable(symtable).datasize:=ppufile.getlongint;
trecordsymtable(symtable).datasize:=ppufile.getaint;
trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
@ -3196,7 +3212,7 @@ implementation
procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwritedef(ppufile);
ppufile.putlongint(trecordsymtable(symtable).datasize);
ppufile.putaint(trecordsymtable(symtable).datasize);
ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
@ -3205,7 +3221,7 @@ implementation
end;
function trecorddef.size:longint;
function trecorddef.size:aint;
begin
result:=trecordsymtable(symtable).datasize;
end;
@ -4561,7 +4577,7 @@ implementation
end;
function tprocvardef.size : longint;
function tprocvardef.size : aint;
begin
if (po_methodpointer in procoptions) and
not(po_addressonly in procoptions) then
@ -4776,7 +4792,7 @@ implementation
objrealname:=stringdup(ppufile.getstring);
objname:=stringdup(upper(objrealname^));
symtable:=tobjectsymtable.create(objrealname^,0);
tobjectsymtable(symtable).datasize:=ppufile.getlongint;
tobjectsymtable(symtable).datasize:=ppufile.getaint;
tobjectsymtable(symtable).fieldalignment:=ppufile.getbyte;
tobjectsymtable(symtable).recordalignment:=ppufile.getbyte;
vmt_offset:=ppufile.getlongint;
@ -4853,7 +4869,7 @@ implementation
inherited ppuwritedef(ppufile);
ppufile.putbyte(byte(objecttype));
ppufile.putstring(objrealname^);
ppufile.putlongint(tobjectsymtable(symtable).datasize);
ppufile.putaint(tobjectsymtable(symtable).datasize);
ppufile.putbyte(tobjectsymtable(symtable).fieldalignment);
ppufile.putbyte(tobjectsymtable(symtable).recordalignment);
ppufile.putlongint(vmt_offset);
@ -5077,7 +5093,7 @@ implementation
end;
function tobjectdef.size : longint;
function tobjectdef.size : aint;
begin
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
result:=sizeof(aint)
@ -6200,7 +6216,11 @@ implementation
end.
{
$Log$
Revision 1.262 2004-11-01 15:33:12 florian
Revision 1.263 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.262 2004/11/01 15:33:12 florian
* fixed type information for dyn. arrays on 64 bit systems
Revision 1.261 2004/10/31 21:45:03 peter

8
compiler/symtable.pas
View File

@ -87,7 +87,7 @@ interface
tabstractrecordsymtable = class(tstoredsymtable)
public
datasize : longint;
datasize : aint;
usefieldalignment, { alignment to use for fields (PACKRECORDS value), -1 is C style }
recordalignment, { alignment required when inserting this record }
fieldalignment, { alignment current alignment used when fields are inserted }
@ -2314,7 +2314,11 @@ implementation
end.
{
$Log$
Revision 1.159 2004-10-15 09:14:17 mazen
Revision 1.160 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.159 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

16
compiler/symtype.pas
View File

@ -80,7 +80,7 @@ interface
function gettypename:string;virtual;
function mangledparaname:string;
function getmangledparaname:string;virtual;abstract;
function size:longint;virtual;abstract;
function size:aint;virtual;abstract;
function alignment:longint;virtual;abstract;
function getparentdef:tdef;virtual;
function getsymtable(t:tgetsymtable):tsymtable;virtual;
@ -162,7 +162,7 @@ interface
next : psymlistitem;
case byte of
0 : (sym : tsym; symderef : tderef);
1 : (value : longint);
1 : (value : TConstExprInt);
2 : (tt : ttype);
end;
@ -176,7 +176,7 @@ interface
function empty:boolean;
procedure addsym(slt:tsltype;p:tsym);
procedure addsymderef(slt:tsltype;const d:tderef);
procedure addconst(slt:tsltype;v:longint);
procedure addconst(slt:tsltype;v:TConstExprInt);
procedure addtype(slt:tsltype;const tt:ttype);
procedure clear;
function getcopy:tsymlist;
@ -709,7 +709,7 @@ implementation
end;
procedure tsymlist.addconst(slt:tsltype;v:longint);
procedure tsymlist.addconst(slt:tsltype;v:TConstExprInt);
var
hp : psymlistitem;
begin
@ -1043,7 +1043,7 @@ implementation
typ : tdereftype;
st : tsymtable;
idx : word;
i : longint;
i : aint;
len : byte;
data : array[0..255] of byte;
begin
@ -1487,7 +1487,11 @@ finalization
end.
{
$Log$
Revision 1.45 2004-10-12 14:34:49 peter
Revision 1.46 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.45 2004/10/12 14:34:49 peter
* fixed visibility for procsyms
* fixed override check when there was no entry yet

193
compiler/x86/cgx86.pas
View File

@ -119,6 +119,7 @@ unit cgx86;
procedure opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
private
procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
procedure make_simple_ref(list:taasmoutput;var ref: treference);
procedure floatload(list: taasmoutput; t : tcgsize;const ref : treference);
procedure floatstore(list: taasmoutput; t : tcgsize;const ref : treference);
@ -321,6 +322,46 @@ unit cgx86;
end;
procedure tcgx86.make_simple_ref(list:taasmoutput;var ref: treference);
{$ifdef x86_64}
var
hreg : tregister;
{$endif x86_64}
begin
{$ifdef x86_64}
{ Only 32bit is allowed }
if ((ref.offset<low(longint)) or (ref.offset>high(longint))) then
begin
{ Load constant value to register }
hreg:=GetAddressRegister(list);
list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg));
ref.offset:=0;
{if assigned(ref.symbol) then
begin
list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_Q,ref.symbol,0,hreg));
ref.symbol:=nil;
end;}
{ Add register to reference }
if ref.index=NR_NO then
ref.index:=hreg
else
begin
if ref.scalefactor<>0 then
begin
list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.base,hreg));
ref.base:=hreg;
end
else
begin
list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.index,hreg));
ref.index:=hreg;
end;
end;
end;
{$endif x86_64}
end;
procedure tcgx86.floatloadops(t : tcgsize;var op : tasmop;var s : topsize);
begin
case t of
@ -355,10 +396,12 @@ unit cgx86;
var
op : tasmop;
s : topsize;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
floatloadops(t,op,s);
list.concat(Taicpu.Op_ref(op,s,ref));
list.concat(Taicpu.Op_ref(op,s,tmpref));
inc_fpu_stack;
end;
@ -398,10 +441,12 @@ unit cgx86;
var
op : tasmop;
s : topsize;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
floatstoreops(t,op,s);
list.concat(Taicpu.Op_ref(op,s,ref));
list.concat(Taicpu.Op_ref(op,s,tmpref));
dec_fpu_stack;
end;
@ -454,25 +499,23 @@ unit cgx86;
procedure tcgx86.a_load_const_ref(list : taasmoutput; tosize: tcgsize; a : aint;const ref : treference);
{$ifdef x86_64}
var
href : treference;
{$endif x86_64}
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
{$ifdef x86_64}
{ x86_64 only supports signed 32 bits constants directly }
if (tosize in [OS_S64,OS_64]) and
((a<low(longint)) or (a>high(longint))) then
((a<low(longint)) or (a>high(longint))) then
begin
href:=ref;
a_load_const_ref(list,OS_32,longint(a and $ffffffff),href);
inc(href.offset,4);
a_load_const_ref(list,OS_32,longint(a shr 32),href);
a_load_const_ref(list,OS_32,longint(a and $ffffffff),tmpref);
inc(tmpref.offset,4);
a_load_const_ref(list,OS_32,longint(a shr 32),tmpref);
end
else
{$endif x86_64}
list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,ref));
list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,tmpref));
end;
@ -481,8 +524,11 @@ unit cgx86;
op: tasmop;
s: topsize;
tmpsize : tcgsize;
tmpreg : tregister;
tmpreg : tregister;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(fromsize,reg);
sizes2load(fromsize,tosize,op,s);
case s of
@ -505,10 +551,10 @@ unit cgx86;
{$endif x86_64}
tmpsize:=tosize;
list.concat(taicpu.op_reg_reg(op,s,reg,tmpreg));
a_load_reg_ref(list,tmpsize,tosize,tmpreg,ref);
a_load_reg_ref(list,tmpsize,tosize,tmpreg,tmpref);
end;
else
list.concat(taicpu.op_reg_ref(op,s,reg,ref));
list.concat(taicpu.op_reg_ref(op,s,reg,tmpref));
end;
end;
@ -517,7 +563,10 @@ unit cgx86;
var
op: tasmop;
s: topsize;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(tosize,reg);
sizes2load(fromsize,tosize,op,s);
{$ifdef x86_64}
@ -527,7 +576,7 @@ unit cgx86;
if s in [S_BL,S_WL,S_L] then
reg:=makeregsize(list,reg,OS_32);
{$endif x86_64}
list.concat(taicpu.op_ref_reg(op,s,ref,reg));
list.concat(taicpu.op_ref_reg(op,s,tmpref,reg));
end;
@ -566,6 +615,8 @@ unit cgx86;
procedure tcgx86.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
tmpref : treference;
begin
with ref do
if (base=NR_NO) and (index=NR_NO) then
@ -582,7 +633,11 @@ unit cgx86;
(offset=0) and (symbol=nil) then
a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r)
else
list.concat(taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],ref,r));
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
list.concat(taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r));
end;
end;
@ -652,13 +707,15 @@ unit cgx86;
procedure tcgx86.a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
var
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
if shuffle=nil then
begin
list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,ref,reg));
end
list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,tmpref,reg))
else if shufflescalar(shuffle) then
list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,ref,reg))
list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,tmpref,reg))
else
internalerror(200312252);
end;
@ -667,21 +724,22 @@ unit cgx86;
procedure tcgx86.a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle);
var
hreg : tregister;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
if shuffle=nil then
begin
list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,ref));
end
list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,tmpref))
else if shufflescalar(shuffle) then
begin
if tosize<>fromsize then
begin
hreg:=getmmregister(list,tosize);
list.concat(taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg,hreg));
list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,ref));
list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,tmpref));
end
else
list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,ref))
list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,tmpref));
end
else
internalerror(200312252);
@ -881,7 +939,10 @@ unit cgx86;
{$ifdef x86_64}
tmpreg : tregister;
{$endif x86_64}
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
{$ifdef x86_64}
{ x86_64 only supports signed 32 bits constants directly }
if (size in [OS_S64,OS_64]) and
@ -889,7 +950,7 @@ unit cgx86;
begin
tmpreg:=getintregister(list,size);
a_load_const_reg(list,size,a,tmpreg);
a_op_reg_ref(list,op,size,tmpreg,ref);
a_op_reg_ref(list,op,size,tmpreg,tmpref);
exit;
end;
{$endif x86_64}
@ -905,7 +966,7 @@ unit cgx86;
opcode := A_SAR;
end;
list.concat(taicpu.op_const_ref(opcode,
TCgSize2OpSize[size],power,ref));
TCgSize2OpSize[size],power,tmpref));
exit;
end;
{ the rest should be handled specifically in the code }
@ -918,12 +979,12 @@ unit cgx86;
ispowerof2(int64(a),power) then
begin
list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
power,ref));
power,tmpref));
exit;
end;
{ can't multiply a memory location directly with a constant }
if op = OP_IMUL then
inherited a_op_const_ref(list,op,size,a,ref)
inherited a_op_const_ref(list,op,size,a,tmpref)
else
{ OP_MUL should be handled specifically in the code }
{ generator because of the silly register usage restraints }
@ -934,14 +995,14 @@ unit cgx86;
(a = 1) and
(op in [OP_ADD,OP_SUB]) then
if op = OP_ADD then
list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],ref))
list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],tmpref))
else
list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],ref))
list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],tmpref))
else if (a = 0) then
if (op <> OP_AND) then
exit
else
a_load_const_ref(list,size,0,ref)
a_load_const_ref(list,size,0,tmpref)
else if (aword(a) = high(aword)) and
(op in [OP_AND,OP_OR,OP_XOR]) then
begin
@ -949,19 +1010,19 @@ unit cgx86;
OP_AND:
exit;
OP_OR:
list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),ref));
list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),tmpref));
OP_XOR:
list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],ref));
list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],tmpref));
end
end
else
list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
TCgSize2OpSize[size],a,ref));
TCgSize2OpSize[size],a,tmpref));
OP_SHL,OP_SHR,OP_SAR:
begin
if (a and 31) <> 0 then
list.concat(taicpu.op_const_ref(
TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,ref));
TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,tmpref));
if (a shr 5) <> 0 Then
internalerror(68991);
end
@ -1008,12 +1069,16 @@ unit cgx86;
procedure tcgx86.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
var
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(size,reg);
case op of
OP_NEG,OP_NOT,OP_IMUL:
begin
inherited a_op_ref_reg(list,op,size,ref,reg);
inherited a_op_ref_reg(list,op,size,tmpref,reg);
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
@ -1022,26 +1087,30 @@ unit cgx86;
else
begin
reg := makeregsize(list,reg,size);
list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],ref,reg));
list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref,reg));
end;
end;
end;
procedure tcgx86.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
var
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(size,reg);
case op of
OP_NEG,OP_NOT:
begin
if reg<>NR_NO then
internalerror(200109237);
list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],ref));
list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref));
end;
OP_IMUL:
begin
{ this one needs a load/imul/store, which is the default }
inherited a_op_ref_reg(list,op,size,ref,reg);
inherited a_op_ref_reg(list,op,size,tmpref,reg);
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
@ -1049,7 +1118,7 @@ unit cgx86;
internalerror(200109238);
else
begin
list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,ref));
list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,tmpref));
end;
end;
end;
@ -1179,23 +1248,26 @@ unit cgx86;
procedure tcgx86.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
l : tasmlabel);
{$ifdef x86_64}
var
{$ifdef x86_64}
tmpreg : tregister;
{$endif x86_64}
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
{$ifdef x86_64}
{ x86_64 only supports signed 32 bits constants directly }
if (size in [OS_S64,OS_64]) and
((a<low(longint)) or (a>high(longint))) then
((a<low(longint)) or (a>high(longint))) then
begin
tmpreg:=getintregister(list,size);
a_load_const_reg(list,size,a,tmpreg);
a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,ref,l);
a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,tmpref,l);
exit;
end;
{$endif x86_64}
list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,ref));
list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,tmpref));
a_jmp_cond(list,cmp_op,l);
end;
@ -1212,17 +1284,25 @@ unit cgx86;
procedure tcgx86.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel);
var
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(size,reg);
list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],ref,reg));
list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],tmpref,reg));
a_jmp_cond(list,cmp_op,l);
end;
procedure tcgx86.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;const ref: treference; l : tasmlabel);
var
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
check_register_size(size,reg);
list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,ref));
list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,tmpref));
a_jmp_cond(list,cmp_op,l);
end;
@ -1271,10 +1351,13 @@ unit cgx86;
procedure tcgx86.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref: TReference);
var
ai : taicpu;
tmpref : treference;
begin
tmpref:=ref;
make_simple_ref(list,tmpref);
if not(size in [OS_8,OS_S8]) then
a_load_const_ref(list,size,0,ref);
ai:=Taicpu.op_ref(A_SETcc,S_B,ref);
a_load_const_ref(list,size,0,tmpref);
ai:=Taicpu.op_ref(A_SETcc,S_B,tmpref);
ai.setcondition(flags_to_cond(f));
list.concat(ai);
end;
@ -1637,7 +1720,11 @@ unit cgx86;
end.
{
$Log$
Revision 1.135 2004-11-01 15:42:47 florian
Revision 1.136 2004-11-01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit
Revision 1.135 2004/11/01 15:42:47 florian
* cvt*2* can't write to memory location, fixed
Revision 1.134 2004/11/01 10:30:06 peter