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

* made assigned() handling generic

Browse Source 
* add nodes now can also evaluate constant expressions at compile time
    that contain nil nodes
This commit is contained in:
Jonas Maebe 2002-08-02 07:44:30 +00:00
parent af5f1fbcb6
commit f8b6c707a2
4 changed files with 64 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
compiler/i386/n386inl.pas
View File

@ -35,7 +35,6 @@ interface
so that the code generator will actually generate so that the code generator will actually generate
these nodes. these nodes.
} }
function first_assigned: tnode;override;
function first_pi: tnode ; override; function first_pi: tnode ; override;
function first_arctan_real: tnode; override; function first_arctan_real: tnode; override;
function first_abs_real: tnode; override; function first_abs_real: tnode; override;
@ -45,7 +44,6 @@ interface
function first_cos_real: tnode; override; function first_cos_real: tnode; override;
function first_sin_real: tnode; override; function first_sin_real: tnode; override;
{ second pass override to generate these nodes } { second pass override to generate these nodes }
procedure second_assigned;override;
procedure second_IncludeExclude;override; procedure second_IncludeExclude;override;
procedure second_pi; override; procedure second_pi; override;
procedure second_arctan_real; override; procedure second_arctan_real; override;
@ -76,12 +74,6 @@ implementation
TI386INLINENODE TI386INLINENODE
*****************************************************************************} *****************************************************************************}
function ti386inlinenode.first_assigned: tnode;
begin
location.loc:=LOC_FLAGS;
first_assigned := nil;
end;
function ti386inlinenode.first_pi : tnode; function ti386inlinenode.first_pi : tnode;
begin begin
location.loc:=LOC_FPUREGISTER; location.loc:=LOC_FPUREGISTER;
@ -248,24 +240,6 @@ implementation
emit_none(A_FSIN,S_NO) emit_none(A_FSIN,S_NO)
end; end;
procedure ti386inlinenode.second_assigned;
begin
secondpass(tcallparanode(left).left);
location_release(exprasmlist,tcallparanode(left).left.location);
if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
begin
emit_reg_reg(A_OR,S_L,
tcallparanode(left).left.location.register,
tcallparanode(left).left.location.register);
end
else
begin
emit_const_ref(A_CMP,S_L,0,tcallparanode(left).left.location.reference);
end;
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_NE;
end;
{***************************************************************************** {*****************************************************************************
INCLUDE/EXCLUDE GENERIC HANDLING INCLUDE/EXCLUDE GENERIC HANDLING
*****************************************************************************} *****************************************************************************}
@ -354,7 +328,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.51 2002-07-26 11:16:35 jonas Revision 1.52 2002-08-02 07:44:31 jonas
* made assigned() handling generic
* add nodes now can also evaluate constant expressions at compile time
that contain nil nodes
Revision 1.51 2002/07/26 11:16:35 jonas
* fixed (actual and potential) range errors * fixed (actual and potential) range errors
Revision 1.50 2002/07/25 18:02:33 carl Revision 1.50 2002/07/25 18:02:33 carl

9
compiler/i386/n386mat.pas
View File

@ -755,8 +755,8 @@ implementation
LOC_CREFERENCE : LOC_CREFERENCE :
begin begin
location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true); location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
location_release(exprasmlist,left.location);
emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register); emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_E; location.resflags:=F_E;
end; end;
@ -830,7 +830,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.33 2002-07-20 11:58:02 florian Revision 1.34 2002-08-02 07:44:31 jonas
* made assigned() handling generic
* add nodes now can also evaluate constant expressions at compile time
that contain nil nodes
Revision 1.33 2002/07/20 11:58:02 florian
* types.pas renamed to defbase.pas because D6 contains a types * types.pas renamed to defbase.pas because D6 contains a types
unit so this would conflicts if D6 programms are compiled unit so this would conflicts if D6 programms are compiled
+ Willamette/SSE2 instructions to assembler added + Willamette/SSE2 instructions to assembler added

38
compiler/nadd.pas
View File

@ -197,7 +197,8 @@ implementation
{ support pointer arithmetics on constants (JM) } { support pointer arithmetics on constants (JM) }
((lt = pointerconstn) and is_constintnode(right) and ((lt = pointerconstn) and is_constintnode(right) and
(nodetype in [addn,subn])) or (nodetype in [addn,subn])) or
((lt = pointerconstn) and (rt = pointerconstn) and (((lt = pointerconstn) or (lt = niln)) and
((rt = pointerconstn) or (rt = niln)) and
(nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
begin begin
{ when comparing/substracting pointers, make sure they are } { when comparing/substracting pointers, make sure they are }
@ -229,14 +230,26 @@ implementation
end; end;
{ load values } { load values }
if (lt = ordconstn) then case lt of
lv:=tordconstnode(left).value ordconstn:
else lv:=tordconstnode(left).value;
lv:=tpointerconstnode(left).value; pointerconstn:
if (rt = ordconstn) then lv:=tpointerconstnode(left).value;
rv:=tordconstnode(right).value niln:
else lv:=0;
rv:=tpointerconstnode(right).value; else
internalerror(2002080202);
end;
case rt of
ordconstn:
rv:=tordconstnode(right).value;
pointerconstn:
rv:=tpointerconstnode(right).value;
niln:
rv:=0;
else
internalerror(2002080203);
end;
if (lt = pointerconstn) and if (lt = pointerconstn) and
(rt <> pointerconstn) then (rt <> pointerconstn) then
rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size; rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
@ -1731,7 +1744,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.58 2002-07-26 11:17:52 jonas Revision 1.59 2002-08-02 07:44:30 jonas
* made assigned() handling generic
* add nodes now can also evaluate constant expressions at compile time
that contain nil nodes
Revision 1.58 2002/07/26 11:17:52 jonas
* the optimization of converting a multiplication with a power of two to * the optimization of converting a multiplication with a power of two to
a shl is moved from n386add/secondpass to nadd/resulttypepass a shl is moved from n386add/secondpass to nadd/resulttypepass

51
compiler/ninl.pas
View File

@ -39,7 +39,6 @@ interface
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
function docompare(p: tnode): boolean; override; function docompare(p: tnode): boolean; override;
function first_assigned: tnode; virtual;
{ All the following routines currently { All the following routines currently
call compilerproc's, unless they are call compilerproc's, unless they are
overriden in which case, the code overriden in which case, the code
@ -1529,25 +1528,21 @@ implementation
in_assigned_x: in_assigned_x:
begin begin
{ assigned(nil) is always false } {
if (tcallparanode(left).left.nodetype=niln) then result := caddnode.create(unequaln,
begin ctypeconvnode.create_explicit(tcallparanode(left).left,
hp:=cordconstnode.create(0,booltype); voidpointertype),cnilnode.create);
result:=hp; }
goto myexit; result := caddnode.create(unequaln,tcallparanode(left).left,
end; cnilnode.create);
{ assigned(pointer(n)) is only false when n=0 } tcallparanode(left).left := nil;
if (tcallparanode(left).left.nodetype=pointerconstn) then { free left, because otherwise some code at 'myexit' tries }
begin { to run get_paratype for it, which crashes since left.left }
if tpointerconstnode(tcallparanode(left).left).value=0 then { is now nil }
hp:=cordconstnode.create(0,booltype) left.free;
else left := nil;
hp:=cordconstnode.create(1,booltype); resulttypepass(result);
result:=hp; goto myexit;
goto myexit;
end;
set_varstate(left,true);
resulttype:=booltype;
end; end;
in_ofs_x : in_ofs_x :
@ -2032,7 +2027,8 @@ implementation
in_assigned_x: in_assigned_x:
begin begin
result := first_assigned; { should be removed in resulttype pass }
internalerror(2002080201);
end; end;
in_ofs_x : in_ofs_x :
@ -2241,12 +2237,6 @@ implementation
{$maxfpuregisters default} {$maxfpuregisters default}
{$endif fpc} {$endif fpc}
function tinlinenode.first_assigned: tnode;
begin
location.loc:=LOC_REGISTER;
first_assigned := nil;
end;
function tinlinenode.docompare(p: tnode): boolean; function tinlinenode.docompare(p: tnode): boolean;
begin begin
docompare := docompare :=
@ -2356,7 +2346,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.82 2002-07-29 21:23:43 florian Revision 1.83 2002-08-02 07:44:31 jonas
* made assigned() handling generic
* add nodes now can also evaluate constant expressions at compile time
that contain nil nodes
Revision 1.82 2002/07/29 21:23:43 florian
* more fixes for the ppc * more fixes for the ppc
+ wrappers for the tcnvnode.first_* stuff introduced + wrappers for the tcnvnode.first_* stuff introduced