Forráskód Böngészése

Merged revisions 2967,2992-2993,3019,3121,3142,3158,3163,3188,3208,3220-3221 via svnmerge from
http://[email protected]/svn/fpc/trunk

........
r2967 | florian | 2006-03-19 14:40:48 +0100 (Sun, 19 Mar 2006) | 2 lines

* svn:executable

........
r2992 | florian | 2006-03-20 22:20:55 +0100 (Mon, 20 Mar 2006) | 2 lines

* "merged" pthread fixes from rtl

........
r2993 | florian | 2006-03-20 23:14:22 +0100 (Mon, 20 Mar 2006) | 2 lines

* some cleanup

........
r3019 | jonas | 2006-03-23 15:24:49 +0100 (Thu, 23 Mar 2006) | 2 lines

* fixed web bug #4934

........
r3121 | michael | 2006-04-02 10:25:36 +0200 (Sun, 02 Apr 2006) | 1 line

+ Support for loading arbitrary libraries, preserved default behaviour
........
r3142 | mattias | 2006-04-04 20:05:15 +0200 (Tue, 04 Apr 2006) | 1 line

added gtk2 functions gtk_tree_view_column_set_expand and gtk_tree_view_column_get_expand from Zhong
........
r3158 | michael | 2006-04-06 10:50:32 +0200 (Thu, 06 Apr 2006) | 1 line

+ Library to be loaded is now selectable
........
r3163 | michael | 2006-04-07 15:08:01 +0200 (Fri, 07 Apr 2006) | 1 line

+ Removed debug statement
........
r3188 | michael | 2006-04-09 23:34:16 +0200 (Sun, 09 Apr 2006) | 2 lines

* fixed library name for shm_unlink,shm_open as per mariano podesta's suggestion.

........
r3208 | daniel | 2006-04-14 16:59:35 +0200 (Fri, 14 Apr 2006) | 2 lines

* Fix integer overflow bug.

........
r3220 | armin | 2006-04-15 21:59:19 +0200 (Sat, 15 Apr 2006) | 2 lines

added sysutils for debug

........
r3221 | armin | 2006-04-15 22:24:12 +0200 (Sat, 15 Apr 2006) | 2 lines

renamed DEBUG to ZLIB_DEBUG

........

git-svn-id: branches/fixes_2_0@3264 -

peter 19 éve
szülő
commit
da7dade6d1

+ 55 - 28
packages/base/ibase/ibase60.inc

@@ -2455,33 +2455,28 @@ implementation
 
 
 {$IFDEF LinkDynamically}
 {$IFDEF LinkDynamically}
 
 
-var RefCount : integer;
-
-Procedure InitialiseIBase60;
+ResourceString
+  SErrEmbeddedFailed = 'Can not load embedded Firebird client "%s". Check your installation.';
+  SErrDefaultsFailed = 'Can not load default Firebird clients ("%s" or "%s"). Check your installation.';
+  SErrLoadFailed     = 'Can not load Firebird client library "%s". Check your installation.';
+  SErrAlreadyLoaded  = 'Firebird interface already initialized from library %s.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+
+Function TryInitialiseIBase60(Const LibraryName : String) : Boolean;
 
 
 begin
 begin
-  inc(RefCount);
-  if RefCount = 1 then
+  Result:=False;
+  if (RefCount=0) then
     begin
     begin
-    If UseEmbeddedFirebird then
-      begin
-      IBaseLibraryHandle:=loadlibrary(fbembedlib);
-      if (IBaseLibraryHandle=nilhandle) then
-        Raise EInOutError.Create('Can not load Firebird Embedded client. Is it installed? ('+fbembedlib+')');
-      end
-    else 
-      begin
-      IBaseLibraryHandle:=loadlibrary(fbclib);
-      if (IBaseLibraryHandle=nilhandle) then
-        begin
-        IBaseLibraryHandle:=loadlibrary(gdslib);
-        if (IBaseLibraryHandle=nilhandle) then
-          begin
-          RefCount := 0;
-          Raise EInOutError.Create('Can not load Firebird or Interbase client. Is it installed? ('+gdslib+' or '+fbclib+')');
-          end;
-        end;
-      end;  
+    IBaseLibraryHandle:=LoadLibrary(LibraryName);
+    Result:=(IBaseLibraryHandle<>nilhandle);
+    If not Result then
+      Exit;
+    inc(RefCount);
+    LoadedLibrary:=LibraryName;
     pointer(isc_attach_database) := GetProcedureAddress(IBaseLibraryHandle,'isc_attach_database');
     pointer(isc_attach_database) := GetProcedureAddress(IBaseLibraryHandle,'isc_attach_database');
     pointer(isc_array_gen_sdl) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_gen_sdl');
     pointer(isc_array_gen_sdl) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_gen_sdl');
     pointer(isc_array_get_slice) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_get_slice');
     pointer(isc_array_get_slice) := GetProcedureAddress(IBaseLibraryHandle,'isc_array_get_slice');
@@ -2648,16 +2643,48 @@ begin
     pointer(isc_reset_form) := GetProcedureAddress(IBaseLibraryHandle,'isc_reset_form');
     pointer(isc_reset_form) := GetProcedureAddress(IBaseLibraryHandle,'isc_reset_form');
     pointer(isc_suspend_window) := GetProcedureAddress(IBaseLibraryHandle,'isc_suspend_window');
     pointer(isc_suspend_window) := GetProcedureAddress(IBaseLibraryHandle,'isc_suspend_window');
 {$ENDIF}
 {$ENDIF}
-    end;
+    end
+  else
+    begin
+    If (LoadedLibrary<>LibraryName) then
+      Raise EInoutError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+    Result:=True;
+    end;  
+end;
+
+Procedure InitialiseIBase60;
+
+begin
+  If UseEmbeddedFirebird then
+    begin
+    If Not TryInitialiseIBase60(fbembedlib) then
+      Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
+    end
+  else
+    begin
+    If (Not TryInitialiseIBase60(fbclib)) and
+       (Not TryInitialiseIBase60(gdslib)) then
+        Raise EInOutError.CreateFmt(SErrDefaultsFailed,[gdslib,fbclib]);
+    end;    
+end;
+
+Procedure InitialiseIBase60(Const LibraryName : String);
+
+begin
+  If Not TryInitialiseIbase60(LibraryName) then
+    Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName]);
 end;
 end;
 
 
+
 Procedure ReleaseIBase60;
 Procedure ReleaseIBase60;
 
 
 begin
 begin
-  if RefCount > 0 then dec(RefCount);
-  if RefCount = 0 then
+  if RefCount>1 then
+    Dec(RefCount)
+  else if UnloadLibrary(IBaseLibraryHandle) then 
     begin
     begin
-    if not UnloadLibrary(IBaseLibraryHandle) then inc(RefCount);
+    Dec(RefCount);
+    LoadedLibrary:='';
     end;
     end;
 end;
 end;
 
 

+ 4 - 2
packages/base/libc/smmaph.inc

@@ -3,6 +3,8 @@
 Const
 Const
   MAP_FAILED = pointer(-1);
   MAP_FAILED = pointer(-1);
 
 
+Const
+  rtlib = 'rt';
 
 
 function mmap(__addr:pointer; __len:size_t; __prot:longint; __flags:longint; __fd:longint;
 function mmap(__addr:pointer; __len:size_t; __prot:longint; __flags:longint; __fd:longint;
            __offset:__off_t):pointer;cdecl;external clib name 'mmap';
            __offset:__off_t):pointer;cdecl;external clib name 'mmap';
@@ -19,8 +21,8 @@ function mlockall(__flags:longint):longint;cdecl;external clib name 'mlockall';
 function munlockall:longint;cdecl;external clib name 'munlockall';
 function munlockall:longint;cdecl;external clib name 'munlockall';
 function mremap(__addr:pointer; __old_len:size_t; __new_len:size_t; __may_move:longint):pointer;cdecl;external clib name 'mremap';
 function mremap(__addr:pointer; __old_len:size_t; __new_len:size_t; __may_move:longint):pointer;cdecl;external clib name 'mremap';
 function mincore(__start:pointer; __len:size_t; __vec:Pbyte):longint;cdecl;external clib name 'mincore';
 function mincore(__start:pointer; __len:size_t; __vec:Pbyte):longint;cdecl;external clib name 'mincore';
-function shm_open(__name:Pchar; __oflag:longint; __mode:mode_t):longint;cdecl;external clib name 'shm_open';
-function shm_unlink(__name:Pchar):longint;cdecl;external clib name 'shm_unlink';
+function shm_open(__name:Pchar; __oflag:longint; __mode:mode_t):longint;cdecl;external rtlib name 'shm_open';
+function shm_unlink(__name:Pchar):longint;cdecl;external rtlib name 'shm_unlink';
 
 
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------

+ 135 - 114
packages/base/mysql/mkdb

@@ -1473,142 +1473,163 @@ uses
 {$endif}
 {$endif}
 
 
 {$IFDEF LinkDynamically}
 {$IFDEF LinkDynamically}
-Procedure InitialiseMysql;
+Function InitialiseMysql(Const LibraryName : String) : Integer;
+Function InitialiseMysql : Integer;
 Procedure ReleaseMysql;
 Procedure ReleaseMysql;
 
 
-var Mysql4LibraryHandle : TLibHandle;
+var MysqlLibraryHandle : TLibHandle;
 {$ENDIF}
 {$ENDIF}
 
 
 implementation
 implementation
 
 
 {$IFDEF LinkDynamically}
 {$IFDEF LinkDynamically}
 
 
-var RefCount : integer;
+ResourceString
+  SErrAlreadyLoaded = 'MySQL interface already initialized from library %s.';
+  SLoadFailed       = 'Can not load MySQL library "%s". Please check your installation.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+
+Function InitialiseMysql : Integer;
+
+begin
+  // Use Default library
+  Result:=InitialiseMySQL(Mysqllib);
+end;
+
+
+Function InitialiseMysql(Const LibraryName : String) : Integer;
 
 
-Procedure InitialiseMysql;
 
 
 begin
 begin
-  inc(RefCount);
-  if RefCount = 1 then
+  if (RefCount=0) then
     begin
     begin
-    Mysql4LibraryHandle := loadlibrary(Mysqllib);
-    if Mysql4LibraryHandle = nilhandle then
+    MysqlLibraryHandle := loadlibrary(LibraryName);
+    if (MysqlLibraryHandle=nilhandle) then
       begin
       begin
-      RefCount := 0;
-      Raise EInOutError.Create('Can not load MySQL client. Is it installed? ('+Mysqllib+')');
+      Raise EInOutError.CreateFmt(SLoadFailed,[LibraryName]);
       end;
       end;
+    Inc(RefCount);  
+    LoadedLibrary:=LibraryName;
 // Only the procedure that are given in the c-library documentation are loaded, to
 // Only the procedure that are given in the c-library documentation are loaded, to
 // avoid problems with 'incomplete' libraries
 // avoid problems with 'incomplete' libraries
-    pointer(my_init) := GetProcedureAddress(Mysql4LibraryHandle,'my_init');
-    pointer(my_thread_init) := GetProcedureAddress(Mysql4LibraryHandle,'my_thread_init');
-    pointer(my_thread_end) := GetProcedureAddress(Mysql4LibraryHandle,'my_thread_end');
-
-    pointer(mysql_affected_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_affected_rows');
-    pointer(mysql_autocommit) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_autocommit');
-    pointer(mysql_change_user) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_change_user');
-//    pointer(mysql_charset_name) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_charset_name');
-    pointer(mysql_close) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_close');
-    pointer(mysql_commit) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_commit');
-//    pointer(mysql_connect) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_connect');
-//    pointer(mysql_create_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_create_db');
-    pointer(mysql_data_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_data_seek');
-//    pointer(mysql_drop_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_drop_db');
-    pointer(mysql_debug) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_debug');
-    pointer(mysql_dump_debug_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_dump_debug_info');
-    pointer(mysql_eof) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_eof');
-    pointer(mysql_errno) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_errno');
-    pointer(mysql_error) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_error');
-    pointer(mysql_escape_string) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_escape_string');
-    pointer(mysql_fetch_field) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_field');
-    pointer(mysql_fetch_field_direct) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_field_direct');
-    pointer(mysql_fetch_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_fields');
-    pointer(mysql_fetch_lengths) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_lengths');
-    pointer(mysql_fetch_row) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_fetch_row');
-    pointer(mysql_field_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_seek');
-    pointer(mysql_field_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_count');
-    pointer(mysql_field_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_field_tell');
-    pointer(mysql_free_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_free_result');
-    pointer(mysql_get_client_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_info');
-    pointer(mysql_get_client_version) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_version');
-    pointer(mysql_get_host_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_host_info');
-    pointer(mysql_get_server_version) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_server_version');
-    pointer(mysql_get_proto_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_proto_info');
-    pointer(mysql_get_server_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_server_info');
-    pointer(mysql_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_info');
-    pointer(mysql_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_init');
-    pointer(mysql_insert_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_insert_id');
-    pointer(mysql_kill) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_kill');
-    pointer(mysql_library_end) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_end');
-    pointer(mysql_library_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_init');
-    pointer(mysql_list_dbs) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_dbs');
-    pointer(mysql_list_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_fields');
-    pointer(mysql_list_processes) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_processes');
-    pointer(mysql_list_tables) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_list_tables');
-    pointer(mysql_more_results) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_more_results');
-    pointer(mysql_next_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_next_result');
-    pointer(mysql_num_fields) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_num_fields');
-    pointer(mysql_num_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_num_rows');
-    pointer(mysql_options) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_options');
-    pointer(mysql_ping) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_ping');
-    pointer(mysql_query) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_query');
-    pointer(mysql_real_connect) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_connect');
-    pointer(mysql_real_escape_string) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_escape_String');
-    pointer(mysql_real_query) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_real_query');
-    pointer(mysql_refresh) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_refresh');
-//    pointer(mysql_reload) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_reload');
-    pointer(mysql_rollback) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_rollback');
-    pointer(mysql_row_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_row_seek');
-    pointer(mysql_row_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_row_tell');
-    pointer(mysql_select_db) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_select_db');
-    pointer(mysql_server_end) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_end');
-    pointer(mysql_server_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_server_init');
-    pointer(mysql_set_server_option) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_set_server_option');
-    pointer(mysql_sqlstate) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_sqlstate');
-    pointer(mysql_shutdown) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_shutdown');
-    pointer(mysql_stat) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stat');
-    pointer(mysql_store_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_store_result');
-    pointer(mysql_thread_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_thread_id');
-//    pointer(mysql_thread_save) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_thread_save');
-    pointer(mysql_use_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_use_result');
-    pointer(mysql_warning_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_warning_count');
-
-    pointer(mysql_stmt_init) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_init');
-    pointer(mysql_stmt_prepare) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_prepare');
-    pointer(mysql_stmt_execute) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_execute');
-    pointer(mysql_stmt_fetch) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_fetch');
-    pointer(mysql_stmt_fetch_column) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_fetch_column');
-    pointer(mysql_stmt_store_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_store_result');
-    pointer(mysql_stmt_param_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_param_count');
-    pointer(mysql_stmt_attr_set) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_attr_set');
-    pointer(mysql_stmt_attr_get) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_attr_get');
-    pointer(mysql_stmt_bind_param) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_bind_param');
-    pointer(mysql_stmt_bind_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_bind_result');
-    pointer(mysql_stmt_close) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_close');
-    pointer(mysql_stmt_reset) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_reset');
-    pointer(mysql_stmt_free_result) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_free_result');
-    pointer(mysql_stmt_send_long_data) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_send_long_data');
-    pointer(mysql_stmt_result_metadata) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_result_metadata');
-    pointer(mysql_stmt_param_metadata) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_param_metadata');
-    pointer(mysql_stmt_errno) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_errno');
-    pointer(mysql_stmt_error) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_error');
-    pointer(mysql_stmt_sqlstate) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_sqlstate');
-    pointer(mysql_stmt_row_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_row_seek');
-    pointer(mysql_stmt_row_tell) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_row_tell');
-    pointer(mysql_stmt_data_seek) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_data_seek');
-    pointer(mysql_stmt_num_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_num_rows');
-    pointer(mysql_stmt_affected_rows) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_affected_rows');
-    pointer(mysql_stmt_insert_id) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_insert_id');
-    pointer(mysql_stmt_field_count) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_stmt_field_count');
-    end;
+    pointer(my_init) := GetProcedureAddress(MysqlLibraryHandle,'my_init');
+    pointer(my_thread_init) := GetProcedureAddress(MysqlLibraryHandle,'my_thread_init');
+    pointer(my_thread_end) := GetProcedureAddress(MysqlLibraryHandle,'my_thread_end');
+
+    pointer(mysql_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_affected_rows');
+    pointer(mysql_autocommit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_autocommit');
+    pointer(mysql_change_user) := GetProcedureAddress(MysqlLibraryHandle,'mysql_change_user');
+//    pointer(mysql_charset_name) := GetProcedureAddress(MysqlLibraryHandle,'mysql_charset_name');
+    pointer(mysql_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_close');
+    pointer(mysql_commit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_commit');
+//    pointer(mysql_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_connect');
+//    pointer(mysql_create_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_create_db');
+    pointer(mysql_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_data_seek');
+//    pointer(mysql_drop_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_drop_db');
+    pointer(mysql_debug) := GetProcedureAddress(MysqlLibraryHandle,'mysql_debug');
+    pointer(mysql_dump_debug_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_dump_debug_info');
+    pointer(mysql_eof) := GetProcedureAddress(MysqlLibraryHandle,'mysql_eof');
+    pointer(mysql_errno) := GetProcedureAddress(MysqlLibraryHandle,'mysql_errno');
+    pointer(mysql_error) := GetProcedureAddress(MysqlLibraryHandle,'mysql_error');
+    pointer(mysql_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_escape_string');
+    pointer(mysql_fetch_field) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_field');
+    pointer(mysql_fetch_field_direct) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_field_direct');
+    pointer(mysql_fetch_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_fields');
+    pointer(mysql_fetch_lengths) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_lengths');
+    pointer(mysql_fetch_row) := GetProcedureAddress(MysqlLibraryHandle,'mysql_fetch_row');
+    pointer(mysql_field_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_seek');
+    pointer(mysql_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_count');
+    pointer(mysql_field_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_tell');
+    pointer(mysql_free_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_free_result');
+    pointer(mysql_get_client_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_info');
+    pointer(mysql_get_client_version) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_version');
+    pointer(mysql_get_host_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_host_info');
+    pointer(mysql_get_server_version) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_server_version');
+    pointer(mysql_get_proto_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_proto_info');
+    pointer(mysql_get_server_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_server_info');
+    pointer(mysql_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_info');
+    pointer(mysql_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_init');
+    pointer(mysql_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_insert_id');
+    pointer(mysql_kill) := GetProcedureAddress(MysqlLibraryHandle,'mysql_kill');
+    pointer(mysql_library_end) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_end');
+    pointer(mysql_library_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_init');
+    pointer(mysql_list_dbs) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_dbs');
+    pointer(mysql_list_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_fields');
+    pointer(mysql_list_processes) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_processes');
+    pointer(mysql_list_tables) := GetProcedureAddress(MysqlLibraryHandle,'mysql_list_tables');
+    pointer(mysql_more_results) := GetProcedureAddress(MysqlLibraryHandle,'mysql_more_results');
+    pointer(mysql_next_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_next_result');
+    pointer(mysql_num_fields) := GetProcedureAddress(MysqlLibraryHandle,'mysql_num_fields');
+    pointer(mysql_num_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_num_rows');
+    pointer(mysql_options) := GetProcedureAddress(MysqlLibraryHandle,'mysql_options');
+    pointer(mysql_ping) := GetProcedureAddress(MysqlLibraryHandle,'mysql_ping');
+    pointer(mysql_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_query');
+    pointer(mysql_real_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_connect');
+    pointer(mysql_real_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_String');
+    pointer(mysql_real_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_query');
+    pointer(mysql_refresh) := GetProcedureAddress(MysqlLibraryHandle,'mysql_refresh');
+//    pointer(mysql_reload) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reload');
+    pointer(mysql_rollback) := GetProcedureAddress(MysqlLibraryHandle,'mysql_rollback');
+    pointer(mysql_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_seek');
+    pointer(mysql_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_tell');
+    pointer(mysql_select_db) := GetProcedureAddress(MysqlLibraryHandle,'mysql_select_db');
+    pointer(mysql_server_end) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_end');
+    pointer(mysql_server_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_server_init');
+    pointer(mysql_set_server_option) := GetProcedureAddress(MysqlLibraryHandle,'mysql_set_server_option');
+    pointer(mysql_sqlstate) := GetProcedureAddress(MysqlLibraryHandle,'mysql_sqlstate');
+    pointer(mysql_shutdown) := GetProcedureAddress(MysqlLibraryHandle,'mysql_shutdown');
+    pointer(mysql_stat) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stat');
+    pointer(mysql_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_store_result');
+    pointer(mysql_thread_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_id');
+//    pointer(mysql_thread_save) := GetProcedureAddress(MysqlLibraryHandle,'mysql_thread_save');
+    pointer(mysql_use_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_use_result');
+    pointer(mysql_warning_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_warning_count');
+    pointer(mysql_stmt_init) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_init');
+    pointer(mysql_stmt_prepare) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_prepare');
+    pointer(mysql_stmt_execute) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_execute');
+    pointer(mysql_stmt_fetch) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_fetch');
+    pointer(mysql_stmt_fetch_column) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_fetch_column');
+    pointer(mysql_stmt_store_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_store_result');
+    pointer(mysql_stmt_param_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_param_count');
+    pointer(mysql_stmt_attr_set) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_attr_set');
+    pointer(mysql_stmt_attr_get) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_attr_get');
+    pointer(mysql_stmt_bind_param) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_bind_param');
+    pointer(mysql_stmt_bind_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_bind_result');
+    pointer(mysql_stmt_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_close');
+    pointer(mysql_stmt_reset) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_reset');
+    pointer(mysql_stmt_free_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_free_result');
+    pointer(mysql_stmt_send_long_data) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_send_long_data');
+    pointer(mysql_stmt_result_metadata) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_result_metadata');
+    pointer(mysql_stmt_param_metadata) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_param_metadata');
+    pointer(mysql_stmt_errno) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_errno');
+    pointer(mysql_stmt_error) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_error');
+    pointer(mysql_stmt_sqlstate) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_sqlstate');
+    pointer(mysql_stmt_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_row_seek');
+    pointer(mysql_stmt_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_row_tell');
+    pointer(mysql_stmt_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_data_seek');
+    pointer(mysql_stmt_num_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_num_rows');
+    pointer(mysql_stmt_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_affected_rows');
+    pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
+    pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
+    end
+  else
+    If (LibraryName<>LoadedLibrary) then
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+  Result:=RefCount;  
 end;
 end;
 
 
 Procedure ReleaseMysql;
 Procedure ReleaseMysql;
 
 
 begin
 begin
-  if RefCount > 0 then dec(RefCount);
-  if RefCount = 0 then
+  if RefCount> 1 then
+    Dec(RefCount)
+  else if UnloadLibrary(MysqlLibraryHandle) then 
     begin
     begin
-    if not UnloadLibrary(Mysql4LibraryHandle) then inc(RefCount);
+    Dec(RefCount);
+    LoadedLibrary:='';
     end;
     end;
 end;
 end;
 
 

+ 30 - 8
packages/base/mysql/mysql4dyn.pp

@@ -151,28 +151,43 @@ function IS_BLOB(n : longint) : boolean;
 function MYSQL_COUNT_ERROR : longint;
 function MYSQL_COUNT_ERROR : longint;
 function mysql_reload(mysql : pmysql) : longint;
 function mysql_reload(mysql : pmysql) : longint;
 
 
-
-Procedure InitialiseMysql4;
+Function InitialiseMysql4 : Integer;
+Function InitialiseMysql4(Const LibraryName : String) : Integer;
 Procedure ReleaseMysql4;
 Procedure ReleaseMysql4;
 
 
 var Mysql4LibraryHandle : TLibHandle;
 var Mysql4LibraryHandle : TLibHandle;
 
 
 implementation
 implementation
 
 
-var RefCount : integer;
+ResourceString
+  SErrAlreadyLoaded = 'MySQL 4.1 already initialized from library %s';
+  SLoadFailed       = 'Can not load MySQL 4.1 library "%s". Please check your installation.';
+  
+var 
+  RefCount : integer;
+  LoadedLibrary : String;
+  
+Function InitialiseMysql4 : Integer;
+
+begin
+  // Use Default library
+  Result:=InitialiseMySQL4(Mysqllib);
+end;
+
+Function InitialiseMysql4(Const LibraryName : String) : Integer;
 
 
-Procedure InitialiseMysql4;
 
 
 begin
 begin
   inc(RefCount);
   inc(RefCount);
   if RefCount = 1 then
   if RefCount = 1 then
     begin
     begin
-    Mysql4LibraryHandle := loadlibrary(Mysqllib);
+    Mysql4LibraryHandle := loadlibrary(LibraryName);
     if Mysql4LibraryHandle = nilhandle then
     if Mysql4LibraryHandle = nilhandle then
       begin
       begin
       RefCount := 0;
       RefCount := 0;
-      Raise EInOutError.Create('Can not load MySQL client. Is it installed? ('+Mysqllib+')');
+      Raise EInOutError.CreateFmt(SLoadFailed,[LibraryName]);
       end;
       end;
+    LoadedLibrary:=LibraryName;  
     pointer(mysql_get_client_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_info');
     pointer(mysql_get_client_info) := GetProcedureAddress(Mysql4LibraryHandle,'mysql_get_client_info');
 
 
     // To avoid the strangest problems for ppl using other client-libs
     // To avoid the strangest problems for ppl using other client-libs
@@ -260,7 +275,11 @@ begin
     pointer(net_safe_read) := GetProcedureAddress(Mysql4LibraryHandle,'net_safe_read');
     pointer(net_safe_read) := GetProcedureAddress(Mysql4LibraryHandle,'net_safe_read');
 
 
     InitialiseMysql4_com;
     InitialiseMysql4_com;
-    end;
+    end
+  else
+    If (LibraryName<>LoadedLibrary) then
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+  Result:=RefCount;  
 end;
 end;
 
 
 Procedure ReleaseMysql4;
 Procedure ReleaseMysql4;
@@ -269,7 +288,10 @@ begin
   if RefCount > 0 then dec(RefCount);
   if RefCount > 0 then dec(RefCount);
   if RefCount = 0 then
   if RefCount = 0 then
     begin
     begin
-    if not UnloadLibrary(Mysql4LibraryHandle) then inc(RefCount);
+    if not UnloadLibrary(Mysql4LibraryHandle) then 
+      inc(RefCount)
+    else
+      LoadedLibrary:='';
     ReleaseMysql4_com;
     ReleaseMysql4_com;
     end;
     end;
 end;
 end;

+ 2 - 1
packages/base/netdb/netdb.pp

@@ -365,7 +365,8 @@ begin
       Inc(I,P+1);
       Inc(I,P+1);
       Inc(O,P);
       Inc(O,P);
       end;
       end;
-   Until (Payload[I]=#0);    
+   Until (Payload[I]=#0);
+   setlength(result,o-1);
 end;
 end;
 
 
 
 

+ 13 - 13
packages/base/paszlib/infblock.pas

@@ -118,7 +118,7 @@ begin
     s.check := s.checkfn(cardinal(0), Pbyte(NIL), 0);
     s.check := s.checkfn(cardinal(0), Pbyte(NIL), 0);
     z.adler := s.check;
     z.adler := s.check;
   end;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate:   blocks reset');
   Tracev('inflate:   blocks reset');
   {$ENDIF}
   {$ENDIF}
 end;
 end;
@@ -158,7 +158,7 @@ begin
   Inc(s^.zend, w);
   Inc(s^.zend, w);
   s^.checkfn := c;
   s^.checkfn := c;
   s^.mode := ZTYPE;
   s^.mode := ZTYPE;
-  {$IFDEF DEBUG}  
+  {$IFDEF ZLIB_DEBUG}  
   Tracev('inflate:   blocks allocated');
   Tracev('inflate:   blocks allocated');
   {$ENDIF}
   {$ENDIF}
   inflate_blocks_reset(s^, z, nil);
   inflate_blocks_reset(s^, z, nil);
@@ -240,7 +240,7 @@ begin
         case (t shr 1) of
         case (t shr 1) of
           0:                         { stored }
           0:                         { stored }
             begin
             begin
-              {$IFDEF DEBUG}
+              {$IFDEF ZLIB_DEBUG}
               if s.last then
               if s.last then
                 Tracev('inflate:     stored block (last)')
                 Tracev('inflate:     stored block (last)')
               else
               else
@@ -260,7 +260,7 @@ begin
           1:                         { fixed }
           1:                         { fixed }
             begin
             begin
               begin
               begin
-                {$IFDEF DEBUG}
+                {$IFDEF ZLIB_DEBUG}
                 if s.last then
                 if s.last then
                   Tracev('inflate:     fixed codes blocks (last)')
                   Tracev('inflate:     fixed codes blocks (last)')
                 else
                 else
@@ -290,7 +290,7 @@ begin
             end;
             end;
           2:                         { dynamic }
           2:                         { dynamic }
             begin
             begin
-              {$IFDEF DEBUG}
+              {$IFDEF ZLIB_DEBUG}
               if s.last then
               if s.last then
                 Tracev('inflate:     dynamic codes block (last)')
                 Tracev('inflate:     dynamic codes block (last)')
               else
               else
@@ -367,7 +367,7 @@ begin
         s.sub.left := cardinal(b) and $ffff;
         s.sub.left := cardinal(b) and $ffff;
         k := 0;
         k := 0;
         b := 0;                      { dump bits }
         b := 0;                      { dump bits }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       stored length '+IntToStr(s.sub.left));
         Tracev('inflate:       stored length '+IntToStr(s.sub.left));
         {$ENDIF}
         {$ENDIF}
         if s.sub.left <> 0 then
         if s.sub.left <> 0 then
@@ -453,7 +453,7 @@ begin
         dec(s.sub.left, t);
         dec(s.sub.left, t);
         if (s.sub.left = 0) then
         if (s.sub.left = 0) then
         begin
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           if (ptrint(q) >= ptrint(s.read)) then
           if (ptrint(q) >= ptrint(s.read)) then
             Tracev('inflate:       stored end '+
             Tracev('inflate:       stored end '+
                 IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
                 IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
@@ -533,7 +533,7 @@ begin
         dec(k, 14);
         dec(k, 14);
 
 
         s.sub.trees.index := 0;
         s.sub.trees.index := 0;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       table sizes ok');
         Tracev('inflate:       table sizes ok');
         {$ENDIF}
         {$ENDIF}
         s.mode := BTREE;
         s.mode := BTREE;
@@ -601,7 +601,7 @@ begin
           exit;
           exit;
         end;
         end;
         s.sub.trees.index := 0;
         s.sub.trees.index := 0;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate:       bits tree ok');
         Tracev('inflate:       bits tree ok');
         {$ENDIF}
         {$ENDIF}
         s.mode := DTREE;
         s.mode := DTREE;
@@ -756,7 +756,7 @@ begin
             inflate_blocks := inflate_flush(s,z,r);
             inflate_blocks := inflate_flush(s,z,r);
             exit;
             exit;
           end;
           end;
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Tracev('inflate:       trees ok');
           Tracev('inflate:       trees ok');
           {$ENDIF}          
           {$ENDIF}          
           { c renamed to cs }
           { c renamed to cs }
@@ -809,7 +809,7 @@ begin
           m := cardinal(ptrint(s.read)-ptrint(q)-1)
           m := cardinal(ptrint(s.read)-ptrint(q)-1)
         else
         else
           m := cardinal(ptrint(s.zend)-ptrint(q));
           m := cardinal(ptrint(s.zend)-ptrint(q));
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         if (ptrint(q) >= ptrint(s.read)) then
         if (ptrint(q) >= ptrint(s.read)) then
           Tracev('inflate:       codes end '+
           Tracev('inflate:       codes end '+
               IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
               IntToStr(z.total_out + ptrint(q) - ptrint(s.read)) + ' total out')
@@ -826,7 +826,7 @@ begin
         {$ifndef patch112}
         {$ifndef patch112}
         if (k > 7) then           { return unused byte, if any }
         if (k > 7) then           { return unused byte, if any }
         begin
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Assert(k < 16, 'inflate_codes grabbed too many bytes');
           Assert(k < 16, 'inflate_codes grabbed too many bytes');
           {$ENDIF}
           {$ENDIF}
           dec(k, 8);
           dec(k, 8);
@@ -920,7 +920,7 @@ begin
   ZFREE(z, s^.window);
   ZFREE(z, s^.window);
   ZFREE(z, s^.hufts);
   ZFREE(z, s^.hufts);
   ZFREE(z, s);
   ZFREE(z, s);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Trace('inflate:   blocks freed');
   Trace('inflate:   blocks freed');
   {$ENDIF}  
   {$ENDIF}  
   inflate_blocks_free := Z_OK;
   inflate_blocks_free := Z_OK;

+ 7 - 7
packages/base/paszlib/infcodes.pas

@@ -50,7 +50,7 @@ begin
     c^.dbits := Byte(bd);
     c^.dbits := Byte(bd);
     c^.ltree := tl;
     c^.ltree := tl;
     c^.dtree := td;
     c^.dtree := td;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Tracev('inflate:       codes new');
     Tracev('inflate:       codes new');
     {$ENDIF}
     {$ENDIF}
   end;
   end;
@@ -167,7 +167,7 @@ begin
       if (e = 0) then            { literal }
       if (e = 0) then            { literal }
       begin
       begin
         c^.sub.lit := t^.base;
         c^.sub.lit := t^.base;
-       {$IFDEF DEBUG}
+       {$IFDEF ZLIB_DEBUG}
         if (t^.base >= $20) and (t^.base < $7f) then
         if (t^.base >= $20) and (t^.base < $7f) then
           Tracevv('inflate:         literal '+char(t^.base))
           Tracevv('inflate:         literal '+char(t^.base))
         else
         else
@@ -191,7 +191,7 @@ begin
       end;
       end;
       if (e and 32 <> 0) then            { end of block }
       if (e and 32 <> 0) then            { end of block }
       begin
       begin
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracevv('inflate:         end of block');
         Tracevv('inflate:         end of block');
         {$ENDIF}        
         {$ENDIF}        
         c^.mode := WASH;
         c^.mode := WASH;
@@ -243,7 +243,7 @@ begin
 
 
       c^.sub.code.need := c^.dbits;
       c^.sub.code.need := c^.dbits;
       c^.sub.code.tree := c^.dtree;
       c^.sub.code.tree := c^.dtree;
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv('inflate:         length '+IntToStr(c^.len));
       Tracevv('inflate:         length '+IntToStr(c^.len));
       {$ENDIF}
       {$ENDIF}
       c^.mode := DIST;
       c^.mode := DIST;
@@ -337,7 +337,7 @@ begin
       {DUMPBITS(j);}
       {DUMPBITS(j);}
       b := b shr j;
       b := b shr j;
       dec(k, j);
       dec(k, j);
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
       Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
       {$ENDIF}
       {$ENDIF}
       c^.mode := COPY;
       c^.mode := COPY;
@@ -483,7 +483,7 @@ begin
       {$ifdef patch112}
       {$ifdef patch112}
       if (k > 7) then           { return unused byte, if any }
       if (k > 7) then           { return unused byte, if any }
       begin
       begin
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(k < 16, 'inflate_codes grabbed too many bytes');
         Assert(k < 16, 'inflate_codes grabbed too many bytes');
         {$ENDIF}
         {$ENDIF}
         dec(k, 8);
         dec(k, 8);
@@ -565,7 +565,7 @@ procedure inflate_codes_free(c : pInflate_codes_state;
                              var z : z_stream);
                              var z : z_stream);
 begin
 begin
   ZFREE(z, c);
   ZFREE(z, c);
-  {$IFDEF DEBUG}  
+  {$IFDEF ZLIB_DEBUG}  
   Tracev('inflate:       codes free');
   Tracev('inflate:       codes free');
   {$ENDIF}
   {$ENDIF}
 end;
 end;

+ 5 - 5
packages/base/paszlib/inffast.pas

@@ -94,7 +94,7 @@ begin
       {DUMPBITS(t^.bits);}
       {DUMPBITS(t^.bits);}
       b := b shr t^.bits;
       b := b shr t^.bits;
       dec(k, t^.bits);
       dec(k, t^.bits);
-     {$IFDEF DEBUG}
+     {$IFDEF ZLIB_DEBUG}
       if (t^.base >= $20) and (t^.base < $7f) then
       if (t^.base >= $20) and (t^.base < $7f) then
         Tracevv('inflate:         * literal '+char(t^.base))
         Tracevv('inflate:         * literal '+char(t^.base))
       else
       else
@@ -118,7 +118,7 @@ begin
         {DUMPBITS(e);}
         {DUMPBITS(e);}
         b := b shr e;
         b := b shr e;
         dec(k, e);
         dec(k, e);
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracevv('inflate:         * length ' + IntToStr(c));
         Tracevv('inflate:         * length ' + IntToStr(c));
         {$ENDIF}
         {$ENDIF}
         { decode distance base of block to copy }
         { decode distance base of block to copy }
@@ -156,7 +156,7 @@ begin
             b := b shr e;
             b := b shr e;
             dec(k, e);
             dec(k, e);
 
 
-            {$IFDEF DEBUG}
+            {$IFDEF ZLIB_DEBUG}
             Tracevv('inflate:         * distance '+IntToStr(d));
             Tracevv('inflate:         * distance '+IntToStr(d));
             {$ENDIF}
             {$ENDIF}
             { do the copy }
             { do the copy }
@@ -236,7 +236,7 @@ begin
           b := b shr t^.bits;
           b := b shr t^.bits;
           dec(k, t^.bits);
           dec(k, t^.bits);
 
 
-         {$IFDEF DEBUG}
+         {$IFDEF ZLIB_DEBUG}
           if (t^.base >= $20) and (t^.base < $7f) then
           if (t^.base >= $20) and (t^.base < $7f) then
             Tracevv('inflate:         * literal '+char(t^.base))
             Tracevv('inflate:         * literal '+char(t^.base))
           else
           else
@@ -251,7 +251,7 @@ begin
       else
       else
         if (e and 32 <> 0) then
         if (e and 32 <> 0) then
         begin
         begin
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Tracevv('inflate:         * end of block');
           Tracevv('inflate:         * end of block');
           {$ENDIF}
           {$ENDIF}
           {UNGRAB}
           {UNGRAB}

+ 1 - 1
packages/base/paszlib/inftrees.pas

@@ -30,7 +30,7 @@ const
   MANY = 1440;
   MANY = 1440;
 
 
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 var
 var
   inflate_hufts : cardinal;
   inflate_hufts : cardinal;
 {$endif}
 {$endif}

+ 46 - 42
packages/base/paszlib/trees.pas

@@ -42,7 +42,11 @@ interface
 {$I zconf.inc}
 {$I zconf.inc}
 
 
 uses
 uses
-  zbase;
+  {$ifdef ZLIB_DEBUG}
+  sysutils,
+  {$endif}
+  zbase
+  ;
 
 
 { ===========================================================================
 { ===========================================================================
   Internal compression state. }
   Internal compression state. }
@@ -283,7 +287,7 @@ type
     matches : cardinal;       { number of string matches in current block }
     matches : cardinal;       { number of string matches in current block }
     last_eob_len : integer;   { bit length of EOB code for last block }
     last_eob_len : integer;   { bit length of EOB code for last block }
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
     bits_sent : longint;    { bit length of the compressed data }
     bits_sent : longint;    { bit length of the compressed data }
 {$endif}
 {$endif}
 
 
@@ -779,7 +783,7 @@ procedure send_bits(var s : deflate_state;
                     value : integer;   { value to send }
                     value : integer;   { value to send }
                     length : integer); { number of bits }
                     length : integer); { number of bits }
 begin
 begin
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));
   Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));
   Assert((length > 0) and (length <= 15), 'invalid length');
   Assert((length > 0) and (length <= 15), 'invalid length');
   inc(s.bits_sent, longint(length));
   inc(s.bits_sent, longint(length));
@@ -811,7 +815,7 @@ begin
   {$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF}
   {$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF}
 end;
 end;
 
 
-{$else} { !DEBUG }
+{$else} { !ZLIB_DEBUG }
 
 
 
 
 macro send_code(s, c, tree)
 macro send_code(s, c, tree)
@@ -838,7 +842,7 @@ begin integer len := length;\
     s^.bi_valid += len;\
     s^.bi_valid += len;\
   end\
   end\
 end;
 end;
-{$endif} { DEBUG }
+{$endif} { ZLIB_DEBUG }
 
 
 { ===========================================================================
 { ===========================================================================
   Reverse the first len bits of a code, using straightforward code (a faster
   Reverse the first len bits of a code, using straightforward code (a faster
@@ -896,7 +900,7 @@ begin
   { Check that the bit counts in bl_count are consistent. The last code
   { Check that the bit counts in bl_count are consistent. The last code
     must be all ones. }
     must be all ones. }
 
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,
   Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,
           'inconsistent bit counts');
           'inconsistent bit counts');
   Tracev(#13'gen_codes: max_code '+IntToStr(max_code));
   Tracev(#13'gen_codes: max_code '+IntToStr(max_code));
@@ -910,7 +914,7 @@ begin
     { Now reverse the bits }
     { Now reverse the bits }
     tree^[n].fc.Code := bi_reverse(next_code[len], len);
     tree^[n].fc.Code := bi_reverse(next_code[len], len);
     inc(next_code[len]);
     inc(next_code[len]);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     if (n>31) and (n<128) then
     if (n>31) and (n<128) then
       Tracecv(tree <> tree_ptr(@static_ltree),
       Tracecv(tree <> tree_ptr(@static_ltree),
        (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
        (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
@@ -1155,7 +1159,7 @@ begin
   s.bi_buf := 0;
   s.bi_buf := 0;
   s.bi_valid := 0;
   s.bi_valid := 0;
   s.last_eob_len := 8; { enough lookahead for inflate }
   s.last_eob_len := 8; { enough lookahead for inflate }
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   s.bits_sent := 0;
   s.bits_sent := 0;
 {$endif}
 {$endif}
 
 
@@ -1297,7 +1301,7 @@ begin
   end;
   end;
   if (overflow = 0) then
   if (overflow = 0) then
     exit;
     exit;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'bit length overflow');
   Tracev(^M'bit length overflow');
   {$endif}
   {$endif}
   { This happens for example on obj2 and pic of the Calgary corpus }
   { This happens for example on obj2 and pic of the Calgary corpus }
@@ -1332,7 +1336,7 @@ begin
         continue;
         continue;
       if (tree^[m].dl.Len <> cardinal(bits)) then
       if (tree^[m].dl.Len <> cardinal(bits)) then
       begin
       begin
-        {$ifdef DEBUG}
+        {$ifdef ZLIB_DEBUG}
         Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
         Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
               +'.'+IntToStr(bits));
               +'.'+IntToStr(bits));
         {$ENDIF}
         {$ENDIF}
@@ -1595,7 +1599,7 @@ begin
       if (count < min_count) then
       if (count < min_count) then
       begin
       begin
         repeat
         repeat
-          {$ifdef DEBUG}
+          {$ifdef ZLIB_DEBUG}
           Tracevvv(#13'cd '+IntToStr(curlen));
           Tracevvv(#13'cd '+IntToStr(curlen));
           {$ENDIF}
           {$ENDIF}
           send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
           send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
@@ -1607,16 +1611,16 @@ begin
         begin
         begin
           if (curlen <> prevlen) then
           if (curlen <> prevlen) then
           begin
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(curlen));
             Tracevvv(#13'cd '+IntToStr(curlen));
             {$ENDIF}
             {$ENDIF}
             send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
             send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
             dec(count);
             dec(count);
           end;
           end;
-          {$IFDEF DEBUG}
+          {$IFDEF ZLIB_DEBUG}
           Assert((count >= 3) and (count <= 6), ' 3_6?');
           Assert((count >= 3) and (count <= 6), ' 3_6?');
           {$ENDIF}
           {$ENDIF}
-          {$ifdef DEBUG}
+          {$ifdef ZLIB_DEBUG}
           Tracevvv(#13'cd '+IntToStr(REP_3_6));
           Tracevvv(#13'cd '+IntToStr(REP_3_6));
           {$ENDIF}
           {$ENDIF}
           send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);
           send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);
@@ -1625,7 +1629,7 @@ begin
         else
         else
           if (count <= 10) then
           if (count <= 10) then
           begin
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(REPZ_3_10));
             Tracevvv(#13'cd '+IntToStr(REPZ_3_10));
             {$ENDIF}
             {$ENDIF}
             send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);
             send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);
@@ -1633,7 +1637,7 @@ begin
           end
           end
           else
           else
           begin
           begin
-            {$ifdef DEBUG}
+            {$ifdef ZLIB_DEBUG}
             Tracevvv(#13'cd '+IntToStr(REPZ_11_138));
             Tracevvv(#13'cd '+IntToStr(REPZ_11_138));
             {$ENDIF}
             {$ENDIF}
             send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);
             send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);
@@ -1689,7 +1693,7 @@ begin
   end;
   end;
   { Update opt_len to include the bit length tree and counts }
   { Update opt_len to include the bit length tree and counts }
   inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);
   inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');
   Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');
   {$ENDIF}
   {$ENDIF}
 
 
@@ -1709,7 +1713,7 @@ procedure send_all_trees(var s : deflate_state;
 var
 var
   rank : integer;                    { index in bl_order }
   rank : integer;                    { index in bl_order }
 begin
 begin
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),
   Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),
           'not enough codes');
           'not enough codes');
   Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)
   Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)
@@ -1721,22 +1725,22 @@ begin
   send_bits(s, blcodes-4,  4); { not -3 as stated in appnote.txt }
   send_bits(s, blcodes-4,  4); { not -3 as stated in appnote.txt }
   for rank := 0 to blcodes-1 do
   for rank := 0 to blcodes-1 do
   begin
   begin
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'bl code '+IntToStr(bl_order[rank]));
     Tracev(^M'bl code '+IntToStr(bl_order[rank]));
     {$ENDIF}
     {$ENDIF}
     send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);
     send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);
   end;
   end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));
   Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
   {$ENDIF}
 
 
   send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }
   send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));
   Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
   {$ENDIF}
 
 
   send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }
   send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));
   Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));
   {$ENDIF}
   {$ENDIF}
 end;
 end;
@@ -1764,7 +1768,7 @@ begin
     end;
     end;
   s.bi_buf := 0;
   s.bi_buf := 0;
   s.bi_valid := 0;
   s.bi_valid := 0;
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   s.bits_sent := (s.bits_sent+7) and (not 7);
   s.bits_sent := (s.bits_sent+7) and (not 7);
 {$endif}
 {$endif}
 end;
 end;
@@ -1795,11 +1799,11 @@ begin
     s.pending_buf^[s.pending] := byte(word(not len) shr 8);;
     s.pending_buf^[s.pending] := byte(word(not len) shr 8);;
     inc(s.pending);
     inc(s.pending);
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
     inc(s.bits_sent, 2*16);
     inc(s.bits_sent, 2*16);
 {$endif}
 {$endif}
   end;
   end;
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
   inc(s.bits_sent, longint(len shl 3));
   inc(s.bits_sent, longint(len shl 3));
 {$endif}
 {$endif}
   while (len <> 0) do
   while (len <> 0) do
@@ -1873,7 +1877,7 @@ end;
 procedure _tr_align(var s : deflate_state);
 procedure _tr_align(var s : deflate_state);
 begin
 begin
   send_bits(s, STATIC_TREES shl 1, 3);
   send_bits(s, STATIC_TREES shl 1, 3);
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   {$ENDIF}
   {$ENDIF}
   send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
   send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
@@ -1886,7 +1890,7 @@ begin
   if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then
   if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then
   begin
   begin
     send_bits(s, STATIC_TREES shl 1, 3);
     send_bits(s, STATIC_TREES shl 1, 3);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracevvv(#13'cd '+IntToStr(END_BLOCK));
     Tracevvv(#13'cd '+IntToStr(END_BLOCK));
     {$ENDIF}
     {$ENDIF}
     send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
     send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
@@ -1957,7 +1961,7 @@ begin
     if (dist = 0) then
     if (dist = 0) then
     begin
     begin
       { send a literal byte }
       { send a literal byte }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(lc));
       Tracevvv(#13'cd '+IntToStr(lc));
       Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
       Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
       {$ENDIF}
       {$ENDIF}
@@ -1968,7 +1972,7 @@ begin
       { Here, lc is the match length - MIN_MATCH }
       { Here, lc is the match length - MIN_MATCH }
       code := _length_code[lc];
       code := _length_code[lc];
       { send the length code }
       { send the length code }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));
       Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));
       {$ENDIF}
       {$ENDIF}
       send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);
       send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);
@@ -1985,12 +1989,12 @@ begin
       else
       else
         code := _dist_code[256+(dist shr 7)];
         code := _dist_code[256+(dist shr 7)];
 
 
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Assert (code < D_CODES, 'bad d_code');
       Assert (code < D_CODES, 'bad d_code');
       {$ENDIF}
       {$ENDIF}
 
 
       { send the distance code }
       { send the distance code }
-      {$ifdef DEBUG}
+      {$ifdef ZLIB_DEBUG}
       Tracevvv(#13'cd '+IntToStr(code));
       Tracevvv(#13'cd '+IntToStr(code));
       {$ENDIF}
       {$ENDIF}
       send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);
       send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);
@@ -2003,12 +2007,12 @@ begin
     end; { literal or match pair ? }
     end; { literal or match pair ? }
 
 
     { Check that the overlay between pending_buf and d_buf+l_buf is ok: }
     { Check that the overlay between pending_buf and d_buf+l_buf is ok: }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');
     Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');
     {$ENDIF}
     {$ENDIF}
   until (lx >= s.last_lit);
   until (lx >= s.last_lit);
 
 
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   Tracevvv(#13'cd '+IntToStr(END_BLOCK));
   {$ENDIF}
   {$ENDIF}
   send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);
   send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);
@@ -2040,12 +2044,12 @@ begin
 
 
     { Construct the literal and distance trees }
     { Construct the literal and distance trees }
     build_tree(s, s.l_desc);
     build_tree(s, s.l_desc);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     {$ENDIF}
     {$ENDIF}
 
 
     build_tree(s, s.d_desc);
     build_tree(s, s.d_desc);
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
     {$ENDIF}
     {$ENDIF}
     { At this point, opt_len and static_len are the total bit lengths of
     { At this point, opt_len and static_len are the total bit lengths of
@@ -2059,7 +2063,7 @@ begin
     opt_lenb := (s.opt_len+3+7) shr 3;
     opt_lenb := (s.opt_len+3+7) shr 3;
     static_lenb := (s.static_len+3+7) shr 3;
     static_lenb := (s.static_len+3+7) shr 3;
 
 
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
     Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
 	    '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
 	    '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
 	    's.last_lit}');
 	    's.last_lit}');
@@ -2071,7 +2075,7 @@ begin
   end
   end
   else
   else
   begin
   begin
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(buf <> nil, 'lost buf');
     Assert(buf <> nil, 'lost buf');
     {$ENDIF}
     {$ENDIF}
     static_lenb := stored_len + 5;
     static_lenb := stored_len + 5;
@@ -2141,7 +2145,7 @@ begin
       compress_block(s, s.dyn_ltree, s.dyn_dtree);
       compress_block(s, s.dyn_ltree, s.dyn_dtree);
       inc(s.compressed_len, 3 + s.opt_len);
       inc(s.compressed_len, 3 + s.opt_len);
     end;
     end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Assert (s.compressed_len = s.bits_sent, 'bad compressed size');
   Assert (s.compressed_len = s.bits_sent, 'bad compressed size');
   {$ENDIF}
   {$ENDIF}
   init_block(s);
   init_block(s);
@@ -2151,7 +2155,7 @@ begin
     bi_windup(s);
     bi_windup(s);
     inc(s.compressed_len, 7);  { align on byte boundary }
     inc(s.compressed_len, 7);  { align on byte boundary }
   end;
   end;
-  {$ifdef DEBUG}
+  {$ifdef ZLIB_DEBUG}
   Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+
   Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+
          's.compressed_len-7*ord(eof)}');
          's.compressed_len-7*ord(eof)}');
   {$ENDIF}
   {$ENDIF}
@@ -2168,7 +2172,7 @@ function _tr_tally (var s : deflate_state;
    dist : cardinal;          { distance of matched string }
    dist : cardinal;          { distance of matched string }
    lc : cardinal) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }
    lc : cardinal) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }
 var
 var
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   MAX_DIST : word;
   MAX_DIST : word;
   {$ENDIF}
   {$ENDIF}
   code : word;
   code : word;
@@ -2198,7 +2202,7 @@ begin
       code := _dist_code[dist]
       code := _dist_code[dist]
     else
     else
       code := _dist_code[256+(dist shr 7)];
       code := _dist_code[256+(dist shr 7)];
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
 {macro  MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)
 {macro  MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)
    In order to simplify the code, particularly on 16 bit machines, match
    In order to simplify the code, particularly on 16 bit machines, match
    distances are limited to MAX_DIST instead of WSIZE. }
    distances are limited to MAX_DIST instead of WSIZE. }
@@ -2225,7 +2229,7 @@ begin
             (cardinal(5)+extra_dbits[dcode])) );
             (cardinal(5)+extra_dbits[dcode])) );
     end;
     end;
     out_length := out_length shr 3;
     out_length := out_length shr 3;
-    {$ifdef DEBUG}
+    {$ifdef ZLIB_DEBUG}
     Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');
     Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');
           { s.last_lit, in_length, out_length,
           { s.last_lit, in_length, out_length,
            cardinal(100) - out_length*100 div in_length)); }
            cardinal(100) - out_length*100 div in_length)); }

+ 2 - 2
packages/base/paszlib/zbase.pas

@@ -399,7 +399,7 @@ const
   PRESET_DICT = $20; { preset dictionary flag in zlib header }
   PRESET_DICT = $20; { preset dictionary flag in zlib header }
 
 
 
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   procedure Assert(cond : boolean; msg : string);
   procedure Assert(cond : boolean; msg : string);
   {$ENDIF}
   {$ENDIF}
 
 
@@ -443,7 +443,7 @@ const
 const
 const
   z_verbose : integer = 1;
   z_verbose : integer = 1;
 
 
-{$IFDEF DEBUG}
+{$IFDEF ZLIB_DEBUG}
 procedure z_error (m : string);
 procedure z_error (m : string);
 {$ENDIF}
 {$ENDIF}
 
 

+ 118 - 126
packages/base/paszlib/zdeflate.pas

@@ -374,7 +374,7 @@ procedure  flush_pending (var strm : z_stream); forward;
 {local}
 {local}
 function read_buf(strm : z_streamp;
 function read_buf(strm : z_streamp;
                   buf : Pbyte;
                   buf : Pbyte;
-                  size : cardinal) : integer; forward;
+                  size : cardinal) : cardinal; forward;
 {$ifdef ASMV}
 {$ifdef ASMV}
 procedure match_init; { asm code initialization }
 procedure match_init; { asm code initialization }
 function longest_match(var deflate_state; cur_match : IPos) : cardinal; forward;
 function longest_match(var deflate_state; cur_match : IPos) : cardinal; forward;
@@ -384,7 +384,7 @@ function longest_match(var s : deflate_state; cur_match : IPos) : cardinal;
   forward;
   forward;
 {$endif}
 {$endif}
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 {local}
 {local}
 procedure check_match(var s : deflate_state;
 procedure check_match(var s : deflate_state;
                       start, match : IPos;
                       start, match : IPos;
@@ -698,9 +698,7 @@ begin
               and s^.hash_mask;
               and s^.hash_mask;
 
 
   for n := 0 to length - MIN_MATCH do
   for n := 0 to length - MIN_MATCH do
-  begin
     INSERT_STRING(s^, n, hash_head);
     INSERT_STRING(s^, n, hash_head);
-  end;
   {if (hash_head <> 0) then
   {if (hash_head <> 0) then
     hash_head := 0;  - to make compiler happy }
     hash_head := 0;  - to make compiler happy }
   deflateSetDictionary := Z_OK;
   deflateSetDictionary := Z_OK;
@@ -996,7 +994,7 @@ begin
 
 
     end;
     end;
   end;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert(strm.avail_out > 0, 'bug2');
   Assert(strm.avail_out > 0, 'bug2');
   {$ENDIF}
   {$ENDIF}
   if (flush <> Z_FINISH) then
   if (flush <> Z_FINISH) then
@@ -1139,31 +1137,25 @@ end;
   (See also flush_pending()). }
   (See also flush_pending()). }
 
 
 {local}
 {local}
-function read_buf(strm : z_streamp; buf : Pbyte; size : cardinal) : integer;
-var
-  len : cardinal;
-begin
-  len := strm^.avail_in;
+function read_buf(strm:z_streamp;buf:Pbyte;size:cardinal):cardinal;
 
 
-  if (len > size) then
-    len := size;
-  if (len = 0) then
-  begin
-    read_buf := 0;
-    exit;
-  end;
+var len:cardinal;
 
 
+begin
+  len:=strm^.avail_in;
+  if len>size then
+    len:=size;
   dec(strm^.avail_in, len);
   dec(strm^.avail_in, len);
 
 
-  if deflate_state_ptr(strm^.state)^.noheader = 0 then
-  begin
-    strm^.adler := adler32(strm^.adler, strm^.next_in, len);
-  end;
-  move(strm^.next_in^,buf^,len);
-  inc(strm^.next_in, len);
-  inc(strm^.total_in, len);
-
-  read_buf := len;
+  if len<>0 then
+    begin
+      if deflate_state_ptr(strm^.state)^.noheader=0 then
+        strm^.adler:=adler32(strm^.adler,strm^.next_in,len);
+      move(strm^.next_in^,buf^,len);
+      inc(strm^.next_in,len);
+      inc(strm^.total_in,len);
+    end;
+  read_buf:=len;
 end;
 end;
 
 
 { ===========================================================================
 { ===========================================================================
@@ -1279,7 +1271,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
 
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
       It is easy to get rid of this optimization if necessary. }
       It is easy to get rid of this optimization if necessary. }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
     {$ENDIF}
     {$ENDIF}
     { Do not waste too much time if we already have a good match: }
     { Do not waste too much time if we already have a good match: }
@@ -1293,11 +1285,11 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
 
     if (cardinal(nice_match) > s.lookahead) then
     if (cardinal(nice_match) > s.lookahead) then
       nice_match := s.lookahead;
       nice_match := s.lookahead;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
     {$ENDIF}
     {$ENDIF}
     repeat
     repeat
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(cur_match < s.strstart, 'no future');
         Assert(cur_match < s.strstart, 'no future');
         {$ENDIF}
         {$ENDIF}
         match := @(s.window^[cur_match]);
         match := @(s.window^[cur_match]);
@@ -1329,7 +1321,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
           at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
           at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
           necessary to put more guard bytes at the end of the window, or
           necessary to put more guard bytes at the end of the window, or
           to check more often for insufficient lookahead. }
           to check more often for insufficient lookahead. }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');
         Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');
         {$ENDIF}
         {$ENDIF}
         inc(scan);
         inc(scan);
@@ -1344,7 +1336,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
         { The funny "do while" generates better code on most compilers }
         { The funny "do while" generates better code on most compilers }
 
 
         { Here, scan <= window+strstart+257 }
         { Here, scan <= window+strstart+257 }
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         {$ifopt R+} {$define RangeCheck} {$endif} {$R-}
         {$ifopt R+} {$define RangeCheck} {$endif} {$R-}
         Assert(ptrint(scan) <=
         Assert(ptrint(scan) <=
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
@@ -1378,7 +1370,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
 
 
         inc(scan, 2);
         inc(scan, 2);
         inc(match);
         inc(match);
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert( scan^ = match^, 'match[2]?');
         Assert( scan^ = match^, 'match[2]?');
         {$ENDIF}
         {$ENDIF}
         { We check for insufficient lookahead only every 8th comparison;
         { We check for insufficient lookahead only every 8th comparison;
@@ -1395,7 +1387,7 @@ distances are limited to MAX_DIST instead of WSIZE. }
           inc(scan); inc(match); if (scan^ <> match^) then break;
           inc(scan); inc(match); if (scan^ <> match^) then break;
         until (ptrint(scan) >= ptrint(strend));
         until (ptrint(scan) >= ptrint(strend));
 
 
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Assert(ptrint(scan) <=
         Assert(ptrint(scan) <=
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
                ptrint(@(s.window^[cardinal(s.window_size-1)])),
                'wild scan');
                'wild scan');
@@ -1454,7 +1446,7 @@ begin
 
 
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
       It is easy to get rid of this optimization if necessary. }
       It is easy to get rid of this optimization if necessary. }
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
 
 
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
     Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
@@ -1512,7 +1504,7 @@ begin
 end;
 end;
 {$endif} { FASTEST }
 {$endif} { FASTEST }
 
 
-{$ifdef DEBUG}
+{$ifdef ZLIB_DEBUG}
 { ===========================================================================
 { ===========================================================================
   Check that the match at match_start is indeed a match. }
   Check that the match at match_start is indeed a match. }
 
 
@@ -1639,7 +1631,7 @@ begin
       * Otherwise, window_size == 2*WSIZE so more >= 2.
       * Otherwise, window_size == 2*WSIZE so more >= 2.
       * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }
       * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }
 
 
-     {$IFDEF DEBUG}
+     {$IFDEF ZLIB_DEBUG}
      Assert(more >= 2, 'more < 2');
      Assert(more >= 2, 'more < 2');
      {$ENDIF}
      {$ENDIF}
 
 
@@ -1679,7 +1671,7 @@ begin
 
 
   s.block_start := s.strstart;
   s.block_start := s.strstart;
   flush_pending(s.strm^);
   flush_pending(s.strm^);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('[FLUSH]');
   Tracev('[FLUSH]');
   {$ENDIF}
   {$ENDIF}
 end;
 end;
@@ -1729,7 +1721,7 @@ begin
     { Fill the window as much as possible: }
     { Fill the window as much as possible: }
     if (s.lookahead <= 1) then
     if (s.lookahead <= 1) then
     begin
     begin
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or
       Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or
               (s.block_start >= longint(s.w_size)), 'slide too late');
               (s.block_start >= longint(s.w_size)), 'slide too late');
       {$ENDIF}
       {$ENDIF}
@@ -1743,7 +1735,7 @@ begin
       if (s.lookahead = 0) then
       if (s.lookahead = 0) then
         break; { flush the current block }
         break; { flush the current block }
     end;
     end;
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Assert(s.block_start >= 0, 'block gone');
     Assert(s.block_start >= 0, 'block gone');
     {$ENDIF}
     {$ENDIF}
     inc(s.strstart, s.lookahead);
     inc(s.strstart, s.lookahead);
@@ -1754,7 +1746,7 @@ begin
     if (s.strstart = 0) or (longint(s.strstart) >= max_start) then
     if (s.strstart = 0) or (longint(s.strstart) >= max_start) then
     begin
     begin
       { strstart = 0 is possible when wraparound on 16-bit machine }
       { strstart = 0 is possible when wraparound on 16-bit machine }
-      s.lookahead := cardinal(s.strstart - max_start);
+      s.lookahead := cardinal(s.strstart) - cardinal(max_start);
       s.strstart := cardinal(max_start);
       s.strstart := cardinal(max_start);
       {FLUSH_BLOCK(s, FALSE);}
       {FLUSH_BLOCK(s, FALSE);}
       FLUSH_BLOCK_ONLY(s, FALSE);
       FLUSH_BLOCK_ONLY(s, FALSE);
@@ -1837,9 +1829,7 @@ begin
       dictionary, and set hash_head to the head of the hash chain: }
       dictionary, and set hash_head to the head of the hash chain: }
 
 
     if (s.lookahead >= MIN_MATCH) then
     if (s.lookahead >= MIN_MATCH) then
-    begin
       INSERT_STRING(s, s.strstart, hash_head);
       INSERT_STRING(s, s.strstart, hash_head);
-    end;
 
 
     { Find the longest match, discarding those <= prev_length.
     { Find the longest match, discarding those <= prev_length.
       At this point we have always match_length < MIN_MATCH }
       At this point we have always match_length < MIN_MATCH }
@@ -1857,7 +1847,7 @@ begin
     end;
     end;
     if (s.match_length >= MIN_MATCH) then
     if (s.match_length >= MIN_MATCH) then
     begin
     begin
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       check_match(s, s.strstart, s.match_start, s.match_length);
       check_match(s, s.strstart, s.match_start, s.match_length);
       {$ENDIF}
       {$ENDIF}
 
 
@@ -1908,7 +1898,7 @@ end;
     else
     else
     begin
     begin
       { No match, output a literal byte }
       { No match, output a literal byte }
-      {$IFDEF DEBUG}
+      {$IFDEF ZLIB_DEBUG}
       Tracevv(char(s.window^[s.strstart]));
       Tracevv(char(s.window^[s.strstart]));
       {$ENDIF}
       {$ENDIF}
       {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
       {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
@@ -1960,33 +1950,30 @@ begin
   hash_head := ZNIL;
   hash_head := ZNIL;
 
 
   { Process the input block. }
   { Process the input block. }
-  while TRUE do
-  begin
+  repeat
     { Make sure that we always have enough lookahead, except
     { Make sure that we always have enough lookahead, except
       at the end of the input file. We need MAX_MATCH bytes
       at the end of the input file. We need MAX_MATCH bytes
       for the next match, plus MIN_MATCH bytes to insert the
       for the next match, plus MIN_MATCH bytes to insert the
       string following the next match. }
       string following the next match. }
 
 
     if (s.lookahead < MIN_LOOKAHEAD) then
     if (s.lookahead < MIN_LOOKAHEAD) then
-    begin
-      fill_window(s);
-      if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
       begin
       begin
-        deflate_slow := need_more;
-        exit;
+        fill_window(s);
+        if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
+          begin
+            deflate_slow := need_more;
+            exit;
+          end;
+
+        if s.lookahead=0 then
+          break; { flush the current block }
       end;
       end;
 
 
-      if (s.lookahead = 0) then
-        break; { flush the current block }
-    end;
-
     { Insert the string window[strstart .. strstart+2] in the
     { Insert the string window[strstart .. strstart+2] in the
       dictionary, and set hash_head to the head of the hash chain: }
       dictionary, and set hash_head to the head of the hash chain: }
 
 
     if (s.lookahead >= MIN_MATCH) then
     if (s.lookahead >= MIN_MATCH) then
-    begin
       INSERT_STRING(s, s.strstart, hash_head);
       INSERT_STRING(s, s.strstart, hash_head);
-    end;
 
 
     { Find the longest match, discarding those <= prev_length. }
     { Find the longest match, discarding those <= prev_length. }
 
 
@@ -1996,113 +1983,118 @@ begin
 
 
     if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and
     if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and
        (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then
        (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then
-    begin
+      begin
         { To simplify the code, we prevent matches with the string
         { To simplify the code, we prevent matches with the string
           of window index 0 (in particular we have to avoid a match
           of window index 0 (in particular we have to avoid a match
           of the string with itself at the start of the input file). }
           of the string with itself at the start of the input file). }
 
 
         if (s.strategy <> Z_HUFFMAN_ONLY) then
         if (s.strategy <> Z_HUFFMAN_ONLY) then
-        begin
           s.match_length := longest_match (s, hash_head);
           s.match_length := longest_match (s, hash_head);
-        end;
         { longest_match() sets match_start }
         { longest_match() sets match_start }
 
 
         if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or
         if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or
              ((s.match_length = MIN_MATCH) and
              ((s.match_length = MIN_MATCH) and
               (s.strstart - s.match_start > TOO_FAR))) then
               (s.strstart - s.match_start > TOO_FAR))) then
-        begin
+          begin
             { If prev_match is also MIN_MATCH, match_start is garbage
             { If prev_match is also MIN_MATCH, match_start is garbage
               but we will ignore the current match anyway. }
               but we will ignore the current match anyway. }
 
 
             s.match_length := MIN_MATCH-1;
             s.match_length := MIN_MATCH-1;
-        end;
-    end;
+          end;
+      end;
     { If there was a match at the previous step and the current
     { If there was a match at the previous step and the current
       match is not better, output the previous match: }
       match is not better, output the previous match: }
 
 
-    if (s.prev_length >= MIN_MATCH)
-      and (s.match_length <= s.prev_length) then
-    begin
-      max_insert := s.strstart + s.lookahead - MIN_MATCH;
-      { Do not insert strings in hash table beyond this. }
-      {$ifdef DEBUG}
-      check_match(s, s.strstart-1, s.prev_match, s.prev_length);
-      {$endif}
+    if (s.prev_length>=MIN_MATCH) and (s.match_length<=s.prev_length) then
+      begin
+        max_insert := s.strstart + s.lookahead - MIN_MATCH;
+        { Do not insert strings in hash table beyond this. }
+        {$ifdef ZLIB_DEBUG}
+        check_match(s, s.strstart-1, s.prev_match, s.prev_length);
+        {$endif}
 
 
-      {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
-	                s->prev_length - MIN_MATCH, bflush);}
-      bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
-                           s.prev_length - MIN_MATCH);
+        {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
+  	                  s->prev_length - MIN_MATCH, bflush);}
+        bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
+                             s.prev_length - MIN_MATCH);
 
 
       { Insert in hash table all strings up to the end of the match.
       { Insert in hash table all strings up to the end of the match.
         strstart-1 and strstart are already inserted. If there is not
         strstart-1 and strstart are already inserted. If there is not
         enough lookahead, the last two strings are not inserted in
         enough lookahead, the last two strings are not inserted in
         the hash table. }
         the hash table. }
 
 
-      dec(s.lookahead, s.prev_length-1);
-      dec(s.prev_length, 2);
-      repeat
+{$ifdef ZLIB_DEBUG}
+        if s.lookahead<s.prev_length-1 then
+           runerror(255);
+{$endif}
+        dec(s.lookahead, s.prev_length-1);
+        dec(s.prev_length, 2);
+        repeat
+          inc(s.strstart);
+          if s.strstart<=max_insert then
+            INSERT_STRING(s, s.strstart, hash_head);
+          dec(s.prev_length);
+        until s.prev_length = 0;
+        s.match_available := false;
+        s.match_length := MIN_MATCH-1;
         inc(s.strstart);
         inc(s.strstart);
-        if (s.strstart <= max_insert) then
-        begin
-          INSERT_STRING(s, s.strstart, hash_head);
-        end;
-        dec(s.prev_length);
-      until (s.prev_length = 0);
-      s.match_available := FALSE;
-      s.match_length := MIN_MATCH-1;
-      inc(s.strstart);
 
 
-      if (bflush) then  {FLUSH_BLOCK(s, FALSE);}
-      begin
-        FLUSH_BLOCK_ONLY(s, FALSE);
-        if (s.strm^.avail_out = 0) then
-        begin
-          deflate_slow := need_more;
-          exit;
-        end;
-      end;
-    end
+        if bflush then  {FLUSH_BLOCK(s, FALSE);}
+          begin
+            FLUSH_BLOCK_ONLY(s,false);
+            if s.strm^.avail_out=0 then
+              begin
+                deflate_slow := need_more;
+                exit;
+              end;
+          end;
+      end
     else
     else
-      if (s.match_available) then
-      begin
-        { If there was no match at the previous position, output a
-          single literal. If there was a match but the current match
-          is longer, truncate the previous match to a single literal. }
-        {$IFDEF DEBUG}
-        Tracevv(char(s.window^[s.strstart-1]));
-        {$ENDIF}
-        bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
-
-        if bflush then
-        begin
-          FLUSH_BLOCK_ONLY(s, FALSE);
-        end;
-        inc(s.strstart);
-        dec(s.lookahead);
-        if (s.strm^.avail_out = 0) then
+      if s.match_available then
         begin
         begin
-          deflate_slow := need_more;
-          exit;
-        end;
-      end
+          { If there was no match at the previous position, output a
+            single literal. If there was a match but the current match
+            is longer, truncate the previous match to a single literal. }
+          {$IFDEF ZLIB_DEBUG}
+          Tracevv(char(s.window^[s.strstart-1]));
+          {$ENDIF}
+          bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
+
+          if bflush then
+            FLUSH_BLOCK_ONLY(s, FALSE);
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+          if (s.strm^.avail_out = 0) then
+            begin
+              deflate_slow := need_more;
+              exit;
+            end;
+        end
       else
       else
-      begin
+        begin
         { There is no previous match to compare with, wait for
         { There is no previous match to compare with, wait for
           the next step to decide. }
           the next step to decide. }
 
 
-        s.match_available := TRUE;
-        inc(s.strstart);
-        dec(s.lookahead);
-      end;
-  end;
+          s.match_available := TRUE;
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+        end;
+  until false;
 
 
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Assert (flush <> Z_NO_FLUSH, 'no flush?');
   Assert (flush <> Z_NO_FLUSH, 'no flush?');
   {$ENDIF}
   {$ENDIF}
   if (s.match_available) then
   if (s.match_available) then
   begin
   begin
-    {$IFDEF DEBUG}
+    {$IFDEF ZLIB_DEBUG}
     Tracevv(char(s.window^[s.strstart-1]));
     Tracevv(char(s.window^[s.strstart-1]));
     bflush :=
     bflush :=
     {$ENDIF}
     {$ENDIF}

+ 5 - 5
packages/base/paszlib/zinflate.pas

@@ -219,7 +219,7 @@ begin
   else
   else
     z.state^.mode := METHOD;
     z.state^.mode := METHOD;
   inflate_blocks_reset(z.state^.blocks^, z, Z_NULL);
   inflate_blocks_reset(z.state^.blocks^, z, Z_NULL);
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: reset');
   Tracev('inflate: reset');
   {$ENDIF}
   {$ENDIF}
   inflateReset :=  Z_OK;
   inflateReset :=  Z_OK;
@@ -237,7 +237,7 @@ begin
     inflate_blocks_free(z.state^.blocks, z);
     inflate_blocks_free(z.state^.blocks, z);
   ZFREE(z, z.state);
   ZFREE(z, z.state);
   z.state := Z_NULL;
   z.state := Z_NULL;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: end');
   Tracev('inflate: end');
   {$ENDIF}
   {$ENDIF}
   inflateEnd :=  Z_OK;
   inflateEnd :=  Z_OK;
@@ -296,7 +296,7 @@ begin
     inflateInit2_ := Z_MEM_ERROR;
     inflateInit2_ := Z_MEM_ERROR;
     exit;
     exit;
   end;
   end;
-  {$IFDEF DEBUG}
+  {$IFDEF ZLIB_DEBUG}
   Tracev('inflate: allocated');
   Tracev('inflate: allocated');
   {$ENDIF}
   {$ENDIF}
   { reset state }
   { reset state }
@@ -447,7 +447,7 @@ begin
           z.state^.sub.marker := 5;       { can't try inflateSync }
           z.state^.sub.marker := 5;       { can't try inflateSync }
           continue;           { break C-switch }
           continue;           { break C-switch }
         end;
         end;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate: zlib check ok');
         Tracev('inflate: zlib check ok');
         {$ENDIF}
         {$ENDIF}
         z.state^.mode := DONE; { falltrough }
         z.state^.mode := DONE; { falltrough }
@@ -512,7 +512,7 @@ begin
           z.state^.sub.marker := 5;       { can't try inflateSync }
           z.state^.sub.marker := 5;       { can't try inflateSync }
           continue;      { break C-switch }
           continue;      { break C-switch }
         end;
         end;
-        {$IFDEF DEBUG}
+        {$IFDEF ZLIB_DEBUG}
         Tracev('inflate: zlib header ok');
         Tracev('inflate: zlib header ok');
         {$ENDIF}
         {$ENDIF}
         if ((b and PRESET_DICT) = 0) then
         if ((b and PRESET_DICT) = 0) then

+ 4 - 0
packages/extra/gtk2/gtk+/gtk/gtktreeviewcolumn.inc

@@ -182,6 +182,10 @@ procedure gtk_tree_view_column_cell_get_size(tree_column:PGtkTreeViewColumn; cel
             height:Pgint); cdecl; external gtklib;
             height:Pgint); cdecl; external gtklib;
 function gtk_tree_view_column_cell_is_visible(tree_column:PGtkTreeViewColumn):gboolean; cdecl; external gtklib;
 function gtk_tree_view_column_cell_is_visible(tree_column:PGtkTreeViewColumn):gboolean; cdecl; external gtklib;
 procedure gtk_tree_view_column_focus_cell(tree_column:PGtkTreeViewColumn; cell:PGtkCellRenderer); cdecl; external gtklib;
 procedure gtk_tree_view_column_focus_cell(tree_column:PGtkTreeViewColumn; cell:PGtkCellRenderer); cdecl; external gtklib;
+
+// since gtk 2.4
+procedure gtk_tree_view_column_set_expand(tree_column: PGtkTreeViewColumn; Expand : gboolean); cdecl; external gtklib;
+function gtk_tree_view_column_get_expand(tree_column: PGtkTreeViewColumn): gboolean; cdecl; external gtklib;
 {$ENDIF read_interface_rest}
 {$ENDIF read_interface_rest}
 
 
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------