paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-05 14:18:50 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ implemented far pointer arithmetic (operating only on the offset, without

Browse Source 
touching the segment)

git-svn-id: trunk@27485 -
This commit is contained in:
nickysn 2014-04-06 13:12:29 +00:00
parent 9e93e4293b
commit 8d1ed088c8
3 changed files with 206 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10838,6 +10838,7 @@ tests/test/cg/variants/tvarol96.pp svneol=native#text/plain
tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarptr3.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tptrsize.pp svneol=native#text/pascal
tests/test/cpu16/taddint1.pp svneol=native#text/pascal
tests/test/dumpclass.pp svneol=native#text/plain

94
compiler/i8086/n8086add.pas
View File

@ -36,6 +36,7 @@ interface
function use_generic_mul32to64: boolean; override;
procedure second_addordinal; override;
procedure second_add64bit;override;
procedure second_addfarpointer;
procedure second_cmp64bit;override;
procedure second_cmp32bit;
procedure second_cmpordinal;override;
@ -72,6 +73,8 @@ interface
not(is_signed(right.resultdef));
if nodetype=muln then
second_mul(unsigned)
else if is_farpointer(left.resultdef) xor is_farpointer(right.resultdef) then
second_addfarpointer
else
inherited second_addordinal;
end;
@ -213,6 +216,97 @@ interface
end;
procedure ti8086addnode.second_addfarpointer;
var
tmpreg : tregister;
pointernode: tnode;
begin
pass_left_right;
force_reg_left_right(false,true);
set_result_location_reg;
if (left.resultdef.typ=pointerdef) and (right.resultdef.typ<>pointerdef) then
pointernode:=left
else if (left.resultdef.typ<>pointerdef) and (right.resultdef.typ=pointerdef) then
pointernode:=right
else
internalerror(2014040601);
if not (nodetype in [addn,subn]) then
internalerror(2014040602);
if nodetype=addn then
begin
if (right.location.loc<>LOC_CONSTANT) then
begin
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
left.location.register,right.location.register,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(pointernode.location.register),GetNextReg(location.register));
end
else
begin
if pointernode=left then
begin
{ farptr_reg + int_const }
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
right.location.value,left.location.register,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(left.location.register),GetNextReg(location.register));
end
else
begin
{ int_reg + farptr_const }
tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,
right.location.value,tmpreg);
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
left.location.register,tmpreg,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(tmpreg),GetNextReg(location.register));
end;
end;
end
else { subtract is a special case since its not commutative }
begin
if (nf_swapped in flags) then
swapleftright;
{ left can only be a pointer in this case, since (int-pointer) is not supported }
if pointernode<>left then
internalerror(2014040603);
if left.location.loc<>LOC_CONSTANT then
begin
if right.location.loc<>LOC_CONSTANT then
begin
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
right.location.register,left.location.register,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(pointernode.location.register),GetNextReg(location.register));
end
else
begin
{ farptr_reg - int_const }
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
right.location.value,left.location.register,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(left.location.register),GetNextReg(location.register));
end;
end
else
begin
{ farptr_const - int_reg }
tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,
left.location.value,tmpreg);
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
right.location.register,tmpreg,location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
GetNextReg(tmpreg),GetNextReg(location.register));
end;
end;
end;
procedure ti8086addnode.second_cmp64bit;
var
hregister,

111
tests/test/cpu16/i8086/tfarptr3.pp Normal file
View File

@ -0,0 +1,111 @@
{ %cpu=i8086 }
{ far pointer arithmetic tests }
{ far pointer arithmetic should work only on the offset,
without changing the segment }
{$R-}
var
ErrorCode: Integer;
procedure Error(Code: Integer);
begin
Writeln('Error: ', code);
ErrorCode := Code;
end;
var
FarPtr: FarPointer;
FarPtr2: FarPointer;
int16: Integer;
int32: LongInt;
begin
ErrorCode := 0;
Writeln('farptr + int16_var');
FarPtr := Ptr($1234, $5678);
int16 := $F0AD;
FarPtr2 := nil;
FarPtr2 := FarPtr + int16;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('int16_var + farptr');
FarPtr := Ptr($1234, $5678);
int16 := $F0AD;
FarPtr2 := nil;
FarPtr2 := int16 + FarPtr;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('farptr + int32_var');
FarPtr := Ptr($1234, $5678);
int32 := $55AAF0AD;
FarPtr2 := nil;
FarPtr2 := FarPtr + int32;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('int32_var + farptr');
FarPtr := Ptr($1234, $5678);
int32 := $55AAF0AD;
FarPtr2 := nil;
FarPtr2 := int32 + FarPtr;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('farptr + int16_const');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := FarPtr + $F0AD;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('int16_const + farptr');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := $F0AD + FarPtr;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('farptr + int32_const');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := FarPtr + $55AAF0AD;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('int32_const + farptr');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := $55AAF0AD + FarPtr;
if FarPtr2 <> Ptr($1234, $4725) then
Error(1);
Writeln('farptr - int16_var');
FarPtr := Ptr($1234, $5678);
int16 := $F0AD;
FarPtr2 := nil;
FarPtr2 := FarPtr - int16;
if FarPtr2 <> Ptr($1234, $65CB) then
Error(1);
Writeln('farptr - int32_var');
FarPtr := Ptr($1234, $5678);
int32 := $55AAF0AD;
FarPtr2 := nil;
FarPtr2 := FarPtr - int32;
if FarPtr2 <> Ptr($1234, $65CB) then
Error(1);
Writeln('farptr - int16_const');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := FarPtr - $F0AD;
if FarPtr2 <> Ptr($1234, $65CB) then
Error(1);
Writeln('farptr - int32_const');
FarPtr := Ptr($1234, $5678);
FarPtr2 := nil;
FarPtr2 := FarPtr - $55AAF0AD;
if FarPtr2 <> Ptr($1234, $65CB) then
Error(1);
if ErrorCode = 0 then
Writeln('Success!')
else
Halt(ErrorCode);
end.