Флаг переполнения чтения Delphi

В ассемблере термин Overflow обычно относится к арифметике со знаком и означает, что знак суммы отличается от знаков обоих операндов; для беззнаковой арифметики предпочтительнее термин Carry.

Вы можете реализовать добавление с проверкой Overflow (Carry) в чистом паскале:

// signed add - returns True if no overflow produced
function SAdd(A, B: integer; out C: integer): Boolean;
begin
  C:= A + B;
  Result:= (A xor B < 0)   // operands have different signs
        or (C xor A >= 0); // sum has the same sign as operands
end;

// unsigned add - returns True if no carry produced
function UAdd(A, B: Cardinal; out C: Cardinal): Boolean;
begin
  C:= A + B;
  Result:= (C >= A);
end;

Те же функции в сборке - оптимизированный вариант решения Андреаса:

// Signed Add
function SAdd(A, B: Integer; out C: Integer): Boolean;
asm
        ADD   EAX,EDX
        MOV   [ECX],EAX
        SETNO AL
end;

// Unsigned Add
function UAdd(A, B: Cardinal; out C: Cardinal): Boolean;
asm
        ADD   EAX,EDX
        MOV   [ECX],EAX
        SETNC AL
end;

Я тоже не эксперт по ассемблеру, но я думаю, что это работает:

Подписанная версия:

function TryAdd(a, b: integer; out c: integer): boolean;
asm
  ADD EAX, EDX             // EAX := a + b;
  MOV [c], EAX             // c := EAX;
  JO @@END                 // if overflow goto end;
  MOV EAX, true            // result := true
  RET                      // Exit;
@@END:
  XOR EAX, EAX             // result := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: integer;
begin
  if TryAdd(MaxInt - 5, 6, c) then
    ShowMessage(IntToHex(c, 8))
  else
    ShowMessage('Overflowed!');
end;

Неподписанная версия:

function TryAdd(a, b: cardinal; out c: cardinal): boolean;
asm
  ADD EAX, EDX             // EAX := a + b;
  MOV [c], EAX             // c := EAX;
  JC @@END                 // if overflow goto end;
  MOV EAX, true            // result := true
  RET                      // Exit;
@@END:
  XOR EAX, EAX             // result := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: cardinal;
begin
  if TryAdd($A0000000, $C0000000, c) then
    ShowMessage(IntToHex(c, 8))
  else
    ShowMessage('Overflowed!');
end;

Решение Андреаса на чистом паскале (с фиксированным TryAdd, как предлагается в комментариях).

function TryAdd(a, b: integer; out c: integer): boolean; overload;
var
  sum: int64;
begin
  sum := int64(a) + int64(b);
  Result := (Low(integer) <= sum) and (sum <= High(integer));
  c := integer(Int64Rec(sum).Lo);
end;

function TryAdd(a, b: cardinal; out c: cardinal): boolean; overload;
var
  sum: int64;
begin
  sum := int64(a) + int64(b);
  Result := sum <= High(cardinal);
  c := Int64Rec(sum).Lo;
end;

procedure TForm32.Button1Click(Sender: TObject);
var
  c: integer;
begin
  if TryAdd(MaxInt - 5, 6, c) then
    ShowMessage(IntToHex(c, 8))
  else
    ShowMessage('Overflowed!');
end;

{$OPTIMIZATION OFF}
procedure TForm1.FormCreate(Sender: TObject);

  function Overflow(): WordBool;
  const
    fOverflow   = $0800;
  asm
      PUSHF
      POP   AX
      AND   AX, fOverflow;
  end;

var
  I, J, K: Integer;
begin
  I := $80000000;
  J := $80000000;

  { method A - read FLAGS register }
  {$OVERFLOWCHECKS OFF}
  K := I + J;
  if Overflow() then Windows.Beep(5000, 50);

  { method B - have compiler to generate check and catch an exception }
  {$OVERFLOWCHECKS ON}
  try
    K := I + J;
  except on E: EIntOverflow do
    ShowMessage('OH SHI-');
  end;

end;

Естественно, чтение FLAGS с использованием метода A должно следовать сразу за рассматриваемым оператором, что делает этот метод не очень практичным. Напротив, метод B использует структурированную обработку ошибок языка высокого уровня и, следовательно, рекомендуется.

Я ненавижу ассемблер (полностью не переносимый), поэтому использую проверку переполнения, например:

{$IFOPT Q-}
{$DEFINE CSI_OVERFLOWCHECKS_OFF}
{$ENDIF}
{$OVERFLOWCHECKS ON}

a:=$80000000;
b:=$80000000;
c:=a+b;

{$IFDEF CSI_OVERFLOWCHECKS_OFF}
{$UNDEF CSI_OVERFLOWCHECKS_OFF}
{$OVERFLOWCHECKS OFF}
{$ENDIF}