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

* small regvar fixes

Browse Source 
* loadref parameter removed from concatcopy,incrrefcount,etc
This commit is contained in:
peter 2004-10-24 11:44:28 +00:00
parent 26141a5440
commit adb6f59eef
13 changed files with 247 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
compiler/cgobj.pas
View File

@ -326,47 +326,38 @@ unit cgobj;
procedure g_maybe_testself(list : taasmoutput;reg:tregister);
procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
{# This should emit the opcode to copy len bytes from the source
to destination, if loadref is true, it assumes that it first must load
the source address from the memory location where
source points to.
to destination.
It must be overriden for each new target processor.
@param(source Source reference of copy)
@param(dest Destination reference of copy)
@param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
}
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;loadref : boolean);virtual; abstract;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);virtual; abstract;
{# This should emit the opcode to copy len bytes from the an unaligned source
to destination, if loadref is true, it assumes that it first must load
the source address from the memory location where
source points to.
to destination.
It must be overriden for each new target processor.
@param(source Source reference of copy)
@param(dest Destination reference of copy)
@param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
}
procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint;loadref : boolean);virtual;
procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);virtual;
{# This should emit the opcode to a shortrstring from the source
to destination, if loadref is true, it assumes that it first must load
the source address from the memory location where
source points to.
to destination.
@param(source Source reference of copy)
@param(dest Destination reference of copy)
@param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
}
procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;loadref : boolean);
procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte);
procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference);
procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference);
{# Generates range checking code. It is to note
that this routine does not need to be overriden,
@ -381,7 +372,7 @@ unit cgobj;
procedure g_overflowcheck(list: taasmoutput; const Loc:tlocation; def:tdef); virtual;abstract;
procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);virtual;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);virtual;
procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
{# Emits instructions when compilation is done in profile
@ -783,7 +774,7 @@ implementation
ref.offset:=paraloc.location^.reference.offset;
{ use concatcopy, because it can also be a float which fails when
load_ref_ref is used }
g_concatcopy(list,r,ref,tcgsize2size[size],false);
g_concatcopy(list,r,ref,tcgsize2size[size]);
end
else
internalerror(2002071004);
@ -826,7 +817,7 @@ implementation
if not(paraloc.location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(2003010901);
reference_reset_base(ref,paraloc.location^.reference.index,paraloc.location^.reference.offset);
g_concatcopy(list,r,ref,size,false);
g_concatcopy(list,r,ref,size);
end;
@ -1024,7 +1015,7 @@ implementation
begin
reference_reset_base(href,paraloc.location^.reference.index,paraloc.location^.reference.offset);
{ concatcopy should choose the best way to copy the data }
g_concatcopy(list,ref,href,tcgsize2size[size],false);
g_concatcopy(list,ref,href,tcgsize2size[size]);
end
else
internalerror(200402201);
@ -1380,13 +1371,13 @@ implementation
end;
procedure tcg.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint;loadref : boolean);
procedure tcg.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);
begin
g_concatcopy(list,source,dest,len,loadref);
g_concatcopy(list,source,dest,len);
end;
procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;loadref : boolean);
procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte);
var
paraloc1,paraloc2,paraloc3 : TCGPara;
begin
@ -1399,10 +1390,7 @@ implementation
paramanager.allocparaloc(list,paraloc3);
a_paramaddr_ref(list,dest,paraloc3);
paramanager.allocparaloc(list,paraloc2);
if loadref then
a_param_ref(list,OS_ADDR,source,paraloc2)
else
a_paramaddr_ref(list,source,paraloc2);
a_paramaddr_ref(list,source,paraloc2);
paramanager.allocparaloc(list,paraloc1);
a_param_const(list,OS_INT,len,paraloc1);
paramanager.freeparaloc(list,paraloc3);
@ -1419,7 +1407,7 @@ implementation
end;
procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference;loadref : boolean);
procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
var
href : treference;
incrfunc : string;
@ -1457,8 +1445,8 @@ implementation
{ call the special incr function or the generic addref }
if incrfunc<>'' then
begin
{ these functions get the pointer by value }
paramanager.allocparaloc(list,paraloc1);
{ these functions get the pointer by value }
a_param_ref(list,OS_ADDR,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@ -1471,10 +1459,7 @@ implementation
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paraloc1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@ -1486,9 +1471,8 @@ implementation
end;
procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference; loadref:boolean);
procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
var
hreg : tregister;
href : treference;
decrfunc : string;
needrtti : boolean;
@ -1535,10 +1519,7 @@ implementation
a_paramaddr_ref(list,href,paraloc2);
end;
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paraloc1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
if needrtti then
paramanager.freeparaloc(list,paraloc2);
@ -1552,10 +1533,7 @@ implementation
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paraloc1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@ -1564,23 +1542,13 @@ implementation
end;
{ Temp locations need always to be reset to 0 }
if tg.istemp(ref) then
begin
if loadref then
begin
hreg:=getaddressregister(list);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,hreg);
reference_reset_base(href,hreg,0);
a_load_const_ref(list,OS_ADDR,0,href);
end
else
a_load_const_ref(list,OS_ADDR,0,ref);
end;
a_load_const_ref(list,OS_ADDR,0,ref);
paraloc2.done;
paraloc1.done;
end;
procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference);
var
href : treference;
paraloc1,paraloc2 : TCGPara;
@ -1600,10 +1568,7 @@ implementation
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paraloc1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@ -1617,9 +1582,8 @@ implementation
end;
procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference);
var
hreg : tregister;
href : treference;
paraloc1,paraloc2 : TCGPara;
begin
@ -1631,20 +1595,10 @@ implementation
is_widestring(t) or
is_interfacecom(t) then
begin
g_decrrefcount(list,t,ref,loadref);
g_decrrefcount(list,t,ref);
{ Temp locations are already reset to 0 }
if not tg.istemp(ref) then
begin
if loadref then
begin
hreg:=getaddressregister(list);
a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,hreg);
reference_reset_base(href,hreg,0);
a_load_const_ref(list,OS_ADDR,0,href);
end
else
a_load_const_ref(list,OS_ADDR,0,ref);
end;
a_load_const_ref(list,OS_ADDR,0,ref);
end
else
begin
@ -1652,10 +1606,7 @@ implementation
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paraloc1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@ -1885,9 +1836,9 @@ implementation
Entry/Exit Code Functions
*****************************************************************************}
procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);
procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);
var
sizereg,sourcereg,destreg : tregister;
sizereg,sourcereg : tregister;
paraloc1,paraloc2,paraloc3 : TCGPara;
begin
{ because ppc abi doesn't support dynamic stack allocation properly
@ -1895,22 +1846,14 @@ implementation
}
{ allocate two registers for len and source }
sizereg:=getintregister(list,OS_INT);
sourcereg:=getintregister(list,OS_ADDR);
destreg:=getintregister(list,OS_ADDR);
sourcereg:=getaddressregister(list);
{ calculate necessary memory }
a_load_loc_reg(list,OS_INT,lenloc,sizereg);
a_op_const_reg(list,OP_ADD,OS_INT,1,sizereg);
a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
{ load source }
if loadref then
a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg)
else
begin
if (ref.index<>NR_NO) or (ref.offset<>0) then
internalerror(200410126);
a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref.base,sourcereg);
end;
a_loadaddr_ref_reg(list,ref,sourcereg);
{ do getmem call }
paraloc1.init;
@ -1924,12 +1867,8 @@ implementation
dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc1.done;
{ return the new address }
a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
{ patch the new address }
if loadref then
a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref)
else
a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref.base);
{ do move call }
paraloc1.init;
@ -2092,7 +2031,11 @@ finalization
end.
{
$Log$
Revision 1.179 2004-10-15 09:14:16 mazen
Revision 1.180 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.179 2004/10/15 09:14:16 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

17
compiler/htypechk.pas
View File

@ -912,10 +912,13 @@ implementation
(tobjectdef(fromdef).is_related(tobjectdef(todef))))) and
(fromdef.size<>todef.size) then
begin
{ in TP it is allowed to typecast to smaller types }
if not(m_tp7 in aktmodeswitches) or
(todef.size>fromdef.size) then
CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));
{ in TP it is allowed to typecast to smaller types. But the variable can't
be in a register }
if (m_tp7 in aktmodeswitches) or
(todef.size<fromdef.size) then
make_not_regable(hp)
else
CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));
end;
{ don't allow assignments to typeconvs that need special code }
if not(gotsubscript or gotvec or gotderef) and
@ -1925,7 +1928,11 @@ implementation
end.
{
$Log$
Revision 1.100 2004-10-12 14:34:49 peter
Revision 1.101 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.100 2004/10/12 14:34:49 peter
* fixed visibility for procsyms
* fixed override check when there was no entry yet

31
compiler/i386/cgcpu.pas
View File

@ -46,7 +46,7 @@ unit cgcpu;
procedure g_save_all_registers(list : taasmoutput);override;
procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override;
procedure g_exception_reason_save(list : taasmoutput; const href : treference);override;
procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);override;
@ -296,7 +296,7 @@ unit cgcpu;
end;
procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;loadref:boolean);
procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);
var
power,len : longint;
opsize : topsize;
@ -363,14 +363,7 @@ unit cgcpu;
a_load_loc_reg(list,OS_INT,lenloc,NR_ECX);
{ load source }
if loadref then
a_load_ref_reg(list,OS_INT,OS_INT,ref,NR_ESI)
else
begin
if (ref.index<>NR_NO) or (ref.offset<>0) then
internalerror(200410123);
a_load_reg_reg(list,OS_INT,OS_INT,ref.base,NR_ESI)
end;
a_loadaddr_ref_reg(list,ref,NR_ESI);
{ scheduled .... }
list.concat(Taicpu.op_reg(A_INC,S_L,NR_ECX));
@ -407,15 +400,9 @@ unit cgcpu;
ungetcpuregister(list,NR_ECX);
ungetcpuregister(list,NR_ESI);
{ patch the new address }
if loadref then
a_load_reg_ref(list,OS_INT,OS_INT,NR_ESP,ref)
else
begin
{ Don't use a_load_reg_reg, that will add a move instruction
that can confuse the reg allocator }
list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,ref.base));
end;
{ patch the new address, but don't use a_load_reg_reg, that will add a move instruction
that can confuse the reg allocator }
list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,destreg));
end;
@ -571,7 +558,11 @@ begin
end.
{
$Log$
Revision 1.57 2004-10-15 09:16:21 mazen
Revision 1.58 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.57 2004/10/15 09:16:21 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

38
compiler/ncgcal.pas
View File

@ -197,7 +197,7 @@ implementation
else
begin
reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size);
end;
end;
else
@ -311,7 +311,7 @@ implementation
end
else
reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size);
{$else i386}
cg.a_param_copy_ref(exprasmlist,left.resulttype.def.size,left.location.reference,tempcgpara);
{$endif i386}
@ -536,17 +536,9 @@ implementation
tempnode.pass_2;
location := tempnode.location;
tempnode.free;
cg.g_decrrefcount(exprasmlist,resulttype.def,location.reference,false);
cg.g_decrrefcount(exprasmlist,resulttype.def,location.reference);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,location.reference);
end;
{ When the result is not used we need to finalize the result and
can release the temp }
if not(cnf_return_value_used in callnodeflags) then
begin
cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
tg.ungetiftemp(exprasmlist,location.reference)
end;
end
else
{ normal (ordinal,float,pointer) result value }
@ -637,6 +629,18 @@ implementation
location_reset(location,LOC_VOID,OS_NO);
end;
end;
{ When the result is not used we need to finalize the result and
can release the temp }
if not(cnf_return_value_used in callnodeflags) then
begin
if location.loc=LOC_REFERENCE then
begin
if resulttype.def.needs_inittable then
cg.g_finalize(exprasmlist,resulttype.def,location.reference);
tg.ungetiftemp(exprasmlist,location.reference)
end;
end;
end;
@ -806,7 +810,7 @@ implementation
not assigned(funcretnode) then
begin
tg.gettemptyped(exprasmlist,resulttype.def,tt_normal,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end;
regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
@ -1066,7 +1070,7 @@ implementation
not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
begin
tg.gettemptyped(exprasmlist,resulttype.def,tt_normal,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end;
{ Push parameters, still use the old current_procinfo. This
@ -1177,7 +1181,7 @@ implementation
begin
{ data which must be finalized ? }
if (resulttype.def.needs_inittable) then
cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
cg.g_finalize(exprasmlist,resulttype.def,location.reference);
{ release unused temp }
tg.ungetiftemp(exprasmlist,location.reference)
end
@ -1239,7 +1243,11 @@ begin
end.
{
$Log$
Revision 1.178 2004-10-15 09:14:16 mazen
Revision 1.179 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.178 2004/10/15 09:14:16 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

14
compiler/ncgflw.pas
View File

@ -928,7 +928,7 @@ implementation
objectlibrary.getlabel(lastonlabel);
get_exception_temps(exprasmlist,excepttemps);
new_exception(exprasmlist,excepttemps,1,exceptlabel);
new_exception(exprasmlist,excepttemps,exceptlabel);
{ try block }
{ set control flow labels for the try block }
@ -988,7 +988,7 @@ implementation
objectlibrary.getlabel(doobjectdestroyandreraise);
get_exception_temps(exprasmlist,destroytemps);
new_exception(exprasmlist,destroytemps,1,doobjectdestroyandreraise);
new_exception(exprasmlist,destroytemps,doobjectdestroyandreraise);
{ here we don't have to reset flowcontrol }
{ the default and on flowcontrols are handled equal }
@ -1176,7 +1176,7 @@ implementation
{ call setjmp, and jump to finally label on non-zero result }
get_exception_temps(exprasmlist,excepttemps);
new_exception(exprasmlist,excepttemps,1,doobjectdestroyandreraise);
new_exception(exprasmlist,excepttemps,doobjectdestroyandreraise);
oldaktbreaklabel:=nil;
oldaktcontinuelabel:=nil;
@ -1326,7 +1326,7 @@ implementation
{ call setjmp, and jump to finally label on non-zero result }
get_exception_temps(exprasmlist,excepttemps);
new_exception(exprasmlist,excepttemps,1,finallylabel);
new_exception(exprasmlist,excepttemps,finallylabel);
{ try code }
if assigned(left) then
@ -1443,7 +1443,11 @@ begin
end.
{
$Log$
Revision 1.100 2004-09-26 17:45:30 peter
Revision 1.101 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.100 2004/09/26 17:45:30 peter
* simple regvar support, not yet finished
Revision 1.99 2004/09/25 14:23:54 peter

50
compiler/ncgld.pas
View File

@ -419,7 +419,10 @@ implementation
useless for string constants}
if (right.resulttype.def.needs_inittable) and
(right.nodetype<>stringconstn) then
cg.g_incrrefcount(exprasmlist,right.resulttype.def,right.location.reference,false);
begin
location_get_data_ref(exprasmlist,right.location,href,false);
cg.g_incrrefcount(exprasmlist,right.resulttype.def,href);
end;
if codegenerror then
exit;
@ -433,7 +436,10 @@ implementation
secondpass(left);
{ decrement destination reference counter }
if (left.resulttype.def.needs_inittable) then
cg.g_decrrefcount(exprasmlist,left.resulttype.def,left.location.reference,false);
begin
location_get_data_ref(exprasmlist,left.location,href,false);
cg.g_decrrefcount(exprasmlist,left.resulttype.def,href);
end;
if codegenerror then
exit;
end;
@ -443,14 +449,17 @@ implementation
{ calculate left sides }
{ don't do it yet if it's a crgister (JM) }
if not(nf_concat_string in flags) then
begin
secondpass(left);
{ decrement destination reference counter }
if (left.resulttype.def.needs_inittable) then
cg.g_decrrefcount(exprasmlist,left.resulttype.def,left.location.reference,false);
if codegenerror then
exit;
end;
begin
secondpass(left);
{ decrement destination reference counter }
if (left.resulttype.def.needs_inittable) then
begin
location_get_data_ref(exprasmlist,left.location,href,false);
cg.g_decrrefcount(exprasmlist,left.resulttype.def,href);
end;
if codegenerror then
exit;
end;
{ left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
{ can be false }
@ -459,7 +468,10 @@ implementation
useless for string constants}
if (right.resulttype.def.needs_inittable) and
(right.nodetype<>stringconstn) then
cg.g_incrrefcount(exprasmlist,right.resulttype.def,right.location.reference,false);
begin
location_get_data_ref(exprasmlist,right.location,href,false);
cg.g_incrrefcount(exprasmlist,right.resulttype.def,href);
end;
if codegenerror then
exit;
@ -576,11 +588,9 @@ implementation
len:=left.resulttype.def.size;
if (right.location.reference.offset mod sizeof(aint)<>0) and
(len>sizeof(aint)) then
cg.g_concatcopy_unaligned(exprasmlist,right.location.reference,
left.location.reference,len,false)
cg.g_concatcopy_unaligned(exprasmlist,right.location.reference,left.location.reference,len)
else
cg.g_concatcopy(exprasmlist,right.location.reference,
left.location.reference,len,false);
cg.g_concatcopy(exprasmlist,right.location.reference,left.location.reference,len);
end;
else
internalerror(200203284);
@ -892,9 +902,9 @@ implementation
begin
if is_shortstring(hp.left.resulttype.def) then
cg.g_copyshortstring(exprasmlist,hp.left.location.reference,href,
Tstringdef(hp.left.resulttype.def).len,false)
Tstringdef(hp.left.resulttype.def).len)
else
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,false);
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize);
end;
else
begin
@ -923,7 +933,11 @@ begin
end.
{
$Log$
Revision 1.127 2004-10-10 20:21:18 peter
Revision 1.128 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.127 2004/10/10 20:21:18 peter
* passing a var parameter to var parameter is now also allowed
for register locations (=regvars)

8
compiler/ncgopt.pas
View File

@ -98,7 +98,7 @@ begin
not(nf_use_strconcat in flags) then
begin
tg.Gettemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,false);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255);
location_freetemp(exprasmlist,left.location);
{ return temp reference }
location_reset(left.location,LOC_REFERENCE,def_cgsize(resulttype.def));
@ -196,7 +196,11 @@ end.
{
$Log$
Revision 1.15 2004-09-25 14:23:54 peter
Revision 1.16 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.15 2004/09/25 14:23:54 peter
* ungetregister is now only used for cpuregisters, renamed to
ungetcpuregister
* renamed (get|unget)explicitregister(s) to ..cpuregister

105
compiler/ncgutil.pas
View File

@ -49,6 +49,10 @@ interface
procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
{ Retrieve the location of the data pointed to in location l, when the location is
a register it is expected to contain the address of the data }
procedure location_get_data_ref(list:TAAsmoutput;const l:tlocation;var ref:treference;loadref:boolean);
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
procedure gen_proc_symbol(list:Taasmoutput);
@ -92,7 +96,7 @@ interface
procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;exceptlabel:tasmlabel);
procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
procedure insertconstdata(sym : ttypedconstsym);
@ -282,7 +286,7 @@ implementation
end;
procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;exceptlabel:tasmlabel);
var
paraloc1,paraloc2,paraloc3 : tcgpara;
begin
@ -659,6 +663,33 @@ implementation
end;
procedure location_get_data_ref(list:TAAsmoutput;const l:tlocation;var ref:treference;loadref:boolean);
begin
case l.loc of
LOC_REGISTER,
LOC_CREGISTER :
begin
if not loadref then
internalerror(200410231);
reference_reset_base(ref,l.register,0);
end;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
if loadref then
begin
reference_reset_base(ref,cg.getaddressregister(list),0);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,l.reference,ref.base);
end
else
ref:=l.reference;
end;
else
internalerror(200309181);
end;
end;
{*****************************************************************************
Maybe_Save
*****************************************************************************}
@ -686,11 +717,11 @@ implementation
procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
var
href1 : treference;
list:TAAsmoutput;
href : treference;
hreg : tregister;
list : TAAsmoutput;
hsym : tvarsym;
l : longint;
loadref : boolean;
localcopyloc : tlocation;
begin
list:=taasmoutput(arg);
@ -698,18 +729,7 @@ implementation
(tvarsym(p).varspez=vs_value) and
(paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
begin
loadref:=true;
case tvarsym(p).localloc.loc of
LOC_CREGISTER :
begin
reference_reset_base(href1,tvarsym(p).localloc.register,0);
loadref:=false;
end;
LOC_REFERENCE :
href1:=tvarsym(p).localloc.reference;
else
internalerror(200309181);
end;
location_get_data_ref(list,tvarsym(p).localloc,href,true);
if is_open_array(tvarsym(p).vartype.def) or
is_array_of_const(tvarsym(p).vartype.def) then
begin
@ -720,7 +740,9 @@ implementation
hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
if not assigned(hsym) then
internalerror(200306061);
cg.g_copyvaluepara_openarray(list,href1,hsym.localloc,tarraydef(tvarsym(p).vartype.def).elesize,loadref);
hreg:=cg.getaddressregister(list);
cg.g_copyvaluepara_openarray(list,href,hsym.localloc,tarraydef(tvarsym(p).vartype.def).elesize,hreg);
cg.a_load_reg_loc(list,OS_ADDR,hreg,tvarsym(p).localloc);
end;
end
else
@ -737,10 +759,10 @@ implementation
so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
}
include(current_procinfo.flags,pi_do_call);
cg.g_copyshortstring(list,href1,localcopyloc.reference,tstringdef(tvarsym(p).vartype.def).len,loadref)
cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tvarsym(p).vartype.def).len)
end
else
cg.g_concatcopy(list,href1,localcopyloc.reference,tvarsym(p).vartype.def.size,loadref);
cg.g_concatcopy(list,href,localcopyloc.reference,tvarsym(p).vartype.def.size);
{ update localloc of varsym }
tg.Ungetlocal(list,tvarsym(p).localloc.reference);
tvarsym(p).localloc:=localcopyloc;
@ -751,9 +773,6 @@ implementation
{ initializes the regvars from staticsymtable with 0 }
procedure initialize_regvars(p : tnamedindexitem;arg:pointer);
var
oldexprasmlist : TAAsmoutput;
hp : tnode;
begin
if (tsym(p).typ=varsym) then
begin
@ -893,7 +912,7 @@ implementation
var
href : treference;
tmpreg : tregister;
list:TAAsmoutput;
list : TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
@ -903,16 +922,15 @@ implementation
case tvarsym(p).varspez of
vs_value :
begin
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309187);
cg.g_incrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
location_get_data_ref(list,tvarsym(p).localloc,href,is_open_array(tvarsym(p).vartype.def));
cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
end;
vs_out :
begin
tmpreg:=cg.getaddressregister(list);
cg.a_load_loc_reg(list,OS_ADDR,tvarsym(p).localloc,tmpreg);
reference_reset_base(href,tmpreg,0);
cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
cg.g_initialize(list,tvarsym(p).vartype.def,href);
end;
end;
end;
@ -922,19 +940,20 @@ implementation
{ generates the code for decrementing the reference count of parameters }
procedure final_paras(p : tnamedindexitem;arg:pointer);
var
list:TAAsmoutput;
list : TAAsmoutput;
href : treference;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
not is_class_or_interface(tvarsym(p).vartype.def) and
tvarsym(p).vartype.def.needs_inittable then
begin
location_get_data_ref(list,tvarsym(p).localloc,href,is_open_array(tvarsym(p).vartype.def));
if (tvarsym(p).varspez=vs_value) then
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309188);
cg.g_decrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
location_get_data_ref(list,tvarsym(p).localloc,href,is_open_array(tvarsym(p).vartype.def));
cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
end;
end
else if (tsym(p).typ=varsym) and
@ -963,7 +982,7 @@ implementation
hp^.def.needs_inittable then
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_initialize(list,hp^.def,href,false);
cg.g_initialize(list,hp^.def,href);
end;
hp:=hp^.next;
end;
@ -983,7 +1002,7 @@ implementation
begin
include(current_procinfo.flags,pi_needs_implicit_finally);
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_finalize(list,hp^.def,href,false);
cg.g_finalize(list,hp^.def,href);
end;
hp:=hp^.next;
end;
@ -1214,7 +1233,7 @@ implementation
{ use concatcopy, because it can also be a float which fails when
load_ref_ref is used. Don't copy data when the references are equal }
if not((href.base=ref.base) and (href.offset=ref.offset)) then
cg.g_concatcopy(list,href,ref,tcgsize2size[paraloc.size],false);
cg.g_concatcopy(list,href,ref,tcgsize2size[paraloc.size]);
end;
else
internalerror(2002081302);
@ -1376,11 +1395,15 @@ implementation
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
potype_proginit:
begin
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
end;
else
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
@ -1391,10 +1414,6 @@ implementation
{ initialize ansi/widesstring para's }
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
{ initialize regvars in staticsymtable with 0, like .bss }
if current_procinfo.procdef.localst.symtabletype=staticsymtable then
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_regvars,list);
{$ifdef OLDREGVARS}
load_regvars(list,nil);
{$endif OLDREGVARS}
@ -2218,7 +2237,11 @@ implementation
end.
{
$Log$
Revision 1.229 2004-10-15 09:14:17 mazen
Revision 1.230 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.229 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

23
compiler/ncnv.pas
View File

@ -1507,14 +1507,10 @@ implementation
end;
end;
if (nf_explicit in flags) or
(nf_absolute in flags) then
begin
{ check if the result could be in a register }
if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left);
end;
{ check if the result could be in a register }
if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left);
{ now call the resulttype helper to do constant folding }
result:=resulttype_call_helper(convtype);
@ -1996,6 +1992,11 @@ implementation
((convtype in [tc_int_2_bool,tc_bool_2_int]) and
(nf_explicit in flags) and
(resulttype.def.size=left.resulttype.def.size));
{ When using only a part of the value it can't be in a register since
that will load the value in a new register first }
if (resulttype.def.size<left.resulttype.def.size) then
make_not_regable(left);
end;
@ -2462,7 +2463,11 @@ begin
end.
{
$Log$
Revision 1.156 2004-10-15 09:14:17 mazen
Revision 1.157 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.156 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

16
compiler/nld.pas
View File

@ -280,9 +280,15 @@ implementation
{ reference in nested procedures, variable needs to be in memory }
make_not_regable(self);
end;
{ static variables referenced in procedures, variable needs to be in memory }
{ static variables referenced in procedures or from finalization,
variable needs to be in memory.
It is too hard and the benefit is too small to detect whether a
variable is only used in the finalization to add support for it (PFV) }
if (symtable.symtabletype=staticsymtable) and
(symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) then
(
(symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
(current_procinfo.procdef.proctypeoption=potype_unitfinalize)
) then
make_not_regable(self);
end;
{ fix self type which is declared as voidpointer in the
@ -1166,7 +1172,11 @@ begin
end.
{
$Log$
Revision 1.134 2004-10-12 14:35:14 peter
Revision 1.135 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.134 2004/10/12 14:35:14 peter
* fixed crash when current_procinfo was not yet available
Revision 1.133 2004/10/11 15:48:15 peter

9
compiler/pdecsub.pas
View File

@ -341,7 +341,8 @@ implementation
exit;
with tvarsym(p) do
begin
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(arg).proccalloption) then
if not vartype.def.needs_inittable and
paramanager.push_addr_param(varspez,vartype.def,tprocdef(arg).proccalloption) then
varregable:=vr_intreg;
end;
end;
@ -2266,7 +2267,11 @@ const
end.
{
$Log$
Revision 1.194 2004-10-15 09:14:17 mazen
Revision 1.195 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.194 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

10
compiler/rautils.pas
View File

@ -858,6 +858,8 @@ Begin
{ that the variable is valid. }
tvarsym(sym).varstate:=vs_used;
inc(tvarsym(sym).refs);
{ variable can't be placed in a register }
tvarsym(sym).varregable:=vr_none;
case tvarsym(sym).owner.symtabletype of
objectsymtable :
begin
@ -903,8 +905,6 @@ Begin
(current_procinfo.procdef.localst.symtablelevel>normal_function_level) and
symtable_has_varsyms(current_procinfo.procdef.localst) then
message1(asmr_e_local_para_unreachable,s);
{ variable can't be placed in a register anymore }
tvarsym(sym).varregable:=vr_none;
opr.localsym:=tvarsym(sym);
opr.localsymofs:=0;
opr.localindexreg:=indexreg;
@ -1664,7 +1664,11 @@ end;
end.
{
$Log$
Revision 1.91 2004-10-15 09:14:17 mazen
Revision 1.92 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.91 2004/10/15 09:14:17 mazen
- remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code

17
compiler/x86/cgx86.pas
View File

@ -102,7 +102,7 @@ unit cgx86;
procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref: TReference); override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint; loadref : boolean);override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);override;
{ entry/exit code helpers }
procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);override;
@ -1268,7 +1268,7 @@ unit cgx86;
{ ************* concatcopy ************ }
procedure Tcgx86.g_concatcopy(list:Taasmoutput;const source,dest:Treference;len:aint;loadref:boolean);
procedure Tcgx86.g_concatcopy(list:Taasmoutput;const source,dest:Treference;len:aint);
const
{$ifdef cpu64bit}
@ -1304,8 +1304,6 @@ unit cgx86;
if (cs_littlesize in aktglobalswitches) and
not((len<=16) and (cm=copy_mmx)) then
cm:=copy_string;
if loadref then
cm:=copy_string;
case cm of
copy_move:
begin
@ -1384,10 +1382,7 @@ unit cgx86;
getcpuregister(list,REGDI);
a_loadaddr_ref_reg(list,dest,REGDI);
getcpuregister(list,REGSI);
if loadref then
a_load_ref_reg(list,OS_ADDR,OS_ADDR,source,REGSI)
else
a_loadaddr_ref_reg(list,source,REGSI);
a_loadaddr_ref_reg(list,source,REGSI);
getcpuregister(list,REGCX);
@ -1679,7 +1674,11 @@ unit cgx86;
end.
{
$Log$
Revision 1.129 2004-10-06 19:27:35 jonas
Revision 1.130 2004-10-24 11:44:28 peter
* small regvar fixes
* loadref parameter removed from concatcopy,incrrefcount,etc
Revision 1.129 2004/10/06 19:27:35 jonas
* regvar fixes from Peter
Revision 1.128 2004/10/05 20:41:02 peter