paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 08:00:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ fixed the emitting of non-nil far and huge pointer constptrs in typed

Browse Source 
constants on i8086

git-svn-id: trunk@32141 -
This commit is contained in:
nickysn 2015-10-24 20:25:49 +00:00
parent 2f83eeba39
commit 1491d9655c
3 changed files with 47 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11477,6 +11477,7 @@ tests/test/cpu16/i8086/tmml.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmmm.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmms.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tmmt.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tptrcon.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
tests/test/cpu16/i8086/ttheap1.pp svneol=native#text/pascal
tests/test/cpu16/taddint1.pp svneol=native#text/pascal

19
compiler/i8086/n8086tcon.pas
View File

@ -42,7 +42,7 @@ interface
implementation
uses
ncnv,defcmp,defutil,aasmtai,symcpu;
ncon,ncnv,defcmp,defutil,aasmtai,symcpu;
{ ti8086typedconstbuilder }
@ -60,7 +60,22 @@ uses
node.free;
node:=hp;
end;
if node.nodetype=niln then
{ const pointer ? }
if (node.nodetype = pointerconstn) then
begin
ftcb.queue_init(def);
if is_farpointer(def) or is_hugepointer(def) then
begin
ftcb.queue_typeconvn(s32inttype,def);
ftcb.queue_emit_ordconst(longint(tpointerconstnode(node).value),s32inttype);
end
else
begin
ftcb.queue_typeconvn(s16inttype,def);
ftcb.queue_emit_ordconst(smallint(tpointerconstnode(node).value),s16inttype);
end;
end
else if node.nodetype=niln then
begin
if is_farpointer(def) or is_hugepointer(def) then
ftcb.emit_tai(Tai_const.Create_32bit(0),u32inttype)

29
tests/test/cpu16/i8086/tptrcon.pp Normal file
View File

@ -0,0 +1,29 @@
{ %cpu=i8086 }
program tptrcon;
var
hp: HugePointer = HugePointer(Ptr($FACE, $55AA));
fp: FarPointer = Ptr($DEAD, $BEEF);
fp2: FarPointer = FarPointer($12345678);
np: NearPointer = NearPointer($FEED);
hpl: LongInt absolute hp;
fpl: LongInt absolute fp;
fp2l: LongInt absolute fp2;
npw: Word absolute np;
procedure Error;
begin
Writeln('Error!');
Halt(1);
end;
begin
if hpl<>LongInt($FACE55AA) then
Error;
if fpl<>LongInt($DEADBEEF) then
Error;
if fp2l<>LongInt($12345678) then
Error;
if npw<>Word($FEED) then
Error;
end.