* when simplifying ordinal expressions during inlining, keep the resultdef

    that was set during the typecheck pass because typeconversion nodes
    may have been optimised away previously and sometimes the resultdef is
    important (e.g. for the value of callparanodes) (mantis #17458)

git-svn-id: trunk@16101 -

.gitattributes

@@ -10689,6 +10689,7 @@ tests/webtbs/tw17402a.pp svneol=native#text/pascal
 tests/webtbs/tw17413.pp svneol=native#text/plain
 tests/webtbs/tw17430.pp svneol=native#text/plain
 tests/webtbs/tw1744.pp svneol=native#text/plain
+tests/webtbs/tw17458.pp svneol=native#text/plain
 tests/webtbs/tw17514.pp svneol=native#text/plain
 tests/webtbs/tw17546.pp svneol=native#text/plain
 tests/webtbs/tw1754c.pp svneol=native#text/plain

compiler/nadd.pas

@@ -44,7 +44,7 @@ interface
           procedure derefimpl;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline: boolean) : tnode;override;
           function dogetcopy : tnode;override;
           function docompare(p: tnode): boolean; override;
     {$ifdef state_tracking}
@@ -173,7 +173,7 @@ implementation
       end;
 
 
-    function taddnode.simplify : tnode;
+    function taddnode.simplify(forinline : boolean) : tnode;
       var
         t, hp   : tnode;
         lt,rt   : tnodetype;
@@ -277,7 +277,7 @@ implementation
                      t := cpointerconstnode.create(qword(v),resultdef)
                    else
                      if is_integer(ld) then
-                       t := genintconstnode(v)
+                       t := create_simplified_ord_const(v,resultdef,forinline)
                      else
                        t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
                  end;
@@ -296,13 +296,13 @@ implementation
                        begin
                          if not(nf_has_pointerdiv in flags) then
                            internalerror(2008030101);
-                         t := genintconstnode(v)
+                         t := cpointerconstnode.create(qword(v),resultdef)
                        end
                      else
                        t := cpointerconstnode.create(qword(v),resultdef)
                    else
                      if is_integer(ld) then
-                       t:=genintconstnode(v)
+                       t := create_simplified_ord_const(v,resultdef,forinline)
                      else
                        t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
                  end;
@@ -316,21 +316,21 @@ implementation
                        t:=genintconstnode(0)
                      end
                    else
-                     t:=genintconstnode(v)
+                     t := create_simplified_ord_const(v,resultdef,forinline)
                  end;
                xorn :
                  if is_integer(ld) then
-                   t:=genintconstnode(lv xor rv)
+                   t := create_simplified_ord_const(lv xor rv,resultdef,forinline)
                  else
                    t:=cordconstnode.create(lv xor rv,resultdef,true);
                orn :
                  if is_integer(ld) then
-                   t:=genintconstnode(lv or rv)
+                   t:=create_simplified_ord_const(lv or rv,resultdef,forinline)
                  else
                    t:=cordconstnode.create(lv or rv,resultdef,true);
                andn :
                  if is_integer(ld) then
-                   t:=genintconstnode(lv and rv)
+                   t:=create_simplified_ord_const(lv and rv,resultdef,forinline)
                  else
                    t:=cordconstnode.create(lv and rv,resultdef,true);
                ltn :
@@ -1890,7 +1890,7 @@ implementation
 
          if not codegenerror and
             not assigned(result) then
-           result:=simplify;
+           result:=simplify(false);
       end;
 
 

compiler/nbas.pas

@@ -70,7 +70,7 @@ interface
 
        tstatementnode = class(tbinarynode)
           constructor create(l,r : tnode);virtual;
-          function simplify : tnode; override;
+          function simplify(forinline : boolean) : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure printnodetree(var t:text);override;
@@ -82,7 +82,7 @@ interface
        tblocknode = class(tunarynode)
           constructor create(l : tnode);virtual;
           destructor destroy; override;
-          function simplify : tnode; override;
+          function simplify(forinline : boolean) : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
 {$ifdef state_tracking}
@@ -333,7 +333,7 @@ implementation
       end;
 
 
-    function tstatementnode.simplify : tnode;
+    function tstatementnode.simplify(forinline: boolean) : tnode;
       begin
         result:=nil;
         { these "optimizations" are only to make it more easy to recognise    }
@@ -456,7 +456,7 @@ implementation
       end;
 
 
-    function tblocknode.simplify: tnode;
+    function tblocknode.simplify(forinline : boolean): tnode;
       begin
         result := nil;
         { Warning: never replace a blocknode with another node type,      }

compiler/ncal.pas

@@ -3269,12 +3269,12 @@ implementation
          if assigned(callinitblock) then
            begin
              typecheckpass(tnode(callinitblock));
-             dosimplify(tnode(callinitblock));
+             doinlinesimplify(tnode(callinitblock));
            end;
          if assigned(callcleanupblock) then
            begin
              typecheckpass(tnode(callcleanupblock));
-             dosimplify(tnode(callcleanupblock));
+             doinlinesimplify(tnode(callcleanupblock));
            end;
 
          { Continue with checking a normal call or generate the inlined code }
@@ -3770,7 +3770,7 @@ implementation
           again inside the args or itself }
         exclude(procdefinition.procoptions,po_inline);
         typecheckpass(tnode(inlineblock));
-        dosimplify(tnode(inlineblock));
+        doinlinesimplify(tnode(inlineblock));
         firstpass(tnode(inlineblock));
         include(procdefinition.procoptions,po_inline);
         result:=inlineblock;

compiler/ncnv.pas

@@ -51,7 +51,7 @@ interface
           procedure printnodeinfo(var t : text);override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify:tnode; override;
+          function simplify(forinline : boolean):tnode; override;
           procedure mark_write;override;
           function docompare(p: tnode) : boolean; override;
           function retains_value_location:boolean;
@@ -1752,7 +1752,7 @@ implementation
               te_exact,
               te_equal :
                 begin
-                  result := simplify;
+                  result := simplify(false);
                   if assigned(result) then
                     exit;
 
@@ -2011,7 +2011,7 @@ implementation
           simplify does not do }
         if (convtype<>tc_cord_2_pointer) then
           begin
-            result := simplify;
+            result := simplify(false);
             if assigned(result) then
               exit;
           end;
@@ -2137,7 +2137,7 @@ implementation
 {$endif not cpu64bitalu}
 
 
-    function ttypeconvnode.simplify: tnode;
+    function ttypeconvnode.simplify(forinline : boolean): tnode;
       var
         hp: tnode;
 {$ifndef cpu64bitalu}

compiler/nflw.pas

@@ -86,7 +86,7 @@ interface
           constructor create(l,r,_t1 : tnode);virtual;reintroduce;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
          private
           function internalsimplify(warn: boolean) : tnode;
        end;
@@ -102,7 +102,7 @@ interface
           procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
        end;
        tfornodeclass = class of tfornode;
 
@@ -187,7 +187,7 @@ interface
           constructor create_implicit(l,r,_t1:tnode);virtual;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
-          function simplify: tnode;override;
+          function simplify(forinline:boolean): tnode;override;
        end;
        ttryfinallynodeclass = class of ttryfinallynode;
 
@@ -1342,7 +1342,7 @@ implementation
       end;
 
 
-    function tifnode.simplify : tnode;
+    function tifnode.simplify(forinline : boolean) : tnode;
       begin
         result:=internalsimplify(false);
       end;
@@ -1433,7 +1433,7 @@ implementation
     end;
 
 
-    function tfornode.simplify : tnode;
+    function tfornode.simplify(forinline : boolean) : tnode;
       begin
         result:=nil;
         if (t1.nodetype=ordconstn) and
@@ -2015,7 +2015,7 @@ implementation
       end;
 
 
-   function ttryfinallynode.simplify: tnode;
+   function ttryfinallynode.simplify(forinline : boolean): tnode;
      begin
        result:=nil;
        { if the try contains no code, we can kill

compiler/ninl.pas

@@ -39,7 +39,7 @@ interface
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify: tnode;override;
+          function simplify(forinline : boolean): tnode;override;
           function docompare(p: tnode): boolean; override;
 
           { pack and unpack are changed into for-loops by the compiler }
@@ -1350,7 +1350,7 @@ implementation
       end;
 
 
-    function tinlinenode.simplify: tnode;
+    function tinlinenode.simplify(forinline : boolean): tnode;
 
       function do_lowhigh(def:tdef) : tnode;
         var
@@ -1545,14 +1545,14 @@ implementation
                case inlinenumber of
                  in_const_abs :
                    if vl.signed then
-                     hp:=genintconstnode(abs(vl.svalue))
+                     hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline)
                    else
-                     hp:=genintconstnode(vl.uvalue);
+                     hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline);
                  in_const_sqr:
                    if vl.signed then
-                     hp:=genintconstnode(sqr(vl.svalue))
+                     hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline)
                    else
-                     hp:=genintconstnode(sqr(vl.uvalue));
+                     hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
                  in_const_odd :
                    hp:=cordconstnode.create(qword(odd(int64(vl))),booltype,true);
                  in_const_swap_word :
@@ -1741,8 +1741,9 @@ implementation
                         vl:=tordconstnode(left).value-1;
                       if is_integer(left.resultdef) then
                       { the type of the original integer constant is irrelevant,
-                        it should be automatically adapted to the new value }
-                        result:=genintconstnode(vl)
+                        it should be automatically adapted to the new value
+                        (except when inlining) }
+                        result:=create_simplified_ord_const(vl,resultdef,forinline)
                       else
                         { check the range for enums, chars, booleans }
                         result:=cordconstnode.create(vl,left.resultdef,true)
@@ -1815,7 +1816,9 @@ implementation
                 end;
               in_round_real :
                 begin
-                  if left.nodetype in [ordconstn,realconstn] then
+                  { can't evaluate while inlining, may depend on fpu setting }
+                  if (not forinline) and
+                     (left.nodetype in [ordconstn,realconstn]) then
                     begin
                       vr:=getconstrealvalue;
                       if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
@@ -2612,7 +2615,7 @@ implementation
 
         if not assigned(result) and not
            codegenerror then
-          result:=simplify;
+          result:=simplify(false);
       end;
 
 

compiler/nld.pas

@@ -73,7 +73,7 @@ interface
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
        {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
@@ -493,7 +493,7 @@ implementation
       end;
 
 
-    function tassignmentnode.simplify : tnode;
+    function tassignmentnode.simplify(forinline : boolean) : tnode;
       begin
         result:=nil;
         { assignment nodes can perform several floating point }

compiler/nmat.pas

@@ -32,7 +32,7 @@ interface
        tmoddivnode = class(tbinopnode)
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
          protected
 {$ifndef cpu64bitalu}
           { override the following if you want to implement }
@@ -47,7 +47,7 @@ interface
        tshlshrnode = class(tbinopnode)
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
 {$ifndef cpu64bitalu}
           { override the following if you want to implement }
           { parts explicitely in the code generator (CEC)
@@ -63,7 +63,7 @@ interface
           constructor create(expr : tnode);virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
        end;
        tunaryminusnodeclass = class of tunaryminusnode;
 
@@ -71,7 +71,7 @@ interface
           constructor create(expr : tnode);virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
-          function simplify : tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
        {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif}
@@ -101,7 +101,7 @@ implementation
                               TMODDIVNODE
  ****************************************************************************}
 
-    function tmoddivnode.simplify:tnode;
+    function tmoddivnode.simplify(forinline : boolean):tnode;
       var
         t : tnode;
         rv,lv : tconstexprint;
@@ -135,9 +135,9 @@ implementation
 
             case nodetype of
               modn:
-                t:=genintconstnode(lv mod rv);
+                t:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
               divn:
-                t:=genintconstnode(lv div rv);
+                t:=create_simplified_ord_const(lv div rv,resultdef,forinline);
             end;
             result:=t;
             exit;
@@ -162,7 +162,7 @@ implementation
          maybe_call_procvar(left,true);
          maybe_call_procvar(right,true);
 
-         result:=simplify;
+         result:=simplify(false);
          if assigned(result) then
            exit;
 
@@ -451,7 +451,7 @@ implementation
                               TSHLSHRNODE
  ****************************************************************************}
 
-    function tshlshrnode.simplify:tnode;
+    function tshlshrnode.simplify(forinline : boolean):tnode;
       var
         t : tnode;
       begin
@@ -461,9 +461,9 @@ implementation
           begin
              case nodetype of
                 shrn:
-                  t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
+                  t:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline);
                 shln:
-                  t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
+                  t:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline);
              end;
              result:=t;
              exit;
@@ -488,7 +488,7 @@ implementation
          maybe_call_procvar(left,true);
          maybe_call_procvar(right,true);
 
-         result:=simplify;
+         result:=simplify(false);
          if assigned(result) then
            exit;
 
@@ -582,13 +582,13 @@ implementation
       end;
 
 
-    function tunaryminusnode.simplify:tnode;
+    function tunaryminusnode.simplify(forinline : boolean):tnode;
       begin
         result:=nil;
         { constant folding }
         if is_constintnode(left) then
           begin
-             result:=genintconstnode(-tordconstnode(left).value);
+             result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
              exit;
           end;
         if is_constrealnode(left) then
@@ -612,7 +612,7 @@ implementation
          if codegenerror then
            exit;
 
-         result:=simplify;
+         result:=simplify(false);
          if assigned(result) then
            exit;
 
@@ -746,7 +746,7 @@ implementation
       end;
 
 
-    function tnotnode.simplify:tnode;
+    function tnotnode.simplify(forinline : boolean):tnode;
       var
         v : tconstexprint;
         t : tnode;
@@ -824,7 +824,10 @@ implementation
                else
                  CGMessage(type_e_mismatch);
              end;
-             t:=cordconstnode.create(v,def,false);
+             if not forinline then
+               t:=cordconstnode.create(v,def,false)
+             else
+               t:=create_simplified_ord_const(v,resultdef,true);
              result:=t;
              exit;
           end;
@@ -846,7 +849,7 @@ implementation
 
          resultdef:=left.resultdef;
 
-         result:=simplify;
+         result:=simplify(false);
          if assigned(result) then
            exit;
 

compiler/node.pas

@@ -337,7 +337,7 @@ interface
 
          { tries to simplify the node, returns a value <>nil if a simplified
            node has been created }
-         function simplify : tnode;virtual;
+         function simplify(forinline : boolean) : tnode;virtual;
 {$ifdef state_tracking}
          { Does optimizations by keeping track of the variable states
            in a procedure }
@@ -807,7 +807,7 @@ implementation
       end;
 
 
-    function tnode.simplify : tnode;
+    function tnode.simplify(forinline : boolean) : tnode;
       begin
         result:=nil;
       end;

compiler/nset.pas

@@ -75,7 +75,7 @@ interface
        tinnode = class(tbinopnode)
           constructor create(l,r : tnode);virtual;reintroduce;
           function pass_typecheck:tnode;override;
-          function simplify:tnode;override;
+          function simplify(forinline : boolean):tnode;override;
           function pass_1 : tnode;override;
        end;
        tinnodeclass = class of tinnode;
@@ -305,11 +305,11 @@ implementation
             exit;
           end;
 
-         result:=simplify;
+         result:=simplify(false);
       end;
 
 
-    function tinnode.simplify:tnode;
+    function tinnode.simplify(forinline : boolean):tnode;
       var
         t : tnode;
       begin

compiler/nutils.pas

@@ -26,7 +26,7 @@ unit nutils;
 interface
 
   uses
-    globtype,
+    globtype,constexp,
     symtype,symsym,symbase,symtable,
     node;
 
@@ -80,8 +80,16 @@ interface
     function node_resources_fpu(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);
+    { tries to simplify the given node after inlining }
+    procedure doinlinesimplify(var n : tnode);
+    { creates an ordinal constant, optionally based on the result from a
+      simplify operation: normally the type is the smallest integer type
+      that can hold the value, but when inlining the "def" will be used instead,
+      which was determined during an earlier typecheck pass (because the value
+      may e.g. be a parameter to a call, which needs to be of the declared
+      parameter type) }
+    function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
+
 
     { returns true if n is only a tree of administrative nodes
       containing no code }
@@ -105,7 +113,7 @@ interface
 implementation
 
     uses
-      cutils,verbose,constexp,globals,
+      cutils,verbose,globals,
       symconst,symdef,
       defutil,defcmp,
       nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
@@ -970,7 +978,7 @@ implementation
            not (lnf_simplify_processing in tloopnode(n).loopflags) then
           begin
             // Try to simplify condition
-            dosimplify(tloopnode(n).left);
+            doinlinesimplify(tloopnode(n).left);
             // call directly second part below,
             // which might change the loopnode into
             // something else if the conditino is a constant node
@@ -982,7 +990,7 @@ implementation
           end
         else
           begin
-            hn:=n.simplify;
+            hn:=n.simplify(true);
             if assigned(hn) then
               begin
                 treechanged := arg;
@@ -999,7 +1007,7 @@ implementation
 
 
     { tries to simplify the given node calling the simplify method recursively }
-    procedure dosimplify(var n : tnode);
+    procedure doinlinesimplify(var n : tnode);
       var
         treechanged : boolean;
       begin
@@ -1011,6 +1019,15 @@ implementation
       end;
 
 
+    function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
+      begin
+        if not forinline then
+          result:=genintconstnode(value)
+        else
+          result:=cordconstnode.create(value,def,cs_check_range in current_settings.localswitches);
+      end;
+
+
     function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
     var
       hpropsym : tpropertysym;

compiler/pass_1.pas

@@ -195,7 +195,7 @@ implementation
                    begin
                      { inlining happens in pass_1 and can cause new }
                      { simplify opportunities                       }
-                     hp:=p.simplify;
+                     hp:=p.simplify(true);
                      if assigned(hp) then
                        begin
                          p.free;

tests/webtbs/tw17458.pp

@@ -0,0 +1,19 @@
+function TailRecFibonacci(const n: Byte): QWord;
+
+  function InnerFibo(const n: Byte; const r1,r2: QWord): QWord; inline;
+  begin
+    case n of
+      0: InnerFibo := r1;
+      1: InnerFibo := r2;
+      else InnerFibo := InnerFibo(n - 1,r2,r1 + r2);
+    end;
+  end;
+
+begin
+  TailRecFibonacci := InnerFibo(n,0,1);
+end;
+
+begin
+  if TailRecFibonacci(10)<>55 then
+    halt(1);
+end.