* Version upgrade to final version from 7 april 2000

git-svn-id: trunk@1839 -

.gitattributes

@@ -1679,6 +1679,7 @@ packages/base/paszlib/Makefile svneol=native#text/plain
 packages/base/paszlib/Makefile.fpc svneol=native#text/plain
 packages/base/paszlib/adler.pas svneol=native#text/plain
 packages/base/paszlib/changes.txt svneol=native#text/plain
+packages/base/paszlib/crc.pas -text
 packages/base/paszlib/example.pas svneol=native#text/plain
 packages/base/paszlib/fpmake.inc svneol=native#text/plain
 packages/base/paszlib/fpmake.pp svneol=native#text/plain

packages/base/paszlib/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/11/20]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/15]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
@@ -277,9 +277,6 @@ endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
 endif
-ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
-endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
 endif
@@ -331,18 +328,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
 endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
-endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
 endif
-ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=paszlib adler gzcrc gzio infblock infcodes inffast inftrees infutil trees zcompres zdeflate zinflate zbase zuncompr zutil
-endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLES+=example minigzip
 endif
@@ -388,9 +376,6 @@ endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 override TARGET_EXAMPLES+=example minigzip
 endif
-ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_EXAMPLES+=example minigzip
-endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_EXAMPLES+=example minigzip
 endif
@@ -442,18 +427,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_EXAMPLES+=example minigzip
 endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_EXAMPLES+=example minigzip
-endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_EXAMPLES+=example minigzip
 endif
-ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_EXAMPLES+=example minigzip
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_EXAMPLES+=example minigzip
-endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
@@ -1229,9 +1205,6 @@ endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),i386-wince)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1283,18 +1256,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),arm-wince)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -1365,12 +1329,12 @@ ifeq ($(CPU_TARGET),i386)
 FPCCPUOPT:=-OG2p3
 else
 ifeq ($(CPU_TARGET),powerpc)
-FPCCPUOPT:=-O1r
+FPCCPUOPT:=-O1
 else
 FPCCPUOPT:=
 endif
 endif
-override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
 override FPCOPTDEF+=RELEASE
 endif
 ifdef STRIP
@@ -1442,14 +1406,6 @@ override FPCEXTCMD:=$(FPCOPT)
 override FPCOPT:=!FPCEXTCMD
 export FPCEXTCMD
 endif
-override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
-override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
-ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
-override ACROSSCOMPILE=1
-endif
-ifdef ACROSSCOMPILE
-override FPCOPT+=$(CROSSOPT)
-endif
 override COMPILER:=$(FPC) $(FPCOPT)
 ifeq (,$(findstring -s ,$(COMPILER)))
 EXECPPAS=

packages/base/paszlib/adler.pas

@@ -40,7 +40,7 @@ function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
 implementation
 
 const
-  BASE = Long(65521); { largest prime smaller than 65536 }
+  BASE = uLong(65521); { largest prime smaller than 65536 }
   {NMAX = 5552; original code with unsigned 32 bit integer }
   { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 }
   NMAX = 3854;        { code with signed 32 bit integer }
@@ -111,3 +111,4 @@ end;
 #define DO16(buf)   DO8(buf,0); DO8(buf,8);
 }
 end.
+

packages/base/paszlib/crc.pas

@@ -0,0 +1,237 @@
+Unit Crc;
+
+{
+  crc32.c -- compute the CRC-32 of a data stream
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I zconf.inc}
+
+uses
+  zutil, zbase;
+
+
+function crc32(crc : uLong; buf : pBytef; len : uInt) : uLong;
+
+{  Update a running crc with the bytes buf[0..len-1] and return the updated
+   crc. If buf is NULL, this function returns the required initial value
+   for the crc. Pre- and post-conditioning (one's complement) is performed
+   within this function so it shouldn't be done by the application.
+   Usage example:
+
+    var
+      crc : uLong;
+    begin
+      crc := crc32(0, Z_NULL, 0);
+
+      while (read_buffer(buffer, length) <> EOF) do
+        crc := crc32(crc, buffer, length);
+
+      if (crc <> original_crc) then error();
+    end;
+
+}
+
+function get_crc_table : puLong;  { can be used by asm versions of crc32() }
+
+
+implementation
+
+{$IFDEF DYNAMIC_CRC_TABLE}
+
+{local}
+const
+  crc_table_empty : boolean = TRUE;
+{local}
+var
+  crc_table : array[0..256-1] of uLongf;
+
+
+{
+  Generate a table for a byte-wise 32-bit CRC calculation on the polynomial:
+  x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.
+
+  Polynomials over GF(2) are represented in binary, one bit per coefficient,
+  with the lowest powers in the most significant bit.  Then adding polynomials
+  is just exclusive-or, and multiplying a polynomial by x is a right shift by
+  one.  If we call the above polynomial p, and represent a byte as the
+  polynomial q, also with the lowest power in the most significant bit (so the
+  byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
+  where a mod b means the remainder after dividing a by b.
+
+  This calculation is done using the shift-register method of multiplying and
+  taking the remainder.  The register is initialized to zero, and for each
+  incoming bit, x^32 is added mod p to the register if the bit is a one (where
+  x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
+  x (which is shifting right by one and adding x^32 mod p if the bit shifted
+  out is a one).  We start with the highest power (least significant bit) of
+  q and repeat for all eight bits of q.
+
+  The table is simply the CRC of all possible eight bit values.  This is all
+  the information needed to generate CRC's on data a byte at a time for all
+  combinations of CRC register values and incoming bytes.
+}
+{local}
+procedure make_crc_table;
+var
+ c    : uLong;
+ n,k  : int;
+ poly : uLong; { polynomial exclusive-or pattern }
+
+const
+ { terms of polynomial defining this crc (except x^32): }
+ p: array [0..13] of Byte = (0,1,2,4,5,7,8,10,11,12,16,22,23,26);
+
+begin
+  { make exclusive-or pattern from polynomial ($EDB88320) }
+  poly := Long(0);
+  for n := 0 to (sizeof(p) div sizeof(Byte))-1 do
+    poly := poly or (Long(1) shl (31 - p[n]));
+
+  for n := 0 to 255 do
+  begin
+    c := uLong(n);
+    for k := 0 to 7 do
+    begin
+      if (c and 1) <> 0 then
+        c := poly xor (c shr 1)
+      else
+        c := (c shr 1);
+    end;
+    crc_table[n] := c;
+  end;
+  crc_table_empty := FALSE;
+end;
+
+{$ELSE}
+
+{ ========================================================================
+  Table of CRC-32's of all single-byte values (made by make_crc_table) }
+
+{local}
+const
+  crc_table : array[0..256-1] of uLongf = (
+  $00000000, $77073096, $ee0e612c, $990951ba, $076dc419,
+  $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
+  $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07,
+  $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de,
+  $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856,
+  $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
+  $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,
+  $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
+  $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3,
+  $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a,
+  $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599,
+  $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
+  $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190,
+  $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,
+  $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e,
+  $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
+  $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed,
+  $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
+  $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3,
+  $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,
+  $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,
+  $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5,
+  $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010,
+  $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
+  $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17,
+  $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6,
+  $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615,
+  $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
+  $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344,
+  $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
+  $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a,
+  $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
+  $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1,
+  $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c,
+  $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,
+  $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
+  $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe,
+  $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31,
+  $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c,
+  $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
+  $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b,
+  $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
+  $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1,
+  $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c,
+  $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278,
+  $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7,
+  $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66,
+  $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
+  $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,
+  $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8,
+  $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,
+  $2d02ef8d);
+
+{$ENDIF}
+
+{ =========================================================================
+  This function can be used by asm versions of crc32() }
+
+function get_crc_table : {const} puLong;
+begin
+{$ifdef DYNAMIC_CRC_TABLE}
+  if (crc_table_empty) then
+    make_crc_table;
+{$endif}
+  get_crc_table :=  {const} puLong(@crc_table);
+end;
+
+{ ========================================================================= }
+
+function crc32 (crc : uLong; buf : pBytef; len : uInt): uLong;
+begin
+  if (buf = Z_NULL) then
+    crc32 := Long(0)
+  else
+  begin
+
+{$IFDEF DYNAMIC_CRC_TABLE}
+    if crc_table_empty then
+      make_crc_table;
+{$ENDIF}
+
+    crc := crc xor uLong($ffffffff);
+    while (len >= 8) do
+    begin
+      {DO8(buf)}
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+
+      Dec(len, 8);
+    end;
+    if (len <> 0) then
+    repeat
+      {DO1(buf)}
+      crc := crc_table[(int(crc) xor buf^) and $ff] xor (crc shr 8);
+      inc(buf);
+
+      Dec(len);
+    until (len = 0);
+    crc32 := crc xor uLong($ffffffff);
+  end;
+end;
+
+
+end.

packages/base/paszlib/example.pas

@@ -8,9 +8,7 @@ program example;
   For conditions of distribution and use, see copyright notice in readme.txt
 }
 {-$define MemCheck}
-{$IFNDEF FPC}
-  {$DEFINE TEST_COMPRESS}
-{$ENDIF}
+{$DEFINE TEST_COMPRESS}
 {$DEFINE TEST_GZIO}
 {$DEFINE TEST_INFLATE}
 {$DEFINE TEST_DEFLATE}
@@ -22,7 +20,9 @@ uses
 {$ifdef ver80}
  WinCrt,
 {$endif}
+{$ifdef you may have to define this in Delphi < 5}
   strings,
+{$endif}
 {$ifndef MSDOS}
   SysUtils,
 {$endif}
@@ -548,10 +548,10 @@ begin
       if (d_stream.adler <> dictId) then
       begin
         WriteLn('unexpected dictionary');
-        Stop;
+	Stop;
       end;
       err := inflateSetDictionary(d_stream, pBytef(dictionary),
-                                     StrLen(dictionary));
+				     StrLen(dictionary));
     end;
     CHECK_ERR(err, 'inflate with dict');
   end;

packages/base/paszlib/gzio.pas

@@ -1,4 +1,4 @@
-Unit gzIO;
+unit gzio;
 
 {
   Pascal unit based on gzio.c -- IO on .gz files
@@ -19,15 +19,14 @@ uses
   {$ifdef MSDOS}
   dos, strings,
   {$else}
-  SysUtils,
+  sysutils,
   {$endif}
-  zutil, zbase, gzcrc, zdeflate, zinflate;
+  zutil, zbase, crc, zdeflate, zinflate;
 
 type gzFile = voidp;
 type z_off_t = long;
 
-function gzopen  (path:ansistring; mode:string) : gzFile;
-function gzsetparams (f:gzfile; level:int; strategy:int) : int;
+function gzopen  (path:string; mode:string) : gzFile;
 function gzread  (f:gzFile; buf:voidp; len:uInt) : int;
 function gzgetc  (f:gzfile) : int;
 function gzgets  (f:gzfile; buf:PChar; len:int) : PChar;
@@ -44,12 +43,13 @@ function gzflush (f:gzFile; flush:int)           : int;
   {$endif}
 {$endif}
 
-function gzseek   (f:gzfile; offset:z_off_t; whence:int) : z_off_t;
+function gzseek  (f:gzfile; offset:z_off_t; whence:int) : z_off_t;
+function gztell  (f:gzfile) : z_off_t;
+function gzclose (f:gzFile)                      : int;
+function gzerror (f:gzFile; var errnum:Int)      : string;
+function gzsetparams (f:gzfile; level:int; strategy:int) : int;
 function gzrewind (f:gzFile) : int;
-function gztell   (f:gzfile) : z_off_t;
-function gzeof    (f:gzfile) : boolean;
-function gzclose  (f:gzFile)                      : int;
-function gzerror  (f:gzFile; var errnum:Int)      : string;
+function gzeof (f:gzfile) : boolean;
 
 const
   SEEK_SET {: z_off_t} = 0; { seek from beginning of file }
@@ -84,7 +84,7 @@ type gz_stream = record
   outbuf      : pBytef;   { output buffer }
   crc         : uLong;    { crc32 of uncompressed data }
   msg,                    { error message - limit 79 chars }
-  path        : ansistring;   { path name for debugging only - limit 79 chars }
+  path        : string[79];   { path name for debugging only - limit 79 chars }
   transparent : boolean;  { true if input file is not a .gz file }
   mode        : char;     { 'w' or 'r' }
   startpos    : long;     { start of compressed data in file (header skipped) }
@@ -115,7 +115,7 @@ procedure check_header(s:gz_streamp); forward;
 
 ============================================================================}
 
-function gzopen (path:ansistring; mode:string) : gzFile;
+function gzopen (path:string; mode:string) : gzFile;
 
 var
 
@@ -126,7 +126,7 @@ var
   s        : gz_streamp;
 {$IFDEF MSDOS}
   attr     : word;       { file attributes }
-{$ENDIF}
+{$ENDIF}  
 
 {$IFNDEF NO_DEFLATE}
   gzheader : array [0..9] of byte;
@@ -225,7 +225,7 @@ begin
     Reset (s^.gzfile,1);
   {$else}
   if (not FileExists(s^.path)) and (s^.mode='w') then
-    ReWrite (s^.gzfile,1)
+    ReWrite (s^.gzfile,1)  
   else
     Reset (s^.gzfile,1);
   {$endif}
@@ -314,7 +314,7 @@ begin
 
   if (s^.stream.avail_in = 0) then begin
     {$I-}
-    blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, Int(s^.stream.avail_in));
+    blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
     {$I+}
     if (s^.stream.avail_in = 0) then begin
       s^.z_eof := true;
@@ -410,7 +410,7 @@ begin
       if (c <> Z_EOF) then begin
         Inc(s^.stream.avail_in);
         Dec(s^.stream.next_in);
-        s^.transparent := TRUE;
+	s^.transparent := TRUE;
       end;
       if (s^.stream.avail_in <> 0) then s^.z_err := Z_OK
       else s^.z_err := Z_STREAM_END;
@@ -583,13 +583,13 @@ begin
 
     if (s^.stream.avail_in = 0) and (s^.z_eof = false) then begin
       {$I-}
-      blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, Int(s^.stream.avail_in));
+      blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
       {$I+}
       if (s^.stream.avail_in = 0) then begin
         s^.z_eof := true;
-        if (IOResult <> 0) then begin
-          s^.z_err := Z_ERRNO;
-          break;
+	if (IOResult <> 0) then begin
+	  s^.z_err := Z_ERRNO;
+	  break;
         end;
       end;
       s^.stream.next_in := s^.inbuf;
@@ -613,18 +613,18 @@ begin
 
       if (s^.crc <> filecrc) or (s^.stream.total_out <> filelen)
         then s^.z_err := Z_DATA_ERROR
-        else begin
-          { Check for concatenated .gz files: }
-          check_header(s);
-          if (s^.z_err = Z_OK) then begin
+	else begin
+	  { Check for concatenated .gz files: }
+	  check_header(s);
+	  if (s^.z_err = Z_OK) then begin
             total_in := s^.stream.total_in;
             total_out := s^.stream.total_out;
 
-            inflateReset (s^.stream);
-            s^.stream.total_in := total_in;
-            s^.stream.total_out := total_out;
-            s^.crc := crc32 (0, Z_NULL, 0);
-          end;
+	    inflateReset (s^.stream);
+	    s^.stream.total_in := total_in;
+	    s^.stream.total_out := total_out;
+	    s^.crc := crc32 (0, Z_NULL, 0);
+	  end;
       end; {IF-THEN-ELSE}
     end;
 
@@ -771,10 +771,10 @@ var
 begin
 {$ifdef HAS_snprintf}
     snprintf(buf, sizeof(buf), format, a1, a2, a3, a4, a5, a6, a7, a8,
-             a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+	     a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
 {$else}
     sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8,
-            a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+	    a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
 {$endif}
     len := strlen(buf); { old sprintf doesn't return the nb of bytes written }
     if (len <= 0) return 0;
@@ -1189,4 +1189,4 @@ begin
   gzerror := s^.msg;
 end;
 
-end.
+end.

packages/base/paszlib/infblock.pas

@@ -1,4 +1,4 @@
-Unit InfBlock;
+unit infblock;
 
 { infblock.h and
   infblock.c -- interpret and process block types to last block
@@ -10,14 +10,11 @@ Unit InfBlock;
 }
 
 interface
-{$ifdef fpc}
-{$goto on}
-{$endif}
 
 {$I zconf.inc}
 
 uses
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}
   strutils,
   {$ENDIF}
   zutil, zbase;
@@ -122,7 +119,7 @@ begin
     s.check := s.checkfn(uLong(0), pBytef(NIL), 0);
     z.adler := s.check;
   end;
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}
   Tracev('inflate:   blocks reset');
   {$ENDIF}
 end;
@@ -162,7 +159,7 @@ begin
   Inc(s^.zend, w);
   s^.checkfn := c;
   s^.mode := ZTYPE;
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}  
   Tracev('inflate:   blocks allocated');
   {$ENDIF}
   inflate_blocks_reset(s^, z, Z_NULL);
@@ -244,7 +241,7 @@ begin
         case (t shr 1) of
           0:                         { stored }
             begin
-              {$IFDEF STRUTILS_DEBUG}
+              {$IFDEF DEBUG}
               if s.last then
                 Tracev('inflate:     stored block (last)')
               else
@@ -264,7 +261,7 @@ begin
           1:                         { fixed }
             begin
               begin
-                {$IFDEF STRUTILS_DEBUG}
+                {$IFDEF DEBUG}
                 if s.last then
                   Tracev('inflate:     fixed codes blocks (last)')
                 else
@@ -294,12 +291,12 @@ begin
             end;
           2:                         { dynamic }
             begin
-              {$IFDEF STRUTILS_DEBUG}
+              {$IFDEF DEBUG}
               if s.last then
                 Tracev('inflate:     dynamic codes block (last)')
               else
                 Tracev('inflate:     dynamic codes block');
-              {$ENDIF}
+              {$ENDIF}                
               {DUMPBITS(3);}
               b := b shr 3;
               Dec(k, 3);
@@ -371,7 +368,7 @@ begin
         s.sub.left := uInt(b) and $ffff;
         k := 0;
         b := 0;                      { dump bits }
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Tracev('inflate:       stored length '+IntToStr(s.sub.left));
         {$ENDIF}
         if s.sub.left <> 0 then
@@ -457,7 +454,7 @@ begin
         Dec(s.sub.left, t);
         if (s.sub.left = 0) then
         begin
-          {$IFDEF STRUTILS_DEBUG}
+          {$IFDEF DEBUG}
           if (ptr2int(q) >= ptr2int(s.read)) then
             Tracev('inflate:       stored end '+
                 IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out')
@@ -537,7 +534,7 @@ begin
         Dec(k, 14);
 
         s.sub.trees.index := 0;
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Tracev('inflate:       table sizes ok');
         {$ENDIF}
         s.mode := BTREE;
@@ -605,7 +602,7 @@ begin
           exit;
         end;
         s.sub.trees.index := 0;
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Tracev('inflate:       bits tree ok');
         {$ENDIF}
         s.mode := DTREE;
@@ -760,9 +757,9 @@ begin
             inflate_blocks := inflate_flush(s,z,r);
             exit;
           end;
-          {$IFDEF STRUTILS_DEBUG}
+          {$IFDEF DEBUG}
           Tracev('inflate:       trees ok');
-          {$ENDIF}
+          {$ENDIF}          
           { c renamed to cs }
           cs := inflate_codes_new(bl, bd, tl, td, z);
           if (cs = Z_NULL) then
@@ -813,7 +810,7 @@ begin
           m := uInt(ptr2int(s.read)-ptr2int(q)-1)
         else
           m := uInt(ptr2int(s.zend)-ptr2int(q));
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         if (ptr2int(q) >= ptr2int(s.read)) then
           Tracev('inflate:       codes end '+
               IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out')
@@ -830,7 +827,7 @@ begin
         {$ifndef patch112}
         if (k > 7) then           { return unused byte, if any }
         begin
-          {$IFDEF STRUTILS_DEBUG}
+          {$IFDEF DEBUG}
           Assert(k < 16, 'inflate_codes grabbed too many bytes');
           {$ENDIF}
           Dec(k, 8);
@@ -924,9 +921,9 @@ begin
   ZFREE(z, s^.window);
   ZFREE(z, s^.hufts);
   ZFREE(z, s);
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}
   Trace('inflate:   blocks freed');
-  {$ENDIF}
+  {$ENDIF}  
   inflate_blocks_free := Z_OK;
 end;
 
@@ -951,4 +948,4 @@ begin
   inflate_blocks_sync_point := int(s.mode = LENS);
 end;
 
-end.
+end.

packages/base/paszlib/infcodes.pas

@@ -13,7 +13,7 @@ interface
 {$I zconf.inc}
 
 uses
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}
   strutils,
   {$ENDIF}
   zutil, zbase;
@@ -53,7 +53,7 @@ begin
     c^.dbits := Byte(bd);
     c^.ltree := tl;
     c^.dtree := td;
-    {$IFDEF STRUTILS_DEBUG}
+    {$IFDEF DEBUG}
     Tracev('inflate:       codes new');
     {$ENDIF}
   end;
@@ -170,12 +170,12 @@ begin
       if (e = 0) then            { literal }
       begin
         c^.sub.lit := t^.base;
-       {$IFDEF STRUTILS_DEBUG}
+       {$IFDEF DEBUG}
         if (t^.base >= $20) and (t^.base < $7f) then
           Tracevv('inflate:         literal '+char(t^.base))
         else
           Tracevv('inflate:         literal '+IntToStr(t^.base));
-        {$ENDIF}
+        {$ENDIF}          
         c^.mode := LIT;
         continue;  { break switch statement }
       end;
@@ -194,9 +194,9 @@ begin
       end;
       if (e and 32 <> 0) then            { end of block }
       begin
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Tracevv('inflate:         end of block');
-        {$ENDIF}
+        {$ENDIF}        
         c^.mode := WASH;
         continue;         { break C-switch statement }
       end;
@@ -246,7 +246,7 @@ begin
 
       c^.sub.code.need := c^.dbits;
       c^.sub.code.tree := c^.dtree;
-      {$IFDEF STRUTILS_DEBUG}
+      {$IFDEF DEBUG}
       Tracevv('inflate:         length '+IntToStr(c^.len));
       {$ENDIF}
       c^.mode := DIST;
@@ -340,7 +340,7 @@ begin
       {DUMPBITS(j);}
       b := b shr j;
       Dec(k, j);
-      {$IFDEF STRUTILS_DEBUG}
+      {$IFDEF DEBUG}
       Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
       {$ENDIF}
       c^.mode := COPY;
@@ -486,7 +486,7 @@ begin
       {$ifdef patch112}
       if (k > 7) then           { return unused byte, if any }
       begin
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Assert(k < 16, 'inflate_codes grabbed too many bytes');
         {$ENDIF}
         Dec(k, 8);
@@ -568,9 +568,9 @@ procedure inflate_codes_free(c : pInflate_codes_state;
                              var z : z_stream);
 begin
   ZFREE(z, c);
-  {$IFDEF STRUTILS_DEBUG}
+  {$IFDEF DEBUG}  
   Tracev('inflate:       codes free');
   {$ENDIF}
 end;
 
-end.
+end.

packages/base/paszlib/inffast.pas

@@ -16,7 +16,7 @@ interface
 {$I zconf.inc}
 
 uses
-  {$ifdef STRUTILS_DEBUG}
+  {$ifdef DEBUG}
   strutils,
   {$ENDIF}
   zutil, zbase;
@@ -97,7 +97,7 @@ begin
       {DUMPBITS(t^.bits);}
       b := b shr t^.bits;
       Dec(k, t^.bits);
-     {$IFDEF STRUTILS_DEBUG}
+     {$IFDEF DEBUG}
       if (t^.base >= $20) and (t^.base < $7f) then
         Tracevv('inflate:         * literal '+char(t^.base))
       else
@@ -121,7 +121,7 @@ begin
         {DUMPBITS(e);}
         b := b shr e;
         Dec(k, e);
-        {$IFDEF STRUTILS_DEBUG}
+        {$IFDEF DEBUG}
         Tracevv('inflate:         * length ' + IntToStr(c));
         {$ENDIF}
         { decode distance base of block to copy }
@@ -159,7 +159,7 @@ begin
             b := b shr e;
             Dec(k, e);
 
-            {$IFDEF STRUTILS_DEBUG}
+            {$IFDEF DEBUG}
             Tracevv('inflate:         * distance '+IntToStr(d));
             {$ENDIF}
             { do the copy }
@@ -239,12 +239,12 @@ begin
           b := b shr t^.bits;
           Dec(k, t^.bits);
 
-         {$IFDEF STRUTILS_DEBUG}
+         {$IFDEF DEBUG}
           if (t^.base >= $20) and (t^.base < $7f) then
             Tracevv('inflate:         * literal '+char(t^.base))
           else
             Tracevv('inflate:         * literal '+IntToStr(t^.base));
-          {$ENDIF}
+          {$ENDIF}            
           q^ := Byte(t^.base);
           Inc(q);
           Dec(m);
@@ -254,7 +254,7 @@ begin
       else
         if (e and 32 <> 0) then
         begin
-          {$IFDEF STRUTILS_DEBUG}
+          {$IFDEF DEBUG}
           Tracevv('inflate:         * end of block');
           {$ENDIF}
           {UNGRAB}
@@ -315,4 +315,4 @@ begin
   inflate_fast := Z_OK;
 end;
 
-end.
+end.

packages/base/paszlib/inftrees.pas

@@ -13,7 +13,7 @@ Unit InfTrees;
   For conditions of distribution and use, see copyright notice in readme.txt
 }
 
-interface
+Interface
 
 {$I zconf.inc}
 
@@ -56,8 +56,8 @@ var z : z_stream                  { for messages }
      ) : int;
 
 function inflate_trees_fixed (
-    var bl : uIntf;               { literal desired/actual bit depth }
-    var bd : uIntf;               { distance desired/actual bit depth }
+    var bl : uInt;                { literal desired/actual bit depth }
+    var bd : uInt;                { distance desired/actual bit depth }
     var tl : pInflate_huft;       { literal/length tree result }
     var td : pInflate_huft;       { distance tree result }
     var z : z_stream              { for memory allocation }
@@ -165,7 +165,7 @@ Var
   i : uInt;  {register}         { counter, current code }
   j : uInt;  {register}         { counter }
   k : Int;   {register}         { number of bits in current code }
-  l : int;                      { bits per table (returned in m) }
+  l : int;			{ bits per table (returned in m) }
   mask : uInt;                  { (1 shl w) - 1, to avoid cc -O bug on HP }
   p : ^uIntf; {register}        { pointer into c[], b[], or v[] }
   q : pInflate_huft;            { points to current table }
@@ -708,8 +708,8 @@ const
 {$ENDIF}
 
 function inflate_trees_fixed(
-var bl : uIntf;              { literal desired/actual bit depth }
-var bd : uIntf;              { distance desired/actual bit depth }
+var bl : uInt;               { literal desired/actual bit depth }
+var bd : uInt;               { distance desired/actual bit depth }
 var tl : pInflate_huft;      { literal/length tree result }
 var td : pInflate_huft;      { distance tree result }
 var  z : z_stream            { for memory allocation }
@@ -777,4 +777,4 @@ begin
 end; { inflate_trees_fixed }
 
 
-end.
+end.

packages/base/paszlib/minigzip.pas

@@ -248,4 +248,4 @@ begin
   if (uncompr = true)
     then file_uncompress (ParamStr(ParamCount))
     else file_compress (ParamStr(ParamCount), outmode);
-end.
+end.

packages/base/paszlib/paszlib.pas

@@ -97,10 +97,10 @@ function gzclose(thefile:gzFile):longint;
 function gzerror(thefile:gzFile; var errnum:longint):string;
 function adler32(theadler:uLong;buf : pchar; len:uInt):uLong;
 function crc32(thecrc:uLong;buf : pchar; len:uInt):uLong;
-function deflateInit_(var strm:TZStream; level:longint; version:pchar; stream_size:longint):longint;
+{function deflateInit_(var strm:TZStream; level:longint; version:pchar; stream_size:longint):longint;
 function inflateInit_(var strm:TZStream; version:pchar; stream_size:longint):longint;
 function deflateInit2_(var strm:TZStream; level:longint; method:longint; windowBits:longint; memLevel:longint;strategy:longint; version:pchar; stream_size:longint):longint;
-function inflateInit2_(var strm:TZStream; windowBits:longint; version:pchar; stream_size:longint):longint;
+function inflateInit2_(var strm:TZStream; windowBits:longint; version:pchar; stream_size:longint):longint;}
 function deflateInit(var strm:TZStream;level : longint) : longint;
 function inflateInit(var strm:TZStream) : longint;
 function deflateInit2(var strm:TZStream;level,method,windowBits,memLevel,strategy : longint) : longint;
@@ -175,18 +175,30 @@ begin
 end;
 
 function compress(dest:pchar;var destLen:uLongf; source : pchar; sourceLen:uLong):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
 begin
-  compress:=zcompres.compress(pbytef(dest),destlen,pbytef(source),sourcelen);
+  compress:=zcompres.compress(pbytef(dest),destlen,Pbytearray(source)^,sourcelen);
 end;
 
 function compress2(dest:pchar;var destLen:uLongf; source : pchar; sourceLen:uLong; level:longint):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
 begin
-  compress2:=zcompres.compress2(pbytef(dest),destlen,pbytef(source),sourcelen,level);
+  compress2:=zcompres.compress2(pbytef(dest),destlen,Pbytearray(source)^,sourcelen,level);
 end;
 
 function uncompress(dest:pchar;var destLen:uLongf; source : pchar; sourceLen:uLong):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
 begin
-  uncompress:=zuncompr.uncompress(pbytef(dest),destlen,pbytef(source),sourcelen);
+  uncompress:=zuncompr.uncompress(pbytef(dest),destlen,Pbytearray(source)^,sourcelen);
 end;
 
 function gzopen(path:pchar; mode:pchar):gzFile;
@@ -273,7 +285,7 @@ function crc32(thecrc:uLong;buf : pchar; len:uInt):uLong;
 begin
   crc32:=gzcrc.crc32(thecrc,pbytef(buf),len);
 end;
-
+{
 function deflateInit_(var strm:TZStream; level:longint; version:pchar; stream_size:longint):longint;
 begin
   deflateInit_:=zdeflate.deflateInit_(@strm,level,version,stream_size);
@@ -293,7 +305,7 @@ function inflateInit2_(var strm:TZStream; windowBits:longint; version:pchar; str
 begin
   inflateInit2_:=zinflate.inflateInit2_(strm,windowBits,version,stream_size);
 end;
-
+}
 function deflateInit(var strm:TZStream;level : longint) : longint;
 begin
   deflateInit:=zdeflate.deflateInit(strm,level);

packages/base/paszlib/readme.txt

@@ -4,7 +4,7 @@ PASZLIB 1.0                                                   May 11th, 1998
 
 Based on the zlib 1.1.2, a general purpose data compression library.
 
-Copyright (C) 1998 by NOMSSI NZALI Jacques H. C. 
+Copyright (C) 1998,1999,2000 by NOMSSI NZALI Jacques H. C. 
 [kn&n DES]         See "Legal issues" for conditions of distribution and use.
 _____________________________________________________________________________
 
@@ -31,17 +31,23 @@ plus a few kilobytes for small objects.
 Change Log
 ==========
 
-May 7th 1999   - Some changes for FPC
-                 deflateCopy() has new parameters
-                 trees.pas - record constant definition
-June 17th 1998 - Applied official 1.1.2 patch. 
-		 Memcheck turned off by default.
-                 zutil.pas patch for Delphi 1 memory allocation corrected.
-                 dzlib.txt file added.
-                 compress2() is now exported
-
-June 25th 1998 - fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was
-                 missing in line 574;
+March 24th 2000 - minizip code by Gilles Vollant ported to Pascal. 
+                  z_stream.msg defined as string[255] to avoid problems
+                  with Delphi 2+ dynamic string handling.
+                  changes to silence Delphi 5 compiler warning. If you
+                  have Delphi 5, defines Delphi5 in zconf.inc
+                              
+May 7th 1999    - Some changes for FPC
+                  deflateCopy() has new parameters
+                  trees.pas - record constant definition
+June 17th 1998  - Applied official 1.1.2 patch. 
+	          Memcheck turned off by default.
+                  zutil.pas patch for Delphi 1 memory allocation corrected.
+                  dzlib.txt file added.
+                  compress2() is now exported
+
+June 25th 1998 -  fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was
+                  missing in line 574;
 
 File list
 =========
@@ -65,7 +71,6 @@ infcodes.pas   process literals and length/distance pairs
 inffast.pas    process literals and length/distance pairs fast
 inftrees.pas   generate Huffman trees for efficient decoding
 infutil.pas    types and macros common to blocks and codes
-minigzip.pas   simulate gzip using the zlib compression library
 strutils.pas   string utilities
 trees.pas      output deflated data using Huffman coding
 zcompres.pas   compress a memory buffer
@@ -75,15 +80,21 @@ zlib.pas       zlib data structures. read the comments there!
 zuncompr.pas   decompress a memory buffer
 zutil.pas
 
+minizip/ziputils.pas data structure and IO on .zip file 
+minizip/unzip.pas  
+minizip/zip.pas
+      
 Test applications
 
 example.pas    usage example of the zlib compression library
 minigzip.pas   simulate gzip using the zlib compression library
+minizip/miniunz.pas  simulates unzip using the zlib compression library
+minizip/minizip.pas  simulates zip using the zlib compression library
 
 Legal issues
 ============
 
-Copyright (C) 1998 by Jacques Nomssi Nzali
+Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali
 
   This software is provided 'as-is', without any express or implied
   warranty.  In no event will the author be held liable for any damages
@@ -114,5 +125,5 @@ Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
 (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
 These documents are also available in other formats from
 ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html.
-_____________________________________________________________________________
-Jacques Nomssi Nzali <mailto:[email protected]> May 7th, 1999
+____________________________________________________________________________
+Jacques Nomssi Nzali <mailto:[email protected]> March 24th, 2000

packages/base/paszlib/trees.pas

@@ -42,6 +42,9 @@ interface
 {$I zconf.inc}
 
 uses
+  {$ifdef DEBUG}
+  strutils,
+  {$ENDIF}
   zutil, zbase;
 
 { ===========================================================================
@@ -102,7 +105,7 @@ type
   dtree_type = array[0..2*D_CODES+1-1] of ct_data;  { distance tree }
   htree_type = array[0..2*BL_CODES+1-1] of ct_data;  { Huffman tree for bit lengths }
   { generic tree type }
-  tree_type = array[0..(MaxInt div SizeOf(ct_data))-1] of ct_data;
+  tree_type = array[0..(MaxMemBlock div SizeOf(ct_data))-1] of ct_data;
 
   tree_ptr = ^tree_type;
   ltree_ptr = ^ltree_type;
@@ -135,7 +138,7 @@ type
 
   pPosf = ^Posf;
 
-  zPosfArray = array[0..(MaxInt div SizeOf(Posf))-1] of Posf;
+  zPosfArray = array[0..(MaxMemBlock div SizeOf(Posf))-1] of Posf;
   pzPosfArray = ^zPosfArray;
 
 { A Pos is an index in the character window. We use short instead of int to
@@ -316,7 +319,7 @@ function _tr_tally (var s : deflate_state;
 function _tr_flush_block (var s : deflate_state;
                           buf : pcharf;
                           stored_len : ulg;
-                          eof : boolean) : ulg;
+			  eof : boolean) : ulg;
 
 procedure _tr_align(var s : deflate_state);
 
@@ -505,7 +508,7 @@ const
 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
 );
 
-
+  
 { First normalized length for each code (0 = MIN_MATCH) }
   base_length : array[0..LENGTH_CODES-1] of int = (
 0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
@@ -768,17 +771,6 @@ begin
 end
 *)
 
-{$ifdef DEBUG}
-Function IntToStr(value : LongInt) : string;
-{ Convert any integer type to a string }
-var
-  s : string[20];
-begin
-  Str(value:0, s);
-  IntToStr := S;
-end;
-{$endif}
-
 { ===========================================================================
   Send a value on a given number of bits.
   IN assertion: length <= 16 and value fits in length bits. }
@@ -964,42 +956,42 @@ begin
   for i := 0 to L_CODES+2-1 do
   begin
     WriteLn(header, '((%3u),(%3u))%s', static_ltree[i].Code,
-                static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
+		static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
   end;
 
   WriteLn(header, 'local const ct_data static_dtree[D_CODES] := (');
   for i := 0 to D_CODES-1 do
   begin
     WriteLn(header, '((%2u),(%2u))%s', static_dtree[i].Code,
-                static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
+		static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
   end;
 
   WriteLn(header, 'const uch _dist_code[DIST_CODE_LEN] := (');
   for i := 0 to DIST_CODE_LEN-1 do
   begin
     WriteLn(header, '%2u%s', _dist_code[i],
-                SEPARATOR(i, DIST_CODE_LEN-1, 20));
+		SEPARATOR(i, DIST_CODE_LEN-1, 20));
   end;
 
   WriteLn(header, 'const uch _length_code[MAX_MATCH-MIN_MATCH+1]= (');
   for i := 0 to MAX_MATCH-MIN_MATCH+1-1 do
   begin
     WriteLn(header, '%2u%s', _length_code[i],
-                SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
+		SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
   end;
 
   WriteLn(header, 'local const int base_length[LENGTH_CODES] := (');
   for i := 0 to LENGTH_CODES-1 do
   begin
     WriteLn(header, '%1u%s', base_length[i],
-                SEPARATOR(i, LENGTH_CODES-1, 20));
+		SEPARATOR(i, LENGTH_CODES-1, 20));
   end;
 
   WriteLn(header, 'local const int base_dist[D_CODES] := (');
   for i := 0 to D_CODES-1 do
   begin
     WriteLn(header, '%5u%s', base_dist[i],
-                SEPARATOR(i, D_CODES-1, 10));
+		SEPARATOR(i, D_CODES-1, 10));
   end;
 
   close(header);
@@ -2072,8 +2064,8 @@ begin
 
     {$ifdef DEBUG}
     Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
-            '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
-            's.last_lit}');
+	    '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
+	    's.last_lit}');
     {$ENDIF}
 
     if (static_lenb <= opt_lenb) then
@@ -2254,4 +2246,4 @@ begin
     64K-1 bytes. }
 end;
 
-end.
+end.

packages/base/paszlib/zbase.pas

@@ -1,4 +1,4 @@
-Unit Zbase;
+unit zbase;
 
 
 { Original:
@@ -73,9 +73,15 @@ uses
 
 { Maximum value for memLevel in deflateInit2 }
 {$ifdef MAXSEG_64K}
-const
-  MAX_MEM_LEVEL = 8;
-  DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
+  {$IFDEF VER70}
+  const
+    MAX_MEM_LEVEL = 7;
+    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
+  {$ELSE}
+  const
+    MAX_MEM_LEVEL = 8;
+    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
+  {$ENDIF}
 {$else}
 const
   MAX_MEM_LEVEL = 9;
@@ -84,7 +90,12 @@ const
 
 { Maximum value for windowBits in deflateInit2 and inflateInit2 }
 const
+{$IFDEF VER70}
+  MAX_WBITS = 14; { 32K LZ77 window }
+{$ELSE}
   MAX_WBITS = 15; { 32K LZ77 window }
+{$ENDIF}
+
 { default windowBits for decompression. MAX_WBITS is for compression only }
 const
   DEF_WBITS = MAX_WBITS;
@@ -117,7 +128,7 @@ type
   End;
 
 type
-  huft_field = Array[0..(MaxInt div SizeOf(inflate_huft))-1] of inflate_huft;
+  huft_field = Array[0..(MaxMemBlock div SizeOf(inflate_huft))-1] of inflate_huft;
   huft_ptr = ^huft_field;
 type
   ppInflate_huft = ^pInflate_huft;
@@ -168,7 +179,7 @@ type
   check_func = function(check : uLong;
                         buf : pBytef;
                         {const buf : array of byte;}
-                        len : uInt) : uLong;
+	                len : uInt) : uLong;
 type
   inflate_block_mode =
      (ZTYPE,    { get type bits (3, including end bit) }
@@ -277,7 +288,7 @@ type
     avail_out : uInt;     { remaining free space at next_out }
     total_out : uLong;    { total nb of bytes output so far }
 
-    msg : string;         { last error message, '' if no error }
+    msg : string[255];         { last error message, '' if no error }
     state : pInternal_state; { not visible by applications }
 
     zalloc : alloc_func;  { used to allocate the internal state }
@@ -288,10 +299,7 @@ type
     adler : uLong;        { adler32 value of the uncompressed data }
     reserved : uLong;     { reserved for future use }
   end;
-{$ifdef fpc}
-  TZStream = z_stream;
-  PZStream = ^TZStream;
-{$endif}
+
 
 {  The application must update next_in and avail_in when avail_in has
    dropped to zero. It must update next_out and avail_out when avail_out
@@ -512,4 +520,4 @@ begin
     strm.zfree(strm.opaque, ptr);
 end;
 
-end.
+end.

packages/base/paszlib/zcompres.pas

@@ -13,14 +13,14 @@ interface
 {$I zconf.inc}
 
 uses
-  zutil, zbase, zDeflate;
+  zutil, zbase, zdeflate;
 
                         { utility functions }
 
 {EXPORT}
 function compress (dest : pBytef;
                    var destLen : uLong;
-                   source : pBytef;
+                   const source : array of Byte;
                    sourceLen : uLong) : int;
 
  { Compresses the source buffer into the destination buffer.  sourceLen is
@@ -37,7 +37,7 @@ function compress (dest : pBytef;
 {EXPORT}
 function compress2 (dest : pBytef;
                     var destLen : uLong;
-                    source : pBytef;
+                    const source : array of byte;
                     sourceLen : uLong;
                     level : int) : int;
 {  Compresses the source buffer into the destination buffer. The level
@@ -56,14 +56,14 @@ implementation
 }
 function compress2 (dest : pBytef;
                     var destLen : uLong;
-                    source : pbytef;
+                    const source : array of byte;
                     sourceLen : uLong;
                     level : int) : int;
 var
   stream : z_stream;
   err : int;
 begin
-  stream.next_in := source;
+  stream.next_in := pBytef(@source);
   stream.avail_in := uInt(sourceLen);
 {$ifdef MAXSEG_64K}
   { Check for source > 64K on 16-bit machine: }
@@ -112,11 +112,11 @@ end;
  }
 function compress (dest : pBytef;
                    var destLen : uLong;
-                   source : pBytef;
+                   const source : array of Byte;
                    sourceLen : uLong) : int;
 begin
   compress := compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION);
 end;
 
 
-end.
+end.

packages/base/paszlib/zconf.inc

@@ -6,6 +6,9 @@
   than 64k bytes at a time (needed on systems with 16-bit int). }
 
 {- $DEFINE MAXSEG_64K}
+{$IFDEF VER70}
+  {$DEFINE MAXSEG_64K}
+{$ENDIF}
 {$IFNDEF WIN32}
   {$DEFINE UNALIGNED_OK}  { requires SizeOf(ush) = 2 ! }
 {$ENDIF}
@@ -14,11 +17,20 @@
 {$UNDEF FASTEST}
 {$define patch112}        { apply patch from the zlib home page }
 { -------------------------------------------------------------------- }
+{$IFDEF WIN32}
+  {$DEFINE Delphi32}
+  {- $DEFINE Delphi5}  { keep compiler quiet }
+{$ENDIF}
+
+{$IFDEF DPMI}
+  {$DEFINE MSDOS}
+{$ENDIF}
+
 {$IFDEF FPC}
  {$DEFINE Use32}
  {$UNDEF DPMI}
  {$UNDEF MSDOS}
  {$UNDEF UNALIGNED_OK}  { requires SizeOf(ush) = 2 ! }
  {$UNDEF MAXSEG_64K}
+ {$UNDEF Delphi32}
 {$ENDIF}
-

packages/base/paszlib/zdeflate.pas

@@ -1,8 +1,4 @@
-Unit zDeflate;
-
-{$ifdef fpc}
-{$goto on}
-{$endif}
+unit zdeflate;
 
 { Orginal: deflate.h -- internal compression state
            deflate.c -- compress data using the deflation algorithm
@@ -55,6 +51,7 @@ Unit zDeflate;
        Fiala,E.R., and Greene,D.H.
           Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595}
 
+{ $Id: deflate.c,v 1.14 1996/07/02 12:40:55 me Exp $ }
 
 interface
 
@@ -179,14 +176,6 @@ function deflateEnd (var strm : z_stream) : int;
 
 { The following functions are needed only in some special applications. }
 
-function deflateInit2_(var strm : z_stream;
-                       level : int;
-                       method : int;
-                       windowBits : int;
-                       memLevel : int;
-                       strategy : int;
-                       const version : string;
-                       stream_size : int) : int;
 
 {EXPORT}
 function deflateInit2 (var strm : z_stream;
@@ -250,7 +239,7 @@ function deflateInit2 (var strm : z_stream;
 {EXPORT}
 function deflateSetDictionary (var strm : z_stream;
                                dictionary : pBytef; {const bytes}
-                               dictLength : uint) : int;
+			       dictLength : uint) : int;
 
 {    Initializes the compression dictionary (history buffer) from the given
    byte sequence without producing any compressed output. This function must
@@ -360,11 +349,11 @@ type
 {local}
 procedure fill_window(var s : deflate_state); forward;
 {local}
-function deflate_stored(var s : deflate_state; flush : int) : block_state;{$ifndef fpc}far;{$endif} forward;
+function deflate_stored(var s : deflate_state; flush : int) : block_state; far; forward;
 {local}
-function deflate_fast(var s : deflate_state; flush : int) : block_state;{$ifndef fpc}far;{$endif} forward;
+function deflate_fast(var s : deflate_state; flush : int) : block_state; far; forward;
 {local}
-function deflate_slow(var s : deflate_state; flush : int) : block_state;{$ifndef fpc}far;{$endif} forward;
+function deflate_slow(var s : deflate_state; flush : int) : block_state; far; forward;
 {local}
 procedure lm_init(var s : deflate_state); forward;
 
@@ -540,19 +529,16 @@ begin
   strm.msg := '';
   if not Assigned(strm.zalloc) then
   begin
-{$ifdef fpc}
-    strm.zalloc := @zcalloc;
-{$else}
+    {$IFDEF FPC}  strm.zalloc := @zcalloc;  {$ELSE}
     strm.zalloc := zcalloc;
-{$endif}
+    {$ENDIF}
     strm.opaque := voidpf(0);
   end;
   if not Assigned(strm.zfree) then
-{$ifdef fpc}
-    strm.zfree := @zcfree;
-{$else}
+    {$IFDEF FPC}  strm.zfree := @zcfree;  {$ELSE}
     strm.zfree := zcfree;
-{$endif}
+    {$ENDIF}
+
   if (level  =  Z_DEFAULT_COMPRESSION) then
     level := 6;
 {$ifdef FASTEST}
@@ -927,10 +913,10 @@ begin
     if (strm.avail_out = 0) then
     begin
       { Since avail_out is 0, deflate will be called again with
-        more output space, but possibly with both pending and
-        avail_in equal to zero. There won't be anything to do,
-        but this is not an error situation so make sure we
-        return OK instead of BUF_ERROR at next call of deflate: }
+	more output space, but possibly with both pending and
+	avail_in equal to zero. There won't be anything to do,
+	but this is not an error situation so make sure we
+	return OK instead of BUF_ERROR at next call of deflate: }
 
       s^.last_flush := -1;
       deflate := Z_OK;
@@ -978,11 +964,11 @@ begin
       deflate := Z_OK;
       exit;
       { If flush != Z_NO_FLUSH && avail_out == 0, the next call
-        of deflate should use the same flush parameter to make sure
-        that the flush is complete. So we don't have to output an
-        empty block here, this will be done at next call. This also
-        ensures that for a very small output buffer, we emit at most
-         one empty block. }
+	of deflate should use the same flush parameter to make sure
+	that the flush is complete. So we don't have to output an
+	empty block here, this will be done at next call. This also
+	ensures that for a very small output buffer, we emit at most
+	 one empty block. }
     end;
     if (bstate = block_done) then
     begin
@@ -1006,7 +992,7 @@ begin
       if (strm.avail_out = 0) then
       begin
         s^.last_flush := -1; { avoid BUF_ERROR at next call, see above }
-        deflate := Z_OK;
+	deflate := Z_OK;
         exit;
       end;
 
@@ -1361,14 +1347,16 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
         { Here, scan <= window+strstart+257 }
         {$IFDEF DEBUG}
+        {$ifopt R+} {$define RangeCheck} {$endif} {$R-}
         Assert(ptr2int(scan) <=
                ptr2int(@(s.window^[unsigned(s.window_size-1)])),
                'wild scan');
+        {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif}
         {$ENDIF}
         if (scan^ = match^) then
           Inc(scan);
 
-        len := (MAX_MATCH - 1) - int(ptr2int(strend)-ptr2int(scan));
+        len := (MAX_MATCH - 1) - int(ptr2int(strend)) + int(ptr2int(scan));
         scan := strend;
         Dec(scan, (MAX_MATCH-1));
 
@@ -1597,7 +1585,7 @@ begin
          move the upper half to the lower one to make room in the upper half.}
      end
      else
-       if (s.strstart >= wsize+ {MAX_DIST}wsize-MIN_LOOKAHEAD) then
+       if (s.strstart >= wsize+ {MAX_DIST}(wsize-MIN_LOOKAHEAD)) then
        begin
          zmemcpy( pBytef(s.window), pBytef(@(s.window^[wsize])),
                  unsigned(wsize));
@@ -2045,7 +2033,7 @@ begin
       {$endif}
 
       {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
-                        s->prev_length - MIN_MATCH, bflush);}
+	                s->prev_length - MIN_MATCH, bflush);}
       bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
                            s.prev_length - MIN_MATCH);
 
@@ -2140,4 +2128,4 @@ begin
     deflate_slow := block_done;
 end;
 
-end.
+end.

packages/base/paszlib/zinflate.pas

@@ -1,4 +1,4 @@
-Unit  zInflate;
+unit  zinflate;
 
 {  inflate.c -- zlib interface to inflate modules
    Copyright (C) 1995-1998 Mark Adler
@@ -39,6 +39,10 @@ function inflateInit2_(var z: z_stream;
                        w : int;
                        const version : string;
                        stream_size : int) : int;
+
+function inflateInit2(var z: z_stream;
+                       windowBits : int) : int;
+
 {
      This is another version of inflateInit with an extra parameter. The
    fields next_in, avail_in, zalloc, zfree and opaque must be initialized
@@ -134,7 +138,7 @@ function inflate(var z : z_stream;
 
      If a preset dictionary is needed at this point (see inflateSetDictionary
   below), inflate sets strm-adler to the adler32 checksum of the
-  dictionary chosen by the compressor and returns Z_NEED_DICT; otherwise
+  dictionary chosen by the compressor and returns Z_NEED_DICT; otherwise 
   it sets strm->adler to the adler32 checksum of all output produced
   so far (that is, total_out bytes) and returns Z_OK, Z_STREAM_END or
   an error code as described below. At the end of the stream, inflate()
@@ -254,23 +258,18 @@ begin
   { initialize state }
   { SetLength(strm.msg, 255); }
   z.msg := '';
-{$ifdef fpc}
-  if not Assigned(z.zalloc) then
-  begin
-    z.zalloc := @zcalloc;
-    z.opaque := voidpf(0);
-  end;
-  if not Assigned(z.zfree) then
-    z.zfree := @zcfree;
-{$else}
   if not Assigned(z.zalloc) then
   begin
+    {$IFDEF FPC}  z.zalloc := @zcalloc;  {$ELSE}
     z.zalloc := zcalloc;
+    {$endif}
     z.opaque := voidpf(0);
   end;
   if not Assigned(z.zfree) then
+    {$IFDEF FPC}  z.zfree := @zcfree;  {$ELSE}
     z.zfree := zcfree;
-{$endif}
+    {$ENDIF}
+
   z.state := pInternal_state( ZALLOC(z,1,sizeof(internal_state)) );
   if (z.state = Z_NULL) then
   begin
@@ -301,11 +300,11 @@ begin
   if z.state^.nowrap then
     z.state^.blocks := inflate_blocks_new(z, NIL, uInt(1) shl w)
   else
-{$ifdef fpc}
+  {$IFDEF FPC}
     z.state^.blocks := inflate_blocks_new(z, @adler32, uInt(1) shl w);
-{$else}
+  {$ELSE}
     z.state^.blocks := inflate_blocks_new(z, adler32, uInt(1) shl w);
-{$endif}
+  {$ENDIF}
   if (z.state^.blocks = Z_NULL) then
   begin
     inflateEnd(z);
@@ -320,10 +319,15 @@ begin
   inflateInit2_ :=  Z_OK;
 end;
 
+function inflateInit2(var z: z_stream; windowBits : int) : int;
+begin
+  inflateInit2 := inflateInit2_(z, windowBits, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+
 function inflateInit(var z : z_stream) : int;
 { inflateInit is a macro to allow checking the zlib version
-  and the compiler's view of z_stream:
-  }
+  and the compiler's view of z_stream:  }
 begin
   inflateInit := inflateInit2_(z, DEF_WBITS, ZLIB_VERSION, sizeof(z_stream));
 end;
@@ -529,7 +533,7 @@ begin
         if ((b and PRESET_DICT) = 0) then
         begin
           z.state^.mode := BLOCKS;
-          continue;      { break C-switch }
+	  continue;      { break C-switch }
         end;
         z.state^.mode := DICT4;
         { falltrough }

packages/base/paszlib/zuncompr.pas

@@ -13,7 +13,7 @@ interface
 {$I zconf.inc}
 
 uses
-  zutil, zbase, zInflate;
+  zutil, zbase, zinflate;
 
 { ===========================================================================
      Decompresses the source buffer into the destination buffer.  sourceLen is
@@ -33,20 +33,20 @@ uses
 
 function uncompress (dest : pBytef;
                      var destLen : uLong;
-                     source : pBytef;
+                     const source : array of byte;
                      sourceLen : uLong) : int;
 
 implementation
 
 function uncompress (dest : pBytef;
                      var destLen : uLong;
-                     source : pBytef;
+                     const source : array of byte;
                      sourceLen : uLong) : int;
 var
   stream : z_stream;
   err : int;
 begin
-  stream.next_in := source;
+  stream.next_in := pBytef(@source);
   stream.avail_in := uInt(sourceLen);
   { Check for source > 64K on 16-bit machine: }
   if (uLong(stream.avail_in) <> sourceLen) then
@@ -89,4 +89,4 @@ begin
   uncompress := err;
 end;
 
-end.
+end.

packages/base/paszlib/zutil.pas

@@ -23,21 +23,20 @@ type
 {$ENDIF}
 
   intf   = int;
-{$IFDEF FPC}
-  uInt = Cardinal;     { 16 bits or more }
+{$IFDEF MSDOS}
+  uInt   = Word;
 {$ELSE}
-  {$IFDEF MSDOS}
-    uInt   = Word;
+  {$IFDEF FPC}
+    uInt   = longint;     { 16 bits or more }
+    {$INFO Cardinal}
+  {$ELSE}
+    uInt   = cardinal;     { 16 bits or more }
   {$ENDIF}
 {$ENDIF}
   uIntf  = uInt;
 
   Long   = longint;
-{$ifdef FPC}
   uLong  = Cardinal;
-{$else}
-  uLong  = LongInt;      { 32 bits or more }
-{$endif}
   uLongf = uLong;
 
   voidp  = pointer;
@@ -52,14 +51,21 @@ type
   ptr2int must be an integer type and sizeof(ptr2int) must be less
   than sizeof(pointer) - Nomssi }
 
+const
+  {$IFDEF MAXSEG_64K}
+  MaxMemBlock = $FFFF;
+  {$ELSE}
+  MaxMemBlock = MaxInt;
+  {$ENDIF}
+
 type
-  zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef;
+  zByteArray = array[0..(MaxMemBlock div SizeOf(Bytef))-1] of Bytef;
   pzByteArray = ^zByteArray;
 type
-  zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf;
+  zIntfArray = array[0..(MaxMemBlock div SizeOf(Intf))-1] of Intf;
   pzIntfArray = ^zIntfArray;
 type
-  zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt;
+  zuIntArray = array[0..(MaxMemBlock div SizeOf(uInt))-1] of uInt;
   PuIntArray = ^zuIntArray;
 
 { Type declarations - only for deflate }
@@ -81,7 +87,7 @@ type
   zuchfArray = zByteArray;
   puchfArray = ^zuchfArray;
 type
-  zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf;
+  zushfArray = array[0..(MaxMemBlock div SizeOf(ushf))-1] of ushf;
   pushfArray = ^zushfArray;
 
 procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
@@ -406,6 +412,10 @@ procedure zcfree(opaque : voidpf; ptr : voidpf);
 var
   Handle : THandle;
 {$endif}
+{$IFDEF FPC}
+var
+  memsize : uint;
+{$ENDIF}
 begin
   {$IFDEF DPMI}
   {h :=} GlobalFreePtr(ptr);
@@ -421,7 +431,13 @@ begin
         GlobalUnLock(Handle);
         GlobalFree(Handle);
         {$else}
+          {$IFDEF FPC}
+          Dec(puIntf(ptr));
+          memsize := puIntf(ptr)^;
+          FreeMem(ptr, memsize+SizeOf(uInt));
+          {$ELSE}
           FreeMem(ptr);  { Delphi 2,3,4 }
+          {$ENDIF}
         {$endif}
       {$endif}
     {$ENDIF}
@@ -431,12 +447,12 @@ end;
 function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
 var
   p : voidpf;
-  memsize : LongInt;
+  memsize : uLong;
 {$ifdef Delphi16}
   handle : THandle;
 {$endif}
 begin
-  memsize := Long(items) * size;
+  memsize := uLong(items) * size;
   {$IFDEF DPMI}
   p := GlobalAllocPtr(gmem_moveable, memsize);
   {$ELSE}
@@ -450,7 +466,13 @@ begin
         Handle := GlobalAlloc(HeapAllocFlags, memsize);
         p := GlobalLock(Handle);
         {$else}
+          {$IFDEF FPC}
+          GetMem(p, memsize+SizeOf(uInt));
+          puIntf(p)^:= memsize;
+          Inc(puIntf(p));
+          {$ELSE}
           GetMem(p, memsize);  { Delphi: p := AllocMem(memsize); }
+          {$ENDIF}
         {$endif}
       {$endif}
     {$ENDIF}
@@ -458,9 +480,11 @@ begin
   zcalloc := p;
 end;
 
-
 end.
+
+
 { edited from a SWAG posting:
+
 In Turbo Pascal 6, the heap is the memory allocated when using the Procedures 'New' and
 'GetMem'. The heap starts at the address location pointed to by 'Heaporg' and
 grows to higher addresses as more memory is allocated. The top of the heap,
@@ -491,26 +515,26 @@ When 'HeapPtr' and 'FreeList' have the same value, the free list is empty.
 
 
                      TP6.0     Heapend
-                ÚÄÄÄÄÄÄÄÄÄ¿ <ÄÄÄÄ
-                ³         ³
-                ³         ³
-                ³         ³
-                ³         ³
-                ³         ³
-                ³         ³
-                ³         ³
-                ³         ³  HeapPtr
-             ÚÄ>ÃÄÄÄÄÄÄÄÄÄ´ <ÄÄÄÄ
-             ³  ³         ³
-             ³  ÃÄÄÄÄÄÄÄÄÄ´
-             ÀÄij  Free   ³
-             ÚÄ>ÃÄÄÄÄÄÄÄÄÄ´
-             ³  ³         ³
-             ³  ÃÄÄÄÄÄÄÄÄÄ´
-             ÀÄij  Free   ³  FreeList
-                ÃÄÄÄÄÄÄÄÄÄ´ <ÄÄÄÄ
-                ³         ³  Heaporg
-                ÃÄÄÄÄÄÄÄÄÄ´ <ÄÄÄÄ
+                +---------+ <----
+                |         |
+                |         |
+                |         |
+                |         |
+                |         |
+                |         |
+                |         |
+                |         |  HeapPtr
+             +->+---------+ <----
+             |  |         |
+             |  +---------+
+             +--|  Free   |
+             +->+---------+
+             |  |         |
+             |  +---------+
+             +--|  Free   |  FreeList
+                +---------+ <----
+                |         |  Heaporg
+                +---------+ <----
 
 
 }