unit Adler32;

{ZLib - Adler32 checksum function}


interface

(*************************************************************************

 DESCRIPTION     :  ZLib - Adler32 checksum function

 REQUIREMENTS    :  TP5-7, D1-D7/D9-D10/D12, FPC, VP

 EXTERNAL DATA   :  ---

 MEMORY USAGE    :  ---

 DISPLAY MODE    :  ---

 REFERENCES      :  RFC 1950 (http://tools.ietf.org/html/rfc1950)


 Version  Date      Author      Modification
 -------  --------  -------     ------------------------------------------
 0.10     30.08.03  W.Ehrhardt  Initial version based on MD5 layout
 2.10     30.08.03  we          Common vers., XL versions for Win32
 2.20     27.09.03  we          FPC/go32v2
 2.30     05.10.03  we          STD.INC, TP5.0
 2.40     10.10.03  we          common version, english comments
 3.00     01.12.03  we          Common version 3.0
 3.01     22.05.05  we          Adler32UpdateXL (i,n: integer)
 3.02     17.12.05  we          Force $I- in Adler32File
 3.03     07.08.06  we          $ifdef BIT32: (const fname: shortstring...)
 3.04     10.02.07  we          Adler32File: no eof, XL and filemode via $ifdef
 3.05     04.07.07  we          BASM16: speed-up factor 15
 3.06     12.11.08  we          uses BTypes, Ptr2Inc and/or Str255
 3.07     25.04.09  we          updated RFC URL(s)
 3.08     19.07.09  we          D12 fix: assign with typecast string(fname)
**************************************************************************)

(*-------------------------------------------------------------------------
 (C) Copyright 2002-2009 Wolfgang Ehrhardt

 This software is provided 'as-is', without any express or implied warranty.
 In no event will the authors be held liable for any damages arising from
 the use of this software.

 Permission is granted to anyone to use this software for any purpose,
 including commercial applications, and to alter it and redistribute it
 freely, subject to the following restrictions:

 1. The origin of this software must not be misrepresented; you must not
    claim that you wrote the original software. If you use this software in
    a product, an acknowledgment in the product documentation would be
    appreciated but is not required.

 2. Altered source versions must be plainly marked as such, and must not be
    misrepresented as being the original software.

 3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)

(*
As per the license above, noting that this implementation of adler32 was stripped of everything we didn't need.
That means no btypes, file loading, and the assembly version disabled.
*)

procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint);

implementation

(*
$ifdef BASM16

procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint);
  //-update Adler32 with Msg data
const
  BASE = 65521; // max. prime < 65536 
  NMAX =  5552; // max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^32
type
  LH    = packed record
            L,H: word;
          end;
var
  s1,s2: longint;
  n: integer;
begin
  s1 := LH(adler).L;
  s2 := LH(adler).H;
  while Len > 0 do begin
    if Len<NMAX then n := Len else n := NMAX;
    //BASM increases speed from about 52 cyc/byte to about 3.7 cyc/byte
    asm
                    mov  cx,[n]
            db $66; mov  ax,word ptr [s1]
            db $66; mov  di,word ptr [s2]
                    les  si,[msg]
      @@1:  db $66, $26, $0f, $b6, $1c      // movzx ebx,es:[si]
                    inc  si
            db $66; add  ax,bx              // inc(s1, pByte(Msg)^)
            db $66; add  di,ax              // inc(s2, s1
                    dec  cx
                    jnz  @@1
            db $66; sub  cx,cx
                    mov  cx,BASE
            db $66; sub  dx,dx
            db $66; div  cx
            db $66; mov  word ptr [s1],dx   // s1 := s1 mod BASE
            db $66; sub  dx,dx
            db $66; mov  ax,di
            db $66; div  cx
            db $66; mov  word ptr [s2],dx   // s2 := s2 mod BASE
                    mov  word ptr [msg],si  // save offset for next chunk
    end;
    dec(len, n);
  end;
  LH(adler).L := word(s1);
  LH(adler).H := word(s2);
end;
*)

procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint);
  {-update Adler32 with Msg data}
const
  BASE = 65521; {max. prime < 65536 }
  NMAX =  3854; {max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^31}
type
  LH    = packed record
            L,H: word;
          end;
var
  s1,s2: longint;
  i,n: integer;
begin
  s1 := LH(adler).L;
  s2 := LH(adler).H;
  while Len > 0 do begin
    if Len<NMAX then n := Len else n := NMAX;
    for i:=1 to n do begin
      inc(s1, pByte(Msg)^);
      inc(Msg);
      inc(s2, s1);
    end;
    s1 := s1 mod BASE;
    s2 := s2 mod BASE;
    dec(len, n);
  end;
  LH(adler).L := word(s1);
  LH(adler).H := word(s2);
end;

end.