paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-08 11:58:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for referencecounted temps

Browse Source
This commit is contained in:
peter 2003-11-04 15:35:13 +00:00
parent 5395916195
commit 30f1eb4705
7 changed files with 88 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/cgbase.pas
View File

@ -167,11 +167,7 @@ interface
{ Temp types }
ttemptype = (tt_none,
tt_free,tt_normal,tt_persistent,
tt_noreuse,tt_freenoreuse,
tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring,
tt_interfacecom,tt_freeinterfacecom);
ttemptypeset = set of ttemptype;
tt_noreuse,tt_freenoreuse);
pmmshuffle = ^tmmshuffle;
@ -462,7 +458,10 @@ finalization
end.
{
$Log$
Revision 1.76 2003-11-03 17:48:04 peter
Revision 1.77 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.76 2003/11/03 17:48:04 peter
* int_cgsize returned garbage for a=0
Revision 1.75 2003/10/31 15:51:11 peter

7
compiler/nbas.pas
View File

@ -29,7 +29,7 @@ interface
uses
cpubase,cgbase,
aasmbase,aasmtai,aasmcpu,
node,
node,tgobj,
symtype,symppu;
type
@ -854,7 +854,10 @@ begin
end.
{
$Log$
Revision 1.71 2003-10-31 15:51:47 peter
Revision 1.72 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.71 2003/10/31 15:51:47 peter
* fix crashes in asmnode.deref when p_asm=nil
Revision 1.70 2003/10/29 20:34:20 peter

8
compiler/ncgbas.pas
View File

@ -341,6 +341,9 @@ interface
internalerror(200108222);
{ get a (persistent) temp }
if tempinfo^.restype.def.needs_inittable then
tg.GetTempTyped(exprasmlist,tempinfo^.restype.def,tempinfo^.temptype,tempinfo^.ref)
else
tg.GetTemp(exprasmlist,size,tempinfo^.temptype,tempinfo^.ref);
tempinfo^.valid := true;
end;
@ -404,7 +407,10 @@ begin
end.
{
$Log$
Revision 1.49 2003-11-02 13:30:05 jonas
Revision 1.50 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.49 2003/11/02 13:30:05 jonas
* fixed ppc compilation
Revision 1.48 2003/10/30 19:59:00 peter

34
compiler/ncgcal.pas
View File

@ -436,8 +436,7 @@ implementation
end
else
{ ansi/widestrings must be registered, so we can dispose them }
if is_ansistring(resulttype.def) or
is_widestring(resulttype.def) then
if resulttype.def.needs_inittable then
begin
{ the FUNCTION_RESULT_REG is already allocated }
cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
@ -682,20 +681,12 @@ implementation
if assigned(varargsparas) then
paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
if not assigned(funcretnode) then
if resulttype.def.needs_inittable and
not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and
not assigned(funcretnode) then
begin
{ if we allocate the temp. location for ansi- or widestrings }
{ already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then
begin
tg.gettemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
tg.gettemptyped(exprasmlist,resulttype.def,tt_persistent,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end
else if is_ansistring(resulttype.def) then
begin
tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end;
end;
regs_to_alloc:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
@ -1014,14 +1005,10 @@ implementation
{ if we allocate the temp. location for ansi- or widestrings }
{ already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then
if resulttype.def.needs_inittable and
not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
begin
tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end
else if is_ansistring(resulttype.def) then
begin
tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
tg.gettemptyped(exprasmlist,resulttype.def,tt_persistent,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end;
@ -1146,7 +1133,10 @@ begin
end.
{
$Log$
Revision 1.135 2003-10-30 17:12:49 peter
Revision 1.136 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.135 2003/10/30 17:12:49 peter
* fixed rangecheck error
Revision 1.134 2003/10/29 21:24:14 jonas

7
compiler/ncgmem.pas
View File

@ -353,7 +353,7 @@ implementation
end
else if is_interfacecom(left.resulttype.def) then
begin
tg.GetTemp(exprasmlist,pointer_size,tt_interfacecom,location.reference);
tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference);
cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
{ implicit deferencing also for interfaces }
if (cs_gdb_heaptrc in aktglobalswitches) and
@ -876,7 +876,10 @@ begin
end.
{
$Log$
Revision 1.79 2003-10-10 17:48:13 peter
Revision 1.80 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.79 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

44
compiler/ncgutil.pas
View File

@ -903,14 +903,12 @@ implementation
hp:=tg.templist;
while assigned(hp) do
begin
if hp^.temptype in [tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring,
tt_interfacecom,tt_freeinterfacecom] then
if assigned(hp^.def) then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_load_const_ref(list,OS_ADDR,0,href);
cg.g_initialize(list,hp^.def,href,false);
end;
hp:=hp^.next;
end;
@ -927,39 +925,10 @@ implementation
hp:=tg.templist;
while assigned(hp) do
begin
case hp^.temptype of
tt_ansistring,
tt_freeansistring :
if assigned(hp^.def) then
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
end;
tt_widestring,
tt_freewidestring :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
end;
tt_interfacecom :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_INTF_DECR_REF');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
end;
cg.g_finalize(list,hp^.def,href,false);
end;
hp:=hp^.next;
end;
@ -1974,7 +1943,10 @@ implementation
end.
{
$Log$
Revision 1.162 2003-10-25 11:34:02 florian
Revision 1.163 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.162 2003/10/25 11:34:02 florian
* fixed compilation of ppc system unit
Revision 1.161 2003/10/19 01:34:30 florian

59
compiler/tgobj.pas
View File

@ -35,15 +35,19 @@ unit tgobj;
uses
cclasses,
globals,globtype,
symtype,
cpubase,cpuinfo,cgbase,
aasmbase,aasmtai,aasmcpu;
aasmbase,aasmtai;
type
ttemptypeset = set of ttemptype;
ptemprecord = ^ttemprecord;
ttemprecord = record
temptype : ttemptype;
pos : longint;
size : longint;
def : tdef;
next : ptemprecord;
nextfree : ptemprecord; { for faster freeblock checking }
{$ifdef EXTDEBUG}
@ -58,7 +62,7 @@ unit tgobj;
private
{ contains all free temps using nextfree links }
tempfreelist : ptemprecord;
function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype; def:tdef) : longint;
procedure freetemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
public
{ contains all temps }
@ -80,6 +84,7 @@ unit tgobj;
procedure setfirsttemp(l : longint);
procedure gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
procedure gettemptyped(list: taasmoutput; def:tdef;temptype:ttemptype;var ref : treference);
procedure ungettemp(list: taasmoutput; const ref : treference);
function sizeoftemp(list: taasmoutput; const ref: treference): longint;
@ -116,27 +121,21 @@ unit tgobj;
const
FreeTempTypes = [tt_free,tt_freenoreuse,tt_freeansistring,
tt_freewidestring,tt_freeinterfacecom];
FreeTempTypes = [tt_free,tt_freenoreuse];
{$ifdef EXTDEBUG}
TempTypeStr : array[ttemptype] of string[18] = (
'<none>',
'free','normal','persistant',
'noreuse','freenoreuse',
'ansistring','freeansistring',
'widestring','freewidestring',
'interfacecom','freeinterfacecom'
'noreuse','freenoreuse'
);
{$endif EXTDEBUG}
Used2Free : array[ttemptype] of ttemptype = (
tt_none,
tt_none,tt_free,tt_free,
tt_freenoreuse,tt_none,
tt_freeansistring,tt_none,
tt_freewidestring,tt_none,
tt_freeinterfacecom,tt_none);
tt_freenoreuse,tt_none
);
{*****************************************************************************
@ -199,7 +198,7 @@ unit tgobj;
end;
function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype;def : tdef) : longint;
var
tl,
bestslot,bestprev,
@ -241,6 +240,7 @@ unit tgobj;
Comment(V_Warning,'tgobj: (AllocTemp) temp at pos '+tostr(hp^.pos)+ ' in freelist is not set to tt_free !');
{$endif}
if (hp^.temptype=freetype) and
(hp^.def=def) and
(hp^.size>=size) then
begin
{ Slot is the same size, then leave immediatly }
@ -272,6 +272,7 @@ unit tgobj;
begin
tl:=bestslot;
tl^.temptype:=temptype;
tl^.def:=def;
{ Remove from the tempfreelist }
if assigned(bestprev) then
bestprev^.nextfree:=tl^.nextfree
@ -286,6 +287,7 @@ unit tgobj;
{ Create new block and link after bestslot }
new(tl);
tl^.temptype:=temptype;
tl^.def:=def;
if direction=1 then
begin
tl^.pos:=bestslot^.pos;
@ -310,6 +312,7 @@ unit tgobj;
{ now we can create the templist entry }
new(tl);
tl^.temptype:=temptype;
tl^.def:=def;
if direction=-1 then
begin
@ -331,6 +334,9 @@ unit tgobj;
end;
{$ifdef EXTDEBUG}
tl^.posinfo:=aktfilepos;
if assigned(tl^.def) then
list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]+' for def '+tl^.def.typename))
else
list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]));
{$else}
list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
@ -422,10 +428,20 @@ unit tgobj;
procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
begin
{ can't use reference_reset_base, because that will let tgobj depend
on rgobj (PFV) }
on cgobj (PFV) }
fillchar(ref,sizeof(ref),0);
ref.base:=current_procinfo.framepointer;
ref.offset:=alloctemp(list,size,temptype);
ref.offset:=alloctemp(list,size,temptype,nil);
end;
procedure ttgobj.gettemptyped(list: taasmoutput; def:tdef;temptype:ttemptype;var ref : treference);
begin
{ can't use reference_reset_base, because that will let tgobj depend
on cgobj (PFV) }
fillchar(ref,sizeof(ref),0);
ref.base:=current_procinfo.framepointer;
ref.offset:=alloctemp(list,def.size,temptype,def);
end;
@ -481,7 +497,7 @@ unit tgobj;
begin
if (hp^.pos=ref.offset) then
begin
if not(hp^.temptype in [tt_free,tt_freeansistring,tt_freewidestring,tt_freeinterfacecom]) then
if hp^.temptype<>tt_free then
begin
{$ifdef EXTDEBUG}
if hp^.temptype=temptype then
@ -514,21 +530,21 @@ unit tgobj;
procedure ttgobj.UnGetTemp(list: taasmoutput; const ref : treference);
begin
FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent,tt_ansistring,tt_widestring,tt_interfacecom]);
FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent]);
end;
procedure ttgobj.UnGetIfTemp(list: taasmoutput; const ref : treference);
begin
if istemp(ref) then
FreeTemp(list,ref.offset,[tt_normal,tt_ansistring,tt_widestring,tt_interfacecom]);
FreeTemp(list,ref.offset,[tt_normal]);
end;
procedure ttgobj.getlocal(list: taasmoutput; size : longint;var ref : tparareference);
begin
ref.index:=current_procinfo.framepointer;
ref.offset:=alloctemp(list,size,tt_persistent);
ref.offset:=alloctemp(list,size,tt_persistent,nil);
end;
@ -541,7 +557,10 @@ unit tgobj;
end.
{
$Log$
Revision 1.40 2003-10-01 20:34:49 peter
Revision 1.41 2003-11-04 15:35:13 peter
* fix for referencecounted temps
Revision 1.40 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose