* i8086 medium/compact memory model fixes in tests tb0368,tb0423,tb0433,tb0433a,

tb0508 and tb0594

git-svn-id: trunk@25822 -
This commit is contained in:
nickysn 2013-10-18 15:43:14 +00:00
parent 7e3d041a11
commit 38ad4974fd
6 changed files with 21 additions and 7 deletions

View File

@ -1,7 +1,8 @@
type
tproc = procedure of object;
trec = record
l1,l2 : ptrint;
l1 : codeptrint;
l2 : ptrint;
end;
var
pfn : tproc;

View File

@ -1,8 +1,12 @@
{$ifdef fpc}{$mode delphi}{$endif}
type
{$ifndef fpc}
codepointer = pointer;
{$endif}
tmethod = record
code,data : pointer;
code : codepointer;
data : pointer;
end;
var

View File

@ -1,5 +1,8 @@
{$ifdef fpc}
{$mode tp}
{$else fpc}
type
codepointer = pointer;
{$endif fpc}
function times2(x : longint) : longint;
@ -10,7 +13,7 @@ end;
var
x:function(x:longint):longint;
y:pointer absolute x;
y:codepointer absolute x;
z,w,v:pointer;
begin
z:=@@x;

View File

@ -1,5 +1,8 @@
{$ifdef fpc}
{$mode delphi}
{$else fpc}
type
codepointer = pointer;
{$endif fpc}
function times2(x : longint) : longint;
@ -10,8 +13,8 @@ end;
var
x:function(x:longint):longint;
y:pointer absolute x;
z,w,v:pointer;
y:codepointer absolute x;
z,w,v:codepointer;
begin
x:=times2;
z:=@x;

View File

@ -3,7 +3,7 @@
type
PointerLocal = procedure(_EBP: Pointer);
procedure proccall(p: pointer);
procedure proccall(p: codepointer);
begin
PointerLocal(p)(get_caller_frame(get_frame));
end;

View File

@ -3,6 +3,9 @@
{$endif}
type
{$ifndef fpc}
codepointer = pointer;
{$endif}
tc = class
class procedure test;
end;
@ -20,6 +23,6 @@ var
begin
p:=tp(tc.test);
p2:=tc.test;
if pointer(@p)<>tmethod(p2).code then
if codepointer(@p)<>tmethod(p2).code then
halt(1);
end.