diff --git a/.gitattributes b/.gitattributes index 5471ca383c..9e1b3b7247 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/i8086/n8086add.pas b/compiler/i8086/n8086add.pas index 6987a9c0eb..286086aed1 100644 --- a/compiler/i8086/n8086add.pas +++ b/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; diff --git a/tests/test/cpu16/i8086/tfarptr5.pp b/tests/test/cpu16/i8086/tfarptr5.pp new file mode 100644 index 0000000000..5b200359c2 --- /dev/null +++ b/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.