1

Тема: Функции для работы со множествами

Системный модуль содержит функции для работы со множествами.

Вот пример, когда они используются
var
  Set1, Set2, Set3: set of Byte;
  Set4:  set of 20..200;
  X, Y: Byte;
  R: Boolean;
...
  Set1 := Set2 + Set3; // _SetUnion
  Set1 := Set2 - Set3; // _SetSub
  Set1 := Set2 * Set3; // _SetIntersect

  R := Set1 <= Set2;   // _SetLe(Set1, Set2, SizeOf(Set1))
  R := Set1 >= Set2;   // _SetLe(Set2, Set1, SizeOf(Set1))
  R := Set1 = Set2;    // _SetEq(Set1, Set2, SizeOf(Set1)) + SETZ
  R := Set1 <> Set2;   // _SetEq(Set1, Set2, SizeOf(Set1)) + SETNZ
  
  Set1 := [X];         // _SetElem(Set1, X, SizeOf(Set1))
  Set1 := [X..Y];      // _SetRange(SizeOf(Set1) shl 8 or X, Y, Set1)
  Set1 := Set2;        // REP MOVSD     
  Set1 := Set4;        // _SetExpand(Set4, Set1, (200/8+1) shl 8 or (20/8))
На Pascal они могли бы выглядеть так
procedure _SetElem(var Dst; Elem, Size: Byte);
begin
  FillChar(Dst, Size, 0);
  if Elem shr 3 >= Size then Exit;
  Byte(PAnsiChar(@Dst)[Elem shr 3]) := 1 shl (Elem and 7);
end;

procedure _SetRange(SizeAndLoLimit: Word; HiLimit: Byte; var Dst);
var
  Size, LoLimit, LoMask, HiMask, LoIndex, HiIndex: Byte;
begin
  Size := Hi(SizeAndLoLimit);
  LoLimit := Lo(SizeAndLoLimit);
  FillChar(Dst, Size, 0);
  if HiLimit >= Size shl 3 then
    HiLimit := Size shl 3 - 1;
  if LoLimit > HiLimit then Exit;
  LoMask := $FF shl (LoLimit and 7);
  LoIndex := LoLimit shr 3;
  HiMask := $FF shr (7 - (HiLimit and 7));
  HiIndex := HiLimit shr 3;
  if LoIndex = HiIndex then
    Byte(PAnsiChar(@Dst)[LoIndex]) := HiMask and LoMask
  else
  begin
    Byte(PAnsiChar(@Dst)[LoIndex]) := LoMask;
    Inc(LoIndex);
    while LoIndex < HiIndex do
    begin
      Byte(PAnsiChar(@Dst)[LoIndex]) := $FF;
      Inc(LoIndex);
    end;
    Byte(PAnsiChar(@Dst)[HiIndex]) := HiMask;
  end;
end;

procedure _SetUnion(var Dst; const Src; Size: Byte);
begin
  repeat
    Dec(Size);
    Byte(PAnsiChar(@Dst)[Size]) := Byte(PAnsiChar(@Dst)[Size]) or
      Byte(PAnsiChar(@Src)[Size]);
  until Size = 0;
end;

procedure _SetSub(var Dst; const Src; Size: Byte);
begin
  repeat
    Dec(Size);
    Byte(PAnsiChar(@Dst)[Size]) := Byte(PAnsiChar(@Dst)[Size]) and
      not Byte(PAnsiChar(@Src)[Size]);
  until Size = 0;
end;

procedure _SetIntersect(var Dst; const Src; Size: Byte);
begin
  repeat
    Dec(Size);
    Byte(PAnsiChar(@Dst)[Size]) := Byte(PAnsiChar(@Dst)[Size]) and
      Byte(PAnsiChar(@Src)[Size]);
  until Size = 0;
end;

procedure _SetEq(const Left, Right; Size: Byte); {: ZeroFlag}
begin
  repeat
    Dec(Size);
    if PAnsiChar(@Left)[Size] <> PAnsiChar(@Right)[Size] then
      Exit;
  until Size = 0;
end;

procedure _SetLe(const Left, Right; Size: Byte); {: ZeroFlag}
begin
  repeat
    Dec(Size);
    if (Byte(PAnsiChar(@Left)[Size]) and
      not Byte(PAnsiChar(@Right)[Size])) <> 0 then
      Exit;
  until Size = 0;
end;

procedure _SetExpand(const Src; var Dst; Limit: Word);
begin
  FillChar(Dst, Lo(Limit), 0);
  Move(Src, PAnsiChar(@Dst)[Lo(Limit)], Hi(Limit) - Lo(Limit));
  FillChar(PAnsiChar(@Dst)[Hi(Limit)], 32 - Hi(Limit), 0);
end;

Функции _SetEq и _SetLe возвращают результат во флаге ZF,
но я всё равно реализовал их на Pascal — должно и так работать, после сравнения нужный флаг должен быть установлен.
 
Не удалось определить, в какой момент вызываются функции:

  • _SetIntersect3; { BEG only }

  • _SetUnion3; { BEG only }

  • _SetSub3; { BEG only }

Возможно, предполагается вызывать их самостоятельно, например

asm 
  CALL System.@SetUnion3 
end;

 
Что касается _SetElem, то на одном из форумов попался код из Delphi XE2.

Там он такой
procedure _SetElem(var Dest {:Set}; Elem, Size: Integer);
var
  P: PByte;
  I: Integer;
begin
  P := @Dest;
  for I := 0 to Size - 1 do
    P[i] := 0;
  if (Elem >= 0) and ((Elem div 8) < Size) then
    P[Elem div 8] := 1 shl (Elem mod 8);
end;  

Похоже в современных версиях многие функции сделаны на Pascal, а не только на ассемблере.
Значит, исходным кодом оттуда было бы проще и удобнее пользоваться для реализации своих аналогов.