+ implemented far pointer comparison operating only on the offset (+ added test)

git-svn-id: trunk@28179 -

.gitattributes

@@ -10855,6 +10855,7 @@ 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/tfarptr4.pp svneol=native#text/pascal
+tests/test/cpu16/i8086/tfarptr5.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/thugeptr1.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/thugeptr1a.pp svneol=native#text/pascal
 tests/test/cpu16/i8086/thugeptr1b.pp svneol=native#text/pascal

compiler/i8086/n8086add.pas

@@ -44,6 +44,7 @@ interface
          procedure second_addfarpointer;
          procedure second_cmp64bit;override;
          procedure second_cmp32bit;
+         procedure second_cmpfarpointer;
          procedure second_cmpordinal;override;
          procedure second_mul(unsigned: boolean);
        end;
@@ -859,9 +860,60 @@ interface
         location_reset(location,LOC_JUMP,OS_NO)
       end;
 
+
+    procedure ti8086addnode.second_cmpfarpointer;
+      begin
+        { handle = and <> as a 32-bit comparison }
+        if nodetype in [equaln,unequaln] then
+          begin
+            second_cmp32bit;
+            exit;
+          end;
+
+        pass_left_right;
+
+        { <, >, <= and >= compare the 16-bit offset only }
+        if (right.location.loc=LOC_CONSTANT) and
+           (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE])
+        then
+          begin
+            emit_const_ref(A_CMP, S_W, word(right.location.value), left.location.reference);
+            location_freetemp(current_asmdata.CurrAsmList,left.location);
+          end
+        else
+          begin
+            { left location is not a register? }
+            if left.location.loc<>LOC_REGISTER then
+             begin
+               { if right is register then we can swap the locations }
+               if right.location.loc=LOC_REGISTER then
+                begin
+                  location_swap(left.location,right.location);
+                  toggleflag(nf_swapped);
+                end
+               else
+                begin
+                  { maybe we can reuse a constant register when the
+                    operation is a comparison that doesn't change the
+                    value of the register }
+                  hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u16inttype,true);
+                end;
+              end;
+
+            emit_generic_code(A_CMP,OS_16,true,false,false);
+            location_freetemp(current_asmdata.CurrAsmList,right.location);
+            location_freetemp(current_asmdata.CurrAsmList,left.location);
+          end;
+        location_reset(location,LOC_FLAGS,OS_NO);
+        location.resflags:=getresflags(true);
+      end;
+
+
     procedure ti8086addnode.second_cmpordinal;
       begin
-        if is_32bit(left.resultdef) or is_farpointer(left.resultdef) or is_hugepointer(left.resultdef) then
+        if is_farpointer(left.resultdef) then
+          second_cmpfarpointer
+        else if is_32bit(left.resultdef) or is_hugepointer(left.resultdef) then
           second_cmp32bit
         else
           inherited second_cmpordinal;

tests/test/cpu16/i8086/tfarptr5.pp

@@ -0,0 +1,86 @@
+{ %cpu=i8086 }
+
+{ far pointer comparison tests (>, <, >= and <=) }
+
+{ >, <, >= and <= should compare only the offset }
+{ = and <> (not tested here) should compare *both* the segment and the offset }
+
+var
+  ErrorCode: Integer;
+
+procedure Error(Code: Integer);
+begin
+  Writeln('Error: ', code);
+  ErrorCode := Code;
+end;
+
+type
+  TFarPtrRec = packed record
+    offset: Word;
+    segment: Word;
+  end;
+
+var
+  FarPtr: FarPointer;
+  FarPtr2: FarPointer;
+  FarPtrRec: TFarPtrRec absolute FarPtr;
+  lt, gt, lteq, gteq: Boolean;
+begin
+  ErrorCode := 0;
+
+  Writeln('var, var');
+  FarPtr := Ptr($4321, $5678);
+  FarPtr2 := Ptr($1234, $89AB);
+  lt := FarPtr < FarPtr2;
+  lteq := FarPtr <= FarPtr2;
+  gt := FarPtr > FarPtr2;
+  gteq := FarPtr >= FarPtr2;
+  if not lt or not lteq or gt or gteq then
+    Error(1);
+
+  FarPtr := Ptr($1234, $89AB);
+  FarPtr2 := Ptr($4321, $5678);
+  lt := FarPtr < FarPtr2;
+  lteq := FarPtr <= FarPtr2;
+  gt := FarPtr > FarPtr2;
+  gteq := FarPtr >= FarPtr2;
+  if lt or lteq or not gt or not gteq then
+    Error(2);
+
+  Writeln('var, ptr(const)');
+  FarPtr := Ptr($4321, $5678);
+  lt := FarPtr < Ptr($1234, $89AB);
+  lteq := FarPtr <= Ptr($1234, $89AB);
+  gt := FarPtr > Ptr($1234, $89AB);
+  gteq := FarPtr >= Ptr($1234, $89AB);
+  if not lt or not lteq or gt or gteq then
+    Error(1);
+
+  FarPtr := Ptr($1234, $89AB);
+  lt := FarPtr < Ptr($4321, $5678);
+  lteq := FarPtr <= Ptr($4321, $5678);
+  gt := FarPtr > Ptr($4321, $5678);
+  gteq := FarPtr >= Ptr($4321, $5678);
+  if lt or lteq or not gt or not gteq then
+    Error(2);
+
+  Writeln('ptr(const), ptr(const)');
+  lt := Ptr($4321, $5678) < Ptr($1234, $89AB);
+  lteq := Ptr($4321, $5678) <= Ptr($1234, $89AB);
+  gt := Ptr($4321, $5678) > Ptr($1234, $89AB);
+  gteq := Ptr($4321, $5678) >= Ptr($1234, $89AB);
+  if not lt or not lteq or gt or gteq then
+    Error(1);
+
+  lt := Ptr($1234, $89AB) < Ptr($4321, $5678);
+  lteq := Ptr($1234, $89AB) <= Ptr($4321, $5678);
+  gt := Ptr($1234, $89AB) > Ptr($4321, $5678);
+  gteq := Ptr($1234, $89AB) >= Ptr($4321, $5678);
+  if lt or lteq or not gt or not gteq then
+    Error(2);
+
+  if ErrorCode = 0 then
+    Writeln('Success!')
+  else
+    Halt(ErrorCode);
+end.