+ started with refactoring det_resulttype

+ dosimplify
* inlinenig makes use of dosimplify

git-svn-id: trunk@140 -

compiler/htypechk.pas

@@ -147,6 +147,7 @@ interface
     function  valid_for_assignment(p:tnode):boolean;
     function  valid_for_addr(p : tnode) : boolean;
 
+    function allowenumop(nt:tnodetype):boolean;
 
 implementation
 
@@ -1349,6 +1350,13 @@ implementation
       end;
 
 
+    function allowenumop(nt:tnodetype):boolean;
+      begin
+        result:=(nt in [equaln,unequaln,ltn,lten,gtn,gten]) or
+                ((cs_allow_enum_calc in aktlocalswitches) and
+                 (nt in [addn,subn]));
+      end;
+
 
 {****************************************************************************
                            TCallCandidates

compiler/nadd.pas

@@ -28,13 +28,15 @@ unit nadd;
 interface
 
     uses
-      node;
+      node,symtype;
 
     type
        taddnode = class(tbinopnode)
+          resultrealtype : ttype;
           constructor create(tt : tnodetype;l,r : tnode);override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function simplify : tnode;override;
     {$ifdef state_tracking}
       function track_state_pass(exec_known:boolean):boolean;override;
     {$endif}
@@ -73,7 +75,7 @@ implementation
 {$ENDIF MACOS_USE_FAKE_SYSUTILS}
       globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symtype,symdef,symsym,symtable,defutil,defcmp,
+      symconst,symdef,symsym,symtable,defutil,defcmp,
       cgbase,
       htypechk,pass_1,
       nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils,
@@ -97,37 +99,551 @@ implementation
       end;
 
 
-    function taddnode.det_resulttype:tnode;
+    function taddnode.simplify : tnode;
+      var
+        t : tnode;
+        lt,rt   : tnodetype;
+        rd,ld   : tdef;
+        rv,lv   : tconstexprint;
+        rvd,lvd : bestreal;
+        ws1,ws2 : pcompilerwidestring;
+        concatstrings : boolean;
+        c1,c2   : array[0..1] of char;
+        s1,s2   : pchar;
+        l1,l2   : longint;
+        resultset : Tconstset;
+        b       : boolean;
+      begin
+        result:=nil;
+        { is one a real float, then both need to be floats, this
+          need to be done before the constant folding so constant
+          operation on a float and int are also handled }
+        resultrealtype:=pbestrealtype^;
+        if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
+         begin
+           { when both floattypes are already equal then use that
+             floattype for results }
+           if (right.resulttype.def.deftype=floatdef) and
+              (left.resulttype.def.deftype=floatdef) and
+              (tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then
+             resultrealtype:=left.resulttype
+           { when there is a currency type then use currency, but
+             only when currency is defined as float }
+           else
+            if (is_currency(right.resulttype.def) or
+                is_currency(left.resulttype.def)) and
+               ((s64currencytype.def.deftype = floatdef) or
+                (nodetype <> slashn)) then
+             begin
+               resultrealtype:=s64currencytype;
+               inserttypeconv(right,resultrealtype);
+               inserttypeconv(left,resultrealtype);
+             end
+           else
+            begin
+              inserttypeconv(right,resultrealtype);
+              inserttypeconv(left,resultrealtype);
+            end;
+         end;
+
+        { If both operands are constant and there is a widechar
+          or widestring then convert everything to widestring. This
+          allows constant folding like char+widechar }
+        if is_constnode(right) and is_constnode(left) and
+           (is_widestring(right.resulttype.def) or
+            is_widestring(left.resulttype.def) or
+            is_widechar(right.resulttype.def) or
+            is_widechar(left.resulttype.def)) then
+          begin
+            inserttypeconv(right,cwidestringtype);
+            inserttypeconv(left,cwidestringtype);
+          end;
 
-        function allowenumop(nt:tnodetype):boolean;
-        begin
-          result:=(nt in [equaln,unequaln,ltn,lten,gtn,gten]) or
-                  ((cs_allow_enum_calc in aktlocalswitches) and
-                   (nt in [addn,subn]));
-        end;
+        { load easier access variables }
+        rd:=right.resulttype.def;
+        ld:=left.resulttype.def;
+        rt:=right.nodetype;
+        lt:=left.nodetype;
+
+        if (nodetype = slashn) and
+           (((rt = ordconstn) and
+             (tordconstnode(right).value = 0)) or
+            ((rt = realconstn) and
+             (trealconstnode(right).value_real = 0.0))) then
+          begin
+            if (cs_check_range in aktlocalswitches) or
+               (cs_check_overflow in aktlocalswitches) then
+               begin
+                 result:=crealconstnode.create(1,pbestrealtype^);
+                 Message(parser_e_division_by_zero);
+                 exit;
+               end;
+          end;
+
+
+        { both are int constants }
+        if (
+            (
+             is_constintnode(left) and
+             is_constintnode(right)
+            ) or
+            (
+             is_constboolnode(left) and
+             is_constboolnode(right) and
+             (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])
+            ) or
+            (
+             is_constenumnode(left) and
+             is_constenumnode(right) and
+             allowenumop(nodetype))
+            ) or
+            (
+             (lt = pointerconstn) and
+             is_constintnode(right) and
+             (nodetype in [addn,subn])
+            ) or
+            (
+             (lt in [pointerconstn,niln]) and
+             (rt in [pointerconstn,niln]) and
+             (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])
+            ) then
+          begin
+             t:=nil;
+             { when comparing/substracting  pointers, make sure they are }
+             { of the same  type (JM)                                    }
+             if (lt = pointerconstn) and (rt = pointerconstn) then
+              begin
+                if not(cs_extsyntax in aktmoduleswitches) and
+                   not(nodetype in [equaln,unequaln]) then
+                  CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename)
+                else
+                  if (nodetype <> subn) and
+                     is_voidpointer(rd) then
+                    inserttypeconv(right,left.resulttype)
+                  else if (nodetype <> subn) and
+                          is_voidpointer(ld) then
+                    inserttypeconv(left,right.resulttype)
+                  else if not(equal_defs(ld,rd)) then
+                    IncompatibleTypes(ld,rd);
+               end
+             else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
+              begin
+                if not(equal_defs(ld,rd)) then
+                  inserttypeconv(right,left.resulttype);
+               end;
+
+             { load values }
+             case lt of
+               ordconstn:
+                 lv:=tordconstnode(left).value;
+               pointerconstn:
+                 lv:=tpointerconstnode(left).value;
+               niln:
+                 lv:=0;
+               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
+                (rt <> pointerconstn) then
+               rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
+             if (rt = pointerconstn) and
+                (lt <> pointerconstn) then
+               lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
+             case nodetype of
+               addn :
+                 begin
+                   {$ifopt Q-}
+                     {$define OVERFLOW_OFF}
+                     {$Q+}
+                   {$endif}
+                   try
+                     if (lt=pointerconstn) then
+                       t := cpointerconstnode.create(lv+rv,left.resulttype)
+                     else
+                       if is_integer(ld) then
+                         t := genintconstnode(lv+rv)
+                     else
+                       t := cordconstnode.create(lv+rv,left.resulttype,(ld.deftype<>enumdef));
+                   except
+                     on E:EIntOverflow do
+                       begin
+                         Message(parser_e_arithmetic_operation_overflow);
+                         { Recover }
+                         t:=genintconstnode(0)
+                       end;
+                   end;
+                   {$ifdef OVERFLOW_OFF}
+                     {$Q-}
+                     {$undef OVERFLOW_OFF}
+                   {$endif}
+                 end;
+               subn :
+                 begin
+                   {$ifopt Q-}
+                     {$define OVERFLOW_OFF}
+                     {$Q+}
+                   {$endif}
+                   try
+                     if (lt=pointerconstn) then
+                       begin
+                         { pointer-pointer results in an integer }
+                         if (rt=pointerconstn) then
+                           t := genintconstnode((lv-rv) div tpointerdef(ld).pointertype.def.size)
+                         else
+                           t := cpointerconstnode.create(lv-rv,left.resulttype);
+                       end
+                     else
+                       begin
+                         if is_integer(ld) then
+                           t:=genintconstnode(lv-rv)
+                         else
+                           t:=cordconstnode.create(lv-rv,left.resulttype,(ld.deftype<>enumdef));
+                       end;
+                   except
+                     on E:EIntOverflow do
+                       begin
+                         Message(parser_e_arithmetic_operation_overflow);
+                         { Recover }
+                         t:=genintconstnode(0)
+                       end;
+                   end;
+                   {$ifdef OVERFLOW_OFF}
+                     {$Q-}
+                     {$undef OVERFLOW_OFF}
+                   {$endif}
+                 end;
+               muln :
+                 begin
+                   {$ifopt Q-}
+                     {$define OVERFLOW_OFF}
+                     {$Q+}
+                   {$endif}
+                   try
+                     if (torddef(ld).typ <> u64bit) or
+                        (torddef(rd).typ <> u64bit) then
+                       t:=genintconstnode(lv*rv)
+                     else
+                       t:=genintconstnode(int64(qword(lv)*qword(rv)));
+                   except
+                     on E:EIntOverflow do
+                       begin
+                         Message(parser_e_arithmetic_operation_overflow);
+                         { Recover }
+                         t:=genintconstnode(0)
+                       end;
+                   end;
+                   {$ifdef OVERFLOW_OFF}
+                     {$Q-}
+                     {$undef OVERFLOW_OFF}
+                   {$endif}
+                 end;
+               xorn :
+                 if is_integer(ld) then
+                   t:=genintconstnode(lv xor rv)
+                 else
+                   t:=cordconstnode.create(lv xor rv,left.resulttype,true);
+               orn :
+                 if is_integer(ld) then
+                   t:=genintconstnode(lv or rv)
+                 else
+                   t:=cordconstnode.create(lv or rv,left.resulttype,true);
+               andn :
+                 if is_integer(ld) then
+                   t:=genintconstnode(lv and rv)
+                 else
+                   t:=cordconstnode.create(lv and rv,left.resulttype,true);
+               ltn :
+                 t:=cordconstnode.create(ord(lv<rv),booltype,true);
+               lten :
+                 t:=cordconstnode.create(ord(lv<=rv),booltype,true);
+               gtn :
+                 t:=cordconstnode.create(ord(lv>rv),booltype,true);
+               gten :
+                 t:=cordconstnode.create(ord(lv>=rv),booltype,true);
+               equaln :
+                 t:=cordconstnode.create(ord(lv=rv),booltype,true);
+               unequaln :
+                 t:=cordconstnode.create(ord(lv<>rv),booltype,true);
+               slashn :
+                 begin
+                   { int/int becomes a real }
+                   rvd:=rv;
+                   lvd:=lv;
+                   t:=crealconstnode.create(lvd/rvd,resultrealtype);
+                 end;
+               else
+                 begin
+                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
+                   t:=cnothingnode.create;
+                 end;
+             end;
+             result:=t;
+             exit;
+          end;
+
+      { both real constants ? }
+        if (lt=realconstn) and (rt=realconstn) then
+          begin
+             lvd:=trealconstnode(left).value_real;
+             rvd:=trealconstnode(right).value_real;
+             case nodetype of
+                addn :
+                  t:=crealconstnode.create(lvd+rvd,resultrealtype);
+                subn :
+                  t:=crealconstnode.create(lvd-rvd,resultrealtype);
+                muln :
+                  t:=crealconstnode.create(lvd*rvd,resultrealtype);
+                starstarn,
+                caretn :
+                  begin
+                    if lvd<0 then
+                     begin
+                       Message(parser_e_invalid_float_operation);
+                       t:=crealconstnode.create(0,resultrealtype);
+                     end
+                    else if lvd=0 then
+                      t:=crealconstnode.create(1.0,resultrealtype)
+                    else
+                      t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealtype);
+                  end;
+                slashn :
+                  t:=crealconstnode.create(lvd/rvd,resultrealtype);
+                ltn :
+                  t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
+                lten :
+                  t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
+                gtn :
+                  t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
+                gten :
+                  t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
+                equaln :
+                  t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
+                unequaln :
+                  t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
+                else
+                  begin
+                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
+                    t:=cnothingnode.create;
+                  end;
+             end;
+             result:=t;
+             exit;
+          end;
+
+        { first, we handle widestrings, so we can check later for }
+        { stringconstn only                                       }
+
+        { widechars are converted above to widestrings too }
+        { this isn't veryy efficient, but I don't think    }
+        { that it does matter that much (FK)               }
+        if (lt=stringconstn) and (rt=stringconstn) and
+          (tstringconstnode(left).st_type=st_widestring) and
+          (tstringconstnode(right).st_type=st_widestring) then
+          begin
+             initwidestring(ws1);
+             initwidestring(ws2);
+             copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
+             copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
+             case nodetype of
+                addn :
+                  begin
+                     concatwidestrings(ws1,ws2);
+                     t:=cstringconstnode.createwstr(ws1);
+                  end;
+                ltn :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
+                lten :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
+                gtn :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
+                gten :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
+                equaln :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
+                unequaln :
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
+                else
+                  begin
+                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
+                    t:=cnothingnode.create;
+                  end;
+             end;
+             donewidestring(ws1);
+             donewidestring(ws2);
+             result:=t;
+             exit;
+          end;
+
+        { concating strings ? }
+        concatstrings:=false;
+
+        if (lt=ordconstn) and (rt=ordconstn) and
+           is_char(ld) and is_char(rd) then
+          begin
+             c1[0]:=char(byte(tordconstnode(left).value));
+             c1[1]:=#0;
+             l1:=1;
+             c2[0]:=char(byte(tordconstnode(right).value));
+             c2[1]:=#0;
+             l2:=1;
+             s1:=@c1;
+             s2:=@c2;
+             concatstrings:=true;
+          end
+        else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
+          begin
+             s1:=tstringconstnode(left).value_str;
+             l1:=tstringconstnode(left).len;
+             c2[0]:=char(byte(tordconstnode(right).value));
+             c2[1]:=#0;
+             s2:=@c2;
+             l2:=1;
+             concatstrings:=true;
+          end
+        else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
+          begin
+             c1[0]:=char(byte(tordconstnode(left).value));
+             c1[1]:=#0;
+             l1:=1;
+             s1:=@c1;
+             s2:=tstringconstnode(right).value_str;
+             l2:=tstringconstnode(right).len;
+             concatstrings:=true;
+          end
+        else if (lt=stringconstn) and (rt=stringconstn) then
+          begin
+             s1:=tstringconstnode(left).value_str;
+             l1:=tstringconstnode(left).len;
+             s2:=tstringconstnode(right).value_str;
+             l2:=tstringconstnode(right).len;
+             concatstrings:=true;
+          end;
+        if concatstrings then
+          begin
+             case nodetype of
+                addn :
+                  t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
+                ltn :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
+                lten :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
+                gtn :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
+                gten :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
+                equaln :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
+                unequaln :
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
+                else
+                  begin
+                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
+                    t:=cnothingnode.create;
+                  end;
+             end;
+             result:=t;
+             exit;
+          end;
+
+        { set constant evaluation }
+        if (right.nodetype=setconstn) and
+           not assigned(tsetconstnode(right).left) and
+           (left.nodetype=setconstn) and
+           not assigned(tsetconstnode(left).left) then
+          begin
+             { check if size adjusting is needed, only for left
+               to right as the other way is checked in the typeconv }
+             if (tsetdef(right.resulttype.def).settype=smallset) and
+                (tsetdef(left.resulttype.def).settype<>smallset) then
+               right.resulttype.setdef(tsetdef.create(tsetdef(right.resulttype.def).elementtype,255));
+             { check base types }
+             inserttypeconv(left,right.resulttype);
+
+             if codegenerror then
+              begin
+                { recover by only returning the left part }
+                result:=left;
+                left:=nil;
+                exit;
+              end;
+             case nodetype of
+               addn :
+                 begin
+                   resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
+                   t:=csetconstnode.create(@resultset,left.resulttype);
+                 end;
+                muln :
+                  begin
+                    resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
+                    t:=csetconstnode.create(@resultset,left.resulttype);
+                  end;
+               subn :
+                  begin
+                    resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
+                            t:=csetconstnode.create(@resultset,left.resulttype);
+                  end;
+               symdifn :
+                  begin
+                    resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
+                        t:=csetconstnode.create(@resultset,left.resulttype);
+                  end;
+               unequaln :
+                  begin
+                    b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
+                    t:=cordconstnode.create(byte(b),booltype,true);
+                  end;
+               equaln :
+                  begin
+                    b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
+                    t:=cordconstnode.create(byte(b),booltype,true);
+                  end;
+               lten :
+                  begin
+                    b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
+                    t:=cordconstnode.create(byte(b),booltype,true);
+                  end;
+               gten :
+                  begin
+                    b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
+                    t:=cordconstnode.create(byte(b),booltype,true);
+                  end;
+                else
+                  begin
+                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
+                    t:=cnothingnode.create;
+                  end;
+             end;
+             result:=t;
+             exit;
+          end;
+
+      end;
 
+
+    function taddnode.det_resulttype:tnode;
       var
-         hp,t    : tnode;
-         lt,rt   : tnodetype;
-         rd,ld   : tdef;
-         htype   : ttype;
-         ot      : tnodetype;
-         hsym    : tfieldvarsym;
-         concatstrings : boolean;
-         resultset : Tconstset;
-         i       : longint;
-         b       : boolean;
-         c1,c2   : array[0..1] of char;
-         s1,s2   : pchar;
-         ws1,ws2 : pcompilerwidestring;
-         l1,l2   : longint;
-         rv,lv   : tconstexprint;
-         rvd,lvd : bestreal;
-         resultrealtype : ttype;
-         strtype: tstringtype;
+        hp      : tnode;
+        lt,rt   : tnodetype;
+        rd,ld   : tdef;
+        htype   : ttype;
+        ot      : tnodetype;
+        hsym    : tfieldvarsym;
+        i       : longint;
+        strtype : tstringtype;
+        b       : boolean;
 {$ifdef state_tracking}
-     factval : Tnode;
-     change  : boolean;
+        factval : Tnode;
+        change  : boolean;
 {$endif}
 
       begin
@@ -196,517 +712,15 @@ implementation
               end;
           end;
 
-         { is one a real float, then both need to be floats, this
-           need to be done before the constant folding so constant
-           operation on a float and int are also handled }
-         resultrealtype:=pbestrealtype^;
-         if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
-          begin
-            { when both floattypes are already equal then use that
-              floattype for results }
-            if (right.resulttype.def.deftype=floatdef) and
-               (left.resulttype.def.deftype=floatdef) and
-               (tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then
-              resultrealtype:=left.resulttype
-            { when there is a currency type then use currency, but
-              only when currency is defined as float }
-            else
-             if (is_currency(right.resulttype.def) or
-                 is_currency(left.resulttype.def)) and
-                ((s64currencytype.def.deftype = floatdef) or
-                 (nodetype <> slashn)) then
-              begin
-                resultrealtype:=s64currencytype;
-                inserttypeconv(right,resultrealtype);
-                inserttypeconv(left,resultrealtype);
-              end
-            else
-             begin
-               inserttypeconv(right,resultrealtype);
-               inserttypeconv(left,resultrealtype);
-             end;
-          end;
-
-         { If both operands are constant and there is a widechar
-           or widestring then convert everything to widestring. This
-           allows constant folding like char+widechar }
-         if is_constnode(right) and is_constnode(left) and
-            (is_widestring(right.resulttype.def) or
-             is_widestring(left.resulttype.def) or
-             is_widechar(right.resulttype.def) or
-             is_widechar(left.resulttype.def)) then
-           begin
-             inserttypeconv(right,cwidestringtype);
-             inserttypeconv(left,cwidestringtype);
-           end;
-
-         { load easier access variables }
-         rd:=right.resulttype.def;
-         ld:=left.resulttype.def;
-         rt:=right.nodetype;
-         lt:=left.nodetype;
-
-         if (nodetype = slashn) and
-            (((rt = ordconstn) and
-              (tordconstnode(right).value = 0)) or
-             ((rt = realconstn) and
-              (trealconstnode(right).value_real = 0.0))) then
-           begin
-             if (cs_check_range in aktlocalswitches) or
-                (cs_check_overflow in aktlocalswitches) then
-                begin
-                  result:=crealconstnode.create(1,pbestrealtype^);
-                  Message(parser_e_division_by_zero);
-                  exit;
-                end;
-           end;
-
-
-         { both are int constants }
-         if (
-             (
-              is_constintnode(left) and
-              is_constintnode(right)
-             ) or
-             (
-              is_constboolnode(left) and
-              is_constboolnode(right) and
-              (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])
-             ) or
-             (
-              is_constenumnode(left) and
-              is_constenumnode(right) and
-              allowenumop(nodetype))
-             ) or
-             (
-              (lt = pointerconstn) and
-              is_constintnode(right) and
-              (nodetype in [addn,subn])
-             ) or
-             (
-              (lt in [pointerconstn,niln]) and
-              (rt in [pointerconstn,niln]) and
-              (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])
-             ) then
-           begin
-              t:=nil;
-              { when comparing/substracting  pointers, make sure they are }
-              { of the same  type (JM)                                    }
-              if (lt = pointerconstn) and (rt = pointerconstn) then
-               begin
-                 if not(cs_extsyntax in aktmoduleswitches) and
-                    not(nodetype in [equaln,unequaln]) then
-                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename)
-                 else
-                   if (nodetype <> subn) and
-                      is_voidpointer(rd) then
-                     inserttypeconv(right,left.resulttype)
-                   else if (nodetype <> subn) and
-                           is_voidpointer(ld) then
-                     inserttypeconv(left,right.resulttype)
-                   else if not(equal_defs(ld,rd)) then
-                     IncompatibleTypes(ld,rd);
-                end
-              else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
-               begin
-                 if not(equal_defs(ld,rd)) then
-                   inserttypeconv(right,left.resulttype);
-                end;
-
-              { load values }
-              case lt of
-                ordconstn:
-                  lv:=tordconstnode(left).value;
-                pointerconstn:
-                  lv:=tpointerconstnode(left).value;
-                niln:
-                  lv:=0;
-                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
-                 (rt <> pointerconstn) then
-                rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
-              if (rt = pointerconstn) and
-                 (lt <> pointerconstn) then
-                lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
-              case nodetype of
-                addn :
-                  begin
-                    {$ifopt Q-}
-                      {$define OVERFLOW_OFF}
-                      {$Q+}
-                    {$endif}
-                    try
-                      if (lt=pointerconstn) then
-                        t := cpointerconstnode.create(lv+rv,left.resulttype)
-                      else
-                        if is_integer(ld) then
-                          t := genintconstnode(lv+rv)
-                      else
-                        t := cordconstnode.create(lv+rv,left.resulttype,(ld.deftype<>enumdef));
-                    except
-                      on E:EIntOverflow do
-                        begin
-                          Message(parser_e_arithmetic_operation_overflow);
-                          { Recover }
-                          t:=genintconstnode(0)
-                        end;
-                    end;
-                    {$ifdef OVERFLOW_OFF}
-                      {$Q-}
-                      {$undef OVERFLOW_OFF}
-                    {$endif}
-                  end;
-                subn :
-                  begin
-                    {$ifopt Q-}
-                      {$define OVERFLOW_OFF}
-                      {$Q+}
-                    {$endif}
-                    try
-                      if (lt=pointerconstn) then
-                        begin
-                          { pointer-pointer results in an integer }
-                          if (rt=pointerconstn) then
-                            t := genintconstnode((lv-rv) div tpointerdef(ld).pointertype.def.size)
-                          else
-                            t := cpointerconstnode.create(lv-rv,left.resulttype);
-                        end
-                      else
-                        begin
-                          if is_integer(ld) then
-                            t:=genintconstnode(lv-rv)
-                          else
-                            t:=cordconstnode.create(lv-rv,left.resulttype,(ld.deftype<>enumdef));
-                        end;
-                    except
-                      on E:EIntOverflow do
-                        begin
-                          Message(parser_e_arithmetic_operation_overflow);
-                          { Recover }
-                          t:=genintconstnode(0)
-                        end;
-                    end;
-                    {$ifdef OVERFLOW_OFF}
-                      {$Q-}
-                      {$undef OVERFLOW_OFF}
-                    {$endif}
-                  end;
-                muln :
-                  begin
-                    {$ifopt Q-}
-                      {$define OVERFLOW_OFF}
-                      {$Q+}
-                    {$endif}
-                    try
-                      if (torddef(ld).typ <> u64bit) or
-                         (torddef(rd).typ <> u64bit) then
-                        t:=genintconstnode(lv*rv)
-                      else
-                        t:=genintconstnode(int64(qword(lv)*qword(rv)));
-                    except
-                      on E:EIntOverflow do
-                        begin
-                          Message(parser_e_arithmetic_operation_overflow);
-                          { Recover }
-                          t:=genintconstnode(0)
-                        end;
-                    end;
-                    {$ifdef OVERFLOW_OFF}
-                      {$Q-}
-                      {$undef OVERFLOW_OFF}
-                    {$endif}
-                  end;
-                xorn :
-                  if is_integer(ld) then
-                    t:=genintconstnode(lv xor rv)
-                  else
-                    t:=cordconstnode.create(lv xor rv,left.resulttype,true);
-                orn :
-                  if is_integer(ld) then
-                    t:=genintconstnode(lv or rv)
-                  else
-                    t:=cordconstnode.create(lv or rv,left.resulttype,true);
-                andn :
-                  if is_integer(ld) then
-                    t:=genintconstnode(lv and rv)
-                  else
-                    t:=cordconstnode.create(lv and rv,left.resulttype,true);
-                ltn :
-                  t:=cordconstnode.create(ord(lv<rv),booltype,true);
-                lten :
-                  t:=cordconstnode.create(ord(lv<=rv),booltype,true);
-                gtn :
-                  t:=cordconstnode.create(ord(lv>rv),booltype,true);
-                gten :
-                  t:=cordconstnode.create(ord(lv>=rv),booltype,true);
-                equaln :
-                  t:=cordconstnode.create(ord(lv=rv),booltype,true);
-                unequaln :
-                  t:=cordconstnode.create(ord(lv<>rv),booltype,true);
-                slashn :
-                  begin
-                    { int/int becomes a real }
-                    rvd:=rv;
-                    lvd:=lv;
-                    t:=crealconstnode.create(lvd/rvd,resultrealtype);
-                  end;
-                else
-                  begin
-                    CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
-                    t:=cnothingnode.create;
-                  end;
-              end;
-              result:=t;
-              exit;
-           end;
-
-       { both real constants ? }
-         if (lt=realconstn) and (rt=realconstn) then
-           begin
-              lvd:=trealconstnode(left).value_real;
-              rvd:=trealconstnode(right).value_real;
-              case nodetype of
-                 addn :
-                   t:=crealconstnode.create(lvd+rvd,resultrealtype);
-                 subn :
-                   t:=crealconstnode.create(lvd-rvd,resultrealtype);
-                 muln :
-                   t:=crealconstnode.create(lvd*rvd,resultrealtype);
-                 starstarn,
-                 caretn :
-                   begin
-                     if lvd<0 then
-                      begin
-                        Message(parser_e_invalid_float_operation);
-                        t:=crealconstnode.create(0,resultrealtype);
-                      end
-                     else if lvd=0 then
-                       t:=crealconstnode.create(1.0,resultrealtype)
-                     else
-                       t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealtype);
-                   end;
-                 slashn :
-                   t:=crealconstnode.create(lvd/rvd,resultrealtype);
-                 ltn :
-                   t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
-                 lten :
-                   t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
-                 gtn :
-                   t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
-                 gten :
-                   t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
-                 equaln :
-                   t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
-                 unequaln :
-                   t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
-                 else
-                   begin
-                     CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
-                     t:=cnothingnode.create;
-                   end;
-              end;
-              result:=t;
-              exit;
-           end;
-
-         { first, we handle widestrings, so we can check later for }
-         { stringconstn only                                       }
-
-         { widechars are converted above to widestrings too }
-         { this isn't veryy efficient, but I don't think    }
-         { that it does matter that much (FK)               }
-         if (lt=stringconstn) and (rt=stringconstn) and
-           (tstringconstnode(left).st_type=st_widestring) and
-           (tstringconstnode(right).st_type=st_widestring) then
-           begin
-              initwidestring(ws1);
-              initwidestring(ws2);
-              copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
-              copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
-              case nodetype of
-                 addn :
-                   begin
-                      concatwidestrings(ws1,ws2);
-                      t:=cstringconstnode.createwstr(ws1);
-                   end;
-                 ltn :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
-                 lten :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
-                 gtn :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
-                 gten :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
-                 equaln :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
-                 unequaln :
-                   t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
-                 else
-                   begin
-                     CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
-                     t:=cnothingnode.create;
-                   end;
-              end;
-              donewidestring(ws1);
-              donewidestring(ws2);
-              result:=t;
-              exit;
-           end;
-
-         { concating strings ? }
-         concatstrings:=false;
-
-         if (lt=ordconstn) and (rt=ordconstn) and
-            is_char(ld) and is_char(rd) then
-           begin
-              c1[0]:=char(byte(tordconstnode(left).value));
-              c1[1]:=#0;
-              l1:=1;
-              c2[0]:=char(byte(tordconstnode(right).value));
-              c2[1]:=#0;
-              l2:=1;
-              s1:=@c1;
-              s2:=@c2;
-              concatstrings:=true;
-           end
-         else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
-           begin
-              s1:=tstringconstnode(left).value_str;
-              l1:=tstringconstnode(left).len;
-              c2[0]:=char(byte(tordconstnode(right).value));
-              c2[1]:=#0;
-              s2:=@c2;
-              l2:=1;
-              concatstrings:=true;
-           end
-         else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
-           begin
-              c1[0]:=char(byte(tordconstnode(left).value));
-              c1[1]:=#0;
-              l1:=1;
-              s1:=@c1;
-              s2:=tstringconstnode(right).value_str;
-              l2:=tstringconstnode(right).len;
-              concatstrings:=true;
-           end
-         else if (lt=stringconstn) and (rt=stringconstn) then
-           begin
-              s1:=tstringconstnode(left).value_str;
-              l1:=tstringconstnode(left).len;
-              s2:=tstringconstnode(right).value_str;
-              l2:=tstringconstnode(right).len;
-              concatstrings:=true;
-           end;
-         if concatstrings then
-           begin
-              case nodetype of
-                 addn :
-                   t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
-                 ltn :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
-                 lten :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
-                 gtn :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
-                 gten :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
-                 equaln :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
-                 unequaln :
-                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
-                 else
-                   begin
-                     CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
-                     t:=cnothingnode.create;
-                   end;
-              end;
-              result:=t;
-              exit;
-           end;
+         result:=simplify;
+         if assigned(result) then
+           exit;
 
-         { set constant evaluation }
-         if (right.nodetype=setconstn) and
-            not assigned(tsetconstnode(right).left) and
-            (left.nodetype=setconstn) and
-            not assigned(tsetconstnode(left).left) then
-           begin
-              { check if size adjusting is needed, only for left
-                to right as the other way is checked in the typeconv }
-              if (tsetdef(right.resulttype.def).settype=smallset) and
-                 (tsetdef(left.resulttype.def).settype<>smallset) then
-                right.resulttype.setdef(tsetdef.create(tsetdef(right.resulttype.def).elementtype,255));
-              { check base types }
-              inserttypeconv(left,right.resulttype);
-
-              if codegenerror then
-               begin
-                 { recover by only returning the left part }
-                 result:=left;
-                 left:=nil;
-                 exit;
-               end;
-              case nodetype of
-                addn :
-                  begin
-                    resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
-                    t:=csetconstnode.create(@resultset,left.resulttype);
-                  end;
-                 muln :
-                   begin
-                     resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
-                     t:=csetconstnode.create(@resultset,left.resulttype);
-                   end;
-                subn :
-                   begin
-                     resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
-                             t:=csetconstnode.create(@resultset,left.resulttype);
-                   end;
-                symdifn :
-                   begin
-                     resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
-                         t:=csetconstnode.create(@resultset,left.resulttype);
-                   end;
-                unequaln :
-                   begin
-                     b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
-                     t:=cordconstnode.create(byte(b),booltype,true);
-                   end;
-                equaln :
-                   begin
-                     b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
-                     t:=cordconstnode.create(byte(b),booltype,true);
-                   end;
-                lten :
-                   begin
-                     b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
-                     t:=cordconstnode.create(byte(b),booltype,true);
-                   end;
-                gten :
-                   begin
-                     b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
-                     t:=cordconstnode.create(byte(b),booltype,true);
-                   end;
-                 else
-                   begin
-                     CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
-                     t:=cnothingnode.create;
-                   end;
-              end;
-              result:=t;
-              exit;
-           end;
+        { load easier access variables }
+        rd:=right.resulttype.def;
+        ld:=left.resulttype.def;
+        rt:=right.nodetype;
+        lt:=left.nodetype;
 
          { but an int/int gives real/real! }
          if nodetype=slashn then

compiler/ncal.pas

@@ -2124,12 +2124,29 @@ type
                 { const parameters which are passed by value instead of by reference }
                 { we need to take care that we use the type of the defined parameter and not of the
                   passed parameter, because these can be different in case of a formaldef (PFV) }
-                if (vo_is_funcret in tparavarsym(para.parasym).varoptions) or
+                if
+                  (
+                   { the problem is that we can't take the address of a function result :( }
+                   (vo_is_funcret in tparavarsym(para.parasym).varoptions) or
                    (para.parasym.varspez = vs_value) or
                    ((para.parasym.varspez = vs_const) and
-                    (not paramanager.push_addr_param(vs_const,para.parasym.vartype.def,procdefinition.proccalloption) or
-                    { the problem is that we can't take the address of a function result :( }
-                     (node_complexity(para.left) >= NODE_COMPLEXITY_INF))) then
+                   { the compiler expects that it can take the address of parameters passed by reference in
+                     the case of const so we can't replace the node simply by a constant node
+                     When playing with this code, ensure that
+                     function f(const a,b  : longint) : longint;inline;
+                       begin
+                         result:=a*b;
+                       end;
+
+                     [...]
+                     ...:=f(10,20));
+                     [...]
+
+                     is still folded. (FK)
+                     }
+                    (paramanager.push_addr_param(vs_const,para.parasym.vartype.def,procdefinition.proccalloption) or
+                    (node_complexity(para.left) >= NODE_COMPLEXITY_INF)))
+                   ) then
                   begin
                     { in theory, this is always regable, but ncgcall can't }
                     { handle it yet in all situations (JM)                 }
@@ -2217,6 +2234,9 @@ type
         { consider it must not be inlined if called
           again inside the args or itself }
         procdefinition.proccalloption:=pocall_default;
+
+        dosimplify(createblock);
+
         firstpass(createblock);
         procdefinition.proccalloption:=pocall_inline;
         { return inlined block }

compiler/node.pas

@@ -307,8 +307,10 @@ interface
           function pass_1 : tnode;virtual;abstract;
           { dermines the resulttype of the node }
           function det_resulttype : tnode;virtual;abstract;
-          { dermines the number of necessary temp. locations to evaluate
-            the node }
+
+          { tries to simplify the node, returns a value <>nil if a simplified
+            node has been created }
+          function simplify : tnode;virtual;
 {$ifdef state_tracking}
           { Does optimizations by keeping track of the variable states
             in a procedure }
@@ -317,6 +319,8 @@ interface
           { For a t1:=t2 tree, mark the part of the tree t1 that gets
             written to (normally the loadnode) as write access. }
           procedure mark_write;virtual;
+          { dermines the number of necessary temp. locations to evaluate
+            the node }
           procedure det_temp;virtual;abstract;
 
           procedure pass_2;virtual;abstract;
@@ -704,6 +708,12 @@ implementation
       end;
 
 
+    function tnode.simplify : tnode;
+      begin
+        result:=nil;
+      end;
+
+
     destructor tnode.destroy;
       begin
 {$ifdef EXTDEBUG}

compiler/nutils.pas

@@ -68,6 +68,9 @@ interface
     function node_complexity(p: tnode): cardinal;
     procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
 
+    { tries to simplify the given node }
+    procedure dosimplify(var n : tnode);
+
 
 implementation
 
@@ -559,4 +562,34 @@ implementation
         foreachnodestatic(n,@setnodefilepos,@filepos);
       end;
 
+{$ifdef FPCMT}
+    threadvar
+{$else FPCMT}
+    var
+{$endif FPCMT}
+      treechanged : boolean;
+
+    function callsimplify(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        hn : tnode;
+      begin
+        result:=fen_false;
+        hn:=n.simplify;
+        if assigned(hn) then
+          begin
+            treechanged:=true;
+            n:=hn;
+          end;
+      end;
+
+
+    { tries to simplify the given node calling the simplify method recursively }
+    procedure dosimplify(var n : tnode);
+      begin
+        repeat
+          treechanged:=false;
+          foreachnodestatic(n,@callsimplify,nil);
+        until not(treechanged);
+      end;
+
 end.