* partially fixed Delphi compatibility for assembler procedures: in case

only parameters on the stack are passed and if the function result is
    not referenced, don't allocate a stackframe. Fixes mantis 8155, but
    see that bug report for other rules (there's one error there: Delphi
    *does* allocate a function result for non-string/variant/interface
    if @result is referenced)

git-svn-id: trunk@6102 -

.gitattributes

@@ -7989,6 +7989,7 @@ tests/webtbs/tw8145.pp svneol=native#text/plain
 tests/webtbs/tw8148.pp svneol=native#text/plain
 tests/webtbs/tw8150a.pp svneol=native#text/plain
 tests/webtbs/tw8150d.pp svneol=native#text/plain
+tests/webtbs/tw8155.pp svneol=native#text/plain
 tests/webtbs/tw8156.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/ncgutil.pas

@@ -2283,7 +2283,18 @@ implementation
                 begin
                   vs:=tabstractnormalvarsym(sym);
                   vs.initialloc.size:=def_cgsize(vs.vardef);
-                  if vs.is_regvar(false) then
+                  if (m_delphi in current_settings.modeswitches) and
+                     (po_assembler in current_procinfo.procdef.procoptions) and
+                     (vo_is_funcret in vs.varoptions) and
+                     (vs.refs=0) then
+                    begin
+                      { not referenced, so don't allocate. Use dummy to }
+                      { avoid ie's later on because of LOC_INVALID      }
+                      vs.initialloc.loc:=LOC_REGISTER;
+                      vs.initialloc.size:=OS_INT;
+                      vs.initialloc.register:=NR_FUNCTION_RESULT_REG;
+                    end
+                  else if vs.is_regvar(false) then
                     begin
                       vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable];
                       gen_alloc_regvar(list,vs);

compiler/psub.pas

@@ -763,7 +763,7 @@ implementation
 {$if defined(x86) or defined(arm)}
             { try to strip the stack frame }
             { set the framepointer to esp if:
-              - no assembler directive, those are handled elsewhere
+              - no assembler directive
               - no exceptions are used
               - no debug info
               - no pushes are used/esp modifications, could be:
@@ -771,15 +771,27 @@ implementation
                 * incoming parameters on the stack
                 * open arrays
               - no inline assembler
+             or
+              - Delphi mode
+              - assembler directive
+              - no pushes are used/esp modifications, could be:
+                * outgoing parameters on the stack
+                * incoming parameters on the stack
+                * open arrays
+              - no local variables
             }
-            if (cs_opt_stackframe in current_settings.optimizerswitches) and
+            if ((po_assembler in procdef.procoptions) and
-               not(po_assembler in procdef.procoptions) and
+                (m_delphi in current_settings.modeswitches) and
-               ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
+                (tabstractlocalsymtable(procdef.localst).count_locals = 0)) or
-                       pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
+               ((cs_opt_stackframe in current_settings.optimizerswitches) and
-                       pi_needs_stackframe])=[])
+                not(po_assembler in procdef.procoptions) and
-               {$ifdef arm}
+                ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
-               and ((cs_fp_emulation in current_settings.moduleswitches) or not (pi_uses_fpu in flags))
+                        pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
-               {$endif arm}
+                        pi_needs_stackframe])=[])
+                {$ifdef arm}
+                and ((cs_fp_emulation in current_settings.moduleswitches) or not (pi_uses_fpu in flags))
+                {$endif arm}
+               )
              then
                begin
                  { we need the parameter info here to determine if the procedure gets
@@ -796,6 +808,7 @@ implementation
                      tg.direction:=1;
                    end;
                end;
+            
 {$endif}
             { Create register allocator }
             cg.init_register_allocators;

tests/webtbs/tw8155.pp

@@ -0,0 +1,33 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+{ should not generate a stack frame }
+function testje(l1,l2,l3: longint): longint;
+asm
+  mov eax, 30000
+  ret
+end;
+
+procedure test;
+var
+  l1,l2,l3,l4,l5: cardinal;
+begin
+  l1 := $f00beef;
+  l2 := $cafebabe;
+  l3 := $c001d00d;
+  l4 := $12345678;
+  l5 := $90abcdef;
+  if testje(1,2,3) <> 30000 then
+    halt(1);
+  if (l1 <> $f00beef) or
+     (l2 <> $cafebabe) or
+     (l3 <> $c001d00d) or
+     (l4 <> $12345678) or
+     (l5 <> $90abcdef) then
+    halt(2);
+end;
+
+begin
+  test;
+end.