FLOAT_INVALID_OPERATION und FLOAT_OVERFLOW nur 64Bit

[venice2]

Gleiche Funktion in 32Bit und 64Bit

Delphi-Quellcode:

procedure TBassPlayer.XFFT(FR, FI: array of single; Sign, Sample, SampleCount: Integer);
// Wave Daten glätten
var
  Q, J, M, L, le, le1, ip: integer;
  tr, ti, s, ur, ur1, ui, wr, wi: single;

begin

    J := 1;
    for Q := Sample to SampleCount do
    begin
      if Q < J then
      begin
        s     := FR[Q];
        FR[Q] := FR[J];
        FR[J] := s;
        s     := FI[Q];
        FI[Q] := FI[J];
        FI[J] := s;
      end;

      M := ((SampleCount + 1) div 2);
      while M < J do
      begin
        J := J - M;
        M := M div 2;
      end;
      J := J + M;
    end;

    for L := 1 to 8 do
    begin
      le  := trunc(Power(2, L));
      le1 := le div 2;
      ur  := 1;
      ui  := 0;
      wr  := Cos(PI / le1);
      wi  := Sign * Sin(PI / le1);

      for J := 1 to le1 do
      begin
        Q := J;
        while Q <= (SampleCount + 1) do
        begin
          ip     := Q + (le1 - 1);
          tr     := FR[ip] * ur - FI[ip] * ui; // FLOAT_INVALID_OPERATION nur 64Bit
          ti     := FR[ip] * ui + FI[ip] * ur;
          FR[ip] := FR[Q] - tr;
          FI[ip] := FI[Q] - ti; // FLOAT_OVERFLOW nur 64Bit
          FR[Q]  := FR[Q] + tr;
          FI[Q]  := FI[Q] + ti;
          Q      := Q + le;
        end;

        ur1 := ur * wr - ui * wi;
        ui  := ur * wi + ui * wr;
        ur  := ur1;
      end;
    end;

    for Q := Sample to (SampleCount + 1) do
    begin
      FR[Q] := FR[Q] * DivN;
      FI[Q] := FI[Q] * DivN;
    end;
end;

Dies Funktion Arbeitet unter 32Bit so wie sie soll.
In 64Bit muß ich beide Fehler ignorieren.
Dort bekomme ich diese beiden Fehler! FLOAT_INVALID_OPERATION, FLOAT_OVERFLOW

Wieder irgend so ein Ding mit Daten Typen?

[himitsu]

Den Einzigen Typ-Unterschied gibt es beim Extended, welchen man eigentlich eh hätte nie direkt verwenden sollen.

Extended gibt es unter 64 Bit nicht, das ist dort bloß noch ein Alias für Double.


Aber eventuell sieht die Exception-Maske unterschiedlich aus?
FGetExceptMask
FSetExceptMask
[EDIT]
besser Folgenes verwenden
GetExceptionMask
SetExceptionMask
(welches unter 64 Bit auf GetSSEExceptionMask umgeleitet wird)
[/EDIT]

Zitat:

exInvalidOp - An invalid operation was attempted.
exDenormalized - A number was reduced in size smaller than can be stored as non-zero. It has been denormalized.
exZeroDivide - An attempt was made to divide by zero.
exOverflow - A number has exceeded the highest positive value supported.
exUnderflow - A number has exceeded the highest negative value supported.
exPrecision - A number has exceeded the number of digits of precision.

Aber wenn es daran liegt, dass unter 32 Bit einige Exception nicht ausgelöst werden, dann würde ich wohl eher nachsehn, warum es zum Überlauf kommt, also die Ursache beheben, anstatt nur an den Symptomen rumzupfuschen.


Single ist und bleibt auch unter 64 Bit Single
und Integer war mal als platformabhängiger Typ definiert (unter 16 Bit war er noch 16 Bit), aber für/vor 64 Bit wurde er auf 32 Bit eingefroren (von den CPU-Entwicklern und alle Softwaretools machten mit) und stattdessen ein neuer Typ erfunden (nennt sich in Delphi NativeInt),
also Integer (LongInt) bleibt auch unverändert.




[EDIT]
Unter 64 Bit dürften die Floats über SSE behandelt werden (GetMXCSR),
wärend es unter 32 Bit noch die FPU machte (Get8087CW).

[venice2]

Zitat:

Unter 64 Bit dürften die Floats über SSE behandelt werden,
wärend es unter 32 Bit noch die FPU machte.

Und wie soll ich das beheben?

Zitat:

Aber wenn es daran liegt, dass unter 32 Bit einige Exception nicht ausgelöst werden, dann würde ich wohl eher nachsehn, warum es zum Überlauf kommt, also die Ursache beheben, anstatt nur an den Symptomen rumzupfuschen.

Deshalb stelle ja ich die Frage hier!
Wie gesagt 32Bit macht keinen Ärger.

Im Moment habe ich nur die Möglichkeit diese Exzeption von der Anwendung auswerten zu lassen anstelle vom Debugger.
Denke das ist legitim sonst würde man diese Möglichkeit nicht anbieten oder?
Das ist doch kein Rumpfuschen.

[himitsu]

Zitat:

Wie gesagt 32Bit macht keinen Ärger.

* die Berechnungen ergeben dort keine Überläufe
* oder es gibt Überläufe, aber es werden keine Exceptions ausgelöst

Das muß erstmal eklärt werden. (darum eben mal schnell nachsehn, ob sich die Masken unterscheiden .... ich hab auch schon Fremdkompnenten gesehn, welche grob fahrlässig heimlich dauerhaft die Fehlermasken verändern)
Rein rechnerisch sollte FPU und SSE die gleichen Ergebnisse liefern, also dürfte es da eigentlich keinen (großen) Unterschied geben.
https://xem.github.io/minix86/manual...5b67a-276.html

"Damals" war die Floating Point Unit "8087" ein eigener Chip, neben der Central Processing Unit "8086" ... schon länger ist der Teil in die CPU integriert, ähnlich wie inzwischen oftmals auch GPU und andere "Chips".
Und nun hatte man sich halt gedacht diesen "alten" Teil mal zu ensorgen.

Zitat:

Das ist doch kein Rumpfuschen.

Es kommt drauf an.
* ist es vorgesehn, daß mit Überläufen "gerechnet" wird (z.B. bei Verschlüssels-Algorithmen oft gern ausgenutzt)
* sollte es eigentlich garkeine Überläufe geben, dann wäre es doch bissl blöd nur die "Fehlermeldung" abzuschalten, anstatt den eigentlichen Fehler zu beheben

[venice2]

Zitat:

* die Berechnungen ergeben dort keine Überläufe
* oder es gibt Überläufe, aber es werden keine Exceptions ausgelöst

Nun ja laut den Einstellungen müßte eigentlich ein Exception geworfen werden wenn eines Aufritt. Siehe Pic.
Aber es gibt keines.

Habe das hier mal getestet bringt aber keine Änderung

Delphi-Quellcode:

type
  TFPControlState = record
    _8087CW: Word;
    MXCSR: UInt32;
  end;

function GetFPControlState: TFPControlState;
begin
  Result._8087CW := Get8087CW;
  Result.MXCSR := GetMXCSR;
end;

procedure RestoreFPControlState(const State: TFPControlState);
begin
  Set8087CW(State._8087CW);
  SetMXCSR(State.MXCSR);
end;

var
  FPControlState: TFPControlState;
....
FPControlState := GetFPControlState;
try
  // call into external library that changes FP control state
finally
  RestoreFPControlState(FPControlState);
end;

Zitat:

sollte es eigentlich garkeine Überläufe geben, dann wäre es doch bissl blöd nur die "Fehlermeldung" abzuschalten, anstatt den eigentlichen Fehler zu beheben

Das ist korrekt.
Muß halt mal schauen wie ich das lösen kann.

[venice2]

Es geht nur Fehlerfrei mit Extended unter 64Bit
Auch wenn du sagst

Zitat:

welchen man eigentlich eh hätte nie direkt verwenden sollen.

[Amateurprofi]

@venice2:
Ohne mich wirklich intensiv damit befasst zu haben:

Delphi-Quellcode:

    while Q <= (SampleCount + 1) do

sollte m.E. heißen

Delphi-Quellcode:

while Q < SampleCount

.
Du greifst mit FR[Q] und FI[Q] auf die Arrays FR und FI zu.
Die Arrays sind als Array of Single deklariert und ich vermute, sie enthalten SampleCount Einträge, also die Indizes 0..SampleCount-1.
Wenn Q der Wert SampleCount erreicht, wird der Zugriff FR[Q] und FI[Q] je nach Compiler-Einstellung entweder eine Exception auslösen oder aber irgendwelche Daten liefern, die nicht aus den Arrays stammen.

Weiß nicht, ab das das Problem ist.

[venice2]

Es setzt sich so zusammen.

In Create erstelle ich einen Temporären DC

Delphi-Quellcode:

TempBufferDC := gSprVizC.GI_Create32bitDC(255, 60, $00000000);

Delphi-Quellcode:

procedure TBassPlayer.DrawData;
var
  k:  integer;
  TRA: array[1..512] of single;
  TIA: array[1..512] of single;
begin

  // Fülle das Array mit den Wave Daten
  for k := 0 to 511 do
    TRA[k + 1] := WaveData[k] / 1.50; 

  XFFT(TRA, TIA, -1, 1, 512); // Wave Daten glätten

  for k := 1 to 512 do // PicFlame auf den TempBufferDC Blitten
  begin
    if TRA[k] < 0 then
      TRA[k] := 0;

    BitBlt(TempBufferDC, k - 1, trunc(Abs(FHeight - TRA[k])), 1, FHeight,
      PicFlame[FCurentFlame].Canvas.Handle, 0, 0, SRCCOPY);
  end;

  FadeBackBuffer(TempBufferDC); // Inhalt vom TempBufferDC Faden

  BitBlt(PaintDC, 0, 0, FWidth, FHeight, TempBufferDC, 0, 0, SRCCOPY);

Delphi-Quellcode:

procedure TBassPlayer.XFFT(FR, FI: array of single; Sign, Sample, SampleCount: Integer);

Zitat:

also die Indizes 0..SampleCount-1.

Delphi-Quellcode:

for Q := Sample to (SampleCount) do

Zitat:

Weiß nicht, ab das das Problem ist.

Wenn die Schleifen nicht korrekt wären dürfte es auch unter 32Bit nicht laufen.

Wenn es jemand testen möchte schicke ich ihm gern den Quelltext zu.

[brechi]

Bei mir läuft der bei deinen Angaben schon direkt in eine Endlosschleife, weil M irgendwann 0 ist:

Delphi-Quellcode:

      M := ((SampleCount + 1) div 2);
      while M < J do
      begin
        J := J - M;
        M := M div 2;
      end;
      J := J + M;

Da in der zweiten Schleife le1 immer größer wird

Delphi-Quellcode:

      le := trunc(Power(2, L));
      le1 := le div 2;

und dann irgendwann

Delphi-Quellcode:

ip := Q + (le1 - 1);

// mit 
 while Q <= (SampleCount + 1) do

auf außerhalb des arrays Zugegriffen wird

Delphi-Quellcode:

  
tr := FR[ip] * ur - FI[ip] * ui; // FLOAT_INVALID_OPERATION nur 64Bit
ti := FR[ip] * ui + FI[ip] * ur;

kann nur murks bei rumkommen. Das wird auch unter 32Bit keine korrekten Ergebnisse liefern, sondern nur zufällig laufen, je nachdem was gerade auf dem Heap ist.

Bau mal ein:

Delphi-Quellcode:

ip := Q + (le1 - 1);

          if ip > High(fi) then
            raise Exception.Create('Fehler');
          if ip > High(FR) then
            raise Exception.Create('Fehler');

          tr := FR[ip] * ur - FI[ip] * ui; // FLOAT_INVALID_OPERATION nur 64Bit
          ti := FR[ip] * ui + FI[ip] * ur;

ein

[Amateurprofi]

@venice2:

Ich glaube da machst du einen Denkfehler.

In "TBassPlayer.DrawData" sind TRA und TIA zwar als Array[1..512] of Single, also statische Arrays deklariert.
Aber an

Delphi-Quellcode:

procedure TBassPlayer.XFFT(FR, FI: array of single; Sign, Sample, SampleCount: Integer);

.
werden die TRA und TIA als dynamische Arrays übergeben und haben dort die Indizes 0..511, SampleCount jedoch hat den Wert 512.
Wenn du in "TBassPlayer.XFFT" das

Delphi-Quellcode:

while Q <= (SampleCount + 1) do

abarbeitest kommt es 2 mal zu Bereichsüberschreitungen.
Das erste mal wenn Q = 512 ist.
Das zweite mal wenn Q = 513 ist, denn die while Schleife arbeitet ja nicht nur bis SampleCount sondern sogar bis SampleCount+1.
In beiden Fällen wird nicht auf Inhalte der Arrays zugegriffen, sondern auf irgendwelche Daten, die zufälligerweise an den Adressen stehen,
auf die zugegriffen wird
Die Fehlermeldung FLOAT_INVALID_OPERATION deutet darauf hin, dass mit einer ungültigen Fließkommazahl, z.B. einer NaN irgendetwas
gerechnet wird.
Die Fehlermeldung FLOAT_OVERFLOW sagt, dass das Rechenergebnis außerhalb des für Singles gültigen Bereiches ist.

Richtig wäre also, wie bereits in #7 gesagt:

Delphi-Quellcode:

while Q < SampleCount

.

Zitat:

Wenn die Schleifen nicht korrekt wären dürfte es auch unter 32Bit nicht laufen.

Vielleicht stehen unter 32 Bit an den Adressen außerhalb der Arrays 0 Werte und unter 64 Bit z.B. NaNs.
Dann hättest du unter 32 Bit zwar fehlerhafte Ergebnisse aber keine Exeptions, unter 64 Bit dagegen würden dann Exceptions ausgelöst.

[venice2]

Zitat:

Vielleicht stehen unter 32 Bit an den Adressen außerhalb der Arrays 0 Werte und unter 64 Bit z.B. NaNs.
Dann hättest du unter 32 Bit zwar fehlerhafte Ergebnisse aber keine Exeptions, unter 64 Bit dagegen würden dann Exceptions ausgelöst.

Das mag sein.
Danke für deine Ausführliche Erklärung.
Werde es mal testen.

EDIT:
Nein geht nicht hatte das Extended noch definiert.
Kommen die gleichen Fehler mit Single.

Habe deine Änderung trotzdem belassen da es mir schlüssig erscheint. Danke!

[brechi]

Hast du denn mal den rangecheck eingebaut?

[venice2]

Zitat:

Zitat von brechi (Beitrag 1492442)

Hast du denn mal den rangecheck eingebaut?

Das sind Grundvoraussetzungen. :wink:

[brechi]

Delphi-Quellcode:

//...
ip := Q + (le1 - 1);

          if ip > High(fi) then //rangecheck
            raise Exception.Create('Fehler');
          if ip > High(FR) then
            raise Exception.Create('Fehler');

          tr := FR[ip] * ur - FI[ip] * ui; // FLOAT_INVALID_OPERATION nur 64Bit
          ti := FR[ip] * ui + FI[ip] * ur;

Läuft das bei dir durch, oder wird ein Fehler angezeigt?

[venice2]

Zitat:

Zitat von brechi (Beitrag 1492444)

Delphi-Quellcode:

//...
ip := Q + (le1 - 1);

          if ip > High(fi) then //rangecheck
            raise Exception.Create('Fehler');
          if ip > High(FR) then
            raise Exception.Create('Fehler');

          tr := FR[ip] * ur - FI[ip] * ui; // FLOAT_INVALID_OPERATION nur 64Bit
          ti := FR[ip] * ui + FI[ip] * ur;

Läuft das bei dir durch, oder wird ein Fehler angezeigt?

Falls hier ein Fehler auftreten sollte und ich habe unter den Option die Bereichsprüfung eingeschaltet dann sollte der Debugger einen Fehler melden oder?
Aber ich kann es auch mal auf diese weise versuchen. Danke!

Das ist was ich meinte mit Grundvoraussetzung.

EDIT:
Aber der rangecheck hat nichts mit FLOAT_INVALID_OPERATION zu tun oder?
Habe es versucht.
FLOAT_INVALID_OPERATION kommt trotzdem auch mit deinem rangecheck

[brechi]

Die Frage ist, ob die die Range-Prüfung ausgelöst wird. Wenn FLOAT_INV.. vorher kommt, liegt es zumindest nicht daran, dass du auf einen ungültigen Speicherbereich zugreift.
Wenn du auf Speicherbereich nach dem Array zugreift würdest, dann kann dadurch schon der Fehler FLOAT_INV ausgelöst werden, je nachdem was dort steht.
Da wie bereits erwähnt ein array of single bei 0 startet müsste auch sample bei 0 beginnen und auch in die anderen beiden schleifen dürften immer nur bis samplecount-1 laufen.

[venice2]

Zitat:

Zitat von brechi (Beitrag 1492448)

Die Frage ist, ob die die Range-Prüfung ausgelöst wird. Wenn FLOAT_INV.. vorher kommt, liegt es zumindest nicht daran, dass du auf einen ungültigen Speicherbereich zugreift.
Wenn du auf Speicherbereich nach dem Array zugreift würdest, dann kann dadurch schon der Fehler FLOAT_INV ausgelöst werden, je nachdem was dort steht.
Da wie bereits erwähnt ein array of single bei 0 startet müsste auch sample bei 0 beginnen und auch in die anderen beiden schleifen dürften immer nur bis samplecount-1 laufen.

Ich sagte schon

Zitat:

FLOAT_INVALID_OPERATION kommt trotzdem auch mit deinem rangecheck

Also danach.
Und nein diese werden nicht ausgelöst.

Aber ein versuch war es wert.

Habe es deaktiviert und werde die Daten Faden ohne die Wave Daten zu glätten.
Die Funktion habe ich vor 20 Jahren von Klaus Langbein aus dem VB-Forum bekommen der ist aber leider verstorben.
Na ja wie dem auch sei.

Am ende ein Programm das ich alleine verwende daher nicht so wichtig.
Danke für euer Interesse.

[venice2]

Falls mir doch noch jemand bei dem Problem helfen möchte hier ist der Quelltext.
Quelltext entfernt. Bei bedarf lade ich ihn nochmal hoch.

In uBass

Delphi-Quellcode:

procedure TBassPlayer.DrawData(PaintDC: HDC);

müssen diese Zeilen wieder aktiviert werden.

// TIA: array[1..512] of single;
// XFFT(TRA, TIA, -1, 1, 511);

und anschließend so ändern.

Delphi-Quellcode:

TIA: array[1..256] of single;
XFFT(TRA, TIA, -1, 1, 255);

die anderen bitte kommentiert lassen (ist nur ein Test)

DragDrop einen Ordner mit *.mp3 Dateien.
Wenn ein Titel gefällt diesen zu Favoriten addieren erst danach wird eine m3u erstellt mit den Lieblings Titeln.
Beim nächsten Start wird die m3u automatisch geöffnet.

Unter Plugins Settings muß "Use WaveFade" eingeschaltet sein um die Glättung der Wave Daten zu testen.
Mindest Voraussetzung Windows 10

[Fritzew]

Hallo Emil,

habe mir Dein Projekt angeschaut.

Zuerst : Deine Grafik ist echt gut. (Optik)

Dann habe ich mir die
procedure TBassPlayer.XFFT angeschaut.
Sehe da mehrere Probleme
1. Du willst ja was zurück , dann solltest Du zumindest die 2 Arrays als Var deklarieren.
aktuell schiebst Du die nur über den Stack in die procedure, da kommt niemals was zurück.
Also so:

Delphi-Quellcode:

procedure TBassPlayer.XFFT(var FR, FI: array of single; Sign, Sample, SampleCount: Integer);

Innerhalb der procedure fehlt eine Abbruch-Bedingung in

Delphi-Quellcode:

         M := ((SampleCount) div 2);
      while M < J do
      begin
        J := J - M;
        M := M div 2;
        // Nachtragen
        if M=0 then break; // Hier steckst Du in einer endlosSchleife
      end;

Und leere Exceptblöcke sind böse. So eine methode sollte keine Exceptions werfen,
und wenn Doch willst Du das wissen :-)


Und deine FloatingPoint Probleme:

Delphi-Quellcode:

procedure TBassPlayer.DrawData(PaintDC: HDC);
var
  k:  integer;
  TRA: array[1..256] of single;
  TIA: array[1..256] of single;
begin

  // Render alle Bilder in den temporären Buffer TempBufferDC
   for k := 0 to 255 do
    TRA[k + 1] := WaveData[k] / 1.50;
// Das Array TIA  liegt auf dem Stack da ist zu 100% Müll drin
// Also:

  fillchar(TIA, sizeof(TIA), #0);


  XFFT(TRA, TIA, -1, 1, 255);
//

Mit diesen Änderungen läuft es bei mir durch ohne Probleme

Gruss Fritz

[venice2]

@FritzW erstmal Danke das du dir das angeschaut hast.
Manchmal ist es schwer ohne den Quelltext zu zeigen etwas vernünftig erklären zu wollen.
Hatte schon befürchtet das es niemanden interessiert. :wink:

Zitat:

Zuerst : Deine Grafik ist echt gut. (Optik)

Danke!

Zitat:

1. Du willst ja was zurück , dann solltest Du zumindest die 2 Arrays als Var deklarieren.
aktuell schiebst Du die nur über den Stack in die procedure, da kommt niemals was zurück.
Also so:

Jep! Das ist sehr schlecht ist mir ehrlich gesagt gar nicht aufgefallen.
Werde es beheben.

Zitat:

Und leere Exceptblöcke sind böse. So eine methode sollte keine Exceptions werfen,
und wenn Doch willst Du das wissen

Gebe ich dir recht.
Wollte nur mal grundsätzlich rausspringen können wenn was fehl schlägt. Aber bringt beim debuggen von Float exeptions eh nichts.

Zitat:

Mit diesen Änderungen läuft es bei mir durch ohne Probleme

Werde deine Einstellungen übernehmen und anschließend eine Meldung abgeben wie es hier läuft.
Nochmals Danke.

[venice2]

Bitte überprüfe nochmals das var in der XFFT das verändert mir die Visualisierung.
Siehe beide Pics.

Es läuft auch ohne var durch! Super keine Exception mehr.

Das erste visualisiert mehr in Richtung Wave das zweite zeigt mir mehr ein Spectrum.
Bin mir jetzt nicht sicher ob das so sein muß da die Glättung Funktion wie gesagt von Klaus war und dieser lebt leider nicht mehr. Kann ihn also nicht fragen.
Das erste sieht mir persönlich besser aus.

Aber wichtig die Fehler sind erst einmal weg. Danke.

Funktionieren die Visualisierungen, Sonique bei dir? (Interesse halber)

Eventuell kann ich das Auswählen lassen.
Füge eine neue Abfrage ""SmoothWaveData" in der Preference hinzu dann kann man auswählen ob XFFT durchlaufen werden soll oder nicht.
Ich denke Var ist in Ordnung und das Resultat abhängig davon auch.

Durch die Glättung soll ja eine Art Spektrum aus den Wave Daten entstehen.
Hast mir sehr geholfen :)

[venice2]

Das var ist Richtig. (Habe auch nichts anderes erwartet) ;)
habe es aber geändert das man es auch ohne Glättung verwenden kann.
Siehe Smooth the Wave Data"

Delphi-Quellcode:

procedure TBassPlayer.DrawData(PaintDC: HDC);
var
  k:  integer;
  TRA: array[1..256] of single;
  TIA: array[1..256] of single;
begin

  if gBin.SmoothWaveData = 1 then
  begin
    for k := 0 to 255 do
      TRA[k + 1] := WaveData[k];

    Fillchar(TIA, SizeOf(TIA), #0);
    XFFT(TRA, TIA, -1, 1, 255);
  end
  else
    for k := 0 to 255 do
      TRA[k + 1] := WaveData[k] / 1.50;

  // Render alle Bilder in den temporären Buffer TempBufferDC
  for k := 1 to 256 do
  begin
    if TRA[k] < 0 then
      TRA[k] := 0;

    BitBlt(TempBufferDC, k - 1, trunc(Abs(FHeight - TRA[k])), 1, FHeight,
      PicFlame[FCurentFlame].Canvas.Handle, 0, 0, SRCCOPY);
  end;

  FadeBackBuffer(TempBufferDC);

  BitBlt(PaintDC, 0, 0, FWidth, FHeight, TempBufferDC, 0, 0, SRCCOPY);
end;

Delphi-Quellcode:

procedure TBassPlayer.XFFT(var FR, FI: array of single; Sign, Sample, SampleCount: Integer);
// Wave Daten glätten
var
  Q, J, M, L, le, le1, ip: integer;
  tr, ti, s, ur, ur1, ui, wr, wi: single;

begin

    J := 1;
    for Q := Sample to (SampleCount - 1) do
    begin
      if Q < J then
      begin
        s     := FR[Q];
        FR[Q] := FR[J];
        FR[J] := s;
        s     := FI[Q];
        FI[Q] := FI[J];
        FI[J] := s;
      end;

      M := ((SampleCount) div 2);
      while M < J do
      begin
        J := J - M;
        M := M div 2;
        if M = 0 then
          break;
      end;
      J := J + M;
    end;

    for L := 1 to 8 do
    begin
      le  := trunc(Power(2, L));
      le1 := le div 2;
      ur  := 1;
      ui  := 0;
      wr  := Cos(PI / le1);
      wi  := Sign * Sin(PI / le1);


      for J := 1 to le1 do
      begin
        Q := J;
        while Q < (SampleCount) do
        begin
          ip     := Q + (le1 - 1);
          tr     := FR[ip] * ur - FI[ip] * ui;
          ti     := FR[ip] * ui + FI[ip] * ur;
          FR[ip] := FR[Q] - tr;
          FI[ip] := FI[Q] - ti;
          FR[Q]  := FR[Q] + tr;
          FI[Q]  := FI[Q] + ti;
          Q      := Q + le;
        end;

        ur1 := ur * wr - ui * wi;
        ui  := ur * wi + ui * wr;
        ur  := ur1;
      end;

    end;

    for Q := Sample to (SampleCount) do
    begin
      FR[Q] := FR[Q] * DivN;
      FI[Q] := FI[Q] * DivN;
    end;
end;