* when passing a parameter by var/out, its address leaves the current scope so the compiler has to take care of this

* when getting rid of temps. of inline parameters, take care if somewhere an alias of the variable might exist, resolves #24796 and #26534

git-svn-id: trunk@29616 -

.gitattributes

@@ -14083,6 +14083,7 @@ tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24690.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw2473.pp svneol=native#text/plain
+tests/webtbs/tw24796.pp svneol=native#text/pascal
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
@@ -14190,6 +14191,8 @@ tests/webtbs/tw26482.pp svneol=native#text/pascal
 tests/webtbs/tw26483.pp svneol=native#text/pascal
 tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
+tests/webtbs/tw26534a.pp svneol=native#text/pascal
+tests/webtbs/tw26534b.pp svneol=native#text/pascal
 tests/webtbs/tw26536.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain

compiler/ncal.pas

@@ -1008,10 +1008,17 @@ implementation
                         { uninitialized warnings (tbs/tb0542)         }
                         set_varstate(left,vs_written,[]);
                         set_varstate(left,vs_readwritten,[]);
+                        make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
                       end;
                     vs_var,
                     vs_constref:
-                      set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                      begin
+                        set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
+                        { constref takes also the address, but storing it is actually the compiler
+                          is not supposed to expect }
+                        if parasym.varspez=vs_var then
+                          make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
+                      end;
                     else
                       set_varstate(left,vs_read,[vsf_must_be_valid]);
                   end;
@@ -3916,7 +3923,10 @@ implementation
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }
              ((tloadnode(n).symtable.symtabletype = staticsymtable) and
-              (tloadnode(n).symtable = TSymtable(arg))))) or
+              (tloadnode(n).symtable = TSymtable(arg))) or
+              { if the addr of the symbol is taken somewhere, it can be also non-local }
+              (tabstractvarsym(tloadnode(n).symtableentry).addr_taken)
+           )) or
            ((n.nodetype = subscriptn) and
             (tsubscriptnode(n).vs.owner.symtabletype = ObjectSymtable)) then
           result := fen_norecurse_true;

tests/webtbs/tw24796.pp

@@ -0,0 +1,94 @@
+{$apptype console}
+{$mode objfpc}
+{$inline on}
+
+{$define debug_inline}
+
+var
+    fault_mask: integer = 0;
+
+/////////////////////////////////////////
+
+function dummy1( x: integer; var y: integer ): boolean; {$ifdef debug_inline}inline;{$endif}
+begin
+    y := x + 1;
+    result := ( y = x + 1 );
+end;
+
+function dummy2( x: integer; out y: integer ): boolean; {$ifdef debug_inline}inline;{$endif}
+begin
+    y := x + 1;
+    result := ( y = x + 1 );
+end;
+
+procedure test1;
+var
+    y: integer;
+begin
+
+    y := 0;
+
+    if not dummy1( y, y ) then
+    begin
+        writeln( 'fail 1' );
+        fault_mask := fault_mask or 1;
+    end;
+
+    if not dummy2( y, y ) then
+    begin
+        writeln( 'fail 2' );
+        fault_mask := fault_mask or 2;
+    end;
+
+end;
+
+/////////////////////////////////////////
+
+type
+    bits64 = qword;
+
+procedure add128( a0, a1, b0, b1 : bits64; var z0Ptr, z1Ptr : bits64); {$ifdef debug_inline}inline;{$endif}
+// routine from the SOFTFPU unit
+var
+    z1 : bits64;
+begin
+    z1 := a1 + b1;
+    z1Ptr := z1; // overrites "a1" when called as below and inlined
+    z0Ptr := a0 + b0 + ord( z1 < a1 ); // z1 compared with wrong value
+end;
+
+const
+    correct_zSig0 = bits64($0001A784379D99DB);
+    correct_zSig1 = bits64($4200000000000000);
+
+procedure test2;
+var
+    zSig0, zSig1, aSig0, aSig1: bits64;
+begin
+
+    zSig0 := bits64($000054B40B1F852B);
+    zSig1 := bits64($DA00000000000000);
+    aSig0 := bits64($000152D02C7E14AF);
+    aSig1 := bits64($6800000000000000);
+
+    // this usage pattern from routine SOFTFPU::float128_mul
+    add128( zSig0, zSig1, aSig0, aSig1, zSig0, zSig1 );
+
+    if zSig0 <> correct_zSig0 then
+    begin
+        writeln( 'fail 3' ); // fail if add128 is inlined
+        fault_mask := fault_mask or 4;
+    end;
+
+end;
+
+/////////////////////////////////////////
+
+begin
+    test1;
+    test2;
+    if fault_mask = 0 then
+        writeln( 'pass' )
+    else
+        halt( fault_mask );
+end.

tests/webtbs/tw26534a.pp

@@ -0,0 +1,26 @@
+{ %norun }
+{ %opt=-O2 }
+{Opt.level: -O2}
+{$inline on}
+unit tw26534a;
+interface
+
+implementation
+
+procedure redirect( p: pointer );
+begin
+end;
+
+procedure inlined( var R: byte ); inline;
+begin
+  redirect(@R);
+end;
+
+procedure comp_failed;
+var
+  a: byte;
+begin
+  inlined(a); // ie2006111510
+end;
+
+end.

tests/webtbs/tw26534b.pp

@@ -0,0 +1,19 @@
+{ %opt=-O2 }
+// Opt.level: -O2
+{$inline on}
+program test2;
+
+procedure redirect( p: pointer );
+begin
+end;
+
+procedure inlined( var R: byte ); inline;
+begin
+  redirect(@R);
+end;
+
+var
+  a: byte;
+begin
+  inlined(a); // ie2006111510
+end.