瀏覽代碼

* make call by value stdcall for records and arrays delphi compatible

git-svn-id: trunk@9280 -
peter 17 年之前
父節點
當前提交
05e44101e8
共有 3 個文件被更改,包括 65 次插入15 次删除
  1. 1 0
      .gitattributes
  2. 5 15
      compiler/i386/cpupara.pas
  3. 59 0
      tests/webtbs/tw10203.pp

+ 1 - 0
.gitattributes

@@ -7776,6 +7776,7 @@ tests/webtbs/tw10002.pp svneol=native#text/plain
 tests/webtbs/tw10009.pp svneol=native#text/plain
 tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw10072.pp svneol=native#text/plain
+tests/webtbs/tw10203.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw1023.pp svneol=native#text/plain
 tests/webtbs/tw1041.pp svneol=native#text/plain

+ 5 - 15
compiler/i386/cpupara.pas

@@ -173,12 +173,10 @@ unit cpupara;
             result:=true;
           recorddef :
             begin
-              { Win32 stdcall passes small records on the stack for call by
-                value }
+              { Delphi stdcall passes records on the stack for call by value }
               if (target_info.system=system_i386_win32) and
                  (calloption=pocall_stdcall) and
-                 (varspez=vs_value) and
-                 (def.size<=16) then
+                 (varspez=vs_value) then
                 result:=false
               else
                 result:=
@@ -189,19 +187,11 @@ unit cpupara;
             end;
           arraydef :
             begin
-              { Win32 stdcall passes arrays on the stack for call by
-                value }
-              if (target_info.system=system_i386_win32) and
-                 (calloption=pocall_stdcall) and
-                 (varspez=vs_value) and
-                 (tarraydef(def).highrange>=tarraydef(def).lowrange) then
-                result:=false
-              else
               { array of const values are pushed on the stack as
                 well as dyn. arrays }
-                if (calloption in [pocall_cdecl,pocall_cppdecl]) then
-                  result:=not(is_array_of_const(def) or
-                    is_dynamic_array(def))
+              if (calloption in [pocall_cdecl,pocall_cppdecl]) then
+                result:=not(is_array_of_const(def) or
+                        is_dynamic_array(def))
               else
                 begin
                   result:=(

+ 59 - 0
tests/webtbs/tw10203.pp

@@ -0,0 +1,59 @@
+{ %cpu=i386 }
+{ %target=win32 }
+
+{compilation: fpc test.pp}
+{$IFDEF FPC}
+{$MODE DELPHI}
+{$ASMMODE Intel}
+{$ELSE}
+{$APPTYPE CONSOLE}
+{$ENDIF}
+type
+  TBig=record
+    data:array[1..1000] of integer;
+  end;
+  TBig2=array[1..1000] of integer;
+var
+  s,s1:integer;
+  x:TBig;
+  x2:TBig2;
+  err : boolean;
+procedure temp(x:TBig);stdcall;
+begin
+  asm
+    mov s,ebp
+  end;
+end;
+procedure temp2(x:TBig2);stdcall;
+begin
+  asm
+    mov s,ebp
+  end;
+end;
+begin
+  asm
+    mov s1,esp
+  end;
+  writeln(s1);
+  temp(x);
+  writeln(s);
+  if (s1-s)<1000 then
+    begin
+      writeln('incompatible with Delphi: records');
+      err:=true;
+    end;
+
+  asm
+    mov s1,esp
+  end;
+  writeln(s1);
+  temp2(x2);
+  writeln(s);
+  if (s1-s)>1000 then
+    begin
+      writeln('incompatible with Delphi: arrays');
+      err:=true;
+    end;
+  if err then
+    halt(1);
+end.