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

* low-highval always checked if limit ober 2GB is reached (to avoid overflow)

Browse Source
This commit is contained in:
carl 2002-09-27 21:13:28 +00:00
parent ab9e07a2d7
commit f3d9f997cd
7 changed files with 82 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/nld.pas
View File

@ -857,7 +857,7 @@ implementation
if not assigned(htype.def) then
htype:=voidtype;
resulttype.setdef(tarraydef.create(0,len-1,s32bittype));
tarraydef(resulttype.def).elementtype:=htype;
tarraydef(resulttype.def).setelementtype(htype);
tarraydef(resulttype.def).IsConstructor:=true;
tarraydef(resulttype.def).IsVariant:=varia;
end;
@ -867,7 +867,7 @@ implementation
var
hp : tarrayconstructornode;
begin
tarraydef(resulttype.def).elementtype:=tt;
tarraydef(resulttype.def).setelementtype(tt);
tarraydef(resulttype.def).IsConstructor:=true;
tarraydef(resulttype.def).IsVariant:=false;
if assigned(left) then
@ -1144,7 +1144,10 @@ begin
end.
{
$Log$
Revision 1.59 2002-09-26 15:02:05 florian
Revision 1.60 2002-09-27 21:13:28 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.59 2002/09/26 15:02:05 florian
+ support of passing variants to "array of const"
Revision 1.58 2002/09/07 15:25:03 peter

7
compiler/nmem.pas
View File

@ -751,7 +751,7 @@ implementation
begin
{ convert pointer to array }
htype.setdef(tarraydef.create(0,$7fffffff,s32bittype));
tarraydef(htype.def).elementtype:=tpointerdef(left.resulttype.def).pointertype;
tarraydef(htype.def).setelementtype(tpointerdef(left.resulttype.def).pointertype);
inserttypeconv(left,htype);
resulttype:=tarraydef(htype.def).elementtype;
@ -1057,7 +1057,10 @@ begin
end.
{
$Log$
Revision 1.39 2002-09-01 18:44:17 peter
Revision 1.40 2002-09-27 21:13:28 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.39 2002/09/01 18:44:17 peter
* cleanup of tvecnode.det_resulttype
* move 0 element of string access check to resulttype

9
compiler/pdecobj.pas
View File

@ -225,6 +225,7 @@ implementation
varspez : tvarspez;
s : string;
tt : ttype;
arraytype : ttype;
declarepos : tfileposinfo;
pp : Tprocdef;
pd : tprocdef;
@ -297,7 +298,8 @@ implementation
{ define range and type of range }
tt.setdef(tarraydef.create(0,-1,s32bittype));
{ define field type }
single_type(tarraydef(tt.def).elementtype,s,false);
single_type(arraytype,s,false);
tarraydef(tt.def).setelementtype(arraytype);
end
else
single_type(tt,s,false);
@ -1150,7 +1152,10 @@ implementation
end.
{
$Log$
Revision 1.52 2002-09-16 14:11:13 peter
Revision 1.53 2002-09-27 21:13:28 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.52 2002/09/16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.51 2002/09/09 17:34:15 peter

11
compiler/pdecsub.pas
View File

@ -105,6 +105,7 @@ implementation
sc : tsinglelist;
htype,
tt : ttype;
arrayelementtype : ttype;
hvs,
vs : tvarsym;
srsym : tsym;
@ -218,13 +219,14 @@ implementation
srsym:=searchsymonlyin(systemunit,'TVARREC');
if not assigned(srsym) then
InternalError(1234124);
tarraydef(tt.def).elementtype:=ttypesym(srsym).restype;
tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
tarraydef(tt.def).IsArrayOfConst:=true;
end
else
begin
{ define field type }
single_type(tarraydef(tt.def).elementtype,hs1,false);
single_type(arrayelementtype,hs1,false);
tarraydef(tt.def).setelementtype(arrayelementtype);
end;
inserthigh:=true;
end
@ -1989,7 +1991,10 @@ const
end.
{
$Log$
Revision 1.75 2002-09-16 14:11:13 peter
Revision 1.76 2002-09-27 21:13:29 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.75 2002/09/16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.74 2002/09/10 16:27:28 peter

11
compiler/psystem.pas
View File

@ -192,12 +192,12 @@ implementation
vmtsymtable.insert(tvarsym.create('$length',s32bittype));
vmtsymtable.insert(tvarsym.create('$mlength',s32bittype));
vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
tarraydef(vmtarraytype.def).elementtype:=voidpointertype;
tarraydef(vmtarraytype.def).setelementtype(voidpointertype);
vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype));
addtype('$__vtbl_ptr_type',vmttype);
addtype('$pvmt',pvmttype);
vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
tarraydef(vmtarraytype.def).elementtype:=pvmttype;
tarraydef(vmtarraytype.def).setelementtype(pvmttype);
addtype('$vtblarray',vmtarraytype);
{ Add functions that require compiler magic }
insertinternsyms(p);
@ -283,7 +283,7 @@ implementation
{ length=0 for shortstring is open string (needed for readln(string) }
openshortstringtype.setdef(tstringdef.createshort(0));
openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
tarraydef(openchararraytype.def).elementtype:=cchartype;
tarraydef(openchararraytype.def).setelementtype(cchartype);
{$ifdef x86}
{$ifdef i386}
ordpointertype:=u32bittype;
@ -469,7 +469,10 @@ implementation
end.
{
$Log$
Revision 1.39 2002-09-07 20:46:10 carl
Revision 1.40 2002-09-27 21:13:29 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.39 2002/09/07 20:46:10 carl
* cardinal -> longword
Revision 1.38 2002/08/23 13:11:11 mazen

7
compiler/ptype.pas
View File

@ -445,7 +445,7 @@ implementation
read_type(tt2,'');
{ if no error, set element type }
if assigned(ap) then
ap.elementtype:=tt2;
ap.setelementtype(tt2);
end;
var
@ -640,7 +640,10 @@ implementation
end.
{
$Log$
Revision 1.44 2002-09-10 16:26:39 peter
Revision 1.45 2002-09-27 21:13:29 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.44 2002/09/10 16:26:39 peter
* safety check for typesym added for incomplete type def check
Revision 1.43 2002/09/09 19:34:07 peter

71
compiler/symdef.pas
View File

@ -340,18 +340,21 @@ interface
rangenr : longint;
lowrange,
highrange : longint;
elementtype,
rangetype : ttype;
IsDynamicArray,
IsVariant,
IsConstructor,
IsArrayOfConst : boolean;
protected
_elementtype : ttype;
public
function elesize : longint;
constructor create(l,h : longint;const t : ttype);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
function gettypename:string;override;
function getmangledparaname : string;override;
procedure setelementtype(t: ttype);
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
@ -368,6 +371,7 @@ interface
function needs_inittable : boolean;override;
procedure write_child_rtti_data(rt:trttitype);override;
procedure write_rtti_data(rt:trttitype);override;
property elementtype : ttype Read _ElementType;
end;
torddef = class(tstoreddef)
@ -2590,7 +2594,7 @@ implementation
inherited ppuloaddef(ppufile);
deftype:=arraydef;
{ the addresses are calculated later }
ppufile.gettype(elementtype);
ppufile.gettype(_elementtype);
ppufile.gettype(rangetype);
lowrange:=ppufile.getlongint;
highrange:=ppufile.getlongint;
@ -2641,7 +2645,7 @@ implementation
procedure tarraydef.deref;
begin
inherited deref;
elementtype.resolve;
_elementtype.resolve;
rangetype.resolve;
end;
@ -2649,7 +2653,7 @@ implementation
procedure tarraydef.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwritedef(ppufile);
ppufile.puttype(elementtype);
ppufile.puttype(_elementtype);
ppufile.puttype(rangetype);
ppufile.putlongint(lowrange);
ppufile.putlongint(highrange);
@ -2663,7 +2667,7 @@ implementation
function tarraydef.stabstring : pchar;
begin
stabstring := strpnew('ar'+tstoreddef(rangetype.def).numberstring+';'
+tostr(lowrange)+';'+tostr(highrange)+';'+tstoreddef(elementtype.def).numberstring);
+tostr(lowrange)+';'+tostr(highrange)+';'+tstoreddef(_elementtype.def).numberstring);
end;
@ -2673,7 +2677,7 @@ implementation
and (is_def_stab_written = not_written) then
begin
{when array are inserted they have no definition yet !!}
if assigned(elementtype.def) then
if assigned(_elementtype.def) then
inherited concatstabto(asmlist);
end;
end;
@ -2682,7 +2686,7 @@ implementation
function tarraydef.elesize : longint;
begin
elesize:=elementtype.def.size;
elesize:=_elementtype.def.size;
end;
@ -2696,31 +2700,41 @@ implementation
size:=POINTER_SIZE;
exit;
end;
cachedsize := elesize;
{Tarraydef.size may never be called for an open array!}
if highrange<lowrange then
internalerror(99080501);
cachedsize := elesize;
newsize:=(int64(highrange)-int64(lowrange)+1)*cachedsize;
If (cachedsize>0) and
(
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
{ () are needed around elesize-1 to avoid a possible
integer overflow for elesize=1 !! PM }
(($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
) Then
Begin
Message(sym_e_segment_too_large);
size := 4
End
Else
begin
newsize:=(int64(highrange)-int64(lowrange)+1)*cachedsize;
{ prevent an overflow }
if newsize>high(longint) then
size:=high(longint)
else
size:=newsize;
(
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
{ () are needed around elesize-1 to avoid a possible
integer overflow for elesize=1 !! PM }
(($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
) Then
Begin
Message(sym_e_segment_too_large);
size:=4;
end
else
{ prevent an overflow }
if newsize>high(longint) then
size:=high(longint)
else
size:=newsize;
end;
procedure tarraydef.setelementtype(t: ttype);
var
cachedsize: TConstExprInt;
begin
_elementtype:=t;
If IsDynamicArray then
exit;
if (TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) then
Message(sym_e_segment_too_large);
end;
function tarraydef.alignment : longint;
@ -5542,7 +5556,10 @@ implementation
end.
{
$Log$
Revision 1.95 2002-09-16 09:31:10 florian
Revision 1.96 2002-09-27 21:13:29 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.95 2002/09/16 09:31:10 florian
* fixed currency size
Revision 1.94 2002/09/09 17:34:15 peter