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

* qword/int64 multiplication fixed

Browse Source 
+ qword/int64 subtraction
This commit is contained in:
florian 1999-05-23 19:55:10 +00:00
parent 6b33f4d87d
commit 59c6d9f289
2 changed files with 99 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
compiler/cg386add.pas
View File

@ -583,6 +583,7 @@ implementation
mmxbase : tmmxtype; mmxbase : tmmxtype;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
pushedreg : tpushed; pushedreg : tpushed;
hloc : tlocation;
begin begin
{ to make it more readable, string and set (not smallset!) have their { to make it more readable, string and set (not smallset!) have their
@ -1451,7 +1452,9 @@ implementation
if p^.treetype=muln then if p^.treetype=muln then
begin begin
release_qword_loc(p^.left^.location); { save p^.lcoation, because we change it now }
set_location(hloc,p^.location);
release_qword_loc(p^.location);
release_qword_loc(p^.right^.location); release_qword_loc(p^.right^.location);
p^.location.registerlow:=getexplicitregister32(R_EAX); p^.location.registerlow:=getexplicitregister32(R_EAX);
p^.location.registerhigh:=getexplicitregister32(R_EDX); p^.location.registerhigh:=getexplicitregister32(R_EDX);
@ -1462,7 +1465,12 @@ implementation
push_int(1) push_int(1)
else else
push_int(0); push_int(0);
emit_pushq_loc(p^.left^.location); { the left operand is in hloc, because the
location of left is p^.location but p^.location
is already destroyed
}
emit_pushq_loc(hloc);
clear_location(hloc);
emit_pushq_loc(p^.right^.location); emit_pushq_loc(p^.right^.location);
if porddef(p^.resulttype)^.typ=u64bit then if porddef(p^.resulttype)^.typ=u64bit then
emitcall('FPC_MUL_QWORD',true) emitcall('FPC_MUL_QWORD',true)
@ -1555,7 +1563,7 @@ implementation
{ and p^.location.register should be a valid register } { and p^.location.register should be a valid register }
{ containing the left result } { containing the left result }
if p^.right^.location.loc<>LOC_REGISTER then if p^.right^.location.loc<>LOC_REGISTER then
begin begin
if (p^.treetype=subn) and p^.swaped then if (p^.treetype=subn) and p^.swaped then
begin begin
@ -1564,13 +1572,25 @@ implementation
emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI); emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
emit_reg_reg(op,opsize,p^.location.register,R_EDI); emit_reg_reg(op,opsize,p^.location.register,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register); emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
emit_reg_reg(A_MOV,opsize,p^.right^.location.registerhigh,R_EDI);
{ the carry flag is still ok }
emit_reg_reg(op2,opsize,p^.location.registerhigh,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.registerhigh);
end end
else else
begin begin
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize, exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),R_EDI))); newreference(p^.right^.location.reference),R_EDI)));
exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,p^.location.register,R_EDI))); exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,p^.location.registerlow,R_EDI)));
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,p^.location.register))); exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,p^.location.registerlow)));
hr:=newreference(p^.right^.location.reference);
inc(hr^.offset,4);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
hr,R_EDI)));
{ here the carry flag is still preserved }
exprasmlist^.concat(new(pai386,op_reg_reg(op2,opsize,p^.location.registerhigh,R_EDI)));
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,
p^.location.registerhigh)));
ungetiftemp(p^.right^.location.reference); ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
end; end;
@ -1653,12 +1673,16 @@ implementation
{ when swapped another result register } { when swapped another result register }
if (p^.treetype=subn) and p^.swaped then if (p^.treetype=subn) and p^.swaped then
begin begin
exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize, exprasmlist^.concat(new(pai386,op_reg_reg(op,S_L,
p^.location.register,p^.right^.location.register))); p^.location.registerlow,
swap_location(p^.location,p^.right^.location); p^.right^.location.registerlow)));
{ newly swapped also set swapped flag } exprasmlist^.concat(new(pai386,op_reg_reg(op2,S_L,
{ just to maintain ordering } p^.location.registerhigh,
p^.swaped:=not(p^.swaped); p^.right^.location.registerhigh)));
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
{ just to maintain ordering }
p^.swaped:=not(p^.swaped);
end end
else if cmpop then else if cmpop then
begin begin
@ -2029,7 +2053,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.59 1999-05-19 10:31:53 florian Revision 1.60 1999-05-23 19:55:10 florian
* qword/int64 multiplication fixed
+ qword/int64 subtraction
Revision 1.59 1999/05/19 10:31:53 florian
* two bugs reported by Romio (bugs 13) are fixed: * two bugs reported by Romio (bugs 13) are fixed:
- empty array constructors are now handled correctly (e.g. for sysutils.format) - empty array constructors are now handled correctly (e.g. for sysutils.format)
- comparsion of ansistrings was sometimes coded wrong - comparsion of ansistrings was sometimes coded wrong

107
compiler/cg386inl.pas
View File

@ -92,53 +92,60 @@ implementation
floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference); floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference);
orddef: orddef:
begin begin
Case dest^.resulttype^.size of if porddef(dest^.resulttype)^.typ in [u64bit,s64bitint] then
1 : hreg:=regtoreg8(accumulator); begin
2 : hreg:=regtoreg16(accumulator); emit_movq_reg_loc(R_EDX,R_EAX,dest^.location);
4 : hreg:=accumulator; end
End; else
emit_mov_reg_loc(hreg,dest^.location); begin
If (cs_check_range in aktlocalswitches) and Case dest^.resulttype^.size of
{no need to rangecheck longints or cardinals on 32bit processors} 1 : hreg:=regtoreg8(accumulator);
not((porddef(dest^.resulttype)^.typ = s32bit) and 2 : hreg:=regtoreg16(accumulator);
(porddef(dest^.resulttype)^.low = $80000000) and 4 : hreg:=accumulator;
(porddef(dest^.resulttype)^.high = $7fffffff)) and End;
not((porddef(dest^.resulttype)^.typ = u32bit) and emit_mov_reg_loc(hreg,dest^.location);
(porddef(dest^.resulttype)^.low = 0) and If (cs_check_range in aktlocalswitches) and
(porddef(dest^.resulttype)^.high = $ffffffff)) then {no need to rangecheck longints or cardinals on 32bit processors}
Begin not((porddef(dest^.resulttype)^.typ = s32bit) and
{do not register this temporary def} (porddef(dest^.resulttype)^.low = $80000000) and
OldRegisterDef := RegisterDef; (porddef(dest^.resulttype)^.high = $7fffffff)) and
RegisterDef := False; not((porddef(dest^.resulttype)^.typ = u32bit) and
hdef:=nil; (porddef(dest^.resulttype)^.low = 0) and
Case PordDef(dest^.resulttype)^.typ of (porddef(dest^.resulttype)^.high = $ffffffff)) then
u8bit,u16bit,u32bit: Begin
begin {do not register this temporary def}
new(hdef,init(u32bit,0,$ffffffff)); OldRegisterDef := RegisterDef;
hreg:=accumulator; RegisterDef := False;
end; hdef:=nil;
s8bit,s16bit,s32bit: Case PordDef(dest^.resulttype)^.typ of
begin u8bit,u16bit,u32bit:
new(hdef,init(s32bit,$80000000,$7fffffff)); begin
hreg:=accumulator; new(hdef,init(u32bit,0,$ffffffff));
end; hreg:=accumulator;
end; end;
{ create a fake node } s8bit,s16bit,s32bit:
hp := genzeronode(nothingn); begin
hp^.location.loc := LOC_REGISTER; new(hdef,init(s32bit,$80000000,$7fffffff));
hp^.location.register := hreg; hreg:=accumulator;
if assigned(hdef) then end;
hp^.resulttype:=hdef end;
else { create a fake node }
hp^.resulttype:=dest^.resulttype; hp := genzeronode(nothingn);
{ emit the range check } hp^.location.loc := LOC_REGISTER;
emitrangecheck(hp,dest^.resulttype); hp^.location.register := hreg;
hp^.right := nil; if assigned(hdef) then
if assigned(hdef) then hp^.resulttype:=hdef
Dispose(hdef, Done); else
RegisterDef := OldRegisterDef; hp^.resulttype:=dest^.resulttype;
disposetree(hp); { emit the range check }
End; emitrangecheck(hp,dest^.resulttype);
hp^.right := nil;
if assigned(hdef) then
Dispose(hdef, Done);
RegisterDef := OldRegisterDef;
disposetree(hp);
End;
end;
End; End;
else else
internalerror(66766766); internalerror(66766766);
@ -1240,7 +1247,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.53 1999-05-23 18:42:01 florian Revision 1.54 1999-05-23 19:55:11 florian
* qword/int64 multiplication fixed
+ qword/int64 subtraction
Revision 1.53 1999/05/23 18:42:01 florian
* better error recovering in typed constants * better error recovering in typed constants
* some problems with arrays of const fixed, some problems * some problems with arrays of const fixed, some problems
due my previous due my previous