CODEWITHSUNDEEP
delphioverridingrounding
Michael
Michael

Reputation: 766

Override Delphi function System.Round

I just discovered that a software I have to reimplement uses extensivelly System.Round(). The problem is that this function uses "Bankers rounding" and the behaviour can not be changed like in Math.RoundTo() (rmDown,rmUp,rmNearest,rmTruncate).

I have to change the behaviour to "normal rounding" (12.5 -> 13 NOT 12.5 -> 12)... So I would like to override System.Round() globally. I want to do this, because Round() is used so many times and I do not want to change them all manually.

How is this possible?

Upvotes: 8

Views: 2596

Answers (4)

Deathspank
Deathspank

Reputation: 1

// bankers round omzeilen

function RoundN(X: double): double;
const
  cFuncName = 'RoundN';
begin
  Result := Trunc(X + Frac(X));
end;

Upvotes: 0

David Heffernan
David Heffernan

Reputation: 612964

WARNING: Although the answer below addresses the question that was asked, I would recommend that nobody ever uses it. If you want to perform rounding differently from Round then write and call a dedicated function.

You can use a runtime code hook to change the implementation of Round.

The wrinkle is that it's a little tricky to get hold of the address of the Round function though because it is an intrinsic. You also have to be careful to follow the calling convention used. The input value is passed in the x87 stack register ST(0) and the return value is a 64 bit integer in EDX:EAX.

Here's how to do it.

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then 
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := 
    NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

function System_Round: Pointer;
asm
  MOV     EAX, offset System.@Round
end;

procedure _ROUND;
asm
        { ->    FST(0)  Extended argument       }
        { <-    EDX:EAX Result                  }

        // your implementation goes here
end;

initialization
  RedirectProcedure(System_Round, @_ROUND);

If you'd rather implement your version in Pascal than asm then you need to adapt the non-standard calling convention of _ROUND to the standard Delphi calling convention. Like this:

function MyRound(x: Extended): Int64;
begin
  // your implementation goes here
end;

procedure _ROUND;
var
  x: Extended;
asm
        { ->    FST(0)  Extended argument       }
        { <-    EDX:EAX Result                  }

        FSTP    TBYTE PTR [x]
        CALL    MyRound
end;

Note that I have assumed here that your program is targeting 32 bit. If you need to target 64 bit then the principles are much the same, but the details obviously differ.

Upvotes: 14

Rob Kennedy
Rob Kennedy

Reputation: 163277

You're concerned about the time and effort required to manually change all your existing Round calls to call something else. So don't change them manually. Use a tool to automate it. For example, you could use sed.

sed -i -e "s/\bRound\b/BiasedRoundAwayFromZero/g" *.pas

With that change, your code is now explicit about what rounding it uses. It doesn't require everyone reading your code to know that a patch was applied elsewhere in the code to affect the global behavior of standard functions. It also doesn't affect code you link to from other libraries, which might rely on the standard behavior of Round and be broken by a global change.

Upvotes: 1

HeartWare
HeartWare

Reputation: 8243

UNIT MathRound;

INTERFACE

FUNCTION ROUND(X : Extended) : Int64;

IMPLEMENTATION

FUNCTION ROUND(X : Extended) : Int64;
  BEGIN
    Result:=TRUNC(X+0.5)
  END;

END.

If you save the above in MathRound.PAS i your project's directory, then include this unit in your source files, you will have a mathematical ROUND function instead of the banker's rounding that is implemented by default.

It'll round off -12.5 to -12 (ie. always rounding towards zero for .5 values) and -12.1 to -11. If you want a more "Logical" rounding, you should use this line instead:

  IF X<0.0 THEN Result:=-TRUNC(ABS(X)+0.5) ELSE Result:=TRUNC(X+0.5)

as the function body.

This will result in

ROUND(12.5) = 13
ROUND(12.1) = 12
ROUND(-12.5)= -13
ROUND(-12.1)= -12

Upvotes: 7

Related Questions