Преглед на файлове

+ only allocate a result variable for asm routines on i8086, if they are
returned in a parameter. This improves TP7 compatibility.

git-svn-id: trunk@38246 -

nickysn преди 7 години
родител
ревизия
f1b6be2d74
променени са 3 файла, в които са добавени 82 реда и са изтрити 0 реда
  1. 1 0
      .gitattributes
  2. 9 0
      compiler/i8086/cpupara.pas
  3. 72 0
      tests/test/tasm20.pp

+ 1 - 0
.gitattributes

@@ -12513,6 +12513,7 @@ tests/test/tasm18h.pp svneol=native#text/plain
 tests/test/tasm19.pp svneol=native#text/plain
 tests/test/tasm2.inc svneol=native#text/plain
 tests/test/tasm2.pp svneol=native#text/plain
+tests/test/tasm20.pp svneol=native#text/plain
 tests/test/tasm2a.pp svneol=native#text/plain
 tests/test/tasm3.pp svneol=native#text/plain
 tests/test/tasm4.pp svneol=native#text/plain

+ 9 - 0
compiler/i8086/cpupara.pas

@@ -35,6 +35,7 @@ unit cpupara;
        tcpuparamanager = class(tparamanager)
           function param_use_paraloc(const cgpara:tcgpara):boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
+          function asm_result_var(def:tdef;pd:tabstractprocdef):boolean;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_para_align(calloption : tproccalloption):byte;override;
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
@@ -115,6 +116,14 @@ unit cpupara;
       end;
 
 
+    function tcpuparamanager.asm_result_var(def:tdef;pd:tabstractprocdef):boolean;
+      begin
+        if not(po_assembler in pd.procoptions) then
+          internalerror(2018021501);
+        result:=ret_in_param(def,pd);
+      end;
+
+
     function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;

+ 72 - 0
tests/test/tasm20.pp

@@ -0,0 +1,72 @@
+{ %CPU=i8086 }
+
+{$IFDEF FPC}
+{$MODE TP}
+{$ENDIF FPC}
+
+program tasm20;
+
+{$S-}
+
+{ This test checks that assembler functions that return a value in register(s)
+  do not get allocated an extra $result variable on the stack }
+
+var
+  res: integer;
+  res2: longint;
+{$ifdef FPC}
+  res3: int64;
+{$endif FPC}
+  expect_sp: word;
+  actual_sp: word;
+
+procedure myproc; assembler;
+asm
+  mov expect_sp, sp
+end;
+
+function myfunc: integer; assembler;
+asm
+  mov actual_sp, sp
+  mov ax, $1234
+end;
+
+function myfunc2: longint; assembler;
+asm
+  mov actual_sp, sp
+  mov ax, $5678
+  mov dx, $1234
+end;
+
+{$ifdef FPC}
+function myfunc3: int64; assembler;
+asm
+  mov actual_sp, sp
+  mov ax, $1234
+  mov bx, $5678
+  mov cx, $9ABC
+  mov dx, $DEF0
+end;
+{$endif FPC}
+
+procedure Error;
+begin
+  Writeln('Error!');
+  Halt(1);
+end;
+
+begin
+  myproc;
+  res := myfunc;
+  if (res <> $1234) or (expect_sp <> actual_sp) then
+    Error;
+  res2 := myfunc2;
+  if (res2 <> $12345678) or (expect_sp <> actual_sp) then
+    Error;
+{$ifdef FPC}
+  res3 := myfunc3;
+  if (res3 <> $123456789ABCDEF0) or (expect_sp <> actual_sp) then
+    Error;
+{$endif FPC}
+  Writeln('Ok!');
+end.