paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 16:50:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed several problems with the int64 constants

Browse Source
This commit is contained in:
florian 2000-08-17 12:03:48 +00:00
parent 10df99b121
commit 60f46dcd29
3 changed files with 57 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/tcadd.pas
View File

@ -227,20 +227,24 @@ implementation
(is_constboolnode(p^.left) and is_constboolnode(p^.right) and
(p^.treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
begin
{ xor, and, or are handled different from arithmetic }
{ operations regarding the result type }
{ return a boolean for boolean operations (and,xor,or) }
if is_constboolnode(p^.left) then
resdef:=booldef
else if is_64bitint(rd) or is_64bitint(ld) then
resdef:=cs64bitdef
else
resdef:=s32bitdef;
resdef:=s32bitdef;
lv:=p^.left^.value;
rv:=p^.right^.value;
case p^.treetype of
addn : t:=genordinalconstnode(lv+rv,resdef);
subn : t:=genordinalconstnode(lv-rv,resdef);
muln : t:=genordinalconstnode(lv*rv,resdef);
addn : t:=genintconstnode(lv+rv);
subn : t:=genintconstnode(lv-rv);
muln : t:=genintconstnode(lv*rv);
xorn : t:=genordinalconstnode(lv xor rv,resdef);
orn : t:=genordinalconstnode(lv or rv,resdef);
andn : t:=genordinalconstnode(lv and rv,resdef);
orn: t:=genordinalconstnode(lv or rv,resdef);
andn: t:=genordinalconstnode(lv and rv,resdef);
ltn : t:=genordinalconstnode(ord(lv<rv),booldef);
lten : t:=genordinalconstnode(ord(lv<=rv),booldef);
gtn : t:=genordinalconstnode(ord(lv>rv),booldef);
@ -451,12 +455,12 @@ implementation
end;
(*
{ these one can't be in flags! }
Yes they can, secondadd converts the loc_flags to a register.
The typeconversions below are simply removed by firsttypeconv()
because the resulttype of p^.left = p^.left^.resulttype
(surprise! :) (JM)
if p^.treetype in [xorn,unequaln,equaln] then
begin
if p^.left^.location.loc=LOC_FLAGS then
@ -1285,7 +1289,10 @@ implementation
end.
{
$Log$
Revision 1.4 2000-07-27 09:19:37 jonas
Revision 1.5 2000-08-17 12:03:48 florian
* fixed several problems with the int64 constants
Revision 1.4 2000/07/27 09:19:37 jonas
* removed obsolete typeconversion (it got removed by the compiler in
firsttypeconv anyway) (merged from fixes branch)
@ -1295,4 +1302,4 @@ end.
Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs
}
}

31
compiler/tcmat.pas
View File

@ -38,7 +38,7 @@ implementation
globtype,systems,tokens,
cobjects,verbose,globals,
symconst,symtable,aasm,types,
htypechk,pass_1,cpubase,
htypechk,pass_1,cpubase,cpuinfo,
{$ifdef newcg}
cgbase,
{$else newcg}
@ -54,7 +54,7 @@ implementation
procedure firstmoddiv(var p : ptree);
var
t : ptree;
rv,lv : longint;
rv,lv : tconstexprint;
rd,ld : pdef;
begin
@ -81,8 +81,10 @@ implementation
if is_constintnode(p^.left) and is_constintnode(p^.right) then
begin
case p^.treetype of
modn : t:=genordinalconstnode(lv mod rv,s32bitdef);
divn : t:=genordinalconstnode(lv div rv,s32bitdef);
modn:
t:=genintconstnode(lv mod rv);
divn:
t:=genintconstnode(lv div rv);
end;
disposetree(p);
firstpass(t);
@ -199,8 +201,10 @@ implementation
if is_constintnode(p^.left) and is_constintnode(p^.right) then
begin
case p^.treetype of
shrn : t:=genordinalconstnode(p^.left^.value shr p^.right^.value,s32bitdef);
shln : t:=genordinalconstnode(p^.left^.value shl p^.right^.value,s32bitdef);
shrn:
t:=genintconstnode(p^.left^.value shr p^.right^.value);
shln:
t:=genintconstnode(p^.left^.value shl p^.right^.value);
end;
disposetree(p);
firstpass(t);
@ -256,7 +260,7 @@ implementation
exit;
if is_constintnode(p^.left) then
begin
t:=genordinalconstnode(-p^.left^.value,s32bitdef);
t:=genintconstnode(-p^.left^.value);
disposetree(p);
firstpass(t);
p:=t;
@ -378,11 +382,11 @@ implementation
if (p^.left^.treetype=ordconstn) then
begin
if is_boolean(p^.left^.resulttype) then
{ here we do a boolena(byte(..)) type cast because }
{ boolean(<int64>) is buggy in 1.00 }
t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
{ here we do a boolena(byte(..)) type cast because }
{ boolean(<int64>) is buggy in 1.00 }
t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
else
t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
disposetree(p);
firstpass(t);
p:=t;
@ -479,7 +483,10 @@ implementation
end.
{
$Log$
Revision 1.3 2000-08-16 13:06:07 florian
Revision 1.4 2000-08-17 12:03:48 florian
* fixed several problems with the int64 constants
Revision 1.3 2000/08/16 13:06:07 florian
+ support of 64 bit integer constants
Revision 1.2 2000/07/13 11:32:52 michael

22
compiler/tree.pas
View File

@ -274,6 +274,9 @@ unit tree;
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
function genordinalconstnode(v : TConstExprInt;def : pdef) : ptree;
{ same as genordinalconstnode, but the resulttype }
{ is determines automatically }
function genintconstnode(v : TConstExprInt) : ptree;
function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
function genfixconstnode(v : longint;def : pdef) : ptree;
function gentypeconvnode(node : ptree;t : pdef) : ptree;
@ -876,6 +879,20 @@ unit tree;
genordinalconstnode:=p;
end;
function genintconstnode(v : TConstExprInt) : ptree;
var
i : TConstExprInt;
begin
{ we need to bootstrap this code, so it's a little bit messy }
i:=2147483647;
if (v<=i) and (v>=-i-1) then
genintconstnode:=genordinalconstnode(v,s32bitdef)
else
genintconstnode:=genordinalconstnode(v,cs64bitdef);
end;
function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
var
@ -2133,7 +2150,10 @@ unit tree;
end.
{
$Log$
Revision 1.6 2000-08-16 13:06:07 florian
Revision 1.7 2000-08-17 12:03:48 florian
* fixed several problems with the int64 constants
Revision 1.6 2000/08/16 13:06:07 florian
+ support of 64 bit integer constants
Revision 1.5 2000/08/12 06:46:51 florian