From b951947b645bb8cb88da57d6fd462e2562025819 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 21 Jan 2007 16:53:59 +0000
Subject: [PATCH] * 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 | 1 +
compiler/ncgutil.pas | 13 ++++++++++++-
compiler/psub.pas | 31 ++++++++++++++++++++++---------
tests/webtbs/tw8155.pp | 33 +++++++++++++++++++++++++++++++++
4 files changed, 68 insertions(+), 10 deletions(-)
create mode 100644 tests/webtbs/tw8155.pp
diff --git a/.gitattributes b/.gitattributes
index 3b631cee01..1ac90d5032 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas
index 3a542c731c..27ce9d1491 100644
--- a/compiler/ncgutil.pas
+++ b/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);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 34c49aefa8..ca7f59b692 100644
--- a/compiler/psub.pas
+++ b/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
- not(po_assembler in procdef.procoptions) and
- ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
- pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
- pi_needs_stackframe])=[])
- {$ifdef arm}
- and ((cs_fp_emulation in current_settings.moduleswitches) or not (pi_uses_fpu in flags))
- {$endif arm}
+ if ((po_assembler in procdef.procoptions) and
+ (m_delphi in current_settings.modeswitches) and
+ (tabstractlocalsymtable(procdef.localst).count_locals = 0)) or
+ ((cs_opt_stackframe in current_settings.optimizerswitches) and
+ not(po_assembler in procdef.procoptions) and
+ ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
+ pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
+ 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;
diff --git a/tests/webtbs/tw8155.pp b/tests/webtbs/tw8155.pp
new file mode 100644
index 0000000000..06d2519c68
--- /dev/null
+++ b/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.