Der DEC x32 ASM in x64/PurePascal Konvertierungsthread

[Namenloser]

Uff, ich hab mich mal an dem fetten Monstrum zu schaffen gemacht. Das ist mein vorläufiges Ergebnis:

Delphi-Quellcode:

function CRCSetup(var CRCDef: TCRCDef; Polynomial, Bits, InitVector,
  FinalVector: Cardinal; Inverse: LongBool): Boolean; register;
var
  XORValue, Value: LongWord;
  Index: Byte;
  i: Integer;
  Carry: Boolean;
  function Add(var Value: LongWord; const Add: LongWord): Boolean; inline;
  begin
    Value := Value + Add;
    Result := (Value < Add); // set Carry Flag on overflow
  end;
  procedure AddC(var Value: LongWord; const Add: LongWord; var Carry: Boolean); inline;
  begin
    if Carry then
    begin
      inc(Value);
      Carry := (Value = 0); // we might cause another overflow by adding the carry bit
      Value := Value + Add;
      Carry := Carry or (Value < Add);
    end
    else
    begin
      Value := Value + Add;
      Carry := (Value < Add);
    end;
  end;
  procedure SubB(var Value: LongWord; const Sub: LongWord; var Carry: Boolean); inline;
  var
    OldValue: LongWord;
  begin
    if Carry then
    begin
      dec(Value);
      Carry := (Value = LongWord(-1));
      OldValue := Value;
      Value := Value - Sub;
      Carry := Carry or (Value > OldValue);
    end
    else
    begin
      OldValue := Value;
      Value := Value - Sub;
      Carry := Carry or (Value > OldValue);
    end;
  end;
  function ShiftR(var Value: LongWord; const Count: Byte): Boolean; inline;
  begin
    Result := Boolean(Value and ($1 shl (Count-1)));
    Value := Value shr Count;
  end;
  procedure ROL(var Value: LongWord; const Count: Byte); inline;
  begin
    Value := (Value shl Count) or (Value shr (32-Count));
  end;
  procedure ROR(var Value: LongWord; const Count: Byte); inline;
  begin
    Value := (Value shr Count) or (Value shl (32-Count));
  end;
begin
  if Bits < 8 then
  begin
    Result := False;
    exit;
  end;

  Carry := False;

  CRCDef.Polynomial := Polynomial;
  CRCDef.Bits := Bits;
  CRCDef.CRC := InitVector;
  CRCDef.InitVector := InitVector;
  CRCDef.FinalVector := FinalVector;
  CRCDef.Inverse := Inverse;
  CRCDef.Shift := Bits - 8;
  CRCDef.Mask := $FFFFFFFF shr Byte(-Bits + 32);

  if Inverse then
  begin
    XORValue := 0;
    repeat
      Carry := ShiftR(Polynomial, 1);
      AddC(XORValue, XORValue, Carry);
      dec(Bits);
    until Bits = 0;

    for Index := 255 downto 0 do
    begin
      Value := Index;

      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;

      CRCDef.Table[Index] := Value;
    end;
  end
  else
  begin
    XORValue := Polynomial and FinalVector;
    ROL(XORValue, Byte(Bits));
    for Index := 255 downto 0 do
    begin
      Value := Index shl 25;

      if Boolean(Index and $80) then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;

      ROR(Value, Byte(Bits));
      CRCDef.Table[Index] := Value;
    end;
  end;

  Result := True;
end;

Es ist aber nahezu ausgeschlossen, dass das fehlerfrei läuft, weil ich über eine Stunde lang im „Blindflug“ daran gearbeitet habe. Da werde ich sicher noch debuggen müssen. Deshalb habe ich auch ein paar Labels usw. vorerst dringelassen, damit man die korrespondierende Stelle im Original schneller findet.

Bin dann mal gespannt auf deinen Unit-Test.

Hab’s jetzt getestet, es funktioniert.