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

  touching the segment)

git-svn-id: trunk@27485 -

.gitattributes

@@ -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

compiler/i8086/n8086add.pas

@@ -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,

tests/test/cpu16/i8086/tfarptr3.pp

@@ -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.