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

* fixed internalerror(10) due to previous fpu overflow fixes ("merged")

Browse Source 
* fixed bug in n386add (introduced after compilerproc changes for string
    operations) where calcregisters wasn't called for shortstring addnodes
  * NOTE: from now on, the location of a binary node must now always be set
     before you call calcregisters() for it
This commit is contained in:
Jonas Maebe 2001-10-12 13:51:51 +00:00
parent 98ce4e5868
commit 8a2c142e46
7 changed files with 153 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/htypechk.pas
View File

@ -416,7 +416,16 @@ implementation
begin begin
if assigned(p.right) then if assigned(p.right) then
begin begin
if (abs(p.left.registers32-p.right.registers32)<r32) then { the location must be already filled in because we need it to }
{ calculate the necessary number of registers (JM) }
if p.location.loc = LOC_INVALID then
internalerror(200110101);
if (abs(p.left.registers32-p.right.registers32)<r32) or
((p.location.loc = LOC_FPU) and
(p.right.registersfpu <= p.left.registersfpu) and
((p.right.registersfpu <> 0) or (p.left.registersfpu <> 0)) and
(p.left.registers32 < p.right.registers32)) then
inc(p.registers32,r32); inc(p.registers32,r32);
if (abs(p.left.registersfpu-p.right.registersfpu)<fpu) then if (abs(p.left.registersfpu-p.right.registersfpu)<fpu) then
inc(p.registersfpu,fpu); inc(p.registersfpu,fpu);
@ -958,7 +967,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.35 2001-09-17 21:29:11 peter Revision 1.36 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.35 2001/09/17 21:29:11 peter
* merged netbsd, fpu-overflow from fixes branch * merged netbsd, fpu-overflow from fixes branch
Revision 1.34 2001/09/07 07:46:17 jonas Revision 1.34 2001/09/07 07:46:17 jonas

32
compiler/i386/n386add.pas
View File

@ -45,8 +45,8 @@ interface
uses uses
globtype,systems, globtype,systems,
cutils,verbose,globals,widestr, cutils,verbose,globals,widestr,
symconst,symdef,aasm,types, symconst,symdef,aasm,types,htypechk,
cgbase,temp_gen,pass_2, cgbase,temp_gen,pass_2,regvars,
cpuasm, cpuasm,
ncon,nset, ncon,nset,
cga,n386util,tgcpu; cga,n386util,tgcpu;
@ -54,12 +54,14 @@ interface
function ti386addnode.getresflags(unsigned : boolean) : tresflags; function ti386addnode.getresflags(unsigned : boolean) : tresflags;
begin begin
case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
else
if not(unsigned) then if not(unsigned) then
begin begin
if nf_swaped in flags then if nf_swaped in flags then
case nodetype of case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_G; ltn : getresflags:=F_G;
lten : getresflags:=F_GE; lten : getresflags:=F_GE;
gtn : getresflags:=F_L; gtn : getresflags:=F_L;
@ -67,8 +69,6 @@ interface
end end
else else
case nodetype of case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_L; ltn : getresflags:=F_L;
lten : getresflags:=F_LE; lten : getresflags:=F_LE;
gtn : getresflags:=F_G; gtn : getresflags:=F_G;
@ -79,8 +79,6 @@ interface
begin begin
if nf_swaped in flags then if nf_swaped in flags then
case nodetype of case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_A; ltn : getresflags:=F_A;
lten : getresflags:=F_AE; lten : getresflags:=F_AE;
gtn : getresflags:=F_B; gtn : getresflags:=F_B;
@ -88,8 +86,6 @@ interface
end end
else else
case nodetype of case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_B; ltn : getresflags:=F_B;
lten : getresflags:=F_BE; lten : getresflags:=F_BE;
gtn : getresflags:=F_A; gtn : getresflags:=F_A;
@ -97,6 +93,7 @@ interface
end; end;
end; end;
end; end;
end;
procedure ti386addnode.SetResultLocation(cmpop,unsigned : boolean); procedure ti386addnode.SetResultLocation(cmpop,unsigned : boolean);
@ -142,6 +139,11 @@ interface
((right.nodetype=stringconstn) and (str_length(right)=0))) and ((right.nodetype=stringconstn) and (str_length(right)=0))) and
is_shortstring(left.resulttype.def)) then is_shortstring(left.resulttype.def)) then
begin begin
if nodetype = addn then
location.loc := LOC_MEM
else
location.loc := LOC_FLAGS;
calcregisters(self,0,0,0);
result := nil; result := nil;
exit; exit;
end; end;
@ -299,6 +301,7 @@ interface
oldnodetype : tnodetype; oldnodetype : tnodetype;
begin begin
load_all_regvars(exprasmlist);
{ the jump the sequence is a little bit hairy } { the jump the sequence is a little bit hairy }
case nodetype of case nodetype of
ltn,gtn: ltn,gtn:
@ -1861,7 +1864,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.24 2001-09-17 21:29:13 peter Revision 1.25 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.24 2001/09/17 21:29:13 peter
* merged netbsd, fpu-overflow from fixes branch * merged netbsd, fpu-overflow from fixes branch
Revision 1.23 2001/09/05 15:22:09 jonas Revision 1.23 2001/09/05 15:22:09 jonas

19
compiler/i386/n386util.pas
View File

@ -1237,15 +1237,17 @@ implementation
internalerror(234234); internalerror(234234);
end end
else else
if ((p.location.loc=LOC_FPU) and if (((p.location.loc=LOC_FPU) and
(p.right.registersfpu > p.left.registersfpu)) or (p.right.registersfpu > p.left.registersfpu)) or
((p.location.loc<>LOC_FPU) and ((((p.left.registersfpu = 0) and
(p.left.registers32<p.right.registers32) and (p.right.registersfpu = 0)) or
(p.location.loc<>LOC_FPU)) and
(p.left.registers32<p.right.registers32))) and
{ the following check is appropriate, because all } { the following check is appropriate, because all }
{ 4 registers are rarely used and it is thereby } { 4 registers are rarely used and it is thereby }
{ achieved that the extra code is being dropped } { achieved that the extra code is being dropped }
{ by exchanging not commutative operators } { by exchanging not commutative operators }
(p.right.registers32<=4)) then (p.right.registers32<=4) then
begin begin
hp:=p.left; hp:=p.left;
p.left:=p.right; p.left:=p.right;
@ -1532,7 +1534,14 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.21 2001-09-17 21:29:14 peter Revision 1.22 2001-10-12 13:51:52 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.21 2001/09/17 21:29:14 peter
* merged netbsd, fpu-overflow from fixes branch * merged netbsd, fpu-overflow from fixes branch
Revision 1.20 2001/08/26 13:37:01 florian Revision 1.20 2001/08/26 13:37:01 florian

56
compiler/nadd.pas
View File

@ -1337,6 +1337,7 @@ implementation
{ int/int gives real/real! } { int/int gives real/real! }
if nodetype=slashn then if nodetype=slashn then
begin begin
location.loc:=LOC_FPU;
{ maybe we need an integer register to save } { maybe we need an integer register to save }
{ a reference } { a reference }
if ((left.location.loc<>LOC_FPU) or if ((left.location.loc<>LOC_FPU) or
@ -1345,7 +1346,6 @@ implementation
calcregisters(self,1,1,0) calcregisters(self,1,1,0)
else else
calcregisters(self,0,1,0); calcregisters(self,0,1,0);
location.loc:=LOC_FPU;
end end
{ if both are orddefs then check sub types } { if both are orddefs then check sub types }
@ -1357,11 +1357,12 @@ implementation
if not(cs_full_boolean_eval in aktlocalswitches) and if not(cs_full_boolean_eval in aktlocalswitches) and
(nodetype in [andn,orn]) then (nodetype in [andn,orn]) then
begin begin
calcregisters(self,0,0,0);
location.loc:=LOC_JUMP; location.loc:=LOC_JUMP;
calcregisters(self,0,0,0);
end end
else else
begin begin
location.loc := LOC_FLAGS;
if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
(left.location.loc in [LOC_JUMP,LOC_FLAGS]) then (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
calcregisters(self,2,0,0) calcregisters(self,2,0,0)
@ -1375,6 +1376,7 @@ implementation
begin begin
if nodetype=addn then if nodetype=addn then
internalerror(200103291); internalerror(200103291);
location.loc := LOC_FLAGS;
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
end end
{ is there a 64 bit type ? } { is there a 64 bit type ? }
@ -1383,11 +1385,19 @@ implementation
result := first_add64bitint; result := first_add64bitint;
if assigned(result) then if assigned(result) then
exit; exit;
if nodetype in [addn,subn,muln,andn,orn,xorn] then
location.loc := LOC_REGISTER
else
location.loc := LOC_JUMP;
calcregisters(self,2,0,0) calcregisters(self,2,0,0)
end end
{ is there a cardinal? } { is there a cardinal? }
else if (torddef(ld).typ=u32bit) then else if (torddef(ld).typ=u32bit) then
begin begin
if nodetype in [addn,subn,muln,andn,orn,xorn] then
location.loc := LOC_REGISTER
else
location.loc := LOC_FLAGS;
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
{ for unsigned mul we need an extra register } { for unsigned mul we need an extra register }
if nodetype=muln then if nodetype=muln then
@ -1395,7 +1405,13 @@ implementation
end end
{ generic s32bit conversion } { generic s32bit conversion }
else else
begin
if nodetype in [addn,subn,muln,andn,orn,xorn] then
location.loc := LOC_REGISTER
else
location.loc := LOC_FLAGS;
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
end;
end end
{ left side a setdef, must be before string processing, { left side a setdef, must be before string processing,
@ -1404,22 +1420,22 @@ implementation
begin begin
if tsetdef(ld).settype=smallset then if tsetdef(ld).settype=smallset then
begin begin
location.loc:=LOC_REGISTER;
{ are we adding set elements ? } { are we adding set elements ? }
if right.nodetype=setelementn then if right.nodetype=setelementn then
calcregisters(self,2,0,0) calcregisters(self,2,0,0)
else else
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end end
else else
begin begin
result := first_addset; result := first_addset;
if assigned(result) then if assigned(result) then
exit; exit;
location.loc:=LOC_MEM;
calcregisters(self,0,0,0); calcregisters(self,0,0,0);
{ here we call SET... } { here we call SET... }
procinfo^.flags:=procinfo^.flags or pi_do_call; procinfo^.flags:=procinfo^.flags or pi_do_call;
location.loc:=LOC_MEM;
end; end;
end end
@ -1486,8 +1502,8 @@ implementation
{ is one a real float ? } { is one a real float ? }
else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
begin begin
calcregisters(self,0,1,0);
location.loc:=LOC_FPU; location.loc:=LOC_FPU;
calcregisters(self,0,1,0);
end end
{ pointer comperation and subtraction } { pointer comperation and subtraction }
@ -1513,8 +1529,8 @@ implementation
else if ((ld.deftype=procvardef) and (rt=niln)) or else if ((ld.deftype=procvardef) and (rt=niln)) or
((rd.deftype=procvardef) and (lt=niln)) then ((rd.deftype=procvardef) and (lt=niln)) then
begin begin
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER; location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end end
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
@ -1536,12 +1552,13 @@ implementation
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
begin begin
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER; location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end end
else if (ld.deftype=enumdef) then else if (ld.deftype=enumdef) then
begin begin
location.loc := LOC_FLAGS;
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
end end
@ -1558,22 +1575,8 @@ implementation
{ the general solution is to convert to 32 bit int } { the general solution is to convert to 32 bit int }
else else
begin begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0); calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end;
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln:
begin
if is_64bitint(left.resulttype.def) then
location.loc:=LOC_JUMP
else
location.loc:=LOC_FLAGS;
end;
xorn:
begin
location.loc:=LOC_REGISTER;
end;
end; end;
end; end;
@ -1582,7 +1585,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.39 2001-09-05 15:22:09 jonas Revision 1.40 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.39 2001/09/05 15:22:09 jonas
* made multiplying, dividing and mod'ing of int64 and qword processor * made multiplying, dividing and mod'ing of int64 and qword processor
independent with compilerprocs (+ small optimizations by using shift/and independent with compilerprocs (+ small optimizations by using shift/and
where possible) where possible)

14
compiler/nld.pas
View File

@ -559,6 +559,7 @@ implementation
begin begin
firstpass(left); firstpass(left);
firstpass(right); firstpass(right);
location.loc := LOC_MEM;
calcregisters(self,0,0,0); calcregisters(self,0,0,0);
result:=nil; result:=nil;
end; end;
@ -734,15 +735,15 @@ implementation
end; end;
include(chp.flags,nf_cargs); include(chp.flags,nf_cargs);
include(chp.flags,nf_cargswap); include(chp.flags,nf_cargswap);
calcregisters(chp,0,0,0);
chp.location.loc:=LOC_MEM; chp.location.loc:=LOC_MEM;
calcregisters(chp,0,0,0);
chp.resulttype:=htype; chp.resulttype:=htype;
result:=chp; result:=chp;
exit; exit;
end; end;
end; end;
calcregisters(self,0,0,0);
location.loc:=LOC_MEM; location.loc:=LOC_MEM;
calcregisters(self,0,0,0);
end; end;
@ -800,7 +801,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.25 2001-09-02 21:12:07 peter Revision 1.26 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.25 2001/09/02 21:12:07 peter
* move class of definitions into type section for delphi * move class of definitions into type section for delphi
Revision 1.24 2001/08/30 15:48:34 jonas Revision 1.24 2001/08/30 15:48:34 jonas

13
compiler/nmat.pas
View File

@ -253,6 +253,7 @@ implementation
result := first_moddiv64bitint; result := first_moddiv64bitint;
if assigned(result) then if assigned(result) then
exit; exit;
location.loc:=LOC_REGISTER;
calcregisters(self,2,0,0); calcregisters(self,2,0,0);
end end
else else
@ -334,9 +335,8 @@ implementation
if (right.nodetype<>ordconstn) then if (right.nodetype<>ordconstn) then
inc(regs); inc(regs);
calcregisters(self,regs,0,0);
location.loc:=LOC_REGISTER; location.loc:=LOC_REGISTER;
calcregisters(self,regs,0,0);
end; end;
@ -640,7 +640,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.23 2001-09-05 15:22:09 jonas Revision 1.24 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.23 2001/09/05 15:22:09 jonas
* made multiplying, dividing and mod'ing of int64 and qword processor * made multiplying, dividing and mod'ing of int64 and qword processor
independent with compilerprocs (+ small optimizations by using shift/and independent with compilerprocs (+ small optimizations by using shift/and
where possible) where possible)

11
compiler/nset.pas
View File

@ -160,8 +160,8 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
calcregisters(self,0,0,0);
set_location(location,left.location); set_location(location,left.location);
calcregisters(self,0,0,0);
end; end;
@ -588,7 +588,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.15 2001-09-02 21:12:07 peter Revision 1.16 2001-10-12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
* fixed bug in n386add (introduced after compilerproc changes for string
operations) where calcregisters wasn't called for shortstring addnodes
* NOTE: from now on, the location of a binary node must now always be set
before you call calcregisters() for it
Revision 1.15 2001/09/02 21:12:07 peter
* move class of definitions into type section for delphi * move class of definitions into type section for delphi
Revision 1.14 2001/08/26 13:36:43 florian Revision 1.14 2001/08/26 13:36:43 florian