From: blundellc Date: Sat, 31 Jul 2010 23:06:34 +0000 (+0000) Subject: rename double_build -> split_build X-Git-Url: https://git.donarmstrong.com/?p=cran2deb.git;a=commitdiff_plain;h=42bff07893104a11db95c8d65fe518a336463351 rename double_build -> split_build git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@320 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- diff --git a/branch/double_build/DESCRIPTION b/branch/double_build/DESCRIPTION deleted file mode 100644 index b5129db..0000000 --- a/branch/double_build/DESCRIPTION +++ /dev/null @@ -1,11 +0,0 @@ -Package: cran2deb -Version: 0.0 -Date: 2008-07-14 -Title: Convert CRAN packages into Debian packages -Author: Charles Blundell , with assistance from Dirk Eddelbuettel <> -Maintainer: Charles Blundell -Depends: ctv, utils, RSQLite, DBI, digest, hwriter -SystemRequirements: littler, rc, pbuilder, debian toolchain, web server, mini-dinstall, curl -Description: Convert CRAN packages into Debian packages, mostly unassisted, easily - subverting the R package system. -License: GPL-3 diff --git a/branch/double_build/R/build.R b/branch/double_build/R/build.R deleted file mode 100644 index 60a3aac..0000000 --- a/branch/double_build/R/build.R +++ /dev/null @@ -1,133 +0,0 @@ - -build <- function(name,extra_deps,force=F,do_cleanup=T) { - # can't, and hence don't need to, build base packages - if (name %in% base_pkgs) { - return(T) - } - log_clear() - dir <- setup() - - # obtain the Debian version-to-be - version <- try(new_build_version(name)) - if (inherits(version,'try-error')) { - error('failed to build',name) - return(NULL) - } - - result <- try((function() { - if (!force && !needs_build(name,version)) { - notice('skipping build of',name) - return(NULL) - } - - if (name %in% db_blacklist_packages()) { - #fail('package',name,'is blacklisted. consult database for reason.') - notice('package',name,'is blacklisted. consult database for reason.') - return(NULL) - } - - pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps) - if (pkg$debversion != version) { - fail('expected Debian version',version,'not equal to actual version',pkg$debversion) - } - - notice('R dependencies:',paste(pkg$depends$r,collapse=', ')) - try_upload <- function(pkg, arch) { - ret = log_system('umask 002; reprepro -b ',reprepro_dir,' include testing', changesfile(pkg$srcname,pkg$debversion, arch)) - if (ret != 0) { - fail('upload failed!') - } - } - if (pkg$archdep) { - build_debian(pkg, indep_arch) - try_upload(pkg, indep_arch) - } else { - for (arch in archs) { - build_debian(pkg, arch) - try_upload(pkg, arch) - } - } - - return(pkg$debversion) - })()) - if (do_cleanup) { - cleanup(dir) - } else { - notice('output is in',dir,'. you must clean this up yourself.') - } - if (is.null(result)) { - # nothing was done so escape asap. - return(result) - } - - # otherwise record progress - failed = inherits(result,'try-error') - if (failed) { - error('failure of',name,'means these packages will fail:' - ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', ')) - } - db_record_build(name, version, log_retrieve(), !failed) - return(!failed) -} - -needs_build <- function(name,version) { - # see if the last build was successful - build <- db_latest_build(name) - if (!is.null(build) && build$success) { - # then something must have changed for us to attempt this - # build - if (build$r_version == version_upstream(version) && - build$deb_epoch == version_epoch(version) && - build$db_version == db_get_version()) { - return(F) - } - } else { - # always rebuild on failure or no record - notice('rebuilding',name,': no build record or previous build failed') - return(T) - } - # see if it has already been built *and* successfully uploaded - srcname <- pkgname_as_debian(name,binary=F) - debname <- pkgname_as_debian(name,binary=T) - all=TRUE - for (arch in archs) { - all = all && file.exists(changesfile(srcname, version, arch)) - } - if (all || file.exists(changesfile(srcname, version,indep_arch))) { - notice('already built',srcname,'version',version) - return(F) - } - - if (build$r_version != version_upstream(version)) { - notice('rebuilding',name,': new upstream version',build$r_version,'(old) vs',version_upstream(version),'(new)') - } - if (build$deb_epoch != version_epoch(version)) { - notice('rebuilding',name,': new cran2deb epoch',build$deb_epoch,'(old) vs',version_epoch(version),'(new)') - } - if (build$db_version != db_get_version()) { - notice('rebuilding',name,': new db version',build$db_version,'(old) vs',db_get_version(),'(new)') - } - rm(debname,srcname) - return(T) -} - -build_debian <- function(pkg,arch) { - wd <- getwd() - setwd(pkg$path) - notice('building Debian package' - ,pkg$debname - ,paste('(',pkg$debversion,')',sep='') - ,'for',arch,'...') - - cmd = paste('pdebuild --configfile',shQuote(get_pbuilder_config(arch))) - if (version_revision(pkg$debversion) > 2) { - cmd = paste(cmd,'--debbuildopts','-sd') - notice('build should exclude original source') - } - ret = log_system(cmd) - setwd(wd) - if (ret != 0) { - fail('Failed to build package.') - } -} - diff --git a/branch/double_build/R/db.R b/branch/double_build/R/db.R deleted file mode 100644 index a906b04..0000000 --- a/branch/double_build/R/db.R +++ /dev/null @@ -1,493 +0,0 @@ - -db_start <- function() { - drv <- dbDriver('SQLite') - con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db')) - if (!dbExistsTable(con,'sysreq_override')) { - dbGetQuery(con,paste('CREATE TABLE sysreq_override (' - ,' depend_alias TEXT NOT NULL' - ,',r_pattern TEXT PRIMARY KEY NOT NULL' - ,')')) - } - if (!dbExistsTable(con,'debian_dependency')) { - dbGetQuery(con,paste('CREATE TABLE debian_dependency (' - ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' - ,',system TEXT NOT NULL' - ,',alias TEXT NOT NULL' - ,',build INTEGER NOT NULL' - ,',debian_pkg TEXT NOT NULL' - ,',UNIQUE (alias,build,debian_pkg)' - ,')')) - } - if (!dbExistsTable(con,'forced_depends')) { - dbGetQuery(con,paste('CREATE TABLE forced_depends (' - ,' r_name TEXT NOT NULL' - ,',depend_alias TEXT NOT NULL' - ,',PRIMARY KEY (r_name,depend_alias)' - ,')')) - } - if (!dbExistsTable(con,'license_override')) { - dbGetQuery(con,paste('CREATE TABLE license_override (' - ,' name TEXT PRIMARY KEY NOT NULL' - ,',accept INT NOT NULL' - ,')')) - } - if (!dbExistsTable(con,'license_hashes')) { - dbGetQuery(con,paste('CREATE TABLE license_hashes (' - ,' name TEXT NOT NULL' - ,',sha1 TEXT PRIMARY KEY NOT NULL' - ,')')) - } - if (!dbExistsTable(con,'database_versions')) { - dbGetQuery(con,paste('CREATE TABLE database_versions (' - ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' - ,',version_date INTEGER NOT NULL' - ,',base_epoch INTEGER NOT NULL' - ,')')) - db_add_version(con,1,0) - } - if (!dbExistsTable(con,'packages')) { - dbGetQuery(con,paste('CREATE TABLE packages (' - ,' package TEXT PRIMARY KEY NOT NULL' - ,',latest_r_version TEXT' - ,')')) - } - if (!dbExistsTable(con,'builds')) { - dbGetQuery(con,paste('CREATE TABLE builds (' - ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' - ,',system TEXT NOT NULL' - ,',package TEXT NOT NULL' - ,',r_version TEXT NOT NULL' - ,',deb_epoch INTEGER NOT NULL' - ,',deb_revision INTEGER NOT NULL' - ,',db_version INTEGER NOT NULL' - ,',date_stamp TEXT NOT NULL' - ,',time_stamp TEXT NOT NULL' - ,',scm_revision TEXT NOT NULL' - ,',success INTEGER NOT NULL' - ,',log TEXT' - ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)' - ,')')) - } - if (!dbExistsTable(con,'blacklist_packages')) { - dbGetQuery(con,paste('CREATE TABLE blacklist_packages (' - ,' package TEXT PRIMARY KEY NOT NULL ' - ,',system TEXT NOT NULL' - ,',nonfree INTEGER NOT NULL DEFAULT 0' - ,',obsolete INTEGER NOT NULL DEFAULT 0' - ,',broken_dependency INTEGER NOT NULL DEFAULT 0' - ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0' - ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0' - ,',other INTEGER NOT NULL DEFAULT 0' - ,',explanation TEXT NOT NULL ' - ,')')) - } - return(con) -} - -db_stop <- function(con,bump=F) { - if (bump) { - db_bump(con) - } - dbDisconnect(con) -} - -db_quote <- function(text) { - return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep='')) -} - -db_now <- function() { - return(as.integer(gsub('-','',Sys.Date()))) -} - -db_cur_version <- function(con) { - return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]])) -} - -db_base_epoch <- function(con) { - return(as.integer(dbGetQuery(con, - paste('SELECT max(base_epoch) FROM database_versions' - ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]])) -} - -db_get_base_epoch <- function() { - con <- db_start() - v <- db_base_epoch(con) - db_stop(con) - return(v) -} - -db_get_version <- function() { - con <- db_start() - v <- db_cur_version(con) - db_stop(con) - return(v) -} - -db_add_version <- function(con, version, epoch) { - dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)' - ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')')) -} - -db_bump <- function(con) { - db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)) -} - -db_bump_epoch <- function(con) { - db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1) -} - -db_sysreq_override <- function(sysreq_text) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE' - ,db_quote(tolower(sysreq_text)),'LIKE r_pattern')) - db_stop(con) - if (length(results) == 0) { - return(NULL) - } - return(results$depend_alias) -} - -db_add_sysreq_override <- function(pattern,depend_alias) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'INSERT OR REPLACE INTO sysreq_override' - ,'(depend_alias, r_pattern) VALUES (' - ,' ',db_quote(tolower(depend_alias)) - ,',',db_quote(tolower(pattern)) - ,')')) - db_stop(con) -} - -db_sysreq_overrides <- function() { - con <- db_start() - overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override')) - db_stop(con) - return(overrides) -} - -db_get_depends <- function(depend_alias,build=F) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE' - ,db_quote(tolower(depend_alias)),'= alias' - ,'AND',as.integer(build),'= build', - ,'AND',db_quote(which_system),'= system')) - db_stop(con) - return(results$debian_pkg) -} - -db_add_depends <- function(depend_alias,debian_pkg,build=F) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'INSERT OR REPLACE INTO debian_dependency' - ,'(system, alias, build, debian_pkg) VALUES (' - ,' ',db_quote(which_system) - ,' ',db_quote(tolower(depend_alias)) - ,',',as.integer(build) - ,',',db_quote(tolower(debian_pkg)) - ,')')) - db_stop(con) -} - -db_depends <- function() { - con <- db_start() - depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency WHERE system = ',db_quote(which_system))) - db_stop(con) - return(depends) -} - -db_get_forced_depends <- function(r_name) { - con <- db_start() - forced_depends <- dbGetQuery(con, - paste('SELECT depend_alias FROM forced_depends WHERE' - ,db_quote(r_name),'= r_name')) - db_stop(con) - return(forced_depends$depend_alias) -} - -db_add_forced_depends <- function(r_name, depend_alias) { - if (!length(db_get_depends(depend_alias,build=F)) && - !length(db_get_depends(depend_alias,build=T))) { - fail('Debian dependency alias',depend_alias,'is not know,' - ,'yet trying to force a dependency on it?') - } - con <- db_start() - dbGetQuery(con, - paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)' - ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')')) - db_stop(con) -} - -db_forced_depends <- function() { - con <- db_start() - depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends')) - db_stop(con) - return(depends) -} - -db_license_override_name <- function(name) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'SELECT DISTINCT accept FROM license_override WHERE' - ,db_quote(tolower(name)),'= name')) - db_stop(con) - if (length(results) == 0) { - return(NULL) - } - return(as.logical(results$accept)) -} - -db_add_license_override <- function(name,accept) { - notice('adding',name,'accept?',accept) - if (accept != TRUE && accept != FALSE) { - fail('accept must be TRUE or FALSE') - } - con <- db_start() - results <- dbGetQuery(con,paste( - 'INSERT OR REPLACE INTO license_override' - ,'(name, accept) VALUES (' - ,' ',db_quote(tolower(name)) - ,',',as.integer(accept) - ,')')) - db_stop(con) -} - -db_license_override_hash <- function(license_sha1) { - con <- db_start() - results <- dbGetQuery(con,paste( - 'SELECT DISTINCT accept FROM license_override' - ,'INNER JOIN license_hashes' - ,'ON license_hashes.name = license_override.name WHERE' - ,db_quote(tolower(license_sha1)),'= license_hashes.sha1')) - db_stop(con) - if (length(results) == 0) { - return(NULL) - } - return(as.logical(results$accept)) -} - -db_license_overrides <- function() { - con <- db_start() - overrides <- dbGetQuery(con,paste('SELECT * FROM license_override')) - hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes')) - db_stop(con) - return(list(overrides=overrides,hashes=hashes)) -} - -db_add_license_hash <- function(name,license_sha1) { - if (is.null(db_license_override_name(name))) { - fail('license',name,'is not know, yet trying to add a hash for it?') - } - notice('adding hash',license_sha1,'for',name) - con <- db_start() - dbGetQuery(con,paste( - 'INSERT OR REPLACE INTO license_hashes' - ,'(name, sha1) VALUES (' - ,' ',db_quote(tolower(name)) - ,',',db_quote(tolower(license_sha1)) - ,')')) - db_stop(con) -} - - -db_update_package_versions <- function() { - # seems like the quickest way of doing this: - con <- db_start() - dbGetQuery(con, 'DROP TABLE packages') - db_stop(con) - # db_start re-makes all tables - con <- db_start() - for (package in available[,'Package']) { - dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)' - ,'VALUES (',db_quote(package) - ,',',db_quote(available[package,'Version']),')')) - } - dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)') - db_stop(con) -} - -db_date_format <- '%Y-%m-%d' -db_time_format <- '%H:%M:%OS' - -db_record_build <- function(package, deb_version, log, success=F) { - # if the log is more than 1kB, only keep the last 1kB. - # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors. - # if the log is not pruned then we get the following error: - # - # Error in gsub("(['\"])", "\\1\\1", text) : - # Calloc could not allocate (-197080581 of 1) memory - # Error in dbGetQuery(con, paste("INSERT OR REPLACE INTO builds", "(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)", : - # error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery' - - log <- paste(log,collapse='\n') - end <- nchar(log) - max_log_len <- 10240 - if (end > max_log_len) { - log <- db_quote(substr(log,end-max_log_len,end)) - } else { - log <- db_quote(log) - } - con <- db_start() - o <- options(digits.secs = 6) - sqlcmd <- paste('INSERT OR REPLACE INTO builds' - ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)' - ,'VALUES' - ,'(',db_quote(package) - ,',',db_quote(which_system) - ,',',db_quote(version_upstream(deb_version)) - ,',',db_quote(version_epoch(deb_version)) - ,',',db_quote(version_revision(deb_version)) - ,',',db_cur_version(con) - ,',',as.integer(success) - ,',',db_quote(format(Sys.time(), db_date_format)) - ,',',db_quote(format(Sys.time(), db_time_format)) - ,',',db_quote(scm_revision) - ,',',log - ,')') - ##print(sqlcmd) - try(dbGetQuery(con,sqlcmd)) - options(o) - db_stop(con) -} - -db_builds <- function(pkgname) { - # returns all successful builds - con <- db_start() - build <- dbGetQuery(con, paste('SELECT * FROM builds' - ,'WHERE success = 1' - ,'AND system =',db_quote(which_system) - ,'AND package =',db_quote(pkgname))) - db_stop(con) - if (length(build) == 0) { - return(NULL) - } - return(db_cleanup_builds(build)) -} - -db_cleanup_builds <- function(build) { - build$success <- as.logical(build$success) - #o <-options(digits.secs = 6) - dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])), - paste(db_date_format, db_time_format))) - build$time_stamp <- NULL - build$date_stamp <- NULL - newdf <- data.frame(build, date_stamp=dt) - #print(newdf[, -grep("log", colnames(newdf))]) - #options(o) - #print(newdf[, -grep("log", colnames(newdf))]) - return(newdf) -} - -db_latest_build <- function(pkgname) { - con <- db_start() - build <- dbGetQuery(con, paste('SELECT * FROM builds' - ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' - , 'WHERE system =',db_quote(which_system) - , 'GROUP BY package) AS last' - ,'WHERE id = max_id' - ,'AND builds.package =',db_quote(pkgname))) - db_stop(con) - if (length(build) == 0) { - return(NULL) - } - return(db_cleanup_builds(build)) -} - -db_latest_build_version <- function(pkgname) { - build <- db_latest_build(pkgname) - if (is.null(build)) { - return(NULL) - } - return(version_new(build$r_version, build$deb_revision, build$deb_epoch)) -} - -db_latest_build_status <- function(pkgname) { - build <- db_latest_build(pkgname) - if (is.null(build)) { - return(NULL) - } - return(list(build$success,build$log)) -} - -db_outdated_packages <- function() { - con <- db_start() - packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages' - ,'LEFT OUTER JOIN (' - # extract the latest attempt at building each package - , 'SELECT * FROM builds' - , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' - , 'WHERE system =',db_quote(which_system) - , 'GROUP BY package) AS last' - , 'WHERE id = max_id) AS build' - ,'ON build.package = packages.package' - # outdated iff: - # - there is no latest build - ,'WHERE build.package IS NULL' - # - the database has changed since last build - ,'OR build.db_version < (SELECT max(version) FROM database_versions)' - # - the debian epoch has been bumped up - ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions' - , 'WHERE version IN (' - , 'SELECT max(version) FROM database_versions))' - # - the latest build is not of the latest R version - ,'OR build.r_version != packages.latest_r_version' - ))$package - db_stop(con) - return(packages) -} - -db_blacklist_packages <- function() { - con <- db_start() - packages <- dbGetQuery(con,paste('SELECT package from blacklist_packages' - ,' where system=',db_quote(which_system)))$package - db_stop(con) - return(packages) -} - -db_blacklist_reasons <- function () { - con <- db_start() - packages <- dbGetQuery(con,paste('SELECT package,explanation from blacklist_packages' - ,'where system=',db_quote(which_system),' group by explanation')) - db_stop(con) - return(packages) -} - -db_todays_builds <- function() { - today <- db_quote(format(Sys.time(), db_date_format)) - con <- db_start() - builds <- dbGetQuery(con,paste('select id,success,system,package, - r_version as version,deb_epoch as epo, - deb_revision as rev, scm_revision as svnrev, - db_version as db,date_stamp,time_stamp - from builds where date_stamp = ',today)) - db_stop(con) - return(builds) -} - -db_successful_builds <- function() { - con <- db_start() - builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp - from builds natural join (select system,package,max(id) as id - from builds - where package not in - (select package from blacklist_packages - where blacklist_packages.system == builds.system) - group by package,system) - where success = 1') - db_stop(con) - return(builds) -} - -db_failed_builds <- function() { - con <- db_start() - builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp - from builds natural join (select system,package,max(id) as id - from builds - where package not in - (select package from blacklist_packages) - group by package,system) - where success = 0') - db_stop(con) - return(builds) -} diff --git a/branch/double_build/R/debcontrol.R b/branch/double_build/R/debcontrol.R deleted file mode 100644 index a044f89..0000000 --- a/branch/double_build/R/debcontrol.R +++ /dev/null @@ -1,168 +0,0 @@ -get_dependencies <- function(pkg,extra_deps) { - # determine dependencies - dependencies <- r_dependencies_of(description=pkg$description) - depends <- list() - # these are used for generating the Depends fields - as_deb <- function(r,build) { - return(pkgname_as_debian(paste(dependencies[r,]$name) - ,version=dependencies[r,]$version - ,repopref=pkg$repo - ,build=build)) - } - depends$bin <- lapply(rownames(dependencies), as_deb, build=F) - depends$build <- lapply(rownames(dependencies), as_deb, build=T) - # add the command line dependencies - depends$bin = c(extra_deps$deb,depends$bin) - depends$build = c(extra_deps$deb,depends$build) - # add the system requirements - if ('SystemRequirements' %in% colnames(pkg$description)) { - sysreq <- sysreqs_as_debian(pkg$description[1,'SystemRequirements']) - depends$bin = c(sysreq$bin,depends$bin) - depends$build = c(sysreq$build,depends$build) - } - - forced <- forced_deps_as_debian(pkg$name) - if (length(forced)) { - notice('forced build dependencies:',paste(forced$build, collapse=', ')) - notice('forced binary dependencies:',paste(forced$bin, collapse=', ')) - depends$bin = c(forced$bin,depends$bin) - depends$build = c(forced$build,depends$build) - } - - # make sure we depend upon R in some way... - if (!length(grep('^r-base',depends$build))) { - depends$build = c(depends$build,pkgname_as_debian('R',version='>= 2.7.0',build=T)) - depends$bin = c(depends$bin, pkgname_as_debian('R',version='>= 2.7.0',build=F)) - } - # also include stuff to allow tcltk to build (suggested by Dirk) - depends$build = c(depends$build,'xvfb','xauth','xfonts-base') - - # make all bin dependencies build dependencies. - depends$build = c(depends$build, depends$bin) - - # remove duplicates - depends <- lapply(depends,unique) - - # append the Debian dependencies - depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs') - if (file.exists(file.path(patch_dir, pkg$name))) { - depends$build <- c(depends$build,'dpatch') - } - if (pkg$archdep) { - depends$bin=c(depends$bin,'${shlibs:Depends}') - } - - # the names of dependent source packages (to find the .changes file to - # upload via dput). these can be found recursively. - depends$r = r_dependency_closure(dependencies) - # append command line dependencies - depends$r = c(extra_deps$r, depends$r) - return(depends) -} - -sysreqs_as_debian <- function(sysreq_text) { - # form of this field is unspecified (ugh) but most people seem to stick - # with this - aliases <- c() - sysreq_text <- gsub('[[:space:]]and[[:space:]]',' , ',tolower(sysreq_text)) - for (sysreq in strsplit(sysreq_text,'[[:space:]]*,[[:space:]]*')[[1]]) { - startreq = sysreq - # constant case - sysreq = tolower(sysreq) - # drop version information/comments for now - sysreq = gsub('[[][^])]*[]]','',sysreq) - sysreq = gsub('\\([^)]*\\)','',sysreq) - sysreq = gsub('[[][^])]*[]]','',sysreq) - sysreq = gsub('version','',sysreq) - sysreq = gsub('from','',sysreq) - sysreq = gsub('[<>=]*[[:space:]]*[[:digit:]]+[[:digit:].+:~-]*','',sysreq) - # byebye URLs - sysreq = gsub('(ht|f)tps?://[[:alnum:]!?*"\'(),%$_@.&+/=-]*','',sysreq) - # squish out space - sysreq = chomp(gsub('[[:space:]]+',' ',sysreq)) - if (nchar(sysreq) == 0) { - notice('part of the SystemRequirement became nothing') - next - } - alias <- db_sysreq_override(sysreq) - if (is.null(alias)) { - error('do not know what to do with SystemRequirement:',sysreq) - error('original SystemRequirement:',startreq) - fail('unmet system requirement') - } - notice('mapped SystemRequirement',startreq,'onto',alias,'via',sysreq) - aliases = c(aliases,alias) - } - return(map_aliases_to_debian(aliases)) -} - -forced_deps_as_debian <- function(r_name) { - aliases <- db_get_forced_depends(r_name) - return(map_aliases_to_debian(aliases)) -} - -map_aliases_to_debian <- function(aliases) { - if (!length(aliases)) { - return(aliases) - } - debs <- list() - debs$bin = unlist(sapply(aliases, db_get_depends)) - debs$build = unlist(sapply(aliases, db_get_depends, build=T)) - debs$bin = debs$bin[debs$bin != 'build-essential'] - debs$build = debs$build[debs$build != 'build-essential'] - return(debs) -} - -generate_control <- function(pkg) { - # construct control file - - control <- data.frame() - control[1,'Source'] <- pkg$srcname - control[1,'Section'] <- 'gnu-r' - control[1,'Priority'] <- 'optional' - control[1,'Maintainer'] <- maintainer - control[1,'Build-Depends'] <- paste(pkg$depends$build, collapse=', ') - control[1,'Standards-Version'] <- '3.8.4' - - control[2,'Package'] <- pkg$debname - control[2,'Architecture'] <- 'all' - if (pkg$archdep) { - control[2,'Architecture'] <- 'any' - } - control[2,'Depends'] <- paste(pkg$depends$bin,collapse=', ') - - # generate the description - descr <- 'GNU R package "' - if ('Title' %in% colnames(pkg$description)) { - descr <- paste(descr,pkg$description[1,'Title'],sep='') - } else { - descr <- paste(descr,pkg$name,sep='') - } - long_descr <- pkg$description[1,'Description'] - - if (length(long_descr) < 1 || long_descr == "") { - # bypass lintian extended-description-is-empty for which we care not. - long_descr <- paste('The author/maintainer of this package' - ,'did not care to enter a longer description.') - } - - # using \n\n.\n\n is not very nice, but is necessary to make sure - # the longer description does not begin on the synopsis line --- R's - # write.dcf does not appear to have a nicer way of doing this. - descr <- paste(descr,'"\n\n', long_descr, sep='') - # add some extra nice info about the original R package - for (r_info in c('Author','Maintainer','URL')) { - if (r_info %in% colnames(pkg$description)) { - descr <- paste(descr,'\n\n',r_info,': ',pkg$description[1,r_info],sep='') - } - } - if (Encoding(descr) == "unknown") - Encoding(descr) <- "latin1" # or should it be UTF-8 - - control[2,'Description'] <- descr - - # Debian policy says 72 char width; indent minimally - write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72) - write.dcf(control,indent=1,width=72) -} - diff --git a/branch/double_build/R/debiannaming.R b/branch/double_build/R/debiannaming.R deleted file mode 100644 index 7e07c9e..0000000 --- a/branch/double_build/R/debiannaming.R +++ /dev/null @@ -1,46 +0,0 @@ -repourl_as_debian <- function(url) { - # map the url to a repository onto its name in debian package naming - if (length(grep('cran',url))) { - return('cran') - } - if (length(grep('bioc',url))) { - return('bioc') - } - fail('unknown repository',url) -} - -pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) { - # generate the debian package name corresponding to the R package name - if (name %in% base_pkgs) { - name = 'R' - } - if (name == 'R') { - # R is special. - if (binary) { - if (build) { - debname='r-base-dev' - } else { - debname='r-base-core' - } - } else { - debname='R' - } - } else { - # XXX: data.frame rownames are unique, so always override repopref for - # now. - debname = tolower(name) - if (binary) { - if (name %in% rownames(available)) { - repopref <- tolower(repourl_as_debian(available[name,'Repository'])) - } else if (is.null(repopref)) { - repopref <- 'unknown' - } - debname = paste('r',repopref,debname,sep='-') - } - } - if (!is.null(version) && length(version) > 1) { - debname = paste(debname,' (',version,')',sep='') - } - return(debname) -} - diff --git a/branch/double_build/R/debianpkg.R b/branch/double_build/R/debianpkg.R deleted file mode 100644 index 3b33ca2..0000000 --- a/branch/double_build/R/debianpkg.R +++ /dev/null @@ -1,136 +0,0 @@ -append_build_from_pkg <- function(pkg, builds) { - pkg_build <- data.frame(id = -1 # never used - ,package = pkg$name - ,system = which_system - ,r_version = version_upstream(pkg$debversion) - ,deb_epoch = version_epoch(pkg$debversion) - ,deb_revision = version_revision(pkg$debversion) - ,db_version = db_get_version() - ,date_stamp = pkg$date_stamp - ,scm_revision = scm_revision - ,success = 1 # never used - ,log = '' # never used - ) - return(cbind(data.frame(srcname=pkg$srcname), rbind(builds, pkg_build))) -} - -generate_changelog <- function(pkg) { - # TODO: ``Writing R extensions'' mentions that a package may also have - # {NEWS,ChangeLog} files. - builds <- append_build_from_pkg(pkg, db_builds(pkg$name)) - sapply(rev(rownames(builds)), function(b, changelog) generate_changelog_entry(builds[b,], changelog), pkg$debfile('changelog.in')) -} - -generate_changelog_entry <- function(build, changelog) { - # TODO: should say 'New upstream release' when necessary - debversion <- version_new(build$r_version, build$deb_revision, build$deb_epoch) - cat(paste(paste(build$srcname,' (',debversion,') testing; urgency=low',sep='') - ,'' ,paste(' * cran2deb ',build$scm_revision - ,' with DB version ',as.integer(build$db_version),'.',sep='') - ,'',paste(' --',maintainer,'',format(build$date_stamp,'%a, %d %b %Y %H:%M:%S %z')) - ,'','','',sep='\n'),file=changelog, append=TRUE) -} - -generate_rules <- function(pkg) { - cat(paste('#!/usr/bin/make -f' - ,paste('debRreposname :=',pkg$repo) - ,'include /usr/share/R/debian/r-cran.mk' - ,'',sep='\n') - ,file=pkg$debfile('rules')) - if (pkg$name %in% c("Rmpi", "npRmpi", "doMPI")) { - cat("extraInstallFlags=\"--no-test-load\"\n", file=pkg$debfile('rules'), append=TRUE) - } - Sys.chmod(pkg$debfile('rules'),'0700') -} - -generate_copyright <- function(pkg) { - # generate_copyright file; we trust DESCRIPTION - - # if maintainer is missing then try to use author - if (!('Maintainer' %in% colnames(pkg$description))) { - if ('Author' %in% colnames(pkg$description)) { - maintainer = pkg$description[1,'Author'] - } else { - fail('Maintainer and Author not defined in R DESCRIPTION') - } - } else { - maintainer = pkg$description[1,'Maintainer'] - } - # likewise if author is missing then try to use maintainer - if (!('Author' %in% colnames(pkg$description))) { - author = maintainer - } else { - author = pkg$description[1,'Author'] - } - - writeLines(strwrap( - paste('This Debian package of the GNU R package',pkg$name - ,'was generated automatically using cran2deb by' - ,paste(maintainer,'.',sep='') - ,'' - ,'The original GNU R package is Copyright (C) ' - # TODO: copyright start date, true copyright date - ,format(Sys.time(),'%Y') - ,author - ,'and possibly others.' - ,'' - ,'The original GNU R package is maintained by' - ,maintainer,'and was obtained from:' - ,'' - ,pkg$repoURL - ,'' - ,'' - ,'The GNU R package DESCRIPTION offers a' - ,'Copyright licenses under the terms of the license:' - ,pkg$license,'. On a Debian GNU/Linux system, common' - ,'licenses are included in the directory' - ,'/usr/share/common-licenses/.' - ,'' - ,'The DESCRIPTION file for the original GNU R package ' - ,'can be found in ' - ,file.path('/usr/lib/R/site-library' - ,pkg$debname - ,'DESCRIPTION' - ) - ,sep='\n'), width=72), con=pkg$debfile('copyright.in')) -} - -prepare_new_debian <- function(pkg,extra_deps) { - # generate Debian version and name - pkg$debversion = new_build_version(pkg$name) - - # make the debian/ directory - debdir <- file.path(pkg$path,'debian') - pkg$debfile <- function(x) { file.path(debdir,x) } - unlink(debdir,recursive=T) - dir.create(debdir) - - # see if this is an architecture-dependent package. - # heuristic: if /src/ exists in pkg$path, then this is an - # architecture-dependent package. - # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions'' - # says: ``The sources and headers for the compiled code are in src, plus - # optionally file Makevars or Makefile.'' It seems unlikely that - # architecture independent code would end up here. - pkg$archdep = file.exists(file.path(pkg$path,'src')) - pkg$license <- accept_license(pkg) - pkg$depends <- get_dependencies(pkg,extra_deps) - apply_patches(pkg) - generate_lintian(pkg) - generate_changelog(pkg) - generate_rules(pkg) - generate_copyright(pkg) - generate_control(pkg) - ## debdir <- file.path(pkg$path,'debian') - ## system(paste("ls ", debdir, "; ls -l ", debdir, "/patches/*", sep="")) - - # convert text to utf8 (who knows what the original character set is -- - # let's hope iconv DTRT). - for (file in c('control','changelog','copyright')) { - log_system('iconv -o ',shQuote(pkg$debfile(file)) - ,' -t utf8 -c ' - ,shQuote(pkg$debfile(paste(file,'in',sep='.')))) - file.remove(pkg$debfile(paste(file,'in',sep='.'))) - } - return(pkg) -} diff --git a/branch/double_build/R/getrpkg.R b/branch/double_build/R/getrpkg.R deleted file mode 100644 index 38d7a59..0000000 --- a/branch/double_build/R/getrpkg.R +++ /dev/null @@ -1,166 +0,0 @@ -setup <- function() { - # set up the working directory - tmp <- tempfile('cran2deb') - dir.create(tmp) - return (tmp) -} - -cleanup <- function(dir) { - # remove the working directory - unlink(dir,recursive=T) - invisible() -} - -download_pkg <- function(dir, pkgname) { - # download pkgname into dir, and construct some metadata - - # record some basic information - pkg <- pairlist() - pkg$date_stamp = Sys.time() - pkg$name = pkgname - pkg$repoURL = available[pkgname,'Repository'] - pkg$repo = repourl_as_debian(pkg$repoURL) - if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) { - fail('Cannot convert package name into a Debian name',pkg$name) - } - pkg$srcname = pkgname_as_debian(pkg$name,binary=F) - pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo) - pkg$version <- available[pkgname,'Version'] - - # see if we have already built this release and uploaded it. - debfn <- get_reprepro_orig_tgz(pkg$srcname, pkg$version) - pkg$need_repack = FALSE - if (file.exists(debfn)) { - # if so, use the existing archive. this is good for three reasons: - # 1. it saves downloading the archive again - # 2. the repacking performed below changes the MD5 sum of the archive - # which upsets some Debian archive software. - # 3. why repack more than once? - pkg$archive <- file.path(dir, basename(debfn)) - file.copy(debfn,pkg$archive) - pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-')) - notice('using an existing debianized source tarball:',debfn) - } else { - # see if we have a local mirror in /srv/R - use_local = FALSE - if (pkg$repo == 'cran') { - localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) - use_local = file.exists(localfn) - } else if (pkg$repo == 'bioc') { - localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) - use_local = file.exists(localfn) - } - - fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='') - archive <- file.path(dir, fn) - - if (use_local) { - file.copy(localfn, archive) - } else { - # use this instead of download.packages as it is more resilient to - # dodgy network connections (hello BT 'OpenWorld', bad ISP) - url <- paste(available[pkgname,'Repository'], fn, sep='/') - # don't log the output -- we don't care! - ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url))) - if (ret != 0) { - fail('failed to download',url) - } - # end of download.packages replacement - } - - if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) { - fail('funny looking path',archive) - } - pkg$path = sub("_\\.(zip|tar\\.gz)", "" - ,gsub(.standard_regexps()$valid_package_version, "" - ,archive)) - pkg$archive = archive - # this is not a Debian conformant archive - pkg$need_repack = TRUE - } - return(pkg) -} - -repack_pkg <- function(pkg) { - # re-pack into a Debian-named archive with a Debian-named directory. - notice('repacking into debian source archive.') - debpath = file.path(dirname(pkg$archive) - ,paste(pkg$srcname - ,pkg$version - ,sep='-')) - file.rename(pkg$path, debpath) - pkg$path = debpath - debarchive = file.path(dirname(pkg$archive) - ,paste(pkg$srcname,'_' - ,pkg$version,'.orig.tar.gz' - ,sep='')) - wd <- getwd() - setwd(dirname(pkg$path)) - # remove them pesky +x files - # BUT EXCLUDE configure and cleanup - log_system('find',shQuote(basename(pkg$path)) - ,'-type f -a ' - , '! \\( -name configure -o -name cleanup \\)' - ,'-exec chmod -x {} \\;') - if (file.exists(file.path(basename(pkg$path),'debian'))) { - warn('debian/ directory found in tarball! removing...') - unlink(file.path(basename(pkg$path),'debian'),recursive=TRUE) - } - # tar it all back up - log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))) - setwd(wd) - file.remove(pkg$archive) - pkg$archive = debarchive - pkg$need_repack = FALSE - return(pkg) -} - -prepare_pkg <- function(dir, pkgname) { - # download and extract an R package named pkgname - - # based loosely on library/utils/R/packages2.R::install.packages - - # grab the archive and some metadata - pkg <- download_pkg(dir, pkgname) - - # now extract the archive - if (!length(grep('\\.tar\\.gz',pkg$archive))) { - fail('archive is not tarball') - } - wd <- getwd() - setwd(dir) - ret = log_system('tar','xzf',shQuote(pkg$archive)) - setwd(wd) - if (ret != 0) { - fail('Extraction of archive',pkg$archive,'failed.') - } - - # if necessary, repack the archive into Debian-conformant format - if (pkg$need_repack) { - pkg <- repack_pkg(pkg) - } - if (!file.info(pkg$path)[,'isdir']) { - fail(pkg$path,'is not a directory and should be.') - } - - # extract the DESCRIPTION file, which contains much metadata - pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) - - # ensure consistency of version numbers - if ('Version' %in% names(pkg$description[1,])) { - if (pkg$description[1,'Version'] != available[pkg$name,'Version']) { - # should never happen since available is the basis upon which the - # package is retrieved. - error('available version:',available[pkg$name,'Version']) - error('package version:',pkg$description[1,'Version']) - fail('inconsistency between R package version and cached R version') - } - } - - # note subtly of short circuit operators (no absorption) - if (pkg$description[1,'Package'] != pkg$name) { - fail('package name mismatch') - } - return(pkg) -} - diff --git a/branch/double_build/R/license.R b/branch/double_build/R/license.R deleted file mode 100644 index 113b99e..0000000 --- a/branch/double_build/R/license.R +++ /dev/null @@ -1,166 +0,0 @@ -is_acceptable_license <- function(license) { - # determine if license text is acceptable - - if (length(grep('^file ',license))) { - # skip file licenses - return(FALSE) - } - license <- license_text_reduce(license) - action = db_license_override_name(license) - if (!is.null(action)) { - return(action) - } - license <- license_text_further_reduce(license) - action = db_license_override_name(license) - if (!is.null(action)) { - warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') - return(action) - } - license <- license_text_extreme_reduce(license) - action = db_license_override_name(license) - if (!is.null(action)) { - warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') - return(action) - } - error('Wild license',license,'did not match classic rules; rejecting') - return(F) -} - -license_text_reduce <- function(license) { - # these reduction steps are sound for all conformant R license - # specifications. - - if (Encoding(license) == "unknown") - Encoding(license) <- "latin1" # or should it be UTF-8 ? - - ## compress spaces into a single space - license = gsub('[[:space:]]+',' ',license) - # make all characters lower case - license = tolower(license) - # don't care about versions of licenses - license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' - ,sub('-[0-9.-]+','',license))) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - return(license) -} - -license_text_further_reduce <- function(license) { - # these reduction steps are heuristic and may lead to - # in correct acceptances, if care is not taken. - - # uninteresting urls - license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license) - license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license) - license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license) - # remove all punctuation - license = gsub('[[:punct:]]+','',license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - # redundant - license = gsub('the','',license) - license = gsub('see','',license) - license = gsub('standard','',license) - license = gsub('licen[sc]e','',license) - license = gsub('(gnu )?(gpl|general public)','gpl',license) - license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - return(license) -} - -license_text_extreme_reduce <- function(license) { - # remove everything that may or may not be a version specification - license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?','' - ,license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - return(license) -} - -license_text_hash_reduce <- function(text) { - # reduction of license text, suitable for hashing. - return(chomp(tolower(gsub('[[:space:]]+',' ',text)))) -} - -get_license <- function(pkg,license) { - license <- chomp(gsub('[[:space:]]+',' ',license)) - if (length(grep('^file ',license))) { - if (length(grep('^file LICEN[CS]E$',license))) { - file = gsub('file ','',license) - path = file.path(pkg$path, file) - if (file.exists(path)) { - #license <- license_text_reduce(readChar(path,file.info(path)$size)) - con <- file(path, "rb") - content <- paste(readLines(con), collapse="\n") - close(con) - license <- license_text_reduce(content) - } else { - path = file.path(pkg$path, 'inst', file) - if (file.exists(path)) { - #license <- license_text_reduce(readChar(path,file.info(path)$size)) - con <- file(path, "rb") - content <- paste(readLines(con), collapse="\n") - close(con) - license <- license_text_reduce(content) - } else { - error('said to look at a license file but license file is missing') - } - } - } else { - error('invalid license file specification',license) - return(NA) - } - } - return(license) -} - -get_license_hash <- function(pkg,license) { - return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE)) -} - -is_acceptable_hash_license <- function(pkg,license) { - license_sha1 <- get_license_hash(pkg,license) - if (is.null(license_sha1)) { - return(FALSE) - } - action = db_license_override_hash(license_sha1) - if (is.null(action)) { - action = FALSE - } - if (action) { - warn('Wild license',license,'accepted via hash',license_sha1) - } - return(action) -} - - -accept_license <- function(pkg) { - # check the license - if (!('License' %in% names(pkg$description[1,]))) { - fail('package has no License: field in description!') - } - accept=NULL - for (license in strsplit(chomp(pkg$description[1,'License']) - ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { - if (is_acceptable_license(license)) { - accept=license - break - } - if (is_acceptable_hash_license(pkg,license)) { - accept=license - break - } - } - if (is.null(accept)) { - fail('No acceptable license:',pkg$description[1,'License']) - } else { - notice('Auto-accepted license',accept) - } - if (accept == 'Unlimited') { - # definition of Unlimited from ``Writing R extensions'' - accept=paste('Unlimited (no restrictions on distribution or' - ,'use other than those imposed by relevant laws)') - } - return(accept) -} diff --git a/branch/double_build/R/lintian.R b/branch/double_build/R/lintian.R deleted file mode 100644 index 9aa02fa..0000000 --- a/branch/double_build/R/lintian.R +++ /dev/null @@ -1,14 +0,0 @@ -generate_lintian <- function(pkg) { - lintian_src = file.path(lintian_dir, pkg$name) - if (!file.exists(lintian_src)) { - notice('no lintian overrides ', lintian_src) - return() - } - - # copy the lintian file - notice('including lintian file', lintian_src) - lintian_tgt <- pkg$debfile(paste(pkg$debname, "lintian-overrides", sep=".")) - file.copy(lintian_src, lintian_tgt) - invisible(NULL) -} - diff --git a/branch/double_build/R/log.R b/branch/double_build/R/log.R deleted file mode 100644 index 3d74bae..0000000 --- a/branch/double_build/R/log.R +++ /dev/null @@ -1,66 +0,0 @@ -log_messages <- list() - -log_clear <- function() { - assign('log_messages',list(),envir=.GlobalEnv) -} - -log_add <- function(text,print=T) { - if (print) { - message(text) - } - assign('log_messages',c(log_messages, text),envir=.GlobalEnv) -} - -log_retrieve <- function() { - return(log_messages) -} - -notice <- function(...) { - log_add(paste('N:',...)) -} - -warn <- function(...) { - log_add(paste('W:',...)) -} - -error <- function(...) { - log_add(paste('E:',...)) -} - -fail <- function(...) { - txt <- paste('E:',...) - log_add(txt) - stop(txt) -} - -log_system <- function(...) { - r <- try((function() { - # pipe() does not appear useful here, since - # we want the return value! - # XXX: doesn't work with ; or | ! - tmp <- tempfile('log_system') - on.exit(unlink(tmp)) - cmd <- paste(...) - # unfortunately this destroys ret - #cmd <- paste(cmd,'2>&1','| tee',tmp) - cmd <- paste(cmd,'>',tmp,'2>&1') - ret <- system(cmd) - f <- file(tmp) - output <- readLines(f) - close(f) - unlink(tmp) - return(list(ret,output)) - })()) - if (inherits(r,'try-error')) { - fail('system failed on:',paste(...)) - } - log_add(paste('C:',...)) - for (line in r[[2]]) { - if (!length(grep('^[WENI]:',line))) { - line = paste('I:',line) - } - log_add(line) #,print=F) - } - return(r[[1]]) -} - diff --git a/branch/double_build/R/patch.R b/branch/double_build/R/patch.R deleted file mode 100644 index b9dc8ce..0000000 --- a/branch/double_build/R/patch.R +++ /dev/null @@ -1,20 +0,0 @@ -apply_patches <- function(pkg) { - patch_path = file.path(patch_dir, pkg$name) - if (!file.exists(patch_path)) { - notice('no patches in',patch_path) - return() - } - - # make debian/patches for simple-patchsys - deb_patch = pkg$debfile('patches') - if (!dir.create(deb_patch)) { - fail('could not create patches directory', deb_patch) - } - - # now just copy the contents of patch_path into debian/patches - for (patch in list.files(patch_path)) { - notice('including patch', patch) - file.copy(file.path(patch_path, patch), deb_patch) - } -} - diff --git a/branch/double_build/R/rdep.R b/branch/double_build/R/rdep.R deleted file mode 100644 index 78c5d79..0000000 --- a/branch/double_build/R/rdep.R +++ /dev/null @@ -1,117 +0,0 @@ - - -r_requiring <- function(names) { - # approximately prune first into a smaller availability - candidates <- rownames(available)[sapply(rownames(available) - ,function(name) - length(grep(paste(names,collapse='|') - ,available[name,r_depend_fields])) > 0)] - if (length(candidates) == 0) { - return(c()) - } - # find a logical index into available of every package - # whose dependency field contains at least one element of names. - # (this is not particularly easy to read---sorry---but is much faster than - # the alternatives i could think of) - prereq=c() - dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names - any_dep_matches <- function(name,field=NA) - any(sapply(strsplit(chomp(available[name,field]) - ,'[[:space:]]*,[[:space:]]*') - ,dep_matches)) - - for (field in r_depend_fields) { - matches = sapply(candidates, any_dep_matches, field=field) - if (length(matches) > 0) { - prereq = c(prereq,candidates[matches]) - } - } - return(unique(prereq)) -} - -r_dependencies_of <- function(name=NULL,description=NULL) { - # find the immediate dependencies (children in the dependency graph) of an - # R package - if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) { - return(data.frame()) - } - if (is.null(description) && is.null(name)) { - fail('must specify either a description or a name.') - } - if (is.null(description)) { - if (!(name %in% rownames(available))) { - # unavailable packages don't depend upon anything - return(data.frame()) - } - description <- data.frame() - # keep only the interesting fields - for (field in r_depend_fields) { - if (!(field %in% names(available[name,]))) { - next - } - description[1,field] = available[name,field] - } - } - # extract the dependencies from the description - deps <- data.frame() - for (field in r_depend_fields) { - if (!(field %in% names(description[1,]))) { - next - } - new_deps <- lapply(strsplit(chomp(description[1,field]) - ,'[[:space:]]*,[[:space:]]*')[[1]] - ,r_parse_dep_field) - deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind) - } - return (deps) -} - -r_parse_dep_field <- function(dep) { - if (is.na(dep)) { - return(NA) - } - # remove other comments - dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep) - # squish spaces - dep = chomp(gsub('[[:space:]]+',' ',dep)) - # parse version - pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' - if (!length(grep(pat,dep))) { - fail('R dependency',dep,'does not appear to be well-formed') - } - version = sub(pat,'\\3',dep) - dep = sub(pat,'\\1',dep) - return(list(name=dep,version=version)) -} - -r_dependency_closure <- function(fringe, forward_arcs=T) { - # find the transitive closure of the dependencies/prerequisites of some R - # packages - closure <- list() - if (is.data.frame(fringe)) { - fringe <- as.list(fringe$name) - } - fun = function(x) r_dependencies_of(name=x)$name - if (!forward_arcs) { - fun = r_requiring - } - while(length(fringe) > 0) { - # pop off the top - top <- fringe[[1]] - if (length(fringe) > 1) { - fringe <- fringe[2:length(fringe)] - } else { - fringe <- list() - } - src <- pkgname_as_debian(top,binary=F) - if (src == 'R') { - next - } - newdeps <- fun(top) - closure=c(closure,top) - fringe=c(fringe,newdeps) - } - # build order - return(rev(unique(closure,fromLast=T))) -} - diff --git a/branch/double_build/R/util.R b/branch/double_build/R/util.R deleted file mode 100644 index 68401fd..0000000 --- a/branch/double_build/R/util.R +++ /dev/null @@ -1,20 +0,0 @@ -iterate <- function(xs,z,fun) { - y <- z - for (x in xs) - y <- fun(y,x) - return(y) -} - -chomp <- function(x) { - # remove leading and trailing spaces - return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x))) -} - -err <- function(...) { - error(...) - exit() -} - -exit <- function() { - q(save='no') -} diff --git a/branch/double_build/R/version.R b/branch/double_build/R/version.R deleted file mode 100644 index 5795233..0000000 --- a/branch/double_build/R/version.R +++ /dev/null @@ -1,88 +0,0 @@ -version_new <- function(rver,debian_revision=1, debian_epoch=db_get_base_epoch()) { - # generate a string representation of the Debian version of an - # R version of a package - pkgver = rver - - # ``Writing R extensions'' says that the version consists of at least two - # non-negative integers, separated by . or - - if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) { - fail('Not a valid R package version',rver) - } - - # Debian policy says that an upstream version should start with a digit and - # may only contain ASCII alphanumerics and '.+-:~' - if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) { - fail('R package version',rver - ,'does not obviously translate into a valid Debian version.') - } - - # if rver contains a : then the Debian version must also have a colon - if (debian_epoch == 0 && length(grep(':',pkgver))) - debian_epoch = 1 - - # if the epoch is non-zero then include it - if (debian_epoch != 0) - pkgver = paste(debian_epoch,':',pkgver,sep='') - - # always add the '-1' Debian release; nothing is lost and rarely will R - # packages be Debian packages without modification. - return(paste(pkgver,'-',version_suffix_step,version_suffix,debian_revision,sep='')) -} - -version_epoch <- function(pkgver) { - # return the Debian epoch of a Debian package version - if (!length(grep(':',pkgver))) - return(0) - return(as.integer(sub('^([0-9]+):.*$','\\1',pkgver))) -} -# version_epoch . version_new(x,y) = id -# version_epoch(version_new(x,y)) = base_epoch - -version_revision <- function(pkgver) { - # return the Debian revision of a Debian package version - return(as.integer(sub(paste('.*-([0-9]+',version_suffix,')?([0-9]+)$',sep=''),'\\2',pkgver))) -} -# version_revision . version_new(x) = id -# version_revision(version_new(x)) = 1 - -version_upstream <- function(pkgver) { - # return the upstream version of a Debian package version - return(sub('-[a-zA-Z0-9+.~]+$','',sub('^[0-9]+:','',pkgver))) -} -# version_upstream . version_new = id - -version_update <- function(rver, prev_pkgver, prev_success) { - # return the next debian package version - prev_rver <- version_upstream(prev_pkgver) - if (prev_rver == rver) { - # increment the Debian revision if the previous build was successful - inc = 0 - if (prev_success) { - inc = 1 - } - return(version_new(rver - ,debian_revision = version_revision(prev_pkgver)+inc - ,debian_epoch = version_epoch(prev_pkgver) - )) - } - # new release - # TODO: implement Debian ordering over version and then autoincrement - # Debian epoch when upstream version does not increment. - return(version_new(rver - ,debian_epoch = version_epoch(prev_pkgver) - )) -} - -new_build_version <- function(pkgname) { - if (!(pkgname %in% rownames(available))) { - fail('tried to discover new version of',pkgname,'but it does not appear to be available') - } - db_ver <- db_latest_build_version(pkgname) - db_succ <- db_latest_build_status(pkgname)[[1]] - latest_r_ver <- available[pkgname,'Version'] - if (!is.null(db_ver)) { - return(version_update(latest_r_ver, db_ver, db_succ)) - } - return(version_new(latest_r_ver)) -} - diff --git a/branch/double_build/R/zzz.R b/branch/double_build/R/zzz.R deleted file mode 100644 index dc2a5e0..0000000 --- a/branch/double_build/R/zzz.R +++ /dev/null @@ -1,42 +0,0 @@ -.First.lib <- function(libname, pkgname) { - global <- function(name,value) assign(name,value,envir=.GlobalEnv) - global("which_system", Sys.getenv('CRAN2DEB_SYS','debian')) - if (!length(grep('^[a-z]+$',which_system))) { - stop('Invalid system specification: must be of the form name') - } - global("maintainer", 'cran2deb autobuild ') - global("root", system.file(package='cran2deb')) - global("cache_root", '/var/cache/cran2deb') - global("indep_arch", "all") - global("archs", c("i386", "amd64")) - # get the pbuilder results dir, and config - global("get_pbuilder_config", function(arch) { - sys_arch <- paste(which_system, arch, sep='-') - return(c(file.path('/var/cache/cran2deb/results',sys_arch)) - ,file.path('/etc/cran2deb/sys',sys_arch,'pbuilderrc')) - }) - global("reprepro_dir", file.path('/var/www/repo',which_system)) - global("get_reprepro_orig_tgz", function(srcname, version) { - return file.path(reprepro_dir, 'pool', 'main', substr(srcname, 1, 1), - srcname, paste(srcname,'_',version,'.orig.tar.gz', - sep='')) - }) - global("r_depend_fields", c('Depends','Imports')) # Suggests, Enhances - global("scm_revision", paste("svn:", svnversion())) - global("patch_dir", '/etc/cran2deb/patches') - global("lintian_dir", '/etc/cran2deb/lintian') - global("changesfile", function(srcname,version='*',arch='*') { - return(file.path(pbuilder_results - ,paste(srcname,'_',version,'_' - ,arch,'.changes',sep=''))) - }) - global("version_suffix","cran") - # perhaps db_cur_version() should be used instead? - global("version_suffix_step",1) - - cache <- file.path(cache_root,'cache.rda') - if (file.exists(cache)) { - load(cache,envir=.GlobalEnv) - } - message(paste('I: cran2deb',scm_revision,'building for',which_system,'at',Sys.time())) -} diff --git a/branch/double_build/README b/branch/double_build/README deleted file mode 120000 index a6047ac..0000000 --- a/branch/double_build/README +++ /dev/null @@ -1 +0,0 @@ -inst/doc/README \ No newline at end of file diff --git a/branch/double_build/configure b/branch/double_build/configure deleted file mode 100755 index fa1a12a..0000000 --- a/branch/double_build/configure +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh -# -# We are tricking the builds process into executing this so that we can -# extract an svn revision number from the source directory - -# do nothing if we are not in a svn repository -if [ ! -d .svn ]; then - exit -fi - -svnrev=$(svnversion | cut -f1 -d:) - -cat < R/svnversion.R -# Autogenerated by configure. Do not edit. -svnversion <- function() { - return("$svnrev") -} -EOF - diff --git a/branch/double_build/data/populate_depend_aliases b/branch/double_build/data/populate_depend_aliases deleted file mode 100644 index 3b1b9cb..0000000 --- a/branch/double_build/data/populate_depend_aliases +++ /dev/null @@ -1,135 +0,0 @@ -alias_build boost libboost-dev -alias_build boost libboost-graph-dev -alias_build ggobi ggobi -alias_run ggobi ggobi -alias_build glade libglade2-dev -alias_run glade libglade2-0 -alias_build glib libglib2.0-dev -alias_run glib libglib2.0-0 -alias_build glu libglu1-mesa-dev -alias_run glu libglu1-mesa -alias_build gmp libgmp3-dev -alias_run gmp libgmp3c2 -alias_build gsl libgsl0-dev -alias_run gsl libgsl0ldbl -alias_build ignore build-essential -alias_build java openjdk-6-jdk -alias_build java libgcj10-dev -alias_run java openjdk-6-jre -alias_build libatk libatk1.0-dev -alias_run libatk libatk1.0-0 -alias_build libcairo libcairo2-dev -alias_run libcairo libcairo2 -alias_run libcurl libcurl3 -alias_build libcurl libcurl4-openssl-dev -alias_build libdieharder libdieharder-dev -alias_run libdieharder libdieharder2 -alias_build libfontconfig libfontconfig1-dev -alias_run libfontconfig libfontconfig1 -alias_build libfreetype libfreetype6-dev -alias_run libfreetype libfreetype6 -alias_build libgdal libgdal1-dev -alias_run libgdal libgdal1-1.6.0 -alias_build libgd libgd2-noxpm-dev -alias_run libgd libgd2-noxpm -alias_build libgraphviz libgraphviz-dev -alias_run libgraphviz libgraphviz4 -alias_build libgtk libgtk2.0-dev -alias_run libgtk libgtk2.0-0 -alias_build libjpeg libjpeg62-dev -alias_run libjpeg libjpeg62 -alias_build libmagick libmagick9-dev -alias_run libmagick libmagick9 -alias_build libpango libpango1.0-dev -alias_run libpango libpango1.0-0 -alias_build libpng libpng12-dev -alias_run libpng libpng12-0 -alias_build libxml libxml2-dev -alias_run libxml libxml2 -alias_build msttcorefonts ttf-liberation -alias_run msttcorefonts ttf-liberation -alias_run netcdf libnetcdf4 -alias_build opengl libgl1-mesa-dev -alias_run opengl libgl1-mesa-glx -alias_build pari-gp pari-gp -alias_run pari-gp pari-gp -alias_build proj proj -alias_run proj proj -alias_build quantlib libquantlib0-dev -alias_run quantlib libquantlib-0.9.9 -alias_run sqlite libsqlite3-0 -alias_build sqlite libsqlite3-dev -alias_build zlib zlib1g-dev -alias_run zlib zlib1g -alias_build cshell tcsh|csh|c-shell -alias_run cshell tcsh|csh|c-shell -alias_build autotools autotools-dev -alias_build tcl tcl8.5-dev -alias_build tk tk8.5-dev -alias_build odbc unixodbc-dev -alias_build mysql libmysqlclient-dev -alias_build mpi libopenmpi-dev -alias_build pvm pvm-dev -alias_build hdf5 libhdf5-serial-dev -alias_build sprng libsprng2-dev -alias_build netcdf libnetcdf-dev -alias_build libtiff libtiff4-dev -alias_build fftw libfftw3-dev -alias_build fftw-dev fftw-dev -alias_build r-recommended r-recommended -alias_run r-recommended r-recommended -alias_build libxt libxt-dev -alias_run libxt libxt6 -alias_build grass grass-dev -alias_build blacs blacsgf-mpich-dev -alias_build scalapack scalapack-mpich-dev -alias_build mpich libmpich1.0-dev -alias_run libblas libblas3gf -alias_build libblas libblas-dev -alias_run wordnet wordnet-base -alias_build wordnet wordnet-base -alias_build postgresql libpq-dev -alias_build jags jags -alias_run jags jags -alias_build udunits udunits -alias_run udunits udunits -alias_build nlme r-cran-nlme -alias_run nlme r-cran-nlme -alias_build vcd r-cran-vcd -alias_run vcd r-cran-vcd -alias_build vr r-cran-vr -alias_run vr r-cran-vr -alias_build colorspace r-cran-colorspace -alias_run colorspace r-cran-colorspace -alias_run rgrs xclip -alias_run flac flac -alias_build latticist r-cran-vr -alias_run latticist r-cran-vr -alias_build writexls-perl libtext-csv-xs-perl -alias_run writexls-perl libtext-csv-xs-perl -alias_run perl perl -alias_build perl libperl-dev -alias_build tktable libtktable2.9 -alias_run tktable libtktable2.9 -alias_build bwidget bwidget -alias_run bwidget bwidget -alias_build graphviz graphviz -alias_run graphviz graphviz -alias_build libdb libdb-dev -alias_build mpfr libmpfr-dev -alias_run tk-img libtk-img -alias_build tk-img libtk-img-dev -alias_build pkg-config pkg-config -alias_run pkg-config pkg-config -alias_build rgtk2 r-cran-rgtk2 -alias_run rgtk2 r-cran-rgtk2 -alias_build libitpp libitpp-dev -alias_build libxerces-c libxerces-c-dev -alias_build protobuf-compiler protobuf-compiler -alias_build libprotobuf-dev libprotobuf-dev -alias_build libprotoc-dev libprotoc-dev -alias_build postgresql_java libpg-java -alias_run postgresql_java libpg-java -alias_build armadillo libarmadillo-dev -alias_build rpcgen libc-dev-bin -alias_run rpcgen libc-dev-bin diff --git a/branch/double_build/data/populate_forcedep b/branch/double_build/data/populate_forcedep deleted file mode 100644 index 52f4551..0000000 --- a/branch/double_build/data/populate_forcedep +++ /dev/null @@ -1,69 +0,0 @@ -force java rJava -force autotools rJava -force sqlite RSQLite -force sqlite SQLiteDF -force netcdf ncdf -force cshell dse -force libgtk cairoDevice -force tcl tkrplot -force tk tkrplot -force mysql RMySQL -force mpi Rmpi -force pvm rpvm -force hdf5 hdf5 -force libgtk rggobi -force libxml rggobi -force sprng rsprng -force gmp rsprng -force java JavaGD -force boost RBGL -force netcdf RNetCDF -force libtiff biOps -force fftw-dev rimage -force libxt Cairo -force autotools qp -force boost MBA -force mpich RScaLAPACK -force libblas odesolve -force postgresql RPostgreSQL -force udunits udunits -force nlme primer -force vcd biclust -force vr mboost -force colorspace mboost -force vr party -force colorspace party -force vr latticist -force colorspace latticist -force writexls-perl WriteXLS -force fftw ReadImages -force fftw-dev ReadImages -force vr surveillance -force colorspace surveillance -force vr TIMP -force colorspace TIMP -force VR cmm -force libdb RBerkeley -force vr DoE.base -force colorspace DoE.base -force pkg-config mvgraph -force glade RGtk2 -force rgtk2 rattle -force libitpp psgp -force java farmR -force gsl mvabund -force colorspace nnDiag -force autotools fftw -force protobuf-compiler RProtoBuf -force libprotobuf-dev RProtoBuf -force libprotoc-dev RProtoBuf -force pkg-config RProtoBuf -force colorspace simPopulation -force java RpgSQL -force netcdf ncdf4 -force colorspace vcdExtra -force boost RcppArmadillo -force pkg-config fftw -force boost SV -force gsl magnets -force mpi npRmpi diff --git a/branch/double_build/data/populate_license_hashes b/branch/double_build/data/populate_license_hashes deleted file mode 100644 index 32cc69b..0000000 --- a/branch/double_build/data/populate_license_hashes +++ /dev/null @@ -1,156 +0,0 @@ -accept apache -accept artistic -accept bsd -accept cecill -accept gpl -accept gplqa -accept gpl+qhull -accept lgpl -accept mit -accept mpl -accept unlimited -accept x11 -accept distrib-noncomm -accept gpl+acm -accept unclear -accept nistnls -accept rtiff -accept mvpart -accept mmcm -accept grade -accept agpl -accept scagnostics -accept akima -accept tripack -reject mclust -accept gpl+agpl -accept cpl -accept cc-sa -accept acm -accept camassclass -accept rwt -accept tcltk2 -accept agpl-3 -accept gpl-2-qa -accept ff_license -accept rindex_license -accept eupl -accept statnet -accept degreenet -accept geometry -accept ergm -accept acepack -accept ff -accept mspath -accept ever -accept latentnet -accept sgeostat -hash_sha1 apache 2b8b815229aa8a61e483fb4ba0588b8b6c491890 -hash_sha1 artistic be0627fff2e8aef3d2a14d5d7486babc8a4873ba -hash_sha1 bsd 095d1f504f6fd8add73a4e4964e37f260f332b6a -hash_sha1 gpl 06877624ea5c77efe3b7e39b0f909eda6e25a4ec -hash_sha1 gpl 842745cb706f8f2126506f544492f7a80dbe29b3 -hash_sha1 lgpl c08668a6ace9b36ba46940609040748161b03a37 -hash_sha1 lgpl 9a1929f4700d2407c70b507b3b2aaf6226a9543c -hash_sha1 lgpl e7d563f52bf5295e6dba1d67ac23e9f6a160fab9 -hash_sha1 bsd 691cf5d9d41c00bd9df4f71a769903cd3c1114e5 -hash_sha1 cecill 7b5d0f2dcc332e487cfce45d67694829e2dc551f -hash_sha1 cpl 24f4880707f1a115710b08691a134fbcac8b3187 -hash_sha1 distrib-noncomm fbcd040e3968045f82ec3eae01c0ee4d023aaf0a -hash_sha1 distrib-noncomm 6821f142965fb3093f42d4a3bf188966ef559947 -hash_sha1 distrib-noncomm 430b61f55057719112e0a4fcea37bc05e1951cb8 -hash_sha1 distrib-noncomm eff2ff3591871ede0ee8b4397bdc7ff059edd91e -hash_sha1 distrib-noncomm 56911f201d1c8e0d9a2c7bb8820369c31dd727b3 -hash_sha1 distrib-noncomm 34cd71d41285f582be7c00f0c180eaf3ec6d6840 -hash_sha1 distrib-noncomm 4aa695cbc309ab9fa4d74d28675a0e8e8ec299db -hash_sha1 gpl+acm f53f55135e38afd2993d3990fad973b49cd16bef -hash_sha1 gpl+acm 5ec09fa25a8aabad7d54901e5a4ee9e799b334ef -hash_sha1 gpl dd5ca2e0351075a5985dbc75aea9a579367c3603 -hash_sha1 gpl 2c02993e7c8f22d0b5bb590125c37fa58a24637e -hash_sha1 gpl 37bcb2c23ebffb2a669d606391d4df1c4d794b37 -hash_sha1 gpl 4ac49046f7c453d5d4992dc1695acd447effaebb -hash_sha1 gpl 811325c3b7f5e0b1073a382c4f53c37a47720e47 -hash_sha1 gpl 67f006f04797fc844b71c55b911656ab8144317a -hash_sha1 gpl 31fe0bd96e05d07216701ff457b8adaf6462379b -hash_sha1 gpl f50f1034fc720a1c03875d5bf3b79d102c9d6605 -hash_sha1 gpl+qhull 9b03de793e5641feb756a7b0ce2bfffdeb778ccd -hash_sha1 gpl 34f7b4fc3375c326ea742f053ba75e4e80795cf4 -hash_sha1 gpl e6e02671a920a2a1befa8cebf2d152ef70d0ed20 -hash_sha1 gpl b0909a630db543721dafe4a348ee755f85fbe001 -hash_sha1 gpl 1fabda5fc86f494ae54cf8f8ad85fde49e0548c9 -hash_sha1 lgpl bb3101315829c159125a337b1e11b9ad9e9bad31 -hash_sha1 mclust bc98e96bfbbe8396c57d9decccb8bd6bcea99a04 -hash_sha1 tcltk2 50424add056b71665e3e26b393f460e0908e9da2 -hash_sha1 unclear 3d76287efb04bc6eb366ea0d49ac518d811bd32f -hash_sha1 unclear 8408f5eaded6ad4895fdf161c9cd38231dd072ad -hash_sha1 unclear 1ecc6e16f3390f00709b2516e609366f2efeabb7 -hash_sha1 unclear eee8da9d5d6ac0f21d97b3038c0fc7f86a4891a0 -hash_sha1 unclear 4932e4c94fb80efe20297bd9ace2fda86758874d -hash_sha1 unlimited b4323144ad3c121088025ff951028ae588ba3031 -hash_sha1 gplqa b39206c5297bcea7e6abbc4981f8f15a76aef24f -hash_sha1 gpl 5b7c62c4726d772162e3e4fbf368dfaf65fe5e32 -hash_sha1 gpl ecdf063f8a937c005c4f02450d0ecbdc3376acf6 -hash_sha1 gpl 64ed18b138fcc9389a33f620eaa2f9479f367ff7 -hash_sha1 gpl 931a2aaf2fac897138f90c96a27e5acaf74b4694 -hash_sha1 gpl edde20802066923644c363328903121c05799bb6 -hash_sha1 agpl 86d2ea18c092d87328f06d22d997af59cee10fc4 -hash_sha1 gpl d093976b85026cb225a12908088bb19dd9d480b7 -hash_sha1 gpl 0e9f026efef26009619f9048637eb2a498379c88 -hash_sha1 acepack 6bdcfb412d82fe3ad5b64650d900c2845d08fbc6 -hash_sha1 agpl d3c31418974fd4d69032bc1f5c58e13c1634ca40 -hash_sha1 agpl 6bdfdd431d081dd0bacf493ba3563f3480ab8936 -hash_sha1 nistnls 735b08919865788221c3139506b4f508e6636dfa -hash_sha1 gpl 836f5f94473a04c4b7c48e6cb86c351131201ae9 -hash_sha1 gpl dca3c7c942b9e09fa2dde956b00b1ceaa5b99e02 -hash_sha1 distrib-noncomm 7d15a1e04d01df4fa36abccf1f6702ace54ec15f -hash_sha1 gpl 9e3914cc887ffa697e008b1990607dec00075d9e -hash_sha1 gpl 82a48e8a04d4a53a63cb7d84c57ca3908add375f -hash_sha1 eupl 7642ee2451a0d84de46a7e8236ccfd019e9595b4 -hash_sha1 gpl f76132a54a079daad040663668572cd91a8bfae1 -hash_sha1 scagnostics 5e059a7b25be224c8d9bae55bbdd7cb3675e36b5 -hash_sha1 akima 485316717b03afbd6d20f7810f9123b4445c8660 -hash_sha1 tripack b71ffb1e3a65c83693858fd3c8f1e557f97cc43c -hash_sha1 bsd 105de13a43220f6fc5d7d46d7b592298c4a23f64 -hash_sha1 mclust 9ac21f87563664c2a2ebc6d4413ec61c8ebb84ff -hash_sha1 distrib-noncomm c14cd24b4e49bb78bb5b57472c6253781f6efed3 -hash_sha1 distrib-noncomm a0ba68c1c804fda1edde14e8d42225b8225cb0b7 -hash_sha1 distrib-noncomm e7f48dfecfde56adcf5c9bd57779a0d7d15c4f4b -hash_sha1 gpl+agpl 4c667eba3ef3f3cdd47170fe438b8abc1adcfaff -hash_sha1 cpl 69c37907f7adb8ec4d7189aed8a4dd12294056f2 -hash_sha1 cc-sa c960bb1a7ed5e5f8c24591f77256eb8f5b9ae73b -hash_sha1 acm 1127f761137a717b10892c1b4df07fc14d70f659 -hash_sha1 acm 4cfe0db3b018ae1f7ad70556753dec9c603ada50 -hash_sha1 camassclass 8b455d73a369934c7e84b24e0a16886248285221 -hash_sha1 artistic 07ce494c32b890b381e73b8fa4fdf87a8d946e1e -hash_sha1 gpl 78f806d7e93a3c1ec08836b9d4b689fecb1df19b -hash_sha1 gpl 756981bd0b95c68fd2d1c9123759261aefb51373 -hash_sha1 rwt b6da6c2417cc2cd2be37db408543c2f8c2201034 -hash_sha1 unclear befc3a63448173d57ad7304319ceaf01302ba035 -hash_sha1 tcltk2 e7d59565ab5ec7245fbfea74384798e5f6a9f483 -hash_sha1 tcltk2 7ddf1b18f9624b0a6ded40c70be329cadd074af8 -hash_sha1 gpl 6866382245b1802189e6e8b956196ce4715fc67f -hash_sha1 agpl-3 70ae9c1442b696a7b3ded90579785030ff7bdbb4 -hash_sha1 agpl-3 a596e7f3a3125045173253bddfc8e4b3cba09004 -hash_sha1 rindex_license fa72fc5a881001769d691af7ab529699c08edda0 -hash_sha1 eupl 4418cb312744f1b1a76420cf3ed43dded454e1a2 -hash_sha1 eupl 4b4f67314d4b0cbdcf18e8c765374bfc49c699d1 -hash_sha1 statnet 73d704179dcbe75498f174941036db921e4aab98 -hash_sha1 statnet d6cfab1f34efdeb09ff17948ef37eb82bb151d71 -hash_sha1 degreenet bcfb8b637a823520e18cd00570ab67ac34355e9b -hash_sha1 degreenet c1a8f1e9fda548a222131a42db976a9b841a8b84 -hash_sha1 geometry 4265480ee7ad0ef41f684d20c8204356e12c525c -hash_sha1 geometry c52bef65629df25bcd18e97236f5405e7c408097 -hash_sha1 ergm 2f7fb32f8c752f73fd9f32e92af697c8395ad3ae -hash_sha1 ergm e36db453758cb8173f7cd80561feaea796f767ce -hash_sha1 acepack 698e04a130a50d9e0b990f4bd2569fa54366102a -hash_sha1 acepack 44801e90a3c00a7fe4f5a6bff8c9eaf743d717f4 -hash_sha1 ff 220e79fccd4f8e4874b8c8c481fe7ff9b8e3c850 -hash_sha1 ff 1e0f7f00f430604860afdb5fe911be5db07d5913 -hash_sha1 mspath 58c267c9ae997b5814c5fcaaf6233783f937a2c3 -hash_sha1 mspath 0a4121a7735852e842112b0dd667160f99df39d4 -hash_sha1 ever a3ab3a534d3514d56ae1ea76414e51543af5bef8 -hash_sha1 ever 8b25578cf5d509b042115c54824e8423d95f4061 -hash_sha1 latentnet a67ae6964aa0ede190721cfd17c2509b7799e881 -hash_sha1 latentnet d72813ddddb94f752d9929bdbe622179a623986b -hash_sha1 sgeostat c66e00dc696a8e22dff8f1f180612ac535c0706c -hash_sha1 sgeostat 8c36b0a6a8bf9a031086c85ff41eb7081ba2ae62 diff --git a/branch/double_build/data/populate_licenses b/branch/double_build/data/populate_licenses deleted file mode 100644 index 7de0360..0000000 --- a/branch/double_build/data/populate_licenses +++ /dev/null @@ -1,120 +0,0 @@ -accept AGPL -accept APACHE -accept ARTISTIC -accept BSD -accept CPL -accept CeCILL -accept EUPL -accept GPL -accept GPL+ACM -accept GPL+QHULL -accept GPLQA -accept LGPL -reject MCLUST -accept MIT -accept MPL -accept NISTnls -accept TCLTK2 -accept UNCLEAR -accept UNLIMITED -accept X11 -accept acepack -accept distrib-noncomm -accept ff -accept grade -accept mmcm -accept mvpart -accept rtiff -accept scagnostics -accept tripack -hash APACHE /usr/share/common-licenses/Apache-2.0 -hash ARTISTIC /usr/share/common-licenses/Artistic -hash BSD /usr/share/common-licenses/BSD -hash GPL /usr/share/common-licenses/GPL-2 -hash GPL /usr/share/common-licenses/GPL-3 -hash LGPL /usr/share/common-licenses/LGPL-2 -hash LGPL /usr/share/common-licenses/LGPL-2.1 -hash LGPL /usr/share/common-licenses/LGPL-3 -pkg AGPL AIS -pkg AGPL BARD -pkg AGPL Zelig -pkg AGPL accuracy -pkg BSD minpack.lm -pkg CPL lmom -pkg CeCILL LLAhclust -pkg EUPL EVER -pkg GPL BayesDA -pkg GPL CDNmoney -pkg GPL HTMLapplets -pkg GPL ICE -pkg GPL ICEinfer -pkg GPL NMMAPSlite -pkg GPL PET -pkg GPL PKtools -pkg GPL RXshrink -pkg GPL Rigroup -pkg GPL TWIX -pkg GPL aplpack -pkg GPL degreenet -pkg GPL ergm -pkg GPL gllm -pkg GPL gmodels -pkg GPL ibdreg -pkg GPL latentnet -pkg GPL moc -pkg GPL network -pkg GPL networksis -pkg GPL partsm -pkg GPL pastecs -pkg GPL pbatR -pkg GPL rake -pkg GPL reldist -pkg GPL snpMatrix -pkg GPL splancs -pkg GPL statnet -pkg GPL timsac -pkg GPL tsfa -pkg GPL uroot -pkg GPL+ACM akima -pkg GPL+ACM tripack -pkg GPL+QHULL geometry -pkg GPLQA regtest -pkg LGPL R.huge -pkg MCLUST mclust -pkg NISTnls NISTnls -pkg TCLTK2 tcltk2 -pkg UNCLEAR adapt -pkg UNCLEAR cat -pkg UNCLEAR cosmo -pkg UNCLEAR mix -pkg UNCLEAR mlmm -pkg UNCLEAR norm -pkg UNCLEAR pan -pkg UNCLEAR titecrm -pkg UNCLEAR tlnise -pkg UNLIMITED boolean -pkg acepack acepack -pkg distrib-noncomm mlbench -pkg ff ff -pkg scagnostics scagnostics -pkg tripack tripack -pkg BSD rtiff -pkg MCLUST mclust02 -pkg distrib-noncomm CoCo -accept GPL+AGPL -pkg GPL+AGPL FAiR -accept CPL -pkg CPL Rcsdp -accept CC-SA -pkg CC-SA SGP -accept ACM -pkg ACM alphahull -pkg ACM asypow -accept caMassClass -pkg caMassClass caMassClass -pkg ARTISTIC matlab -pkg GPL mmcm -pkg GPL mvpart -accept rwt -pkg rwt rwt -pkg UNCLEAR sgeostat diff --git a/branch/double_build/data/populate_sysreq b/branch/double_build/data/populate_sysreq deleted file mode 100644 index 6aa3775..0000000 --- a/branch/double_build/data/populate_sysreq +++ /dev/null @@ -1,107 +0,0 @@ -sysreq ignore gcc -sysreq ignore gnu make -sysreq ignore % if present -sysreq ignore none -sysreq libcurl curl -sysreq ggobi ggobi -sysreq libatk atk -sysreq libcairo cairo -sysreq libdieharder dieharder% -sysreq libfontconfig fontconfig -sysreq libfreetype freetype -sysreq libfreetype %freetype -sysreq libgd libgd -sysreq libgdal %gdal% -sysreq opengl opengl -sysreq glade %glade -sysreq glib glib -sysreq glu glu library -sysreq gmp gmp -sysreq libgraphviz graphviz -sysreq gsl gnu gsl% -sysreq gsl gnu scientific library -sysreq libgtk gtk% -sysreq libjpeg libjpeg% -sysreq libmagick imagemagick -sysreq libpango pango -sysreq libpng libpng -sysreq quantlib quantlib% -sysreq libxml libxml% -sysreq msttcorefonts msttcorefonts -sysreq pari-gp pari/gp -sysreq proj proj% -sysreq zlib zlib -sysreq java java -sysreq odbc %odbc% -sysreq ignore drivers. see readme. -sysreq ignore r must be compiled with --enable-r-shlib if the server is to be built -sysreq yacas yacas% -sysreq libtiff %libtiff% -sysreq ignore zlibdll -sysreq ignore jpegdll% -sysreq fftw fftw% -sysreq python python -sysreq ghostscript ghostscript -sysreq gsl libgsl -sysreq ignore rgl packages for rendering -sysreq grass grass -sysreq ignore internal files xba.cqv -sysreq ignore xba.regions -sysreq ignore lammpi or mpich -sysreq blas blas -sysreq blacs blacs -sysreq scalapack scalapack -sysreq wordnet wndb-tar.gz% -sysreq boost boost% -sysreq jags jags -sysreq ignore winbugs -sysreq ignore posix-compliant os -sysreq curl curl% -sysreq netcdf netcdf% -sysreq udunits udunits% -sysreq rgrs xclip -sysreq flac flac -sysreq perl perl -sysreq ignore encode -sysreq ignore parse::recdescent -sysreq ignore getopt::long -sysreq ignore file::basename -sysreq ignore spreadsheet::writeexcel -sysreq ignore file::glob -sysreq writexls-perl text::csv_xs -sysreq ignore ant -sysreq ignore linux/64bit -sysreq ignore linux/bit -sysreq tk tcl/tk -sysreq tktable tktable -sysreq tktable tktable% -sysreq ignore optional) -sysreq bwidget bwidget -sysreq ignore drivers. -sysreq graphviz dot graphviz -sysreq ignore berkeleydb -sysreq mpfr %mpfr% -sysreq ignore http://mpfr.org/% -sysreq gmp gmp (gnu multiple precision library -sysreq ignore see readme -sysreq tk-img img -sysreq ignore activetcl -sysreq libitpp libitpp -sysreq libxerces-c libxerces-c -sysreq ignore java runtime -sysreq protobuf protocol buffer compiler (to create c++ header -sysreq ignore Protocol Buffer compiler (% -sysreq ignore source files .proto % -sysreq ignore library (version 2.2.0 or later) -sysreq ignore library -sysreq libpng libpng% -sysreq postgresql postgresql -sysreq postgresql_java postgresql jdbc driver -sysreq ignore gmt -sysreq armadillo armadillo -sysreq java jri -sysreq rpcgen rpcgen -sysreq ignore lapack_atlas -sysreq ignore libgsl0ldbl -sysreq ignore libgslldbl -sysreq ignore libgsldev diff --git a/branch/double_build/data/pull b/branch/double_build/data/pull deleted file mode 100755 index f53e1e8..0000000 --- a/branch/double_build/data/pull +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh -cran2deb depend ls aliases >populate_depend_aliases -cran2deb depend ls force >populate_forcedep -cran2deb depend ls sysreq >populate_sysreq -cran2deb license ls >populate_license_hashes -echo NOTE: you need to update populate_licenses manually! diff --git a/branch/double_build/data/quit b/branch/double_build/data/quit deleted file mode 100644 index ff60466..0000000 --- a/branch/double_build/data/quit +++ /dev/null @@ -1 +0,0 @@ -quit diff --git a/branch/double_build/exec/autobuild b/branch/double_build/exec/autobuild deleted file mode 100755 index f9dbaf9..0000000 --- a/branch/double_build/exec/autobuild +++ /dev/null @@ -1,15 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb autobuild -## DOC: automatically builds all out of date packages. -## DOC: -suppressPackageStartupMessages(library(cran2deb)) - -if (exists('argv')) { # check for littler - db_update_package_versions() - outdated <- db_outdated_packages() - build_order <- r_dependency_closure(outdated) - notice('build order',paste(build_order,collapse=', ')) - for (pkg in build_order) { - build(pkg,c()) - } -} diff --git a/branch/double_build/exec/build b/branch/double_build/exec/build deleted file mode 100755 index 6feaf5d..0000000 --- a/branch/double_build/exec/build +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb build [-d] [-D extra_dep1,extra_dep2,...] package1 package2 ... -## DOC: builds a particular package. -## DOC: -d leave the staging directory around for debugging. -## DOC: -suppressPackageStartupMessages(library(cran2deb)) - -if (exists('argv')) { # check for littler - argc <- length(argv) - extra_deps = list() - extra_deps$deb = c() - extra_deps$r = c() - do_cleanup = T - opts = c('-D','-R','-d') - # first argument is the root --- this is dealt with elsewhere. - for (i in 2:argc) { - if (!(argv[i] %in% opts)) { - if (argc >= i) { - argv <- argv[i:argc] - } else { - argv <- list() - } - argc = argc - i + 1 - break - } - if (i == argc) { - err('missing argument') - } - if (argv[i] == '-D') { - extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) - } - if (argv[i] == '-R') { - extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]]) - extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname_as_debian)) - } - if (argv[i] == '-d') { #debug - do_cleanup = F - } - } - if (argc == 0) { - err('usage: cran2deb build [-d] [-D extra_dep1,extra_dep2,...] package package ...') - } - build_order <- r_dependency_closure(c(extra_deps$r,argv)) - notice('build order',paste(build_order,collapse=', ')) - for (pkg in build_order) { - build(pkg,extra_deps,force=pkg %in% argv, do_cleanup) - } -} diff --git a/branch/double_build/exec/build_all b/branch/double_build/exec/build_all deleted file mode 100644 index 64f125d..0000000 --- a/branch/double_build/exec/build_all +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb build_all -## DOC: build all packages again -## DOC: - -suppressPackageStartupMessages(library(cran2deb)) - -if (exists('argv')) { # check for littler - db_update_package_versions() - pkgs <- dimnames(available)[1] - build_order <- r_dependency_closure(pkgs) - notice('build order',paste(build_order,collapse=', ')) - for (pkg in build_order) { - build(pkg,c(),force=T) - } -} diff --git a/branch/double_build/exec/build_ctv b/branch/double_build/exec/build_ctv deleted file mode 100755 index 1e39e04..0000000 --- a/branch/double_build/exec/build_ctv +++ /dev/null @@ -1,14 +0,0 @@ -#!/bin/sh -## DOC: cran2deb build_ctv -## DOC: build all CRAN TaskViews. warning and error logs in ./ctv/ -## DOC: - -for ctv in $(cran2deb cran_pkgs query); do - echo task view $ctv... - if [ ! -e "ctv/$ctv" ]; then - cran2deb build_some "$ctv" - mkdir -p "ctv/$ctv" - mv warn fail "ctv/$ctv" - fi -done - diff --git a/branch/double_build/exec/build_some b/branch/double_build/exec/build_some deleted file mode 100755 index da105fd..0000000 --- a/branch/double_build/exec/build_some +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/rc -## DOC: cran2deb build_some [taskview1 taskview2 ...] -## DOC: build some packages, logging warnings into ./warn/$package -## DOC: and failures into ./fail/$package. with no arguments a random -## DOC: sample of packages is built. the file ./all_pkgs overrides this -## DOC: behaviour and is expected to be a list of packages to build. -## DOC: - -mkdir -p warn fail -shift -if ([ ! -e all_pkgs ]) { - cran2deb cran_pkgs $* >all_pkgs -} - -for (pkg in `{cat all_pkgs}) { - if (~ $pkg *..* */*) { - echo bad name $pkg >>fail/ERROR - } else if ([ -e warn/$pkg ]) { - echo skipping $pkg... - } else if ([ -e fail/$pkg ]) { - echo skipping failed $pkg... - } else { - echo -n .. package $pkg - fail=0 - cran2deb build $pkg >fail/$pkg >[2=1] || fail=1 - if (~ $fail 0) { - echo success - grep '^[WE]:' fail/$pkg >warn/$pkg -# if (~ `{stat -c '%s' warn/$pkg} 0) { -# rm -f warn/$pkg -# } - rm -f fail/$pkg - } else { - echo FAILED - } - } -} diff --git a/branch/double_build/exec/copy_find b/branch/double_build/exec/copy_find deleted file mode 100755 index eebcec1..0000000 --- a/branch/double_build/exec/copy_find +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/rc -## DOC: cran2deb copy_find path -## DOC: a tool for finding (heuristically) some copyright notices. -## DOC: -kwords='copyright|warranty|redistribution|modification|patent|trademark|licen[cs]e|permission' -nl=`` () {printf '\n'} -ifs=$nl { - files=`{find $1 ! -path '*debian*' -type f} - lines=() - for (file in $files) { - notices=`{grep -H '(C)' $file} - notices=($notices `{grep -HEi $kwords $file}) - lines=($lines `{{for (notice in $notices) echo $notice} | sort -u}) - } - # let's hope no file has a : in it - ifs=() { seen_files=`{{for (line in $lines) echo $line} | cut -d: -f1} } - missing_copyright=() - for (file in $files) { - if (echo -n $seen_files | grep -q '^'^$file^'$') { - } else { - missing_copyright=($missing_copyright $file) - } - } - echo 'Suspect copyright notices:' - for (line in $lines) echo ' '$line - echo 'Files without *suspect* copyright notices:' - for (missing in $missing_copyright) { - echo ' '$missing - echo ' type: '`{file $missing} - echo ' chars: '`{wc -c $missing | awk '{print $1}'} - echo ' lines: '`{wc -l $missing | awk '{print $1}'} - } -} diff --git a/branch/double_build/exec/cran2deb b/branch/double_build/exec/cran2deb deleted file mode 100755 index 7efedc7..0000000 --- a/branch/double_build/exec/cran2deb +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh -umask 002 -root=$(r -e 'suppressMessages(library(cran2deb));cat(system.file(package="cran2deb"),file=stdout())') -cmd=$1 -shift -if [ ! -x "$root/exec/$cmd" ]; then - echo unknown command $cmd - exit 1 -fi -"$root/exec/$cmd" "$root" $* diff --git a/branch/double_build/exec/cran_pkgs b/branch/double_build/exec/cran_pkgs deleted file mode 100755 index 201f968..0000000 --- a/branch/double_build/exec/cran_pkgs +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb cran_pkgs -## DOC: print a list of 800 packages picked at random -## DOC: cran2deb cran_pkgs query -## DOC: print the names of all CRAN TaskViews -## DOC: cran2deb cran_pkgs taskview1 taskview2 ... -## DOC: print the names of all packages in a particular CRAN TaskView -## DOC: - -library(cran2deb) - -if (length(argv) == 1) { - writeLines(dimnames(available)[[1]]) -} else { - argv = argv[2:length(argv)] - if (argv[1] == 'query') { - for (ctv in ctv.available) { - writeLines(ctv$name) - } - q(save='no') - } - # list of task lists - for (ctv in ctv.available) { - if (ctv$name %in% argv) { - writeLines(ctv$packagelist$name) - } - } -} diff --git a/branch/double_build/exec/db_release b/branch/double_build/exec/db_release deleted file mode 100755 index cc6d59d..0000000 --- a/branch/double_build/exec/db_release +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb db_release -## DOC: make note of a substantial update of the database. causes all packages to be marked for ebuild. -## DOC: - -suppressPackageStartupMessages(library(cran2deb)) - -con <- db_start() -notice('old db version:',db_cur_version(con)) -db_stop(con,TRUE) -con <- db_start() -notice('new db version:',db_cur_version(con)) -db_stop(con) diff --git a/branch/double_build/exec/depclosure b/branch/double_build/exec/depclosure deleted file mode 100755 index 4ce117f..0000000 --- a/branch/double_build/exec/depclosure +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/r -## DOC: cran2deb depclosure package1 [package2 ...] -## DOC: show the dependency closure for ... -## DOC: -suppressMessages(library(cran2deb)) -print(do.call(rbind, r_dependency_closure(argv,forward_arcs=F))) diff --git a/branch/double_build/exec/depend b/branch/double_build/exec/depend deleted file mode 100755 index 2552d8f..0000000 --- a/branch/double_build/exec/depend +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb depend -## DOC: add dependency aliases, system requirements and forced dependencies -## DOC: - -suppressPackageStartupMessages(library(cran2deb)) -suppressPackageStartupMessages(library(digest)) - -exec_cmd <- function(argc, argv) { - usage <- function() - message(paste('usage: alias ' - ,' alias_run ' - ,' alias_build ' - ,' sysreq ' - ,' force ' - ,' ls [aliases|force|sysreq]' - ,' quit' - ,sep='\n')) - - if (argc < 1) { - return() - } - cmd = argv[1] - - if (cmd == 'alias') { - if (argc < 3) { - usage() - return() - } - alias = argv[2] - pkg = argv[3] - db_add_depends(alias, pkg, build=T) - pkg = gsub('-dev$','',pkg) - db_add_depends(alias, pkg, build=F) - } else if (cmd == 'alias_run' || cmd == 'alias_build') { - if (argc < 3) { - usage() - return() - } - db_add_depends(argv[2], argv[3], cmd == 'alias_build') - } else if (cmd == 'sysreq') { - if (argc < 3) { - usage() - return() - } - sysreq = paste(argv[3:argc],collapse=' ') - db_add_sysreq_override(sysreq,argv[2]) - } else if (cmd == 'force') { - if (argc < 3) { - usage() - return() - } - db_add_forced_depends(argv[3],argv[2]) - } else if (cmd == 'ls') { - if (argc < 2 || argv[2] == 'aliases') { - aliases <- db_depends() - for (i in rownames(aliases)) { - type = 'alias_run' - if (as.logical(aliases[i,'build'])) { - type = 'alias_build' - } - cat(paste(type,aliases[i,'alias'],aliases[i,'debian_pkg'],'\n')) - } - } else if (argv[2] == 'sysreq') { - sysreqs <- db_sysreq_overrides() - for (i in rownames(sysreqs)) { - cat(paste('sysreq',sysreqs[i,'depend_alias'],sysreqs[i,'r_pattern'],'\n')) - } - } else if (argv[2] == 'force') { - forced <- db_forced_depends() - for (i in rownames(forced)) { - cat(paste('force',forced[i,'depend_alias'],forced[i,'r_name'],'\n')) - } - } else { - usage() - return() - } - } else if (cmd == 'quit') { - exit() - } else if (cmd == '#') { - } else { - usage() - return() - } -} - -argc <- length(argv) -if (argc > 1) { - exec_cmd(argc-1,argv[c(2:argc)]) -} else { - while(T) { - argv <- strsplit(readline('depend> '),'[[:space:]]+')[[1]] - exec_cmd(length(argv),argv) - } -} diff --git a/branch/double_build/exec/diagnose b/branch/double_build/exec/diagnose deleted file mode 100755 index b696929..0000000 --- a/branch/double_build/exec/diagnose +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/sh -last='natural join (select system,package,max(id) as id from builds where package not in (select package from blacklist_packages) group by package,system)' - -echo blacklist: -#sqlite3 -header -column /var/cache/cran2deb/cran2deb.db "select count(*) as total_blacklist,sum(nonfree) as num_nonfree, sum(obsolete) as num_obsolete, sum(broken_dependency) as num_broke_depend, sum(unsatisfied_dependency) as num_unsat_depend, sum(breaks_cran2deb) as num_break_cran2deb, sum(other) as num_other from blacklist_packages;" -sqlite3 -header -column /var/cache/cran2deb/cran2deb.db "select count(*) as total,sum(nonfree) as nonfree, sum(obsolete) as obsolete, sum(broken_dependency) as broke_depend, sum(unsatisfied_dependency) as unsat_depend, sum(breaks_cran2deb) as break_cran2deb, sum(other) as other from blacklist_packages;" - -echo bad licenses: -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and log like '%No acceptable license:%' group by system;" -echo -echo bad system req: -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and log like '%do not know what to do with SystemRequirement:%' group by system;" -echo -echo 'c/c++ error (maybe):' -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like '%error: %.h: No such file or directory%' or log like '%error: %.hpp: No such file or directory%') group by system;" -echo -echo 'missing r-cran- package:' -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: Couldn't find package r-cran-%\") group by system;" - -echo -echo 'missing r-cran- package: (frequency, missing package)' -cran2deb latest_log $(sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: Couldn't find package r-cran-%\") group by system;" | head -n 1 | cut -d'|' -f3- | tr ',' ' ') 2>/dev/null | grep "^E: Couldn't find package r-cran-" | awk '{print $5}' | sort | uniq -c | sort -rn - -echo -echo 'lintian:' -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: r-cran-%\") group by system;" -echo -echo some other dependency failure: -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like '%Error: package % could not be loaded%' or log like '%ERROR: lazy loading failed for package%' or log like '%is not available%' or log like '%there is no package called%') and not (log like \"%E: Couldn't find package r-cran-%\") group by system;" - - diff --git a/branch/double_build/exec/diagnose_ctv b/branch/double_build/exec/diagnose_ctv deleted file mode 100755 index 5e7ef03..0000000 --- a/branch/double_build/exec/diagnose_ctv +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -(for x in ctv/*; do echo;echo;echo "$x: "; cd "$x" && cran2deb diagnose && cd ../..; done) >ctv.results diff --git a/branch/double_build/exec/get_base_pkgs b/branch/double_build/exec/get_base_pkgs deleted file mode 100755 index 46de12c..0000000 --- a/branch/double_build/exec/get_base_pkgs +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/env r -instPkgs <- installed.packages(lib.loc="/usr/lib/R/library") -instPkgs <- instPkgs[ instPkgs[,"Priority"] == 'base', ] -for (pkg in rownames(instPkgs)) { - message(pkg) -} diff --git a/branch/double_build/exec/help b/branch/double_build/exec/help deleted file mode 100755 index 3eeabab..0000000 --- a/branch/double_build/exec/help +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/sh -echo usage: cran2deb ' [args ...]' -echo where '' is one of -grep '## [D]OC:' $1/exec/* | sed -e 's/.*[D]OC://' -echo -echo installation root is: $1 diff --git a/branch/double_build/exec/latest_log b/branch/double_build/exec/latest_log deleted file mode 100644 index 1aa875a..0000000 --- a/branch/double_build/exec/latest_log +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb latest_log package1 package2 ... -## DOC: show the latest log output for -## DOC: -suppressPackageStartupMessages(library(cran2deb)) - -if (exists('argv')) { - for (pkg in argv) { - cat(db_latest_build(pkg)$log) - cat('\n') - } -} diff --git a/branch/double_build/exec/license b/branch/double_build/exec/license deleted file mode 100755 index a211525..0000000 --- a/branch/double_build/exec/license +++ /dev/null @@ -1,145 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb license -## DOC: add licenses and change acceptance/rejection of licenses -## DOC: - -suppressPackageStartupMessages(library(cran2deb)) -suppressPackageStartupMessages(library(digest)) - -exec_cmd <- function(argc, argv) { - usage <- function() - message(paste('usage: accept ' - ,' reject ' - ,' hash (|)' - ,' pkg ' - ,' view ' - ,' ls' - ,' quit' - ,sep='\n')) - - if (argc < 1) { - exit() - } - cmd = argv[1] - - if (cmd == 'accept' || cmd == 'reject') { - if (argc != 2) { - usage() - return() - } - action = (cmd == 'accept') - db_add_license_override(argv[2],action) - } else if (cmd == 'hash') { - if (argc != 3) { - usage() - return() - } - license = argv[2] - path = argv[3] - if (is.null(db_license_override_name(license))) { - error('license',license,'is not known; add it first') - return() - } - if (!file.exists(path)) { - error(path,'does not exist') - return() - } - license_sha1 = digest(readChar(path,file.info(path)$size) - ,algo='sha1', serialize=FALSE) - db_add_license_hash(license,license_sha1) - } else if (cmd == 'hash_sha1') { - if (argc != 3) { - usage() - return() - } - license = argv[2] - license_sha1 = argv[3] - if (is.null(db_license_override_name(license))) { - error('license',license,'is not known; add it first') - return() - } - db_add_license_hash(license,license_sha1) - } else if (cmd == 'pkg') { - if (argc != 3) { - usage() - return() - } - license <- argv[2] - pkg_name <- argv[3] - current_action <- db_license_override_name(license) - if (is.null(current_action)) { - notice('license',license,'is not known; add it') - return() - } - action = 'accept' - if (!current_action) { - action = 'reject' - } - notice('in future, will',action,'the package',pkg_name,'under license',license) - tmp <- setup() - success <- try((function() { - pkg <- prepare_pkg(tmp,pkg_name) - if (!('License' %in% names(pkg$description[1,]))) { - error('package',pkg$name,'has no License: field in DESCRIPTION') - return() - } - first_license = (strsplit(chomp(pkg$description[1,'License']) - ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] - license_sha1 <- get_license_hash(pkg,first_license) - db_add_license_hash(license,license_sha1) - })()) - cleanup(tmp) - if (inherits(success,'try-error')) { - return() - } - } else if (cmd == 'view') { - if (argc != 2) { - usage() - return() - } - pkg_name <- argv[2] - tmp <- setup() - success <- try((function() { - pkg <- prepare_pkg(tmp,pkg_name) - if (!('License' %in% names(pkg$description[1,]))) { - error('package',pkg$name,'has no License: field in DESCRIPTION') - return() - } - first_license = (strsplit(chomp(pkg$description[1,'License']) - ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] - first_license = get_license(pkg,first_license) - cat(strwrap(first_license),file='|less') - })()) - cleanup(tmp) - if (inherits(success,'try-error')) { - return() - } - } else if (cmd == 'ls') { - licenses <- db_license_overrides() - for (i in rownames(licenses$overrides)) { - mode='accept' - if (licenses$overrides[i,'accept']==0) { - mode='reject' - } - cat(paste(mode,licenses$overrides[i,'name'],'\n')) - } - for (i in rownames(licenses$hashes)) { - cat(paste('hash_sha1',licenses$hashes[i,'name'],licenses$hashes[i,'sha1'],'\n')) - } - } else if (cmd == 'help') { - usage() - return() - } else if (cmd == 'quit') { - exit() - } -} - -argc <- length(argv) -if (argc > 1) { - exec_cmd(argc-1,argv[c(2:argc)]) -} else { - while(T) { - argv <- strsplit(readline('license> '),'[[:space:]]+')[[1]] - exec_cmd(length(argv),argv) - } -} diff --git a/branch/double_build/exec/progress b/branch/double_build/exec/progress deleted file mode 100755 index e36f274..0000000 --- a/branch/double_build/exec/progress +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/sh -## DOC: cran2deb progress -## DOC: show summary report of aggregate build progress -## DOC: -last='natural join (select system,package,max(id) as id from builds where package not in (select package from blacklist_packages) group by package,system)' -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,(select count(*) from blacklist_packages),-1 from builds group by system;" -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),success from builds $last group by success,system" - -echo failures: -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,group_concat(package) from builds $last where success = 0 group by system" - -echo Xvfb failures: -sqlite3 /var/cache/cran2deb/cran2deb.db "select system,group_concat(package) from builds $last where success = 0 and log like '%Xvfb failed to start%' group by system;" diff --git a/branch/double_build/exec/repopulate b/branch/double_build/exec/repopulate deleted file mode 100755 index ab3ea60..0000000 --- a/branch/double_build/exec/repopulate +++ /dev/null @@ -1,24 +0,0 @@ -#!/bin/sh -## DOC: cran2deb repopulate -## DOC: repopulate the cran2deb database and configurations from a new cran2deb release -## DOC: - -umask 002 -root=$1 -shift -for x in $(find /etc/cran2deb/ -type f -name '*.in'); do - y=$(echo $x | sed -e 's,.in$,,') - sed -e "s:@ROOT@:$root:g" <"$x" >"$y" -done - -# now do an update to reflect any config changes -"$root/exec/update" "$root" - -(for fn in populate_licenses quit; do - cat "$root/data/$fn" -done) | "$root/exec/license" "$root" - -(for fn in populate_depend_aliases populate_sysreq populate_forcedep quit; do - cat "$root/data/$fn" -done) | "$root/exec/depend" "$root" - diff --git a/branch/double_build/exec/root b/branch/double_build/exec/root deleted file mode 100755 index 3133778..0000000 --- a/branch/double_build/exec/root +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -echo $1 diff --git a/branch/double_build/exec/showbuilds b/branch/double_build/exec/showbuilds deleted file mode 100755 index c35e558..0000000 --- a/branch/double_build/exec/showbuilds +++ /dev/null @@ -1,37 +0,0 @@ -#!/bin/sh -## DOC: cran2deb showbuilds [date] -## DOC: list build summary for given date -## DOC: default value for date is current day -## DOC: -db=/var/cache/cran2deb/cran2deb.db -date=`date "+%Y-%m-%d"` - -usage_and_exit() -{ - cat <&1 >/dev/null <' - ,shQuote(file.path(root,'exec/get_base_pkgs')) - ,'| grep -v ^W:'))) - -message('updating list of existing Debian packages...') -debian_pkgs <- readLines(pipe('apt-cache rdepends r-base-core | sed -e "/^ r-cran/{s/^[[:space:]]*r/r/;p}" -e d | sort -u')) - -save(debian_pkgs, base_pkgs, available, ctv.available, file=file.path(cache_root,'cache.rda'),eval.promises=T) - -message('synchronising database...') -db_update_package_versions() diff --git a/branch/double_build/exec/web b/branch/double_build/exec/web deleted file mode 100755 index 10dbcb4..0000000 --- a/branch/double_build/exec/web +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb web -## DOC: generate cran2deb status web pages -## DOC: - -suppressPackageStartupMessages(library(cran2deb)) -library(hwriter) - -banned_builds_path='/var/www/banned_packages.html' -todays_builds_path='/var/www/todays_packages.html' -latest_builds_path='/var/www/latest_packages.html' -failed_builds_path='/var/www/failed_packages.html' - -links <- function(p) { - hwrite(c( - hwrite('Packages built today',link='/todays_packages.html') - ,hwrite('Successful packages',link='/latest_packages.html') - ,hwrite('Failed packages',link='/failed_packages.html') - ,hwrite('Banned packages',link='/banned_packages.html') - ),p,center=TRUE,border=0,style='padding: 6px 6px 6px 12px') -} - -page <- function(content,path,title) { - title <- paste('cran2deb:',title) - p <- openPage(path,title=title) - hwrite(title,p,heading=1) - hwrite('Install instructions',p,center=TRUE,link='/') - links(p) - hwrite(content,p,center=TRUE,border=1,table.style='border-collapse: collapse; padding: 0; margin: 0' - ,row.names=FALSE,row.bgcolor='#ffaaaa') - links(p) - closePage(p) -} - -page(db_blacklist_reasons(),banned_builds_path,'Banned packages') -page(db_todays_builds(),todays_builds_path,'Packages built today') -page(db_successful_builds(),latest_builds_path,'Latest successfully built packages') -page(db_failed_builds(),failed_builds_path,'Recent failed packages') - diff --git a/branch/double_build/exec/which_system b/branch/double_build/exec/which_system deleted file mode 100755 index c7b62de..0000000 --- a/branch/double_build/exec/which_system +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/env r -## DOC: cran2deb which_system -## DOC: show which system cran2deb will build for next -## DOC: -suppressMessages(library(cran2deb)) - -cat(which_system) diff --git a/branch/double_build/inst/doc/DB_NOTES b/branch/double_build/inst/doc/DB_NOTES deleted file mode 100644 index 0960026..0000000 --- a/branch/double_build/inst/doc/DB_NOTES +++ /dev/null @@ -1,81 +0,0 @@ -this file documents some of R/db.R -- the DB interface code. - - -table: sysreq_override -fields: depend_alias TEXT, r_pattern TEXT - -SystemRequirements LIKE r_pattern are mapped onto the dependency alias -depend_alias (this is a foreign key in debian_dependency). - -table: debian_dependency -fields: id INTEGER PRIMARY KEY AUTOINCREMENT, - alias TEXT, - build INTEGER NOT NULL, - debian_pkg TEXT NOT NULL, - UNIQUE (alias,build,debian_pkg) - -sets up a dependency alias. each row is a Debian dependency entry, debian_pkg, which -may be added to Depends: (and Build-Depends: if build = 1). - -table: forced_depends -fields: r_name TEXT. - depend_alias TEXT, - PRIMARY KEY (r_name,depend_alias)' - -forces the R package r_name to have the dependencies implied by depend_alias (a foriegn -key in debian_dependency). - -table: license_override -fields: name TEXT PRIMARY KEY, - accept INT NOT NULL - -specifies whether the license, name, is accepted or rejected. - -table: license_hashes -fields: name TEXT - sha1 TEXT PRIMARY KEY - -matches an SHA1 hash of the LICEN[CS]E file or part of the License: field to -a particular license name (a foreign key in license_override). - -table: database_versions -fields: version INTEGER PRIMARY KEY AUTOINCREMENT, - version_date INTEGER, - base_epoch INTEGER - -a version of the database. each time one of the above tables (but not the below -tables) is updated, a new record is added to this table, indicating significant -changes to the database. version_date indicates when this change occurred -(seconds since UNIX epoch) and base_epoch is the Debian version epoch. - -in future, all of the above fields should be versioned and somehow linked to -the packages that used them, so we only rebuild what is necessary. - -table: packages -fields: package TEXT PRIMARY KEY, - latest_r_version TEXT - -a package, and its latest R version. this is a copy of the 'available' -structure in the cran2deb R cache, and it is here as it allows queries on the -'builds' table to be much simpler (and perhaps faster). - -table: builds -fields: id INTEGER PRIMARY KEY AUTOINCREMENT, - package TEXT, - r_version TEXT, - deb_epoch INTEGER, - deb_revision INTEGER, - db_version INTEGER, - date_stamp TEXT, - git_revision TEXT, - success INTEGER, - log TEXT, - UNIQUE(package,r_version,deb_epoch,deb_revision,db_version) - -Each time a 'package' is built, its 'success' is logged, along with the -particular database, cran2deb, R and Debian version information (db_version, -git_revision, r_version, deb_epoch, deb_revision) and the current date -(date_stamp). 'log' contains the output of the build process. - -A new 'deb_revision' is assigned to each successful build. - diff --git a/branch/double_build/inst/doc/DEPENDS b/branch/double_build/inst/doc/DEPENDS deleted file mode 100644 index 471f240..0000000 --- a/branch/double_build/inst/doc/DEPENDS +++ /dev/null @@ -1,33 +0,0 @@ -A dependency alias (created in populated_depend_aliases) is some name (such as -java) and some associated run and build time dependencies, specified like this: - - alias_build java openjdk-6-jdk - alias_build java libgcj9-dev - alias_run java openjdk-6-jre - -So when cran2deb needs to use the 'java' build dependency, it will add -"openjdk-6-jdk, libgcj9-dev" to the Build-Depends:. alias_run deals with -Depends: only. -Since in Debian you cannot Build-Depend: upon build-essential, there is a -special 'ignore' dependency alias (this can be handy for dropping unnecessary -system requirements) - - alias_build ignore build-essential - -populate_forcedep contains like: - - force java rJava - -which forces the R package rJava to use the dependency alias 'java'. This is -for cases where there is no SystemRequirement. - -Finally, populate_sysreq has lines like: - - sysreq quantlib quantlib% - -This says, whenever a part of a SystemRequirement matches the SQL LIKE pattern -'quantlib%', use the dependency alias. SystemRequirements are converted to -lower case and messed around with; details are in R/debcontrol.R in the -sysreqs_as_debian function. R/debcontrol.R contains pretty much all of the code -for dependencies (the database interface code is in R/db.R). - diff --git a/branch/double_build/inst/doc/INSTALL_NOTES b/branch/double_build/inst/doc/INSTALL_NOTES deleted file mode 100644 index 5acec95..0000000 --- a/branch/double_build/inst/doc/INSTALL_NOTES +++ /dev/null @@ -1,62 +0,0 @@ -*WARNING* This is not up to date! The major difference is that now we have -*WARNING* system-specific configurations, archives and results, so that several -*WARNING* of the paths have either a 'sys/FOO' part or a 'FOO' part where FOO -*WARNING* is something like debian-amd64, debian-i386.. - - -git clone git://github.com/blundellc/cran2deb.git - -apt-get system requirements from DESCRIPTION -apt-get install cdbs - -# install a web server -apt-get install thttpd - -# add a group for cran2deb people -addgroup cran2deb -usermod -a -G cran2deb cb -usermod -a -G cran2deb edd - -# set up web space -mkdir /var/www/cran2deb -chgrp cran2deb /var/www/cran2deb -chmod 3775 /var/www/cran2deb - -# install prereq R packages -r -e "install.packages(c('ctv','RSQLite','DBI','digest'))" -R CMD INSTALL cran2deb - -# set up cran2deb space, as per README -cp /usr/local/lib/R/site-library/cran2deb/exec/cran2deb /usr/local/bin -root=$(cran2deb root) -mkdir /etc/cran2deb -chgrp cran2deb /etc/cran2deb -chmod 3775 /etc/cran2deb -copy ROOT/etc/* to /etc/cran2deb -ln -s /var/www/cran2deb/ /etc/cran2deb/archive -edit /etc/cran2deb/pbuilder.in: -OTHERMIRROR='deb http://localhost/users/cb/cran2deb/ testing/$(ARCH)/ | deb http://localhost/users/cb/cran2deb/ testing/all/' -MIRRORSITE='http://ftp.debian.org/debian/' -to -OTHERMIRROR='deb http://localhost/cran2deb/ testing/$(ARCH)/ | deb http://localhost/cran2deb/ testing/all/' -MIRRORSITE='http://ftp.at.debian.org/debian/' - -# fix permissions for group usage. -mkdir /var/cache/cran2deb -chgrp cran2deb /var/cache/cran2deb -chmod 3775 /var/cache/cran2deb -chgrp -R cran2deb $root -chmod 3775 $root -chmod -R g+w $root - -(log out then log in to get gid cran2deb) - -# build pbuilder archive, initialise database -cran2deb update - -# check it works -cran2deb build zoo - -# is handy -apt-get install sqlite3 - diff --git a/branch/double_build/inst/doc/PKG b/branch/double_build/inst/doc/PKG deleted file mode 100644 index de0a4b2..0000000 --- a/branch/double_build/inst/doc/PKG +++ /dev/null @@ -1,23 +0,0 @@ -One of the key data structures using by cran2deb is commonly called 'pkg'. -It is constructed in R/getrpkg.R by prepare_pkg. prepare_pkg obtains -an R package and converts the source package into something suitable for use -with Debian. - -If a particular upstream version has already been used to create a Debian -package, then the source tarball of that upstream version is expected to be -available locally, and is used for building. In this case no conversion is -performed, so the archive does not change. In future it may be desirable to -obtain the source tarball from some central archive but this is not done at the -moment. - -download_pkg in R/getrpkg.R obtains the tarball (archive) of the R package, either -from the previous Debian build, or from the R archive. The field pkg$need_repack -indicates if the obtained archive must be repacked into a form acceptable -as a Debian source archive. This repacking, if necessary, is performed by -repack_pkg in R/getrpkg.R - - -Most of the creation of pkg is done by R/getrpkg.R. However some more build -specific operations (such as determining the new build version pkg$debversion) -are performed by R/debianpkg.R. - diff --git a/branch/double_build/inst/doc/README b/branch/double_build/inst/doc/README deleted file mode 100644 index a2e51f1..0000000 --- a/branch/double_build/inst/doc/README +++ /dev/null @@ -1,55 +0,0 @@ -To install: - -$ cd .. -$ R CMD INSTALL cran2deb - -copy cran2deb/exec/cran2deb into somewhere in your executable path (e.g., -/usr/local/bin, $home/bin) - - - -To configure: - -1. You need a web server serving from say, /var/www/cran2deb/ - -Let ROOT be the value returned by running: cran2deb root -Let SYS be the system you wish to build for (e.g., debian-amd64) - -2. create /etc/cran2deb - a. copy ROOT/etc/* into /etc/cran2deb/ - b. ensure ROOT/etc/sys/SYS is set up - c. /etc/cran2deb/archive should be a symlink pointing to /var/www/cran2deb/ - - $ ln -s /var/www/cran2deb/ /etc/cran2deb/archive - $ mkdir /var/www/cran2deb/SYS - - d. modify OTHERMIRROR of /etc/cran2deb/sys/SYS/pbuilderrc.in to point to your webserver - e. run: cran2deb repopulate - -3. cran2deb needs a persistent cache outside of R's control. therefore, create - /var/cache/cran2deb, writable by whichever user(s) will run cran2deb. -4. add to /etc/rc.local: - # one mini-dinstall daemon for each apt repo - for sys in debian-i386 debian-amd64 - do - mini-dinstall -c /etc/cran2deb/sys/$sys/mini-dinstall.conf - done - and execute. - -5. run: cran2deb update -6. Try building a simple package: cran2deb build zoo - (The result will be in /var/cache/cran2deb/results/SYS) - - -$ cran2deb help -will display a short summary of help for each cran2deb command. - - -Concerning data/: -This contains scripts necessary to recreate the database should you lose the -database. It's a backup that can be versioned by SVN. There is a script called -pull that, when run from the data directory will recreate all the files from -the database EXCEPT for the licenses. The licenses cannot be recreated because -licenses can be based on one-way hashes. This process could certainly be -improved. - diff --git a/branch/double_build/inst/etc/patches/BayesTree.deprecated/00list b/branch/double_build/inst/etc/patches/BayesTree.deprecated/00list deleted file mode 100644 index 613a63f..0000000 --- a/branch/double_build/inst/etc/patches/BayesTree.deprecated/00list +++ /dev/null @@ -1 +0,0 @@ -01_mpart.cpp.patch diff --git a/branch/double_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch b/branch/double_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch deleted file mode 100644 index f46fbe2..0000000 --- a/branch/double_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch +++ /dev/null @@ -1,19 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_mbart.cpp.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Add valarray header - -@DPATCH@ - -diff -ru BayesTree.orig/src/mbart.cpp BayesTree/src/mbart.cpp ---- BayesTree.orig/src/mbart.cpp 2006-10-16 18:25:18.000000000 -0500 -+++ BayesTree/src/mbart.cpp 2009-05-11 19:32:57.000000000 -0500 -@@ -6,6 +6,7 @@ - #include - #include - #include -+#include - - extern "C" { - #include diff --git a/branch/double_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch b/branch/double_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch deleted file mode 100644 index ce81d47..0000000 --- a/branch/double_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch +++ /dev/null @@ -1,26 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 00_use_local_shebang.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: remove /usr/local from #! - -@DPATCH@ - -diff -Naur CGIwithR.orig/inst/examples/dangerous.R CGIwithR/inst/examples/dangerous.R ---- CGIwithR.orig/inst/examples/dangerous.R 2005-11-23 16:07:08.000000000 +0000 -+++ CGIwithR/inst/examples/dangerous.R 2008-09-13 15:11:14.000000000 +0000 -@@ -1,4 +1,4 @@ --#! /usr/local/bin/R -+#! /usr/bin/R - - ### An example CGI script in R - ### -diff -Naur CGIwithR.orig/inst/examples/trivial.R CGIwithR/inst/examples/trivial.R ---- CGIwithR.orig/inst/examples/trivial.R 2005-11-23 16:07:08.000000000 +0000 -+++ CGIwithR/inst/examples/trivial.R 2008-09-13 15:11:24.000000000 +0000 -@@ -1,4 +1,4 @@ --#! /usr/local/bin/R -+#! /usr/bin/R - - tag(HTML) - tag(HEAD) diff --git a/branch/double_build/inst/etc/patches/CGIwithR/00list b/branch/double_build/inst/etc/patches/CGIwithR/00list deleted file mode 100644 index f951dda..0000000 --- a/branch/double_build/inst/etc/patches/CGIwithR/00list +++ /dev/null @@ -1 +0,0 @@ -00_usr_local_shebang.patch diff --git a/branch/double_build/inst/etc/patches/HAPim/00list b/branch/double_build/inst/etc/patches/HAPim/00list deleted file mode 100644 index e562cca..0000000 --- a/branch/double_build/inst/etc/patches/HAPim/00list +++ /dev/null @@ -1,2 +0,0 @@ -00list -01_DESCRIPTION.patch diff --git a/branch/double_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch b/branch/double_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch deleted file mode 100644 index 7d7eae9..0000000 --- a/branch/double_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch +++ /dev/null @@ -1,17 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_DESCRIPTION.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Add space Package: and name - -@DPATCH@ - -diff -ru HAPim.orig/DESCRIPTION HAPim/DESCRIPTION ---- HAPim.orig/DESCRIPTION 2008-08-25 15:12:59.000000000 +0200 -+++ HAPim/DESCRIPTION 2009-05-12 03:13:29.000000000 +0200 -@@ -1,4 +1,4 @@ --Package:HAPim -+Package: HAPim - Type: Package - Title:HapIM - Version: 1.2 diff --git a/branch/double_build/inst/etc/patches/MatchIt/00list b/branch/double_build/inst/etc/patches/MatchIt/00list deleted file mode 100644 index 2b93818..0000000 --- a/branch/double_build/inst/etc/patches/MatchIt/00list +++ /dev/null @@ -1,2 +0,0 @@ -00list -01_makematchH.patch diff --git a/branch/double_build/inst/etc/patches/MatchIt/01_makematchH.patch b/branch/double_build/inst/etc/patches/MatchIt/01_makematchH.patch deleted file mode 100644 index 7c41ae6..0000000 --- a/branch/double_build/inst/etc/patches/MatchIt/01_makematchH.patch +++ /dev/null @@ -1,17 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_makematchH.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Correct tcsh path - -@DPATCH@ - -diff -ru MatchIt.orig/inst/doc/makematchH MatchIt/inst/doc/makematchH ---- MatchIt.orig/inst/doc/makematchH 2005-03-10 14:25:54.000000000 +0100 -+++ MatchIt/inst/doc/makematchH 2009-05-12 03:23:35.000000000 +0200 -@@ -1,4 +1,4 @@ --#!/bin/tcsh -+#!/usr/bin/tcsh - source ~/.aliases - latex matchit - bibtex matchit diff --git a/branch/double_build/inst/etc/patches/RJaCGH/00list b/branch/double_build/inst/etc/patches/RJaCGH/00list deleted file mode 100644 index 428554e..0000000 --- a/branch/double_build/inst/etc/patches/RJaCGH/00list +++ /dev/null @@ -1 +0,0 @@ -01_remove_zlib.patch diff --git a/branch/double_build/inst/etc/patches/RJaCGH/01_lintian_override.patch b/branch/double_build/inst/etc/patches/RJaCGH/01_lintian_override.patch deleted file mode 100644 index d626c25..0000000 --- a/branch/double_build/inst/etc/patches/RJaCGH/01_lintian_override.patch +++ /dev/null @@ -1,13 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_lintian_override.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Add a lintian override file - -@DPATCH@ - -diff -ruN RJaCGH.orig/debian/RJaCGH.lintian-overrides RJaCGH/debian/RJaCGH.lintian-overrides ---- RJaCGH.orig/debian/RJaCGH.lintian-overrides 1970-01-01 01:00:00.000000000 +0100 -+++ RJaCGH/debian/RJaCGH.lintian-overrides 2009-05-17 21:09:51.000000000 +0200 -@@ -0,0 +1 @@ -+r-cran-rjacgh: embedded-zlib ./usr/lib/R/site-library/RJaCGH/libs/RJaCGH.so diff --git a/branch/double_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch b/branch/double_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch deleted file mode 100644 index e559d61..0000000 --- a/branch/double_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch +++ /dev/null @@ -1,11220 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_remove_zlib_src.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Remove zlib - -@DPATCH@ - -diff -ruN RJaCGH.orig/src/adler32.c RJaCGH/src/adler32.c ---- RJaCGH.orig/src/adler32.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/adler32.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,149 +0,0 @@ --/* adler32.c -- compute the Adler-32 checksum of a data stream -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --#define BASE 65521UL /* largest prime smaller than 65536 */ --#define NMAX 5552 --/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */ -- --#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;} --#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); --#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); --#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); --#define DO16(buf) DO8(buf,0); DO8(buf,8); -- --/* use NO_DIVIDE if your processor does not do division in hardware */ --#ifdef NO_DIVIDE --# define MOD(a) \ -- do { \ -- if (a >= (BASE << 16)) a -= (BASE << 16); \ -- if (a >= (BASE << 15)) a -= (BASE << 15); \ -- if (a >= (BASE << 14)) a -= (BASE << 14); \ -- if (a >= (BASE << 13)) a -= (BASE << 13); \ -- if (a >= (BASE << 12)) a -= (BASE << 12); \ -- if (a >= (BASE << 11)) a -= (BASE << 11); \ -- if (a >= (BASE << 10)) a -= (BASE << 10); \ -- if (a >= (BASE << 9)) a -= (BASE << 9); \ -- if (a >= (BASE << 8)) a -= (BASE << 8); \ -- if (a >= (BASE << 7)) a -= (BASE << 7); \ -- if (a >= (BASE << 6)) a -= (BASE << 6); \ -- if (a >= (BASE << 5)) a -= (BASE << 5); \ -- if (a >= (BASE << 4)) a -= (BASE << 4); \ -- if (a >= (BASE << 3)) a -= (BASE << 3); \ -- if (a >= (BASE << 2)) a -= (BASE << 2); \ -- if (a >= (BASE << 1)) a -= (BASE << 1); \ -- if (a >= BASE) a -= BASE; \ -- } while (0) --# define MOD4(a) \ -- do { \ -- if (a >= (BASE << 4)) a -= (BASE << 4); \ -- if (a >= (BASE << 3)) a -= (BASE << 3); \ -- if (a >= (BASE << 2)) a -= (BASE << 2); \ -- if (a >= (BASE << 1)) a -= (BASE << 1); \ -- if (a >= BASE) a -= BASE; \ -- } while (0) --#else --# define MOD(a) a %= BASE --# define MOD4(a) a %= BASE --#endif -- --/* ========================================================================= */ --uLong ZEXPORT adler32(adler, buf, len) -- uLong adler; -- const Bytef *buf; -- uInt len; --{ -- unsigned long sum2; -- unsigned n; -- -- /* split Adler-32 into component sums */ -- sum2 = (adler >> 16) & 0xffff; -- adler &= 0xffff; -- -- /* in case user likes doing a byte at a time, keep it fast */ -- if (len == 1) { -- adler += buf[0]; -- if (adler >= BASE) -- adler -= BASE; -- sum2 += adler; -- if (sum2 >= BASE) -- sum2 -= BASE; -- return adler | (sum2 << 16); -- } -- -- /* initial Adler-32 value (deferred check for len == 1 speed) */ -- if (buf == Z_NULL) -- return 1L; -- -- /* in case short lengths are provided, keep it somewhat fast */ -- if (len < 16) { -- while (len--) { -- adler += *buf++; -- sum2 += adler; -- } -- if (adler >= BASE) -- adler -= BASE; -- MOD4(sum2); /* only added so many BASE's */ -- return adler | (sum2 << 16); -- } -- -- /* do length NMAX blocks -- requires just one modulo operation */ -- while (len >= NMAX) { -- len -= NMAX; -- n = NMAX / 16; /* NMAX is divisible by 16 */ -- do { -- DO16(buf); /* 16 sums unrolled */ -- buf += 16; -- } while (--n); -- MOD(adler); -- MOD(sum2); -- } -- -- /* do remaining bytes (less than NMAX, still just one modulo) */ -- if (len) { /* avoid modulos if none remaining */ -- while (len >= 16) { -- len -= 16; -- DO16(buf); -- buf += 16; -- } -- while (len--) { -- adler += *buf++; -- sum2 += adler; -- } -- MOD(adler); -- MOD(sum2); -- } -- -- /* return recombined sums */ -- return adler | (sum2 << 16); --} -- --/* ========================================================================= */ --uLong ZEXPORT adler32_combine(adler1, adler2, len2) -- uLong adler1; -- uLong adler2; -- z_off_t len2; --{ -- unsigned long sum1; -- unsigned long sum2; -- unsigned rem; -- -- /* the derivation of this formula is left as an exercise for the reader */ -- rem = (unsigned)(len2 % BASE); -- sum1 = adler1 & 0xffff; -- sum2 = rem * sum1; -- MOD(sum2); -- sum1 += (adler2 & 0xffff) + BASE - 1; -- sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem; -- if (sum1 > BASE) sum1 -= BASE; -- if (sum1 > BASE) sum1 -= BASE; -- if (sum2 > (BASE << 1)) sum2 -= (BASE << 1); -- if (sum2 > BASE) sum2 -= BASE; -- return sum1 | (sum2 << 16); --} -diff -ruN RJaCGH.orig/src/compress.c RJaCGH/src/compress.c ---- RJaCGH.orig/src/compress.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/compress.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,79 +0,0 @@ --/* compress.c -- compress a memory buffer -- * Copyright (C) 1995-2003 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --/* =========================================================================== -- Compresses the source buffer into the destination buffer. The level -- parameter has the same meaning as in deflateInit. sourceLen is the byte -- length of the source buffer. Upon entry, destLen is the total size of the -- destination buffer, which must be at least 0.1% larger than sourceLen plus -- 12 bytes. Upon exit, destLen is the actual size of the compressed buffer. -- -- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_BUF_ERROR if there was not enough room in the output buffer, -- Z_STREAM_ERROR if the level parameter is invalid. --*/ --int ZEXPORT compress2 (dest, destLen, source, sourceLen, level) -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; -- int level; --{ -- z_stream stream; -- int err; -- -- stream.next_in = (Bytef*)source; -- stream.avail_in = (uInt)sourceLen; --#ifdef MAXSEG_64K -- /* Check for source > 64K on 16-bit machine: */ -- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; --#endif -- stream.next_out = dest; -- stream.avail_out = (uInt)*destLen; -- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; -- -- stream.zalloc = (alloc_func)0; -- stream.zfree = (free_func)0; -- stream.opaque = (voidpf)0; -- -- err = deflateInit(&stream, level); -- if (err != Z_OK) return err; -- -- err = deflate(&stream, Z_FINISH); -- if (err != Z_STREAM_END) { -- deflateEnd(&stream); -- return err == Z_OK ? Z_BUF_ERROR : err; -- } -- *destLen = stream.total_out; -- -- err = deflateEnd(&stream); -- return err; --} -- --/* =========================================================================== -- */ --int ZEXPORT compress (dest, destLen, source, sourceLen) -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; --{ -- return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION); --} -- --/* =========================================================================== -- If the default memLevel or windowBits for deflateInit() is changed, then -- this function needs to be updated. -- */ --uLong ZEXPORT compressBound (sourceLen) -- uLong sourceLen; --{ -- return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + 11; --} -diff -ruN RJaCGH.orig/src/crc32.c RJaCGH/src/crc32.c ---- RJaCGH.orig/src/crc32.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/crc32.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,423 +0,0 @@ --/* crc32.c -- compute the CRC-32 of a data stream -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- * -- * Thanks to Rodney Brown for his contribution of faster -- * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing -- * tables for updating the shift register in one step with three exclusive-ors -- * instead of four steps with four exclusive-ors. This results in about a -- * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3. -- */ -- --/* @(#) $Id$ */ -- --/* -- Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore -- protection on the static variables used to control the first-use generation -- of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should -- first call get_crc_table() to initialize the tables before allowing more than -- one thread to use crc32(). -- */ -- --#ifdef MAKECRCH --# include --# ifndef DYNAMIC_CRC_TABLE --# define DYNAMIC_CRC_TABLE --# endif /* !DYNAMIC_CRC_TABLE */ --#endif /* MAKECRCH */ -- --#include "zutil.h" /* for STDC and FAR definitions */ -- --#define local static -- --/* Find a four-byte integer type for crc32_little() and crc32_big(). */ --#ifndef NOBYFOUR --# ifdef STDC /* need ANSI C limits.h to determine sizes */ --# include --# define BYFOUR --# if (UINT_MAX == 0xffffffffUL) -- typedef unsigned int u4; --# else --# if (ULONG_MAX == 0xffffffffUL) -- typedef unsigned long u4; --# else --# if (USHRT_MAX == 0xffffffffUL) -- typedef unsigned short u4; --# else --# undef BYFOUR /* can't find a four-byte integer type! */ --# endif --# endif --# endif --# endif /* STDC */ --#endif /* !NOBYFOUR */ -- --/* Definitions for doing the crc four data bytes at a time. */ --#ifdef BYFOUR --# define REV(w) (((w)>>24)+(((w)>>8)&0xff00)+ \ -- (((w)&0xff00)<<8)+(((w)&0xff)<<24)) -- local unsigned long crc32_little OF((unsigned long, -- const unsigned char FAR *, unsigned)); -- local unsigned long crc32_big OF((unsigned long, -- const unsigned char FAR *, unsigned)); --# define TBLS 8 --#else --# define TBLS 1 --#endif /* BYFOUR */ -- --/* Local functions for crc concatenation */ --local unsigned long gf2_matrix_times OF((unsigned long *mat, -- unsigned long vec)); --local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat)); -- --#ifdef DYNAMIC_CRC_TABLE -- --local volatile int crc_table_empty = 1; --local unsigned long FAR crc_table[TBLS][256]; --local void make_crc_table OF((void)); --#ifdef MAKECRCH -- local void write_table OF((FILE *, const unsigned long FAR *)); --#endif /* MAKECRCH */ --/* -- Generate tables 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 first table is simply the CRC of all possible eight bit values. This is -- all the information needed to generate CRCs on data a byte at a time for all -- combinations of CRC register values and incoming bytes. The remaining tables -- allow for word-at-a-time CRC calculation for both big-endian and little- -- endian machines, where a word is four bytes. --*/ --local void make_crc_table() --{ -- unsigned long c; -- int n, k; -- unsigned long poly; /* polynomial exclusive-or pattern */ -- /* terms of polynomial defining this crc (except x^32): */ -- static volatile int first = 1; /* flag to limit concurrent making */ -- static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26}; -- -- /* See if another task is already doing this (not thread-safe, but better -- than nothing -- significantly reduces duration of vulnerability in -- case the advice about DYNAMIC_CRC_TABLE is ignored) */ -- if (first) { -- first = 0; -- -- /* make exclusive-or pattern from polynomial (0xedb88320UL) */ -- poly = 0UL; -- for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++) -- poly |= 1UL << (31 - p[n]); -- -- /* generate a crc for every 8-bit value */ -- for (n = 0; n < 256; n++) { -- c = (unsigned long)n; -- for (k = 0; k < 8; k++) -- c = c & 1 ? poly ^ (c >> 1) : c >> 1; -- crc_table[0][n] = c; -- } -- --#ifdef BYFOUR -- /* generate crc for each value followed by one, two, and three zeros, -- and then the byte reversal of those as well as the first table */ -- for (n = 0; n < 256; n++) { -- c = crc_table[0][n]; -- crc_table[4][n] = REV(c); -- for (k = 1; k < 4; k++) { -- c = crc_table[0][c & 0xff] ^ (c >> 8); -- crc_table[k][n] = c; -- crc_table[k + 4][n] = REV(c); -- } -- } --#endif /* BYFOUR */ -- -- crc_table_empty = 0; -- } -- else { /* not first */ -- /* wait for the other guy to finish (not efficient, but rare) */ -- while (crc_table_empty) -- ; -- } -- --#ifdef MAKECRCH -- /* write out CRC tables to crc32.h */ -- { -- FILE *out; -- -- out = fopen("crc32.h", "w"); -- if (out == NULL) return; -- fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n"); -- fprintf(out, " * Generated automatically by crc32.c\n */\n\n"); -- fprintf(out, "local const unsigned long FAR "); -- fprintf(out, "crc_table[TBLS][256] =\n{\n {\n"); -- write_table(out, crc_table[0]); --# ifdef BYFOUR -- fprintf(out, "#ifdef BYFOUR\n"); -- for (k = 1; k < 8; k++) { -- fprintf(out, " },\n {\n"); -- write_table(out, crc_table[k]); -- } -- fprintf(out, "#endif\n"); --# endif /* BYFOUR */ -- fprintf(out, " }\n};\n"); -- fclose(out); -- } --#endif /* MAKECRCH */ --} -- --#ifdef MAKECRCH --local void write_table(out, table) -- FILE *out; -- const unsigned long FAR *table; --{ -- int n; -- -- for (n = 0; n < 256; n++) -- fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n], -- n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", ")); --} --#endif /* MAKECRCH */ -- --#else /* !DYNAMIC_CRC_TABLE */ --/* ======================================================================== -- * Tables of CRC-32s of all single-byte values, made by make_crc_table(). -- */ --#include "crc32.h" --#endif /* DYNAMIC_CRC_TABLE */ -- --/* ========================================================================= -- * This function can be used by asm versions of crc32() -- */ --const unsigned long FAR * ZEXPORT get_crc_table() --{ --#ifdef DYNAMIC_CRC_TABLE -- if (crc_table_empty) -- make_crc_table(); --#endif /* DYNAMIC_CRC_TABLE */ -- return (const unsigned long FAR *)crc_table; --} -- --/* ========================================================================= */ --#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8) --#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1 -- --/* ========================================================================= */ --unsigned long ZEXPORT crc32(crc, buf, len) -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --{ -- if (buf == Z_NULL) return 0UL; -- --#ifdef DYNAMIC_CRC_TABLE -- if (crc_table_empty) -- make_crc_table(); --#endif /* DYNAMIC_CRC_TABLE */ -- --#ifdef BYFOUR -- if (sizeof(void *) == sizeof(ptrdiff_t)) { -- u4 endian; -- -- endian = 1; -- if (*((unsigned char *)(&endian))) -- return crc32_little(crc, buf, len); -- else -- return crc32_big(crc, buf, len); -- } --#endif /* BYFOUR */ -- crc = crc ^ 0xffffffffUL; -- while (len >= 8) { -- DO8; -- len -= 8; -- } -- if (len) do { -- DO1; -- } while (--len); -- return crc ^ 0xffffffffUL; --} -- --#ifdef BYFOUR -- --/* ========================================================================= */ --#define DOLIT4 c ^= *buf4++; \ -- c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \ -- crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24] --#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4 -- --/* ========================================================================= */ --local unsigned long crc32_little(crc, buf, len) -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --{ -- register u4 c; -- register const u4 FAR *buf4; -- -- c = (u4)crc; -- c = ~c; -- while (len && ((ptrdiff_t)buf & 3)) { -- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); -- len--; -- } -- -- buf4 = (const u4 FAR *)(const void FAR *)buf; -- while (len >= 32) { -- DOLIT32; -- len -= 32; -- } -- while (len >= 4) { -- DOLIT4; -- len -= 4; -- } -- buf = (const unsigned char FAR *)buf4; -- -- if (len) do { -- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); -- } while (--len); -- c = ~c; -- return (unsigned long)c; --} -- --/* ========================================================================= */ --#define DOBIG4 c ^= *++buf4; \ -- c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \ -- crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24] --#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4 -- --/* ========================================================================= */ --local unsigned long crc32_big(crc, buf, len) -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --{ -- register u4 c; -- register const u4 FAR *buf4; -- -- c = REV((u4)crc); -- c = ~c; -- while (len && ((ptrdiff_t)buf & 3)) { -- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); -- len--; -- } -- -- buf4 = (const u4 FAR *)(const void FAR *)buf; -- buf4--; -- while (len >= 32) { -- DOBIG32; -- len -= 32; -- } -- while (len >= 4) { -- DOBIG4; -- len -= 4; -- } -- buf4++; -- buf = (const unsigned char FAR *)buf4; -- -- if (len) do { -- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); -- } while (--len); -- c = ~c; -- return (unsigned long)(REV(c)); --} -- --#endif /* BYFOUR */ -- --#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */ -- --/* ========================================================================= */ --local unsigned long gf2_matrix_times(mat, vec) -- unsigned long *mat; -- unsigned long vec; --{ -- unsigned long sum; -- -- sum = 0; -- while (vec) { -- if (vec & 1) -- sum ^= *mat; -- vec >>= 1; -- mat++; -- } -- return sum; --} -- --/* ========================================================================= */ --local void gf2_matrix_square(square, mat) -- unsigned long *square; -- unsigned long *mat; --{ -- int n; -- -- for (n = 0; n < GF2_DIM; n++) -- square[n] = gf2_matrix_times(mat, mat[n]); --} -- --/* ========================================================================= */ --uLong ZEXPORT crc32_combine(crc1, crc2, len2) -- uLong crc1; -- uLong crc2; -- z_off_t len2; --{ -- int n; -- unsigned long row; -- unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */ -- unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */ -- -- /* degenerate case */ -- if (len2 == 0) -- return crc1; -- -- /* put operator for one zero bit in odd */ -- odd[0] = 0xedb88320L; /* CRC-32 polynomial */ -- row = 1; -- for (n = 1; n < GF2_DIM; n++) { -- odd[n] = row; -- row <<= 1; -- } -- -- /* put operator for two zero bits in even */ -- gf2_matrix_square(even, odd); -- -- /* put operator for four zero bits in odd */ -- gf2_matrix_square(odd, even); -- -- /* apply len2 zeros to crc1 (first square will put the operator for one -- zero byte, eight zero bits, in even) */ -- do { -- /* apply zeros operator for this bit of len2 */ -- gf2_matrix_square(even, odd); -- if (len2 & 1) -- crc1 = gf2_matrix_times(even, crc1); -- len2 >>= 1; -- -- /* if no more bits set, then done */ -- if (len2 == 0) -- break; -- -- /* another iteration of the loop with odd and even swapped */ -- gf2_matrix_square(odd, even); -- if (len2 & 1) -- crc1 = gf2_matrix_times(odd, crc1); -- len2 >>= 1; -- -- /* if no more bits set, then done */ -- } while (len2 != 0); -- -- /* return combined crc */ -- crc1 ^= crc2; -- return crc1; --} -diff -ruN RJaCGH.orig/src/crc32.h RJaCGH/src/crc32.h ---- RJaCGH.orig/src/crc32.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/crc32.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,441 +0,0 @@ --/* crc32.h -- tables for rapid CRC calculation -- * Generated automatically by crc32.c -- */ -- --local const unsigned long FAR crc_table[TBLS][256] = --{ -- { -- 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL, -- 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL, -- 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, -- 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL, -- 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL, -- 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL, -- 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, -- 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL, -- 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL, -- 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL, -- 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, -- 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL, -- 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL, -- 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL, -- 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, -- 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL, -- 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL, -- 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL, -- 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, -- 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL, -- 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL, -- 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL, -- 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, -- 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL, -- 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL, -- 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL, -- 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, -- 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL, -- 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL, -- 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL, -- 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, -- 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL, -- 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL, -- 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL, -- 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, -- 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL, -- 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL, -- 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL, -- 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, -- 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL, -- 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL, -- 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL, -- 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, -- 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL, -- 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL, -- 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL, -- 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, -- 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL, -- 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL, -- 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL, -- 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, -- 0x2d02ef8dUL --#ifdef BYFOUR -- }, -- { -- 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL, -- 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL, -- 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL, -- 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL, -- 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL, -- 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL, -- 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL, -- 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL, -- 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL, -- 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL, -- 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL, -- 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL, -- 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL, -- 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL, -- 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL, -- 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL, -- 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL, -- 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL, -- 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL, -- 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL, -- 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL, -- 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL, -- 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL, -- 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL, -- 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL, -- 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL, -- 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL, -- 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL, -- 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL, -- 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL, -- 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL, -- 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL, -- 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL, -- 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL, -- 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL, -- 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL, -- 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL, -- 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL, -- 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL, -- 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL, -- 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL, -- 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL, -- 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL, -- 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL, -- 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL, -- 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL, -- 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL, -- 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL, -- 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL, -- 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL, -- 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL, -- 0x9324fd72UL -- }, -- { -- 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL, -- 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL, -- 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL, -- 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL, -- 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL, -- 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL, -- 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL, -- 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL, -- 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL, -- 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL, -- 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL, -- 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL, -- 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL, -- 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL, -- 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL, -- 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL, -- 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL, -- 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL, -- 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL, -- 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL, -- 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL, -- 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL, -- 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL, -- 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL, -- 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL, -- 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL, -- 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL, -- 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL, -- 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL, -- 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL, -- 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL, -- 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL, -- 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL, -- 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL, -- 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL, -- 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL, -- 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL, -- 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL, -- 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL, -- 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL, -- 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL, -- 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL, -- 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL, -- 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL, -- 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL, -- 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL, -- 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL, -- 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL, -- 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL, -- 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL, -- 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL, -- 0xbe9834edUL -- }, -- { -- 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL, -- 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL, -- 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL, -- 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL, -- 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL, -- 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL, -- 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL, -- 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL, -- 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL, -- 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL, -- 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL, -- 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL, -- 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL, -- 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL, -- 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL, -- 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL, -- 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL, -- 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL, -- 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL, -- 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL, -- 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL, -- 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL, -- 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL, -- 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL, -- 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL, -- 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL, -- 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL, -- 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL, -- 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL, -- 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL, -- 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL, -- 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL, -- 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL, -- 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL, -- 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL, -- 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL, -- 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL, -- 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL, -- 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL, -- 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL, -- 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL, -- 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL, -- 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL, -- 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL, -- 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL, -- 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL, -- 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL, -- 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL, -- 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL, -- 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL, -- 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL, -- 0xde0506f1UL -- }, -- { -- 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL, -- 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL, -- 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL, -- 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL, -- 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL, -- 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL, -- 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL, -- 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL, -- 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL, -- 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL, -- 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL, -- 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL, -- 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL, -- 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL, -- 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL, -- 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL, -- 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL, -- 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL, -- 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL, -- 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL, -- 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL, -- 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL, -- 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL, -- 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL, -- 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL, -- 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL, -- 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL, -- 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL, -- 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL, -- 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL, -- 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL, -- 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL, -- 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL, -- 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL, -- 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL, -- 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL, -- 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL, -- 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL, -- 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL, -- 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL, -- 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL, -- 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL, -- 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL, -- 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL, -- 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL, -- 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL, -- 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL, -- 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL, -- 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL, -- 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL, -- 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL, -- 0x8def022dUL -- }, -- { -- 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL, -- 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL, -- 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL, -- 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL, -- 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL, -- 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL, -- 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL, -- 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL, -- 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL, -- 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL, -- 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL, -- 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL, -- 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL, -- 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL, -- 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL, -- 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL, -- 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL, -- 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL, -- 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL, -- 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL, -- 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL, -- 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL, -- 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL, -- 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL, -- 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL, -- 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL, -- 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL, -- 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL, -- 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL, -- 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL, -- 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL, -- 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL, -- 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL, -- 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL, -- 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL, -- 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL, -- 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL, -- 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL, -- 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL, -- 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL, -- 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL, -- 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL, -- 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL, -- 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL, -- 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL, -- 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL, -- 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL, -- 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL, -- 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL, -- 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL, -- 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL, -- 0x72fd2493UL -- }, -- { -- 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL, -- 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL, -- 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL, -- 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL, -- 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL, -- 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL, -- 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL, -- 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL, -- 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL, -- 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL, -- 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL, -- 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL, -- 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL, -- 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL, -- 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL, -- 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL, -- 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL, -- 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL, -- 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL, -- 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL, -- 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL, -- 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL, -- 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL, -- 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL, -- 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL, -- 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL, -- 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL, -- 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL, -- 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL, -- 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL, -- 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL, -- 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL, -- 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL, -- 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL, -- 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL, -- 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL, -- 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL, -- 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL, -- 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL, -- 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL, -- 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL, -- 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL, -- 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL, -- 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL, -- 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL, -- 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL, -- 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL, -- 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL, -- 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL, -- 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL, -- 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL, -- 0xed3498beUL -- }, -- { -- 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL, -- 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL, -- 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL, -- 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL, -- 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL, -- 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL, -- 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL, -- 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL, -- 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL, -- 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL, -- 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL, -- 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL, -- 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL, -- 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL, -- 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL, -- 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL, -- 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL, -- 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL, -- 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL, -- 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL, -- 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL, -- 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL, -- 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL, -- 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL, -- 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL, -- 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL, -- 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL, -- 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL, -- 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL, -- 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL, -- 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL, -- 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL, -- 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL, -- 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL, -- 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL, -- 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL, -- 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL, -- 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL, -- 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL, -- 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL, -- 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL, -- 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL, -- 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL, -- 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL, -- 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL, -- 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL, -- 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL, -- 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL, -- 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL, -- 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL, -- 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL, -- 0xf10605deUL --#endif -- } --}; -diff -ruN RJaCGH.orig/src/deflate.c RJaCGH/src/deflate.c ---- RJaCGH.orig/src/deflate.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/deflate.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1736 +0,0 @@ --/* deflate.c -- compress data using the deflation algorithm -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * ALGORITHM -- * -- * The "deflation" process depends on being able to identify portions -- * of the input text which are identical to earlier input (within a -- * sliding window trailing behind the input currently being processed). -- * -- * The most straightforward technique turns out to be the fastest for -- * most input files: try all possible matches and select the longest. -- * The key feature of this algorithm is that insertions into the string -- * dictionary are very simple and thus fast, and deletions are avoided -- * completely. Insertions are performed at each input character, whereas -- * string matches are performed only when the previous match ends. So it -- * is preferable to spend more time in matches to allow very fast string -- * insertions and avoid deletions. The matching algorithm for small -- * strings is inspired from that of Rabin & Karp. A brute force approach -- * is used to find longer strings when a small match has been found. -- * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze -- * (by Leonid Broukhis). -- * A previous version of this file used a more sophisticated algorithm -- * (by Fiala and Greene) which is guaranteed to run in linear amortized -- * time, but has a larger average cost, uses more memory and is patented. -- * However the F&G algorithm may be faster for some highly redundant -- * files if the parameter max_chain_length (described below) is too large. -- * -- * ACKNOWLEDGEMENTS -- * -- * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and -- * I found it in 'freeze' written by Leonid Broukhis. -- * Thanks to many people for bug reports and testing. -- * -- * REFERENCES -- * -- * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". -- * Available in http://www.ietf.org/rfc/rfc1951.txt -- * -- * A description of the Rabin and Karp algorithm is given in the book -- * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. -- * -- * Fiala,E.R., and Greene,D.H. -- * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 -- * -- */ -- --/* @(#) $Id$ */ -- --#include "deflate.h" -- --const char deflate_copyright[] = -- " deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly "; --/* -- If you use the zlib library in a product, an acknowledgment is welcome -- in the documentation of your product. If for some reason you cannot -- include such an acknowledgment, I would appreciate that you keep this -- copyright string in the executable of your product. -- */ -- --/* =========================================================================== -- * Function prototypes. -- */ --typedef enum { -- need_more, /* block not completed, need more input or more output */ -- block_done, /* block flush performed */ -- finish_started, /* finish started, need only more output at next deflate */ -- finish_done /* finish done, accept no more input or output */ --} block_state; -- --typedef block_state (*compress_func) OF((deflate_state *s, int flush)); --/* Compression function. Returns the block state after the call. */ -- --local void fill_window OF((deflate_state *s)); --local block_state deflate_stored OF((deflate_state *s, int flush)); --local block_state deflate_fast OF((deflate_state *s, int flush)); --#ifndef FASTEST --local block_state deflate_slow OF((deflate_state *s, int flush)); --#endif --local void lm_init OF((deflate_state *s)); --local void putShortMSB OF((deflate_state *s, uInt b)); --local void flush_pending OF((z_streamp strm)); --local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size)); --#ifndef FASTEST --#ifdef ASMV -- void match_init OF((void)); /* asm code initialization */ -- uInt longest_match OF((deflate_state *s, IPos cur_match)); --#else --local uInt longest_match OF((deflate_state *s, IPos cur_match)); --#endif --#endif --local uInt longest_match_fast OF((deflate_state *s, IPos cur_match)); -- --#ifdef DEBUG --local void check_match OF((deflate_state *s, IPos start, IPos match, -- int length)); --#endif -- --/* =========================================================================== -- * Local data -- */ -- --#define NIL 0 --/* Tail of hash chains */ -- --#ifndef TOO_FAR --# define TOO_FAR 4096 --#endif --/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ -- --#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) --/* Minimum amount of lookahead, except at the end of the input file. -- * See deflate.c for comments about the MIN_MATCH+1. -- */ -- --/* Values for max_lazy_match, good_match and max_chain_length, depending on -- * the desired pack level (0..9). The values given below have been tuned to -- * exclude worst case performance for pathological files. Better values may be -- * found for specific files. -- */ --typedef struct config_s { -- ush good_length; /* reduce lazy search above this match length */ -- ush max_lazy; /* do not perform lazy search above this match length */ -- ush nice_length; /* quit search above this match length */ -- ush max_chain; -- compress_func func; --} config; -- --#ifdef FASTEST --local const config configuration_table[2] = { --/* good lazy nice chain */ --/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ --/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ --#else --local const config configuration_table[10] = { --/* good lazy nice chain */ --/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ --/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ --/* 2 */ {4, 5, 16, 8, deflate_fast}, --/* 3 */ {4, 6, 32, 32, deflate_fast}, -- --/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ --/* 5 */ {8, 16, 32, 32, deflate_slow}, --/* 6 */ {8, 16, 128, 128, deflate_slow}, --/* 7 */ {8, 32, 128, 256, deflate_slow}, --/* 8 */ {32, 128, 258, 1024, deflate_slow}, --/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ --#endif -- --/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 -- * For deflate_fast() (levels <= 3) good is ignored and lazy has a different -- * meaning. -- */ -- --#define EQUAL 0 --/* result of memcmp for equal strings */ -- --#ifndef NO_DUMMY_DECL --struct static_tree_desc_s {int dummy;}; /* for buggy compilers */ --#endif -- --/* =========================================================================== -- * Update a hash value with the given input byte -- * IN assertion: all calls to to UPDATE_HASH are made with consecutive -- * input characters, so that a running hash key can be computed from the -- * previous key instead of complete recalculation each time. -- */ --#define UPDATE_HASH(s,h,c) (h = (((h)<hash_shift) ^ (c)) & s->hash_mask) -- -- --/* =========================================================================== -- * Insert string str in the dictionary and set match_head to the previous head -- * of the hash chain (the most recent string with same hash key). Return -- * the previous length of the hash chain. -- * If this file is compiled with -DFASTEST, the compression level is forced -- * to 1, and no hash chains are maintained. -- * IN assertion: all calls to to INSERT_STRING are made with consecutive -- * input characters and the first MIN_MATCH bytes of str are valid -- * (except for the last MIN_MATCH-1 bytes of the input file). -- */ --#ifdef FASTEST --#define INSERT_STRING(s, str, match_head) \ -- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ -- match_head = s->head[s->ins_h], \ -- s->head[s->ins_h] = (Pos)(str)) --#else --#define INSERT_STRING(s, str, match_head) \ -- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ -- match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ -- s->head[s->ins_h] = (Pos)(str)) --#endif -- --/* =========================================================================== -- * Initialize the hash table (avoiding 64K overflow for 16 bit systems). -- * prev[] will be initialized on the fly. -- */ --#define CLEAR_HASH(s) \ -- s->head[s->hash_size-1] = NIL; \ -- zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head)); -- --/* ========================================================================= */ --int ZEXPORT deflateInit_(strm, level, version, stream_size) -- z_streamp strm; -- int level; -- const char *version; -- int stream_size; --{ -- return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, -- Z_DEFAULT_STRATEGY, version, stream_size); -- /* To do: ignore strm->next_in if we use it as window */ --} -- --/* ========================================================================= */ --int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy, -- version, stream_size) -- z_streamp strm; -- int level; -- int method; -- int windowBits; -- int memLevel; -- int strategy; -- const char *version; -- int stream_size; --{ -- deflate_state *s; -- int wrap = 1; -- static const char my_version[] = ZLIB_VERSION; -- -- ushf *overlay; -- /* We overlay pending_buf and d_buf+l_buf. This works since the average -- * output size for (length,distance) codes is <= 24 bits. -- */ -- -- if (version == Z_NULL || version[0] != my_version[0] || -- stream_size != sizeof(z_stream)) { -- return Z_VERSION_ERROR; -- } -- if (strm == Z_NULL) return Z_STREAM_ERROR; -- -- strm->msg = Z_NULL; -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- --#ifdef FASTEST -- if (level != 0) level = 1; --#else -- if (level == Z_DEFAULT_COMPRESSION) level = 6; --#endif -- -- if (windowBits < 0) { /* suppress zlib wrapper */ -- wrap = 0; -- windowBits = -windowBits; -- } --#ifdef GZIP -- else if (windowBits > 15) { -- wrap = 2; /* write gzip wrapper instead */ -- windowBits -= 16; -- } --#endif -- if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || -- windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || -- strategy < 0 || strategy > Z_FIXED) { -- return Z_STREAM_ERROR; -- } -- if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ -- s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); -- if (s == Z_NULL) return Z_MEM_ERROR; -- strm->state = (struct internal_state FAR *)s; -- s->strm = strm; -- -- s->wrap = wrap; -- s->gzhead = Z_NULL; -- s->w_bits = windowBits; -- s->w_size = 1 << s->w_bits; -- s->w_mask = s->w_size - 1; -- -- s->hash_bits = memLevel + 7; -- s->hash_size = 1 << s->hash_bits; -- s->hash_mask = s->hash_size - 1; -- s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH); -- -- s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); -- s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); -- s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); -- -- s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ -- -- overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2); -- s->pending_buf = (uchf *) overlay; -- s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L); -- -- if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || -- s->pending_buf == Z_NULL) { -- s->status = FINISH_STATE; -- strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); -- deflateEnd (strm); -- return Z_MEM_ERROR; -- } -- s->d_buf = overlay + s->lit_bufsize/sizeof(ush); -- s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize; -- -- s->level = level; -- s->strategy = strategy; -- s->method = (Byte)method; -- -- return deflateReset(strm); --} -- --/* ========================================================================= */ --int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength) -- z_streamp strm; -- const Bytef *dictionary; -- uInt dictLength; --{ -- deflate_state *s; -- uInt length = dictLength; -- uInt n; -- IPos hash_head = 0; -- -- if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL || -- strm->state->wrap == 2 || -- (strm->state->wrap == 1 && strm->state->status != INIT_STATE)) -- return Z_STREAM_ERROR; -- -- s = strm->state; -- if (s->wrap) -- strm->adler = adler32(strm->adler, dictionary, dictLength); -- -- if (length < MIN_MATCH) return Z_OK; -- if (length > MAX_DIST(s)) { -- length = MAX_DIST(s); -- dictionary += dictLength - length; /* use the tail of the dictionary */ -- } -- zmemcpy(s->window, dictionary, length); -- s->strstart = length; -- s->block_start = (long)length; -- -- /* Insert all strings in the hash table (except for the last two bytes). -- * s->lookahead stays null, so s->ins_h will be recomputed at the next -- * call of fill_window. -- */ -- s->ins_h = s->window[0]; -- UPDATE_HASH(s, s->ins_h, s->window[1]); -- for (n = 0; n <= length - MIN_MATCH; n++) { -- INSERT_STRING(s, n, hash_head); -- } -- if (hash_head) hash_head = 0; /* to make compiler happy */ -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateReset (strm) -- z_streamp strm; --{ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL || -- strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) { -- return Z_STREAM_ERROR; -- } -- -- strm->total_in = strm->total_out = 0; -- strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ -- strm->data_type = Z_UNKNOWN; -- -- s = (deflate_state *)strm->state; -- s->pending = 0; -- s->pending_out = s->pending_buf; -- -- if (s->wrap < 0) { -- s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ -- } -- s->status = s->wrap ? INIT_STATE : BUSY_STATE; -- strm->adler = --#ifdef GZIP -- s->wrap == 2 ? crc32(0L, Z_NULL, 0) : --#endif -- adler32(0L, Z_NULL, 0); -- s->last_flush = Z_NO_FLUSH; -- -- _tr_init(s); -- lm_init(s); -- -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateSetHeader (strm, head) -- z_streamp strm; -- gz_headerp head; --{ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- if (strm->state->wrap != 2) return Z_STREAM_ERROR; -- strm->state->gzhead = head; -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflatePrime (strm, bits, value) -- z_streamp strm; -- int bits; -- int value; --{ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- strm->state->bi_valid = bits; -- strm->state->bi_buf = (ush)(value & ((1 << bits) - 1)); -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateParams(strm, level, strategy) -- z_streamp strm; -- int level; -- int strategy; --{ -- deflate_state *s; -- compress_func func; -- int err = Z_OK; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- s = strm->state; -- --#ifdef FASTEST -- if (level != 0) level = 1; --#else -- if (level == Z_DEFAULT_COMPRESSION) level = 6; --#endif -- if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { -- return Z_STREAM_ERROR; -- } -- func = configuration_table[s->level].func; -- -- if (func != configuration_table[level].func && strm->total_in != 0) { -- /* Flush the last buffer: */ -- err = deflate(strm, Z_PARTIAL_FLUSH); -- } -- if (s->level != level) { -- s->level = level; -- s->max_lazy_match = configuration_table[level].max_lazy; -- s->good_match = configuration_table[level].good_length; -- s->nice_match = configuration_table[level].nice_length; -- s->max_chain_length = configuration_table[level].max_chain; -- } -- s->strategy = strategy; -- return err; --} -- --/* ========================================================================= */ --int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain) -- z_streamp strm; -- int good_length; -- int max_lazy; -- int nice_length; -- int max_chain; --{ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- s = strm->state; -- s->good_match = good_length; -- s->max_lazy_match = max_lazy; -- s->nice_match = nice_length; -- s->max_chain_length = max_chain; -- return Z_OK; --} -- --/* ========================================================================= -- * For the default windowBits of 15 and memLevel of 8, this function returns -- * a close to exact, as well as small, upper bound on the compressed size. -- * They are coded as constants here for a reason--if the #define's are -- * changed, then this function needs to be changed as well. The return -- * value for 15 and 8 only works for those exact settings. -- * -- * For any setting other than those defaults for windowBits and memLevel, -- * the value returned is a conservative worst case for the maximum expansion -- * resulting from using fixed blocks instead of stored blocks, which deflate -- * can emit on compressed data for some combinations of the parameters. -- * -- * This function could be more sophisticated to provide closer upper bounds -- * for every combination of windowBits and memLevel, as well as wrap. -- * But even the conservative upper bound of about 14% expansion does not -- * seem onerous for output buffer allocation. -- */ --uLong ZEXPORT deflateBound(strm, sourceLen) -- z_streamp strm; -- uLong sourceLen; --{ -- deflate_state *s; -- uLong destLen; -- -- /* conservative upper bound */ -- destLen = sourceLen + -- ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 11; -- -- /* if can't get parameters, return conservative bound */ -- if (strm == Z_NULL || strm->state == Z_NULL) -- return destLen; -- -- /* if not default parameters, return conservative bound */ -- s = strm->state; -- if (s->w_bits != 15 || s->hash_bits != 8 + 7) -- return destLen; -- -- /* default settings: return tight bound for that case */ -- return compressBound(sourceLen); --} -- --/* ========================================================================= -- * Put a short in the pending buffer. The 16-bit value is put in MSB order. -- * IN assertion: the stream state is correct and there is enough room in -- * pending_buf. -- */ --local void putShortMSB (s, b) -- deflate_state *s; -- uInt b; --{ -- put_byte(s, (Byte)(b >> 8)); -- put_byte(s, (Byte)(b & 0xff)); --} -- --/* ========================================================================= -- * Flush as much pending output as possible. All deflate() output goes -- * through this function so some applications may wish to modify it -- * to avoid allocating a large strm->next_out buffer and copying into it. -- * (See also read_buf()). -- */ --local void flush_pending(strm) -- z_streamp strm; --{ -- unsigned len = strm->state->pending; -- -- if (len > strm->avail_out) len = strm->avail_out; -- if (len == 0) return; -- -- zmemcpy(strm->next_out, strm->state->pending_out, len); -- strm->next_out += len; -- strm->state->pending_out += len; -- strm->total_out += len; -- strm->avail_out -= len; -- strm->state->pending -= len; -- if (strm->state->pending == 0) { -- strm->state->pending_out = strm->state->pending_buf; -- } --} -- --/* ========================================================================= */ --int ZEXPORT deflate (strm, flush) -- z_streamp strm; -- int flush; --{ -- int old_flush; /* value of flush param for previous deflate call */ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL || -- flush > Z_FINISH || flush < 0) { -- return Z_STREAM_ERROR; -- } -- s = strm->state; -- -- if (strm->next_out == Z_NULL || -- (strm->next_in == Z_NULL && strm->avail_in != 0) || -- (s->status == FINISH_STATE && flush != Z_FINISH)) { -- ERR_RETURN(strm, Z_STREAM_ERROR); -- } -- if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); -- -- s->strm = strm; /* just in case */ -- old_flush = s->last_flush; -- s->last_flush = flush; -- -- /* Write the header */ -- if (s->status == INIT_STATE) { --#ifdef GZIP -- if (s->wrap == 2) { -- strm->adler = crc32(0L, Z_NULL, 0); -- put_byte(s, 31); -- put_byte(s, 139); -- put_byte(s, 8); -- if (s->gzhead == NULL) { -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, s->level == 9 ? 2 : -- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? -- 4 : 0)); -- put_byte(s, OS_CODE); -- s->status = BUSY_STATE; -- } -- else { -- put_byte(s, (s->gzhead->text ? 1 : 0) + -- (s->gzhead->hcrc ? 2 : 0) + -- (s->gzhead->extra == Z_NULL ? 0 : 4) + -- (s->gzhead->name == Z_NULL ? 0 : 8) + -- (s->gzhead->comment == Z_NULL ? 0 : 16) -- ); -- put_byte(s, (Byte)(s->gzhead->time & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); -- put_byte(s, s->level == 9 ? 2 : -- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? -- 4 : 0)); -- put_byte(s, s->gzhead->os & 0xff); -- if (s->gzhead->extra != NULL) { -- put_byte(s, s->gzhead->extra_len & 0xff); -- put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); -- } -- if (s->gzhead->hcrc) -- strm->adler = crc32(strm->adler, s->pending_buf, -- s->pending); -- s->gzindex = 0; -- s->status = EXTRA_STATE; -- } -- } -- else --#endif -- { -- uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; -- uInt level_flags; -- -- if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) -- level_flags = 0; -- else if (s->level < 6) -- level_flags = 1; -- else if (s->level == 6) -- level_flags = 2; -- else -- level_flags = 3; -- header |= (level_flags << 6); -- if (s->strstart != 0) header |= PRESET_DICT; -- header += 31 - (header % 31); -- -- s->status = BUSY_STATE; -- putShortMSB(s, header); -- -- /* Save the adler32 of the preset dictionary: */ -- if (s->strstart != 0) { -- putShortMSB(s, (uInt)(strm->adler >> 16)); -- putShortMSB(s, (uInt)(strm->adler & 0xffff)); -- } -- strm->adler = adler32(0L, Z_NULL, 0); -- } -- } --#ifdef GZIP -- if (s->status == EXTRA_STATE) { -- if (s->gzhead->extra != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- -- while (s->gzindex < (s->gzhead->extra_len & 0xffff)) { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) -- break; -- } -- put_byte(s, s->gzhead->extra[s->gzindex]); -- s->gzindex++; -- } -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (s->gzindex == s->gzhead->extra_len) { -- s->gzindex = 0; -- s->status = NAME_STATE; -- } -- } -- else -- s->status = NAME_STATE; -- } -- if (s->status == NAME_STATE) { -- if (s->gzhead->name != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- int val; -- -- do { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) { -- val = 1; -- break; -- } -- } -- val = s->gzhead->name[s->gzindex++]; -- put_byte(s, val); -- } while (val != 0); -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (val == 0) { -- s->gzindex = 0; -- s->status = COMMENT_STATE; -- } -- } -- else -- s->status = COMMENT_STATE; -- } -- if (s->status == COMMENT_STATE) { -- if (s->gzhead->comment != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- int val; -- -- do { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) { -- val = 1; -- break; -- } -- } -- val = s->gzhead->comment[s->gzindex++]; -- put_byte(s, val); -- } while (val != 0); -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (val == 0) -- s->status = HCRC_STATE; -- } -- else -- s->status = HCRC_STATE; -- } -- if (s->status == HCRC_STATE) { -- if (s->gzhead->hcrc) { -- if (s->pending + 2 > s->pending_buf_size) -- flush_pending(strm); -- if (s->pending + 2 <= s->pending_buf_size) { -- put_byte(s, (Byte)(strm->adler & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); -- strm->adler = crc32(0L, Z_NULL, 0); -- s->status = BUSY_STATE; -- } -- } -- else -- s->status = BUSY_STATE; -- } --#endif -- -- /* Flush as much pending output as possible */ -- if (s->pending != 0) { -- flush_pending(strm); -- if (strm->avail_out == 0) { -- /* 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: -- */ -- s->last_flush = -1; -- return Z_OK; -- } -- -- /* Make sure there is something to do and avoid duplicate consecutive -- * flushes. For repeated and useless calls with Z_FINISH, we keep -- * returning Z_STREAM_END instead of Z_BUF_ERROR. -- */ -- } else if (strm->avail_in == 0 && flush <= old_flush && -- flush != Z_FINISH) { -- ERR_RETURN(strm, Z_BUF_ERROR); -- } -- -- /* User must not provide more input after the first FINISH: */ -- if (s->status == FINISH_STATE && strm->avail_in != 0) { -- ERR_RETURN(strm, Z_BUF_ERROR); -- } -- -- /* Start a new block or continue the current one. -- */ -- if (strm->avail_in != 0 || s->lookahead != 0 || -- (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { -- block_state bstate; -- -- bstate = (*(configuration_table[s->level].func))(s, flush); -- -- if (bstate == finish_started || bstate == finish_done) { -- s->status = FINISH_STATE; -- } -- if (bstate == need_more || bstate == finish_started) { -- if (strm->avail_out == 0) { -- s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ -- } -- return Z_OK; -- /* 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. -- */ -- } -- if (bstate == block_done) { -- if (flush == Z_PARTIAL_FLUSH) { -- _tr_align(s); -- } else { /* FULL_FLUSH or SYNC_FLUSH */ -- _tr_stored_block(s, (char*)0, 0L, 0); -- /* For a full flush, this empty block will be recognized -- * as a special marker by inflate_sync(). -- */ -- if (flush == Z_FULL_FLUSH) { -- CLEAR_HASH(s); /* forget history */ -- } -- } -- flush_pending(strm); -- if (strm->avail_out == 0) { -- s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ -- return Z_OK; -- } -- } -- } -- Assert(strm->avail_out > 0, "bug2"); -- -- if (flush != Z_FINISH) return Z_OK; -- if (s->wrap <= 0) return Z_STREAM_END; -- -- /* Write the trailer */ --#ifdef GZIP -- if (s->wrap == 2) { -- put_byte(s, (Byte)(strm->adler & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); -- put_byte(s, (Byte)(strm->total_in & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); -- } -- else --#endif -- { -- putShortMSB(s, (uInt)(strm->adler >> 16)); -- putShortMSB(s, (uInt)(strm->adler & 0xffff)); -- } -- flush_pending(strm); -- /* If avail_out is zero, the application will call deflate again -- * to flush the rest. -- */ -- if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ -- return s->pending != 0 ? Z_OK : Z_STREAM_END; --} -- --/* ========================================================================= */ --int ZEXPORT deflateEnd (strm) -- z_streamp strm; --{ -- int status; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- -- status = strm->state->status; -- if (status != INIT_STATE && -- status != EXTRA_STATE && -- status != NAME_STATE && -- status != COMMENT_STATE && -- status != HCRC_STATE && -- status != BUSY_STATE && -- status != FINISH_STATE) { -- return Z_STREAM_ERROR; -- } -- -- /* Deallocate in reverse order of allocations: */ -- TRY_FREE(strm, strm->state->pending_buf); -- TRY_FREE(strm, strm->state->head); -- TRY_FREE(strm, strm->state->prev); -- TRY_FREE(strm, strm->state->window); -- -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- -- return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; --} -- --/* ========================================================================= -- * Copy the source state to the destination state. -- * To simplify the source, this is not supported for 16-bit MSDOS (which -- * doesn't have enough memory anyway to duplicate compression states). -- */ --int ZEXPORT deflateCopy (dest, source) -- z_streamp dest; -- z_streamp source; --{ --#ifdef MAXSEG_64K -- return Z_STREAM_ERROR; --#else -- deflate_state *ds; -- deflate_state *ss; -- ushf *overlay; -- -- -- if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) { -- return Z_STREAM_ERROR; -- } -- -- ss = source->state; -- -- zmemcpy(dest, source, sizeof(z_stream)); -- -- ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); -- if (ds == Z_NULL) return Z_MEM_ERROR; -- dest->state = (struct internal_state FAR *) ds; -- zmemcpy(ds, ss, sizeof(deflate_state)); -- ds->strm = dest; -- -- ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); -- ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); -- ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); -- overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2); -- ds->pending_buf = (uchf *) overlay; -- -- if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || -- ds->pending_buf == Z_NULL) { -- deflateEnd (dest); -- return Z_MEM_ERROR; -- } -- /* following zmemcpy do not work for 16-bit MSDOS */ -- zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); -- zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos)); -- zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos)); -- zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size); -- -- ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); -- ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush); -- ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize; -- -- ds->l_desc.dyn_tree = ds->dyn_ltree; -- ds->d_desc.dyn_tree = ds->dyn_dtree; -- ds->bl_desc.dyn_tree = ds->bl_tree; -- -- return Z_OK; --#endif /* MAXSEG_64K */ --} -- --/* =========================================================================== -- * Read a new buffer from the current input stream, update the adler32 -- * and total number of bytes read. All deflate() input goes through -- * this function so some applications may wish to modify it to avoid -- * allocating a large strm->next_in buffer and copying from it. -- * (See also flush_pending()). -- */ --local int read_buf(strm, buf, size) -- z_streamp strm; -- Bytef *buf; -- unsigned size; --{ -- unsigned len = strm->avail_in; -- -- if (len > size) len = size; -- if (len == 0) return 0; -- -- strm->avail_in -= len; -- -- if (strm->state->wrap == 1) { -- strm->adler = adler32(strm->adler, strm->next_in, len); -- } --#ifdef GZIP -- else if (strm->state->wrap == 2) { -- strm->adler = crc32(strm->adler, strm->next_in, len); -- } --#endif -- zmemcpy(buf, strm->next_in, len); -- strm->next_in += len; -- strm->total_in += len; -- -- return (int)len; --} -- --/* =========================================================================== -- * Initialize the "longest match" routines for a new zlib stream -- */ --local void lm_init (s) -- deflate_state *s; --{ -- s->window_size = (ulg)2L*s->w_size; -- -- CLEAR_HASH(s); -- -- /* Set the default configuration parameters: -- */ -- s->max_lazy_match = configuration_table[s->level].max_lazy; -- s->good_match = configuration_table[s->level].good_length; -- s->nice_match = configuration_table[s->level].nice_length; -- s->max_chain_length = configuration_table[s->level].max_chain; -- -- s->strstart = 0; -- s->block_start = 0L; -- s->lookahead = 0; -- s->match_length = s->prev_length = MIN_MATCH-1; -- s->match_available = 0; -- s->ins_h = 0; --#ifndef FASTEST --#ifdef ASMV -- match_init(); /* initialize the asm code */ --#endif --#endif --} -- --#ifndef FASTEST --/* =========================================================================== -- * Set match_start to the longest match starting at the given string and -- * return its length. Matches shorter or equal to prev_length are discarded, -- * in which case the result is equal to prev_length and match_start is -- * garbage. -- * IN assertions: cur_match is the head of the hash chain for the current -- * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 -- * OUT assertion: the match length is not greater than s->lookahead. -- */ --#ifndef ASMV --/* For 80x86 and 680x0, an optimized version will be provided in match.asm or -- * match.S. The code will be functionally equivalent. -- */ --local uInt longest_match(s, cur_match) -- deflate_state *s; -- IPos cur_match; /* current match */ --{ -- unsigned chain_length = s->max_chain_length;/* max hash chain length */ -- register Bytef *scan = s->window + s->strstart; /* current string */ -- register Bytef *match; /* matched string */ -- register int len; /* length of current match */ -- int best_len = s->prev_length; /* best match length so far */ -- int nice_match = s->nice_match; /* stop if match long enough */ -- IPos limit = s->strstart > (IPos)MAX_DIST(s) ? -- s->strstart - (IPos)MAX_DIST(s) : NIL; -- /* Stop when cur_match becomes <= limit. To simplify the code, -- * we prevent matches with the string of window index 0. -- */ -- Posf *prev = s->prev; -- uInt wmask = s->w_mask; -- --#ifdef UNALIGNED_OK -- /* Compare two bytes at a time. Note: this is not always beneficial. -- * Try with and without -DUNALIGNED_OK to check. -- */ -- register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; -- register ush scan_start = *(ushf*)scan; -- register ush scan_end = *(ushf*)(scan+best_len-1); --#else -- register Bytef *strend = s->window + s->strstart + MAX_MATCH; -- register Byte scan_end1 = scan[best_len-1]; -- register Byte scan_end = scan[best_len]; --#endif -- -- /* 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. -- */ -- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); -- -- /* Do not waste too much time if we already have a good match: */ -- if (s->prev_length >= s->good_match) { -- chain_length >>= 2; -- } -- /* Do not look for matches beyond the end of the input. This is necessary -- * to make deflate deterministic. -- */ -- if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; -- -- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); -- -- do { -- Assert(cur_match < s->strstart, "no future"); -- match = s->window + cur_match; -- -- /* Skip to next match if the match length cannot increase -- * or if the match length is less than 2. Note that the checks below -- * for insufficient lookahead only occur occasionally for performance -- * reasons. Therefore uninitialized memory will be accessed, and -- * conditional jumps will be made that depend on those values. -- * However the length of the match is limited to the lookahead, so -- * the output of deflate is not affected by the uninitialized values. -- */ --#if (defined(UNALIGNED_OK) && MAX_MATCH == 258) -- /* This code assumes sizeof(unsigned short) == 2. Do not use -- * UNALIGNED_OK if your compiler uses a different size. -- */ -- if (*(ushf*)(match+best_len-1) != scan_end || -- *(ushf*)match != scan_start) continue; -- -- /* It is not necessary to compare scan[2] and match[2] since they are -- * always equal when the other bytes match, given that the hash keys -- * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at -- * strstart+3, +5, ... up to strstart+257. We check for insufficient -- * lookahead only every 4th comparison; the 128th check will be made -- * 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 -- * to check more often for insufficient lookahead. -- */ -- Assert(scan[2] == match[2], "scan[2]?"); -- scan++, match++; -- do { -- } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- scan < strend); -- /* The funny "do {}" generates better code on most compilers */ -- -- /* Here, scan <= window+strstart+257 */ -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- if (*scan == *match) scan++; -- -- len = (MAX_MATCH - 1) - (int)(strend-scan); -- scan = strend - (MAX_MATCH-1); -- --#else /* UNALIGNED_OK */ -- -- if (match[best_len] != scan_end || -- match[best_len-1] != scan_end1 || -- *match != *scan || -- *++match != scan[1]) continue; -- -- /* The check at best_len-1 can be removed because it will be made -- * again later. (This heuristic is not always a win.) -- * It is not necessary to compare scan[2] and match[2] since they -- * are always equal when the other bytes match, given that -- * the hash keys are equal and that HASH_BITS >= 8. -- */ -- scan += 2, match++; -- Assert(*scan == *match, "match[2]?"); -- -- /* We check for insufficient lookahead only every 8th comparison; -- * the 256th check will be made at strstart+258. -- */ -- do { -- } while (*++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- scan < strend); -- -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- -- len = MAX_MATCH - (int)(strend - scan); -- scan = strend - MAX_MATCH; -- --#endif /* UNALIGNED_OK */ -- -- if (len > best_len) { -- s->match_start = cur_match; -- best_len = len; -- if (len >= nice_match) break; --#ifdef UNALIGNED_OK -- scan_end = *(ushf*)(scan+best_len-1); --#else -- scan_end1 = scan[best_len-1]; -- scan_end = scan[best_len]; --#endif -- } -- } while ((cur_match = prev[cur_match & wmask]) > limit -- && --chain_length != 0); -- -- if ((uInt)best_len <= s->lookahead) return (uInt)best_len; -- return s->lookahead; --} --#endif /* ASMV */ --#endif /* FASTEST */ -- --/* --------------------------------------------------------------------------- -- * Optimized version for level == 1 or strategy == Z_RLE only -- */ --local uInt longest_match_fast(s, cur_match) -- deflate_state *s; -- IPos cur_match; /* current match */ --{ -- register Bytef *scan = s->window + s->strstart; /* current string */ -- register Bytef *match; /* matched string */ -- register int len; /* length of current match */ -- register Bytef *strend = s->window + s->strstart + MAX_MATCH; -- -- /* 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. -- */ -- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); -- -- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); -- -- Assert(cur_match < s->strstart, "no future"); -- -- match = s->window + cur_match; -- -- /* Return failure if the match length is less than 2: -- */ -- if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; -- -- /* The check at best_len-1 can be removed because it will be made -- * again later. (This heuristic is not always a win.) -- * It is not necessary to compare scan[2] and match[2] since they -- * are always equal when the other bytes match, given that -- * the hash keys are equal and that HASH_BITS >= 8. -- */ -- scan += 2, match += 2; -- Assert(*scan == *match, "match[2]?"); -- -- /* We check for insufficient lookahead only every 8th comparison; -- * the 256th check will be made at strstart+258. -- */ -- do { -- } while (*++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- scan < strend); -- -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- -- len = MAX_MATCH - (int)(strend - scan); -- -- if (len < MIN_MATCH) return MIN_MATCH - 1; -- -- s->match_start = cur_match; -- return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; --} -- --#ifdef DEBUG --/* =========================================================================== -- * Check that the match at match_start is indeed a match. -- */ --local void check_match(s, start, match, length) -- deflate_state *s; -- IPos start, match; -- int length; --{ -- /* check that the match is indeed a match */ -- if (zmemcmp(s->window + match, -- s->window + start, length) != EQUAL) { -- fprintf(stderr, " start %u, match %u, length %d\n", -- start, match, length); -- do { -- fprintf(stderr, "%c%c", s->window[match++], s->window[start++]); -- } while (--length != 0); -- z_error("invalid match"); -- } -- if (z_verbose > 1) { -- fprintf(stderr,"\\[%d,%d]", start-match, length); -- do { putc(s->window[start++], stderr); } while (--length != 0); -- } --} --#else --# define check_match(s, start, match, length) --#endif /* DEBUG */ -- --/* =========================================================================== -- * Fill the window when the lookahead becomes insufficient. -- * Updates strstart and lookahead. -- * -- * IN assertion: lookahead < MIN_LOOKAHEAD -- * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD -- * At least one byte has been read, or avail_in == 0; reads are -- * performed for at least two bytes (required for the zip translate_eol -- * option -- not supported here). -- */ --local void fill_window(s) -- deflate_state *s; --{ -- register unsigned n, m; -- register Posf *p; -- unsigned more; /* Amount of free space at the end of the window. */ -- uInt wsize = s->w_size; -- -- do { -- more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); -- -- /* Deal with !@#$% 64K limit: */ -- if (sizeof(int) <= 2) { -- if (more == 0 && s->strstart == 0 && s->lookahead == 0) { -- more = wsize; -- -- } else if (more == (unsigned)(-1)) { -- /* Very unlikely, but possible on 16 bit machine if -- * strstart == 0 && lookahead == 1 (input done a byte at time) -- */ -- more--; -- } -- } -- -- /* If the window is almost full and there is insufficient lookahead, -- * move the upper half to the lower one to make room in the upper half. -- */ -- if (s->strstart >= wsize+MAX_DIST(s)) { -- -- zmemcpy(s->window, s->window+wsize, (unsigned)wsize); -- s->match_start -= wsize; -- s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ -- s->block_start -= (long) wsize; -- -- /* Slide the hash table (could be avoided with 32 bit values -- at the expense of memory usage). We slide even when level == 0 -- to keep the hash table consistent if we switch back to level > 0 -- later. (Using level 0 permanently is not an optimal usage of -- zlib, so we don't care about this pathological case.) -- */ -- /* %%% avoid this when Z_RLE */ -- n = s->hash_size; -- p = &s->head[n]; -- do { -- m = *--p; -- *p = (Pos)(m >= wsize ? m-wsize : NIL); -- } while (--n); -- -- n = wsize; --#ifndef FASTEST -- p = &s->prev[n]; -- do { -- m = *--p; -- *p = (Pos)(m >= wsize ? m-wsize : NIL); -- /* If n is not on any hash chain, prev[n] is garbage but -- * its value will never be used. -- */ -- } while (--n); --#endif -- more += wsize; -- } -- if (s->strm->avail_in == 0) return; -- -- /* If there was no sliding: -- * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && -- * more == window_size - lookahead - strstart -- * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) -- * => more >= window_size - 2*WSIZE + 2 -- * In the BIG_MEM or MMAP case (not yet supported), -- * window_size == input_size + MIN_LOOKAHEAD && -- * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. -- * Otherwise, window_size == 2*WSIZE so more >= 2. -- * If there was sliding, more >= WSIZE. So in all cases, more >= 2. -- */ -- Assert(more >= 2, "more < 2"); -- -- n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); -- s->lookahead += n; -- -- /* Initialize the hash value now that we have some input: */ -- if (s->lookahead >= MIN_MATCH) { -- s->ins_h = s->window[s->strstart]; -- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); --#if MIN_MATCH != 3 -- Call UPDATE_HASH() MIN_MATCH-3 more times --#endif -- } -- /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, -- * but this is not important since only literal bytes will be emitted. -- */ -- -- } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); --} -- --/* =========================================================================== -- * Flush the current block, with given end-of-file flag. -- * IN assertion: strstart is set to the end of the current match. -- */ --#define FLUSH_BLOCK_ONLY(s, eof) { \ -- _tr_flush_block(s, (s->block_start >= 0L ? \ -- (charf *)&s->window[(unsigned)s->block_start] : \ -- (charf *)Z_NULL), \ -- (ulg)((long)s->strstart - s->block_start), \ -- (eof)); \ -- s->block_start = s->strstart; \ -- flush_pending(s->strm); \ -- Tracev((stderr,"[FLUSH]")); \ --} -- --/* Same but force premature exit if necessary. */ --#define FLUSH_BLOCK(s, eof) { \ -- FLUSH_BLOCK_ONLY(s, eof); \ -- if (s->strm->avail_out == 0) return (eof) ? finish_started : need_more; \ --} -- --/* =========================================================================== -- * Copy without compression as much as possible from the input stream, return -- * the current block state. -- * This function does not insert new strings in the dictionary since -- * uncompressible data is probably not useful. This function is used -- * only for the level=0 compression option. -- * NOTE: this function should be optimized to avoid extra copying from -- * window to pending_buf. -- */ --local block_state deflate_stored(s, flush) -- deflate_state *s; -- int flush; --{ -- /* Stored blocks are limited to 0xffff bytes, pending_buf is limited -- * to pending_buf_size, and each stored block has a 5 byte header: -- */ -- ulg max_block_size = 0xffff; -- ulg max_start; -- -- if (max_block_size > s->pending_buf_size - 5) { -- max_block_size = s->pending_buf_size - 5; -- } -- -- /* Copy as much as possible from input to output: */ -- for (;;) { -- /* Fill the window as much as possible: */ -- if (s->lookahead <= 1) { -- -- Assert(s->strstart < s->w_size+MAX_DIST(s) || -- s->block_start >= (long)s->w_size, "slide too late"); -- -- fill_window(s); -- if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more; -- -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- Assert(s->block_start >= 0L, "block gone"); -- -- s->strstart += s->lookahead; -- s->lookahead = 0; -- -- /* Emit a stored block if pending_buf will be full: */ -- max_start = s->block_start + max_block_size; -- if (s->strstart == 0 || (ulg)s->strstart >= max_start) { -- /* strstart == 0 is possible when wraparound on 16-bit machine */ -- s->lookahead = (uInt)(s->strstart - max_start); -- s->strstart = (uInt)max_start; -- FLUSH_BLOCK(s, 0); -- } -- /* Flush if we may have to slide, otherwise block_start may become -- * negative and the data will be gone: -- */ -- if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) { -- FLUSH_BLOCK(s, 0); -- } -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} -- --/* =========================================================================== -- * Compress as much as possible from the input stream, return the current -- * block state. -- * This function does not perform lazy evaluation of matches and inserts -- * new strings in the dictionary only for unmatched strings or for short -- * matches. It is used only for the fast compression options. -- */ --local block_state deflate_fast(s, flush) -- deflate_state *s; -- int flush; --{ -- IPos hash_head = NIL; /* head of the hash chain */ -- int bflush; /* set if current block must be flushed */ -- -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the next match, plus MIN_MATCH bytes to insert the -- * string following the next match. -- */ -- if (s->lookahead < MIN_LOOKAHEAD) { -- fill_window(s); -- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* Insert the string window[strstart .. strstart+2] in the -- * dictionary, and set hash_head to the head of the hash chain: -- */ -- if (s->lookahead >= MIN_MATCH) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- -- /* Find the longest match, discarding those <= prev_length. -- * At this point we have always match_length < MIN_MATCH -- */ -- if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { -- /* To simplify the code, we prevent matches with the string -- * of window index 0 (in particular we have to avoid a match -- * of the string with itself at the start of the input file). -- */ --#ifdef FASTEST -- if ((s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) || -- (s->strategy == Z_RLE && s->strstart - hash_head == 1)) { -- s->match_length = longest_match_fast (s, hash_head); -- } --#else -- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { -- s->match_length = longest_match (s, hash_head); -- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { -- s->match_length = longest_match_fast (s, hash_head); -- } --#endif -- /* longest_match() or longest_match_fast() sets match_start */ -- } -- if (s->match_length >= MIN_MATCH) { -- check_match(s, s->strstart, s->match_start, s->match_length); -- -- _tr_tally_dist(s, s->strstart - s->match_start, -- s->match_length - MIN_MATCH, bflush); -- -- s->lookahead -= s->match_length; -- -- /* Insert new strings in the hash table only if the match length -- * is not too large. This saves time but degrades compression. -- */ --#ifndef FASTEST -- if (s->match_length <= s->max_insert_length && -- s->lookahead >= MIN_MATCH) { -- s->match_length--; /* string at strstart already in table */ -- do { -- s->strstart++; -- INSERT_STRING(s, s->strstart, hash_head); -- /* strstart never exceeds WSIZE-MAX_MATCH, so there are -- * always MIN_MATCH bytes ahead. -- */ -- } while (--s->match_length != 0); -- s->strstart++; -- } else --#endif -- { -- s->strstart += s->match_length; -- s->match_length = 0; -- s->ins_h = s->window[s->strstart]; -- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); --#if MIN_MATCH != 3 -- Call UPDATE_HASH() MIN_MATCH-3 more times --#endif -- /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not -- * matter since it will be recomputed at next deflate call. -- */ -- } -- } else { -- /* No match, output a literal byte */ -- Tracevv((stderr,"%c", s->window[s->strstart])); -- _tr_tally_lit (s, s->window[s->strstart], bflush); -- s->lookahead--; -- s->strstart++; -- } -- if (bflush) FLUSH_BLOCK(s, 0); -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} -- --#ifndef FASTEST --/* =========================================================================== -- * Same as above, but achieves better compression. We use a lazy -- * evaluation for matches: a match is finally adopted only if there is -- * no better match at the next window position. -- */ --local block_state deflate_slow(s, flush) -- deflate_state *s; -- int flush; --{ -- IPos hash_head = NIL; /* head of hash chain */ -- int bflush; /* set if current block must be flushed */ -- -- /* Process the input block. */ -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the next match, plus MIN_MATCH bytes to insert the -- * string following the next match. -- */ -- if (s->lookahead < MIN_LOOKAHEAD) { -- fill_window(s); -- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* Insert the string window[strstart .. strstart+2] in the -- * dictionary, and set hash_head to the head of the hash chain: -- */ -- if (s->lookahead >= MIN_MATCH) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- -- /* Find the longest match, discarding those <= prev_length. -- */ -- s->prev_length = s->match_length, s->prev_match = s->match_start; -- s->match_length = MIN_MATCH-1; -- -- if (hash_head != NIL && s->prev_length < s->max_lazy_match && -- s->strstart - hash_head <= MAX_DIST(s)) { -- /* To simplify the code, we prevent matches with the string -- * of window index 0 (in particular we have to avoid a match -- * of the string with itself at the start of the input file). -- */ -- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { -- s->match_length = longest_match (s, hash_head); -- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { -- s->match_length = longest_match_fast (s, hash_head); -- } -- /* longest_match() or longest_match_fast() sets match_start */ -- -- if (s->match_length <= 5 && (s->strategy == Z_FILTERED --#if TOO_FAR <= 32767 -- || (s->match_length == MIN_MATCH && -- s->strstart - s->match_start > TOO_FAR) --#endif -- )) { -- -- /* If prev_match is also MIN_MATCH, match_start is garbage -- * but we will ignore the current match anyway. -- */ -- s->match_length = MIN_MATCH-1; -- } -- } -- /* If there was a match at the previous step and the current -- * match is not better, output the previous match: -- */ -- if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { -- uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; -- /* Do not insert strings in hash table beyond this. */ -- -- check_match(s, s->strstart-1, s->prev_match, s->prev_length); -- -- _tr_tally_dist(s, s->strstart -1 - s->prev_match, -- s->prev_length - MIN_MATCH, bflush); -- -- /* Insert in hash table all strings up to the end of the match. -- * strstart-1 and strstart are already inserted. If there is not -- * enough lookahead, the last two strings are not inserted in -- * the hash table. -- */ -- s->lookahead -= s->prev_length-1; -- s->prev_length -= 2; -- do { -- if (++s->strstart <= max_insert) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- } while (--s->prev_length != 0); -- s->match_available = 0; -- s->match_length = MIN_MATCH-1; -- s->strstart++; -- -- if (bflush) FLUSH_BLOCK(s, 0); -- -- } else if (s->match_available) { -- /* 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. -- */ -- Tracevv((stderr,"%c", s->window[s->strstart-1])); -- _tr_tally_lit(s, s->window[s->strstart-1], bflush); -- if (bflush) { -- FLUSH_BLOCK_ONLY(s, 0); -- } -- s->strstart++; -- s->lookahead--; -- if (s->strm->avail_out == 0) return need_more; -- } else { -- /* There is no previous match to compare with, wait for -- * the next step to decide. -- */ -- s->match_available = 1; -- s->strstart++; -- s->lookahead--; -- } -- } -- Assert (flush != Z_NO_FLUSH, "no flush?"); -- if (s->match_available) { -- Tracevv((stderr,"%c", s->window[s->strstart-1])); -- _tr_tally_lit(s, s->window[s->strstart-1], bflush); -- s->match_available = 0; -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} --#endif /* FASTEST */ -- --#if 0 --/* =========================================================================== -- * For Z_RLE, simply look for runs of bytes, generate matches only of distance -- * one. Do not maintain a hash table. (It will be regenerated if this run of -- * deflate switches away from Z_RLE.) -- */ --local block_state deflate_rle(s, flush) -- deflate_state *s; -- int flush; --{ -- int bflush; /* set if current block must be flushed */ -- uInt run; /* length of run */ -- uInt max; /* maximum length of run */ -- uInt prev; /* byte at distance one to match */ -- Bytef *scan; /* scan for end of run */ -- -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the longest encodable run. -- */ -- if (s->lookahead < MAX_MATCH) { -- fill_window(s); -- if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* See how many times the previous byte repeats */ -- run = 0; -- if (s->strstart > 0) { /* if there is a previous byte, that is */ -- max = s->lookahead < MAX_MATCH ? s->lookahead : MAX_MATCH; -- scan = s->window + s->strstart - 1; -- prev = *scan++; -- do { -- if (*scan++ != prev) -- break; -- } while (++run < max); -- } -- -- /* Emit match if have run of MIN_MATCH or longer, else emit literal */ -- if (run >= MIN_MATCH) { -- check_match(s, s->strstart, s->strstart - 1, run); -- _tr_tally_dist(s, 1, run - MIN_MATCH, bflush); -- s->lookahead -= run; -- s->strstart += run; -- } else { -- /* No match, output a literal byte */ -- Tracevv((stderr,"%c", s->window[s->strstart])); -- _tr_tally_lit (s, s->window[s->strstart], bflush); -- s->lookahead--; -- s->strstart++; -- } -- if (bflush) FLUSH_BLOCK(s, 0); -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} --#endif -diff -ruN RJaCGH.orig/src/deflate.h RJaCGH/src/deflate.h ---- RJaCGH.orig/src/deflate.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/deflate.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,331 +0,0 @@ --/* deflate.h -- internal compression state -- * Copyright (C) 1995-2004 Jean-loup Gailly -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* @(#) $Id$ */ -- --#ifndef DEFLATE_H --#define DEFLATE_H -- --#include "zutil.h" -- --/* define NO_GZIP when compiling if you want to disable gzip header and -- trailer creation by deflate(). NO_GZIP would be used to avoid linking in -- the crc code when it is not needed. For shared libraries, gzip encoding -- should be left enabled. */ --#ifndef NO_GZIP --# define GZIP --#endif -- --/* =========================================================================== -- * Internal compression state. -- */ -- --#define LENGTH_CODES 29 --/* number of length codes, not counting the special END_BLOCK code */ -- --#define LITERALS 256 --/* number of literal bytes 0..255 */ -- --#define L_CODES (LITERALS+1+LENGTH_CODES) --/* number of Literal or Length codes, including the END_BLOCK code */ -- --#define D_CODES 30 --/* number of distance codes */ -- --#define BL_CODES 19 --/* number of codes used to transfer the bit lengths */ -- --#define HEAP_SIZE (2*L_CODES+1) --/* maximum heap size */ -- --#define MAX_BITS 15 --/* All codes must not exceed MAX_BITS bits */ -- --#define INIT_STATE 42 --#define EXTRA_STATE 69 --#define NAME_STATE 73 --#define COMMENT_STATE 91 --#define HCRC_STATE 103 --#define BUSY_STATE 113 --#define FINISH_STATE 666 --/* Stream status */ -- -- --/* Data structure describing a single value and its code string. */ --typedef struct ct_data_s { -- union { -- ush freq; /* frequency count */ -- ush code; /* bit string */ -- } fc; -- union { -- ush dad; /* father node in Huffman tree */ -- ush len; /* length of bit string */ -- } dl; --} FAR ct_data; -- --#define Freq fc.freq --#define Code fc.code --#define Dad dl.dad --#define Len dl.len -- --typedef struct static_tree_desc_s static_tree_desc; -- --typedef struct tree_desc_s { -- ct_data *dyn_tree; /* the dynamic tree */ -- int max_code; /* largest code with non zero frequency */ -- static_tree_desc *stat_desc; /* the corresponding static tree */ --} FAR tree_desc; -- --typedef ush Pos; --typedef Pos FAR Posf; --typedef unsigned IPos; -- --/* A Pos is an index in the character window. We use short instead of int to -- * save space in the various tables. IPos is used only for parameter passing. -- */ -- --typedef struct internal_state { -- z_streamp strm; /* pointer back to this zlib stream */ -- int status; /* as the name implies */ -- Bytef *pending_buf; /* output still pending */ -- ulg pending_buf_size; /* size of pending_buf */ -- Bytef *pending_out; /* next pending byte to output to the stream */ -- uInt pending; /* nb of bytes in the pending buffer */ -- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ -- gz_headerp gzhead; /* gzip header information to write */ -- uInt gzindex; /* where in extra, name, or comment */ -- Byte method; /* STORED (for zip only) or DEFLATED */ -- int last_flush; /* value of flush param for previous deflate call */ -- -- /* used by deflate.c: */ -- -- uInt w_size; /* LZ77 window size (32K by default) */ -- uInt w_bits; /* log2(w_size) (8..16) */ -- uInt w_mask; /* w_size - 1 */ -- -- Bytef *window; -- /* Sliding window. Input bytes are read into the second half of the window, -- * and move to the first half later to keep a dictionary of at least wSize -- * bytes. With this organization, matches are limited to a distance of -- * wSize-MAX_MATCH bytes, but this ensures that IO is always -- * performed with a length multiple of the block size. Also, it limits -- * the window size to 64K, which is quite useful on MSDOS. -- * To do: use the user input buffer as sliding window. -- */ -- -- ulg window_size; -- /* Actual size of window: 2*wSize, except when the user input buffer -- * is directly used as sliding window. -- */ -- -- Posf *prev; -- /* Link to older string with same hash index. To limit the size of this -- * array to 64K, this link is maintained only for the last 32K strings. -- * An index in this array is thus a window index modulo 32K. -- */ -- -- Posf *head; /* Heads of the hash chains or NIL. */ -- -- uInt ins_h; /* hash index of string to be inserted */ -- uInt hash_size; /* number of elements in hash table */ -- uInt hash_bits; /* log2(hash_size) */ -- uInt hash_mask; /* hash_size-1 */ -- -- uInt hash_shift; -- /* Number of bits by which ins_h must be shifted at each input -- * step. It must be such that after MIN_MATCH steps, the oldest -- * byte no longer takes part in the hash key, that is: -- * hash_shift * MIN_MATCH >= hash_bits -- */ -- -- long block_start; -- /* Window position at the beginning of the current output block. Gets -- * negative when the window is moved backwards. -- */ -- -- uInt match_length; /* length of best match */ -- IPos prev_match; /* previous match */ -- int match_available; /* set if previous match exists */ -- uInt strstart; /* start of string to insert */ -- uInt match_start; /* start of matching string */ -- uInt lookahead; /* number of valid bytes ahead in window */ -- -- uInt prev_length; -- /* Length of the best match at previous step. Matches not greater than this -- * are discarded. This is used in the lazy match evaluation. -- */ -- -- uInt max_chain_length; -- /* To speed up deflation, hash chains are never searched beyond this -- * length. A higher limit improves compression ratio but degrades the -- * speed. -- */ -- -- uInt max_lazy_match; -- /* Attempt to find a better match only when the current match is strictly -- * smaller than this value. This mechanism is used only for compression -- * levels >= 4. -- */ --# define max_insert_length max_lazy_match -- /* Insert new strings in the hash table only if the match length is not -- * greater than this length. This saves time but degrades compression. -- * max_insert_length is used only for compression levels <= 3. -- */ -- -- int level; /* compression level (1..9) */ -- int strategy; /* favor or force Huffman coding*/ -- -- uInt good_match; -- /* Use a faster search when the previous match is longer than this */ -- -- int nice_match; /* Stop searching when current match exceeds this */ -- -- /* used by trees.c: */ -- /* Didn't use ct_data typedef below to supress compiler warning */ -- struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */ -- struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */ -- struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */ -- -- struct tree_desc_s l_desc; /* desc. for literal tree */ -- struct tree_desc_s d_desc; /* desc. for distance tree */ -- struct tree_desc_s bl_desc; /* desc. for bit length tree */ -- -- ush bl_count[MAX_BITS+1]; -- /* number of codes at each bit length for an optimal tree */ -- -- int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ -- int heap_len; /* number of elements in the heap */ -- int heap_max; /* element of largest frequency */ -- /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. -- * The same heap array is used to build all trees. -- */ -- -- uch depth[2*L_CODES+1]; -- /* Depth of each subtree used as tie breaker for trees of equal frequency -- */ -- -- uchf *l_buf; /* buffer for literals or lengths */ -- -- uInt lit_bufsize; -- /* Size of match buffer for literals/lengths. There are 4 reasons for -- * limiting lit_bufsize to 64K: -- * - frequencies can be kept in 16 bit counters -- * - if compression is not successful for the first block, all input -- * data is still in the window so we can still emit a stored block even -- * when input comes from standard input. (This can also be done for -- * all blocks if lit_bufsize is not greater than 32K.) -- * - if compression is not successful for a file smaller than 64K, we can -- * even emit a stored file instead of a stored block (saving 5 bytes). -- * This is applicable only for zip (not gzip or zlib). -- * - creating new Huffman trees less frequently may not provide fast -- * adaptation to changes in the input data statistics. (Take for -- * example a binary file with poorly compressible code followed by -- * a highly compressible string table.) Smaller buffer sizes give -- * fast adaptation but have of course the overhead of transmitting -- * trees more frequently. -- * - I can't count above 4 -- */ -- -- uInt last_lit; /* running index in l_buf */ -- -- ushf *d_buf; -- /* Buffer for distances. To simplify the code, d_buf and l_buf have -- * the same number of elements. To use different lengths, an extra flag -- * array would be necessary. -- */ -- -- ulg opt_len; /* bit length of current block with optimal trees */ -- ulg static_len; /* bit length of current block with static trees */ -- uInt matches; /* number of string matches in current block */ -- int last_eob_len; /* bit length of EOB code for last block */ -- --#ifdef DEBUG -- ulg compressed_len; /* total bit length of compressed file mod 2^32 */ -- ulg bits_sent; /* bit length of compressed data sent mod 2^32 */ --#endif -- -- ush bi_buf; -- /* Output buffer. bits are inserted starting at the bottom (least -- * significant bits). -- */ -- int bi_valid; -- /* Number of valid bits in bi_buf. All bits above the last valid bit -- * are always zero. -- */ -- --} FAR deflate_state; -- --/* Output a byte on the stream. -- * IN assertion: there is enough room in pending_buf. -- */ --#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);} -- -- --#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) --/* Minimum amount of lookahead, except at the end of the input file. -- * See deflate.c for comments about the MIN_MATCH+1. -- */ -- --#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD) --/* In order to simplify the code, particularly on 16 bit machines, match -- * distances are limited to MAX_DIST instead of WSIZE. -- */ -- -- /* in trees.c */ --void _tr_init OF((deflate_state *s)); --int _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc)); --void _tr_flush_block OF((deflate_state *s, charf *buf, ulg stored_len, -- int eof)); --void _tr_align OF((deflate_state *s)); --void _tr_stored_block OF((deflate_state *s, charf *buf, ulg stored_len, -- int eof)); -- --#define d_code(dist) \ -- ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)]) --/* Mapping from a distance to a distance code. dist is the distance - 1 and -- * must not have side effects. _dist_code[256] and _dist_code[257] are never -- * used. -- */ -- --#ifndef DEBUG --/* Inline versions of _tr_tally for speed: */ -- --#if defined(GEN_TREES_H) || !defined(STDC) -- extern uch _length_code[]; -- extern uch _dist_code[]; --#else -- extern const uch _length_code[]; -- extern const uch _dist_code[]; --#endif -- --# define _tr_tally_lit(s, c, flush) \ -- { uch cc = (c); \ -- s->d_buf[s->last_lit] = 0; \ -- s->l_buf[s->last_lit++] = cc; \ -- s->dyn_ltree[cc].Freq++; \ -- flush = (s->last_lit == s->lit_bufsize-1); \ -- } --# define _tr_tally_dist(s, distance, length, flush) \ -- { uch len = (length); \ -- ush dist = (distance); \ -- s->d_buf[s->last_lit] = dist; \ -- s->l_buf[s->last_lit++] = len; \ -- dist--; \ -- s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \ -- s->dyn_dtree[d_code(dist)].Freq++; \ -- flush = (s->last_lit == s->lit_bufsize-1); \ -- } --#else --# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c) --# define _tr_tally_dist(s, distance, length, flush) \ -- flush = _tr_tally(s, distance, length) --#endif -- --#endif /* DEFLATE_H */ -diff -ruN RJaCGH.orig/src/gzio.c RJaCGH/src/gzio.c ---- RJaCGH.orig/src/gzio.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/gzio.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1026 +0,0 @@ --/* gzio.c -- IO on .gz files -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- * -- * Compile this file with -DNO_GZCOMPRESS to avoid the compression code. -- */ -- --/* @(#) $Id$ */ -- --#include -- --#include "zutil.h" -- --#ifdef NO_DEFLATE /* for compatibility with old definition */ --# define NO_GZCOMPRESS --#endif -- --#ifndef NO_DUMMY_DECL --struct internal_state {int dummy;}; /* for buggy compilers */ --#endif -- --#ifndef Z_BUFSIZE --# ifdef MAXSEG_64K --# define Z_BUFSIZE 4096 /* minimize memory usage for 16-bit DOS */ --# else --# define Z_BUFSIZE 16384 --# endif --#endif --#ifndef Z_PRINTF_BUFSIZE --# define Z_PRINTF_BUFSIZE 4096 --#endif -- --#ifdef __MVS__ --# pragma map (fdopen , "\174\174FDOPEN") -- FILE *fdopen(int, const char *); --#endif -- --#ifndef STDC --extern voidp malloc OF((uInt size)); --extern void free OF((voidpf ptr)); --#endif -- --#define ALLOC(size) malloc(size) --#define TRYFREE(p) {if (p) free(p);} -- --static int const gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ -- --/* gzip flag byte */ --#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ --#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ --#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ --#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ --#define COMMENT 0x10 /* bit 4 set: file comment present */ --#define RESERVED 0xE0 /* bits 5..7: reserved */ -- --typedef struct gz_stream { -- z_stream stream; -- int z_err; /* error code for last stream operation */ -- int z_eof; /* set if end of input file */ -- FILE *file; /* .gz file */ -- Byte *inbuf; /* input buffer */ -- Byte *outbuf; /* output buffer */ -- uLong crc; /* crc32 of uncompressed data */ -- char *msg; /* error message */ -- char *path; /* path name for debugging only */ -- int transparent; /* 1 if input file is not a .gz file */ -- char mode; /* 'w' or 'r' */ -- z_off_t start; /* start of compressed data in file (header skipped) */ -- z_off_t in; /* bytes into deflate or inflate */ -- z_off_t out; /* bytes out of deflate or inflate */ -- int back; /* one character push-back */ -- int last; /* true if push-back is last character */ --} gz_stream; -- -- --local gzFile gz_open OF((const char *path, const char *mode, int fd)); --local int do_flush OF((gzFile file, int flush)); --local int get_byte OF((gz_stream *s)); --local void check_header OF((gz_stream *s)); --local int destroy OF((gz_stream *s)); --local void putLong OF((FILE *file, uLong x)); --local uLong getLong OF((gz_stream *s)); -- --/* =========================================================================== -- Opens a gzip (.gz) file for reading or writing. The mode parameter -- is as in fopen ("rb" or "wb"). The file is given either by file descriptor -- or path name (if fd == -1). -- gz_open returns NULL if the file could not be opened or if there was -- insufficient memory to allocate the (de)compression state; errno -- can be checked to distinguish the two cases (if errno is zero, the -- zlib error is Z_MEM_ERROR). --*/ --local gzFile gz_open (path, mode, fd) -- const char *path; -- const char *mode; -- int fd; --{ -- int err; -- int level = Z_DEFAULT_COMPRESSION; /* compression level */ -- int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */ -- char *p = (char*)mode; -- gz_stream *s; -- char fmode[80]; /* copy of mode, without the compression level */ -- char *m = fmode; -- -- if (!path || !mode) return Z_NULL; -- -- s = (gz_stream *)ALLOC(sizeof(gz_stream)); -- if (!s) return Z_NULL; -- -- s->stream.zalloc = (alloc_func)0; -- s->stream.zfree = (free_func)0; -- s->stream.opaque = (voidpf)0; -- s->stream.next_in = s->inbuf = Z_NULL; -- s->stream.next_out = s->outbuf = Z_NULL; -- s->stream.avail_in = s->stream.avail_out = 0; -- s->file = NULL; -- s->z_err = Z_OK; -- s->z_eof = 0; -- s->in = 0; -- s->out = 0; -- s->back = EOF; -- s->crc = crc32(0L, Z_NULL, 0); -- s->msg = NULL; -- s->transparent = 0; -- -- s->path = (char*)ALLOC(strlen(path)+1); -- if (s->path == NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- strcpy(s->path, path); /* do this early for debugging */ -- -- s->mode = '\0'; -- do { -- if (*p == 'r') s->mode = 'r'; -- if (*p == 'w' || *p == 'a') s->mode = 'w'; -- if (*p >= '0' && *p <= '9') { -- level = *p - '0'; -- } else if (*p == 'f') { -- strategy = Z_FILTERED; -- } else if (*p == 'h') { -- strategy = Z_HUFFMAN_ONLY; -- } else if (*p == 'R') { -- strategy = Z_RLE; -- } else { -- *m++ = *p; /* copy the mode */ -- } -- } while (*p++ && m != fmode + sizeof(fmode)); -- if (s->mode == '\0') return destroy(s), (gzFile)Z_NULL; -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- err = Z_STREAM_ERROR; --#else -- err = deflateInit2(&(s->stream), level, -- Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, strategy); -- /* windowBits is passed < 0 to suppress zlib header */ -- -- s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); --#endif -- if (err != Z_OK || s->outbuf == Z_NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- } else { -- s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); -- -- err = inflateInit2(&(s->stream), -MAX_WBITS); -- /* windowBits is passed < 0 to tell that there is no zlib header. -- * Note that in this case inflate *requires* an extra "dummy" byte -- * after the compressed stream in order to complete decompression and -- * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are -- * present after the compressed stream. -- */ -- if (err != Z_OK || s->inbuf == Z_NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- } -- s->stream.avail_out = Z_BUFSIZE; -- -- errno = 0; -- s->file = fd < 0 ? F_OPEN(path, fmode) : (FILE*)fdopen(fd, fmode); -- -- if (s->file == NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- if (s->mode == 'w') { -- /* Write a very simple .gz header: -- */ -- fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], -- Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, OS_CODE); -- s->start = 10L; -- /* We use 10L instead of ftell(s->file) to because ftell causes an -- * fflush on some systems. This version of the library doesn't use -- * start anyway in write mode, so this initialization is not -- * necessary. -- */ -- } else { -- check_header(s); /* skip the .gz header */ -- s->start = ftell(s->file) - s->stream.avail_in; -- } -- -- return (gzFile)s; --} -- --/* =========================================================================== -- Opens a gzip (.gz) file for reading or writing. --*/ --gzFile ZEXPORT gzopen (path, mode) -- const char *path; -- const char *mode; --{ -- return gz_open (path, mode, -1); --} -- --/* =========================================================================== -- Associate a gzFile with the file descriptor fd. fd is not dup'ed here -- to mimic the behavio(u)r of fdopen. --*/ --gzFile ZEXPORT gzdopen (fd, mode) -- int fd; -- const char *mode; --{ -- char name[46]; /* allow for up to 128-bit integers */ -- -- if (fd < 0) return (gzFile)Z_NULL; -- sprintf(name, "", fd); /* for debugging */ -- -- return gz_open (name, mode, fd); --} -- --/* =========================================================================== -- * Update the compression level and strategy -- */ --int ZEXPORT gzsetparams (file, level, strategy) -- gzFile file; -- int level; -- int strategy; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- /* Make room to allow flushing */ -- if (s->stream.avail_out == 0) { -- -- s->stream.next_out = s->outbuf; -- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { -- s->z_err = Z_ERRNO; -- } -- s->stream.avail_out = Z_BUFSIZE; -- } -- -- return deflateParams (&(s->stream), level, strategy); --} -- --/* =========================================================================== -- Read a byte from a gz_stream; update next_in and avail_in. Return EOF -- for end of file. -- IN assertion: the stream s has been sucessfully opened for reading. --*/ --local int get_byte(s) -- gz_stream *s; --{ -- if (s->z_eof) return EOF; -- if (s->stream.avail_in == 0) { -- errno = 0; -- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); -- if (s->stream.avail_in == 0) { -- s->z_eof = 1; -- if (ferror(s->file)) s->z_err = Z_ERRNO; -- return EOF; -- } -- s->stream.next_in = s->inbuf; -- } -- s->stream.avail_in--; -- return *(s->stream.next_in)++; --} -- --/* =========================================================================== -- Check the gzip header of a gz_stream opened for reading. Set the stream -- mode to transparent if the gzip magic header is not present; set s->err -- to Z_DATA_ERROR if the magic header is present but the rest of the header -- is incorrect. -- IN assertion: the stream s has already been created sucessfully; -- s->stream.avail_in is zero for the first time, but may be non-zero -- for concatenated .gz files. --*/ --local void check_header(s) -- gz_stream *s; --{ -- int method; /* method byte */ -- int flags; /* flags byte */ -- uInt len; -- int c; -- -- /* Assure two bytes in the buffer so we can peek ahead -- handle case -- where first byte of header is at the end of the buffer after the last -- gzip segment */ -- len = s->stream.avail_in; -- if (len < 2) { -- if (len) s->inbuf[0] = s->stream.next_in[0]; -- errno = 0; -- len = (uInt)fread(s->inbuf + len, 1, Z_BUFSIZE >> len, s->file); -- if (len == 0 && ferror(s->file)) s->z_err = Z_ERRNO; -- s->stream.avail_in += len; -- s->stream.next_in = s->inbuf; -- if (s->stream.avail_in < 2) { -- s->transparent = s->stream.avail_in; -- return; -- } -- } -- -- /* Peek ahead to check the gzip magic header */ -- if (s->stream.next_in[0] != gz_magic[0] || -- s->stream.next_in[1] != gz_magic[1]) { -- s->transparent = 1; -- return; -- } -- s->stream.avail_in -= 2; -- s->stream.next_in += 2; -- -- /* Check the rest of the gzip header */ -- method = get_byte(s); -- flags = get_byte(s); -- if (method != Z_DEFLATED || (flags & RESERVED) != 0) { -- s->z_err = Z_DATA_ERROR; -- return; -- } -- -- /* Discard time, xflags and OS code: */ -- for (len = 0; len < 6; len++) (void)get_byte(s); -- -- if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ -- len = (uInt)get_byte(s); -- len += ((uInt)get_byte(s))<<8; -- /* len is garbage if EOF but the loop below will quit anyway */ -- while (len-- != 0 && get_byte(s) != EOF) ; -- } -- if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ -- while ((c = get_byte(s)) != 0 && c != EOF) ; -- } -- if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ -- while ((c = get_byte(s)) != 0 && c != EOF) ; -- } -- if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ -- for (len = 0; len < 2; len++) (void)get_byte(s); -- } -- s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; --} -- -- /* =========================================================================== -- * Cleanup then free the given gz_stream. Return a zlib error code. -- Try freeing in the reverse order of allocations. -- */ --local int destroy (s) -- gz_stream *s; --{ -- int err = Z_OK; -- -- if (!s) return Z_STREAM_ERROR; -- -- TRYFREE(s->msg); -- -- if (s->stream.state != NULL) { -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- err = Z_STREAM_ERROR; --#else -- err = deflateEnd(&(s->stream)); --#endif -- } else if (s->mode == 'r') { -- err = inflateEnd(&(s->stream)); -- } -- } -- if (s->file != NULL && fclose(s->file)) { --#ifdef ESPIPE -- if (errno != ESPIPE) /* fclose is broken for pipes in HP/UX */ --#endif -- err = Z_ERRNO; -- } -- if (s->z_err < 0) err = s->z_err; -- -- TRYFREE(s->inbuf); -- TRYFREE(s->outbuf); -- TRYFREE(s->path); -- TRYFREE(s); -- return err; --} -- --/* =========================================================================== -- Reads the given number of uncompressed bytes from the compressed file. -- gzread returns the number of bytes actually read (0 for end of file). --*/ --int ZEXPORT gzread (file, buf, len) -- gzFile file; -- voidp buf; -- unsigned len; --{ -- gz_stream *s = (gz_stream*)file; -- Bytef *start = (Bytef*)buf; /* starting point for crc computation */ -- Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ -- -- if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; -- -- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1; -- if (s->z_err == Z_STREAM_END) return 0; /* EOF */ -- -- next_out = (Byte*)buf; -- s->stream.next_out = (Bytef*)buf; -- s->stream.avail_out = len; -- -- if (s->stream.avail_out && s->back != EOF) { -- *next_out++ = s->back; -- s->stream.next_out++; -- s->stream.avail_out--; -- s->back = EOF; -- s->out++; -- start++; -- if (s->last) { -- s->z_err = Z_STREAM_END; -- return 1; -- } -- } -- -- while (s->stream.avail_out != 0) { -- -- if (s->transparent) { -- /* Copy first the lookahead bytes: */ -- uInt n = s->stream.avail_in; -- if (n > s->stream.avail_out) n = s->stream.avail_out; -- if (n > 0) { -- zmemcpy(s->stream.next_out, s->stream.next_in, n); -- next_out += n; -- s->stream.next_out = next_out; -- s->stream.next_in += n; -- s->stream.avail_out -= n; -- s->stream.avail_in -= n; -- } -- if (s->stream.avail_out > 0) { -- s->stream.avail_out -= -- (uInt)fread(next_out, 1, s->stream.avail_out, s->file); -- } -- len -= s->stream.avail_out; -- s->in += len; -- s->out += len; -- if (len == 0) s->z_eof = 1; -- return (int)len; -- } -- if (s->stream.avail_in == 0 && !s->z_eof) { -- -- errno = 0; -- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); -- if (s->stream.avail_in == 0) { -- s->z_eof = 1; -- if (ferror(s->file)) { -- s->z_err = Z_ERRNO; -- break; -- } -- } -- s->stream.next_in = s->inbuf; -- } -- s->in += s->stream.avail_in; -- s->out += s->stream.avail_out; -- s->z_err = inflate(&(s->stream), Z_NO_FLUSH); -- s->in -= s->stream.avail_in; -- s->out -= s->stream.avail_out; -- -- if (s->z_err == Z_STREAM_END) { -- /* Check CRC and original size */ -- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); -- start = s->stream.next_out; -- -- if (getLong(s) != s->crc) { -- s->z_err = Z_DATA_ERROR; -- } else { -- (void)getLong(s); -- /* The uncompressed length returned by above getlong() may be -- * different from s->out in case of concatenated .gz files. -- * Check for such files: -- */ -- check_header(s); -- if (s->z_err == Z_OK) { -- inflateReset(&(s->stream)); -- s->crc = crc32(0L, Z_NULL, 0); -- } -- } -- } -- if (s->z_err != Z_OK || s->z_eof) break; -- } -- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); -- -- if (len == s->stream.avail_out && -- (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO)) -- return -1; -- return (int)(len - s->stream.avail_out); --} -- -- --/* =========================================================================== -- Reads one byte from the compressed file. gzgetc returns this byte -- or -1 in case of end of file or error. --*/ --int ZEXPORT gzgetc(file) -- gzFile file; --{ -- unsigned char c; -- -- return gzread(file, &c, 1) == 1 ? c : -1; --} -- -- --/* =========================================================================== -- Push one byte back onto the stream. --*/ --int ZEXPORT gzungetc(c, file) -- int c; -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r' || c == EOF || s->back != EOF) return EOF; -- s->back = c; -- s->out--; -- s->last = (s->z_err == Z_STREAM_END); -- if (s->last) s->z_err = Z_OK; -- s->z_eof = 0; -- return c; --} -- -- --/* =========================================================================== -- Reads bytes from the compressed file until len-1 characters are -- read, or a newline character is read and transferred to buf, or an -- end-of-file condition is encountered. The string is then terminated -- with a null character. -- gzgets returns buf, or Z_NULL in case of error. -- -- The current implementation is not optimized at all. --*/ --char * ZEXPORT gzgets(file, buf, len) -- gzFile file; -- char *buf; -- int len; --{ -- char *b = buf; -- if (buf == Z_NULL || len <= 0) return Z_NULL; -- -- while (--len > 0 && gzread(file, buf, 1) == 1 && *buf++ != '\n') ; -- *buf = '\0'; -- return b == buf && len > 0 ? Z_NULL : b; --} -- -- --#ifndef NO_GZCOMPRESS --/* =========================================================================== -- Writes the given number of uncompressed bytes into the compressed file. -- gzwrite returns the number of bytes actually written (0 in case of error). --*/ --int ZEXPORT gzwrite (file, buf, len) -- gzFile file; -- voidpc buf; -- unsigned len; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- s->stream.next_in = (Bytef*)buf; -- s->stream.avail_in = len; -- -- while (s->stream.avail_in != 0) { -- -- if (s->stream.avail_out == 0) { -- -- s->stream.next_out = s->outbuf; -- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { -- s->z_err = Z_ERRNO; -- break; -- } -- s->stream.avail_out = Z_BUFSIZE; -- } -- s->in += s->stream.avail_in; -- s->out += s->stream.avail_out; -- s->z_err = deflate(&(s->stream), Z_NO_FLUSH); -- s->in -= s->stream.avail_in; -- s->out -= s->stream.avail_out; -- if (s->z_err != Z_OK) break; -- } -- s->crc = crc32(s->crc, (const Bytef *)buf, len); -- -- return (int)(len - s->stream.avail_in); --} -- -- --/* =========================================================================== -- Converts, formats, and writes the args to the compressed file under -- control of the format string, as in fprintf. gzprintf returns the number of -- uncompressed bytes actually written (0 in case of error). --*/ --#ifdef STDC --#include -- --int ZEXPORTVA gzprintf (gzFile file, const char *format, /* args */ ...) --{ -- char buf[Z_PRINTF_BUFSIZE]; -- va_list va; -- int len; -- -- buf[sizeof(buf) - 1] = 0; -- va_start(va, format); --#ifdef NO_vsnprintf --# ifdef HAS_vsprintf_void -- (void)vsprintf(buf, format, va); -- va_end(va); -- for (len = 0; len < sizeof(buf); len++) -- if (buf[len] == 0) break; --# else -- len = vsprintf(buf, format, va); -- va_end(va); --# endif --#else --# ifdef HAS_vsnprintf_void -- (void)vsnprintf(buf, sizeof(buf), format, va); -- va_end(va); -- len = strlen(buf); --# else -- len = vsnprintf(buf, sizeof(buf), format, va); -- va_end(va); --# endif --#endif -- if (len <= 0 || len >= (int)sizeof(buf) || buf[sizeof(buf) - 1] != 0) -- return 0; -- return gzwrite(file, buf, (unsigned)len); --} --#else /* not ANSI C */ -- --int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, -- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) -- gzFile file; -- const char *format; -- int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, -- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20; --{ -- char buf[Z_PRINTF_BUFSIZE]; -- int len; -- -- buf[sizeof(buf) - 1] = 0; --#ifdef NO_snprintf --# ifdef HAS_sprintf_void -- sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, -- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); -- for (len = 0; len < sizeof(buf); len++) -- if (buf[len] == 0) break; --# else -- len = sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, -- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); --# endif --#else --# ifdef HAS_snprintf_void -- 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); -- len = strlen(buf); --# else -- len = 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); --# endif --#endif -- if (len <= 0 || len >= sizeof(buf) || buf[sizeof(buf) - 1] != 0) -- return 0; -- return gzwrite(file, buf, len); --} --#endif -- --/* =========================================================================== -- Writes c, converted to an unsigned char, into the compressed file. -- gzputc returns the value that was written, or -1 in case of error. --*/ --int ZEXPORT gzputc(file, c) -- gzFile file; -- int c; --{ -- unsigned char cc = (unsigned char) c; /* required for big endian systems */ -- -- return gzwrite(file, &cc, 1) == 1 ? (int)cc : -1; --} -- -- --/* =========================================================================== -- Writes the given null-terminated string to the compressed file, excluding -- the terminating null character. -- gzputs returns the number of characters written, or -1 in case of error. --*/ --int ZEXPORT gzputs(file, s) -- gzFile file; -- const char *s; --{ -- return gzwrite(file, (char*)s, (unsigned)strlen(s)); --} -- -- --/* =========================================================================== -- Flushes all pending output into the compressed file. The parameter -- flush is as in the deflate() function. --*/ --local int do_flush (file, flush) -- gzFile file; -- int flush; --{ -- uInt len; -- int done = 0; -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- s->stream.avail_in = 0; /* should be zero already anyway */ -- -- for (;;) { -- len = Z_BUFSIZE - s->stream.avail_out; -- -- if (len != 0) { -- if ((uInt)fwrite(s->outbuf, 1, len, s->file) != len) { -- s->z_err = Z_ERRNO; -- return Z_ERRNO; -- } -- s->stream.next_out = s->outbuf; -- s->stream.avail_out = Z_BUFSIZE; -- } -- if (done) break; -- s->out += s->stream.avail_out; -- s->z_err = deflate(&(s->stream), flush); -- s->out -= s->stream.avail_out; -- -- /* Ignore the second of two consecutive flushes: */ -- if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK; -- -- /* deflate has finished flushing only when it hasn't used up -- * all the available space in the output buffer: -- */ -- done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); -- -- if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; -- } -- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; --} -- --int ZEXPORT gzflush (file, flush) -- gzFile file; -- int flush; --{ -- gz_stream *s = (gz_stream*)file; -- int err = do_flush (file, flush); -- -- if (err) return err; -- fflush(s->file); -- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; --} --#endif /* NO_GZCOMPRESS */ -- --/* =========================================================================== -- Sets the starting position for the next gzread or gzwrite on the given -- compressed file. The offset represents a number of bytes in the -- gzseek returns the resulting offset location as measured in bytes from -- the beginning of the uncompressed stream, or -1 in case of error. -- SEEK_END is not implemented, returns error. -- In this version of the library, gzseek can be extremely slow. --*/ --z_off_t ZEXPORT gzseek (file, offset, whence) -- gzFile file; -- z_off_t offset; -- int whence; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || whence == SEEK_END || -- s->z_err == Z_ERRNO || s->z_err == Z_DATA_ERROR) { -- return -1L; -- } -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- return -1L; --#else -- if (whence == SEEK_SET) { -- offset -= s->in; -- } -- if (offset < 0) return -1L; -- -- /* At this point, offset is the number of zero bytes to write. */ -- if (s->inbuf == Z_NULL) { -- s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); /* for seeking */ -- if (s->inbuf == Z_NULL) return -1L; -- zmemzero(s->inbuf, Z_BUFSIZE); -- } -- while (offset > 0) { -- uInt size = Z_BUFSIZE; -- if (offset < Z_BUFSIZE) size = (uInt)offset; -- -- size = gzwrite(file, s->inbuf, size); -- if (size == 0) return -1L; -- -- offset -= size; -- } -- return s->in; --#endif -- } -- /* Rest of function is for reading only */ -- -- /* compute absolute position */ -- if (whence == SEEK_CUR) { -- offset += s->out; -- } -- if (offset < 0) return -1L; -- -- if (s->transparent) { -- /* map to fseek */ -- s->back = EOF; -- s->stream.avail_in = 0; -- s->stream.next_in = s->inbuf; -- if (fseek(s->file, offset, SEEK_SET) < 0) return -1L; -- -- s->in = s->out = offset; -- return offset; -- } -- -- /* For a negative seek, rewind and use positive seek */ -- if (offset >= s->out) { -- offset -= s->out; -- } else if (gzrewind(file) < 0) { -- return -1L; -- } -- /* offset is now the number of bytes to skip. */ -- -- if (offset != 0 && s->outbuf == Z_NULL) { -- s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); -- if (s->outbuf == Z_NULL) return -1L; -- } -- if (offset && s->back != EOF) { -- s->back = EOF; -- s->out++; -- offset--; -- if (s->last) s->z_err = Z_STREAM_END; -- } -- while (offset > 0) { -- int size = Z_BUFSIZE; -- if (offset < Z_BUFSIZE) size = (int)offset; -- -- size = gzread(file, s->outbuf, (uInt)size); -- if (size <= 0) return -1L; -- offset -= size; -- } -- return s->out; --} -- --/* =========================================================================== -- Rewinds input file. --*/ --int ZEXPORT gzrewind (file) -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r') return -1; -- -- s->z_err = Z_OK; -- s->z_eof = 0; -- s->back = EOF; -- s->stream.avail_in = 0; -- s->stream.next_in = s->inbuf; -- s->crc = crc32(0L, Z_NULL, 0); -- if (!s->transparent) (void)inflateReset(&s->stream); -- s->in = 0; -- s->out = 0; -- return fseek(s->file, s->start, SEEK_SET); --} -- --/* =========================================================================== -- Returns the starting position for the next gzread or gzwrite on the -- given compressed file. This position represents a number of bytes in the -- uncompressed data stream. --*/ --z_off_t ZEXPORT gztell (file) -- gzFile file; --{ -- return gzseek(file, 0L, SEEK_CUR); --} -- --/* =========================================================================== -- Returns 1 when EOF has previously been detected reading the given -- input stream, otherwise zero. --*/ --int ZEXPORT gzeof (file) -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- /* With concatenated compressed files that can have embedded -- * crc trailers, z_eof is no longer the only/best indicator of EOF -- * on a gz_stream. Handle end-of-stream error explicitly here. -- */ -- if (s == NULL || s->mode != 'r') return 0; -- if (s->z_eof) return 1; -- return s->z_err == Z_STREAM_END; --} -- --/* =========================================================================== -- Returns 1 if reading and doing so transparently, otherwise zero. --*/ --int ZEXPORT gzdirect (file) -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r') return 0; -- return s->transparent; --} -- --/* =========================================================================== -- Outputs a long in LSB order to the given file --*/ --local void putLong (file, x) -- FILE *file; -- uLong x; --{ -- int n; -- for (n = 0; n < 4; n++) { -- fputc((int)(x & 0xff), file); -- x >>= 8; -- } --} -- --/* =========================================================================== -- Reads a long in LSB order from the given gz_stream. Sets z_err in case -- of error. --*/ --local uLong getLong (s) -- gz_stream *s; --{ -- uLong x = (uLong)get_byte(s); -- int c; -- -- x += ((uLong)get_byte(s))<<8; -- x += ((uLong)get_byte(s))<<16; -- c = get_byte(s); -- if (c == EOF) s->z_err = Z_DATA_ERROR; -- x += ((uLong)c)<<24; -- return x; --} -- --/* =========================================================================== -- Flushes all pending output if necessary, closes the compressed file -- and deallocates all the (de)compression state. --*/ --int ZEXPORT gzclose (file) -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) return Z_STREAM_ERROR; -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- return Z_STREAM_ERROR; --#else -- if (do_flush (file, Z_FINISH) != Z_OK) -- return destroy((gz_stream*)file); -- -- putLong (s->file, s->crc); -- putLong (s->file, (uLong)(s->in & 0xffffffff)); --#endif -- } -- return destroy((gz_stream*)file); --} -- --#ifdef STDC --# define zstrerror(errnum) strerror(errnum) --#else --# define zstrerror(errnum) "" --#endif -- --/* =========================================================================== -- Returns the error message for the last error which occurred on the -- given compressed file. errnum is set to zlib error number. If an -- error occurred in the file system and not in the compression library, -- errnum is set to Z_ERRNO and the application may consult errno -- to get the exact error code. --*/ --const char * ZEXPORT gzerror (file, errnum) -- gzFile file; -- int *errnum; --{ -- char *m; -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) { -- *errnum = Z_STREAM_ERROR; -- return (const char*)ERR_MSG(Z_STREAM_ERROR); -- } -- *errnum = s->z_err; -- if (*errnum == Z_OK) return (const char*)""; -- -- m = (char*)(*errnum == Z_ERRNO ? zstrerror(errno) : s->stream.msg); -- -- if (m == NULL || *m == '\0') m = (char*)ERR_MSG(s->z_err); -- -- TRYFREE(s->msg); -- s->msg = (char*)ALLOC(strlen(s->path) + strlen(m) + 3); -- if (s->msg == Z_NULL) return (const char*)ERR_MSG(Z_MEM_ERROR); -- strcpy(s->msg, s->path); -- strcat(s->msg, ": "); -- strcat(s->msg, m); -- return (const char*)s->msg; --} -- --/* =========================================================================== -- Clear the error and end-of-file flags, and do the same for the real file. --*/ --void ZEXPORT gzclearerr (file) -- gzFile file; --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) return; -- if (s->z_err != Z_STREAM_END) s->z_err = Z_OK; -- s->z_eof = 0; -- clearerr(s->file); --} -diff -ruN RJaCGH.orig/src/infback.c RJaCGH/src/infback.c ---- RJaCGH.orig/src/infback.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/infback.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,623 +0,0 @@ --/* infback.c -- inflate using a call-back interface -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- This code is largely copied from inflate.c. Normally either infback.o or -- inflate.o would be linked into an application--not both. The interface -- with inffast.c is retained so that optimized assembler-coded versions of -- inflate_fast() can be used with either inflate.c or infback.c. -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- --/* function prototypes */ --local void fixedtables OF((struct inflate_state FAR *state)); -- --/* -- strm provides memory allocation functions in zalloc and zfree, or -- Z_NULL to use the library memory allocation functions. -- -- windowBits is in the range 8..15, and window is a user-supplied -- window and output buffer that is 2**windowBits bytes. -- */ --int ZEXPORT inflateBackInit_(strm, windowBits, window, version, stream_size) --z_streamp strm; --int windowBits; --unsigned char FAR *window; --const char *version; --int stream_size; --{ -- struct inflate_state FAR *state; -- -- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || -- stream_size != (int)(sizeof(z_stream))) -- return Z_VERSION_ERROR; -- if (strm == Z_NULL || window == Z_NULL || -- windowBits < 8 || windowBits > 15) -- return Z_STREAM_ERROR; -- strm->msg = Z_NULL; /* in case we return an error */ -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- state = (struct inflate_state FAR *)ZALLOC(strm, 1, -- sizeof(struct inflate_state)); -- if (state == Z_NULL) return Z_MEM_ERROR; -- Tracev((stderr, "inflate: allocated\n")); -- strm->state = (struct internal_state FAR *)state; -- state->dmax = 32768U; -- state->wbits = windowBits; -- state->wsize = 1U << windowBits; -- state->window = window; -- state->write = 0; -- state->whave = 0; -- return Z_OK; --} -- --/* -- Return state with length and distance decoding tables and index sizes set to -- fixed code decoding. Normally this returns fixed tables from inffixed.h. -- If BUILDFIXED is defined, then instead this routine builds the tables the -- first time it's called, and returns those tables the first time and -- thereafter. This reduces the size of the code by about 2K bytes, in -- exchange for a little execution time. However, BUILDFIXED should not be -- used for threaded applications, since the rewriting of the tables and virgin -- may not be thread-safe. -- */ --local void fixedtables(state) --struct inflate_state FAR *state; --{ --#ifdef BUILDFIXED -- static int virgin = 1; -- static code *lenfix, *distfix; -- static code fixed[544]; -- -- /* build fixed huffman tables if first call (may not be thread safe) */ -- if (virgin) { -- unsigned sym, bits; -- static code *next; -- -- /* literal/length table */ -- sym = 0; -- while (sym < 144) state->lens[sym++] = 8; -- while (sym < 256) state->lens[sym++] = 9; -- while (sym < 280) state->lens[sym++] = 7; -- while (sym < 288) state->lens[sym++] = 8; -- next = fixed; -- lenfix = next; -- bits = 9; -- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); -- -- /* distance table */ -- sym = 0; -- while (sym < 32) state->lens[sym++] = 5; -- distfix = next; -- bits = 5; -- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); -- -- /* do this just once */ -- virgin = 0; -- } --#else /* !BUILDFIXED */ --# include "inffixed.h" --#endif /* BUILDFIXED */ -- state->lencode = lenfix; -- state->lenbits = 9; -- state->distcode = distfix; -- state->distbits = 5; --} -- --/* Macros for inflateBack(): */ -- --/* Load returned state from inflate_fast() */ --#define LOAD() \ -- do { \ -- put = strm->next_out; \ -- left = strm->avail_out; \ -- next = strm->next_in; \ -- have = strm->avail_in; \ -- hold = state->hold; \ -- bits = state->bits; \ -- } while (0) -- --/* Set state from registers for inflate_fast() */ --#define RESTORE() \ -- do { \ -- strm->next_out = put; \ -- strm->avail_out = left; \ -- strm->next_in = next; \ -- strm->avail_in = have; \ -- state->hold = hold; \ -- state->bits = bits; \ -- } while (0) -- --/* Clear the input bit accumulator */ --#define INITBITS() \ -- do { \ -- hold = 0; \ -- bits = 0; \ -- } while (0) -- --/* Assure that some input is available. If input is requested, but denied, -- then return a Z_BUF_ERROR from inflateBack(). */ --#define PULL() \ -- do { \ -- if (have == 0) { \ -- have = in(in_desc, &next); \ -- if (have == 0) { \ -- next = Z_NULL; \ -- ret = Z_BUF_ERROR; \ -- goto inf_leave; \ -- } \ -- } \ -- } while (0) -- --/* Get a byte of input into the bit accumulator, or return from inflateBack() -- with an error if there is no input available. */ --#define PULLBYTE() \ -- do { \ -- PULL(); \ -- have--; \ -- hold += (unsigned long)(*next++) << bits; \ -- bits += 8; \ -- } while (0) -- --/* Assure that there are at least n bits in the bit accumulator. If there is -- not enough available input to do that, then return from inflateBack() with -- an error. */ --#define NEEDBITS(n) \ -- do { \ -- while (bits < (unsigned)(n)) \ -- PULLBYTE(); \ -- } while (0) -- --/* Return the low n bits of the bit accumulator (n < 16) */ --#define BITS(n) \ -- ((unsigned)hold & ((1U << (n)) - 1)) -- --/* Remove n bits from the bit accumulator */ --#define DROPBITS(n) \ -- do { \ -- hold >>= (n); \ -- bits -= (unsigned)(n); \ -- } while (0) -- --/* Remove zero to seven bits as needed to go to a byte boundary */ --#define BYTEBITS() \ -- do { \ -- hold >>= bits & 7; \ -- bits -= bits & 7; \ -- } while (0) -- --/* Assure that some output space is available, by writing out the window -- if it's full. If the write fails, return from inflateBack() with a -- Z_BUF_ERROR. */ --#define ROOM() \ -- do { \ -- if (left == 0) { \ -- put = state->window; \ -- left = state->wsize; \ -- state->whave = left; \ -- if (out(out_desc, put, left)) { \ -- ret = Z_BUF_ERROR; \ -- goto inf_leave; \ -- } \ -- } \ -- } while (0) -- --/* -- strm provides the memory allocation functions and window buffer on input, -- and provides information on the unused input on return. For Z_DATA_ERROR -- returns, strm will also provide an error message. -- -- in() and out() are the call-back input and output functions. When -- inflateBack() needs more input, it calls in(). When inflateBack() has -- filled the window with output, or when it completes with data in the -- window, it calls out() to write out the data. The application must not -- change the provided input until in() is called again or inflateBack() -- returns. The application must not change the window/output buffer until -- inflateBack() returns. -- -- in() and out() are called with a descriptor parameter provided in the -- inflateBack() call. This parameter can be a structure that provides the -- information required to do the read or write, as well as accumulated -- information on the input and output such as totals and check values. -- -- in() should return zero on failure. out() should return non-zero on -- failure. If either in() or out() fails, than inflateBack() returns a -- Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it -- was in() or out() that caused in the error. Otherwise, inflateBack() -- returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format -- error, or Z_MEM_ERROR if it could not allocate memory for the state. -- inflateBack() can also return Z_STREAM_ERROR if the input parameters -- are not correct, i.e. strm is Z_NULL or the state was not initialized. -- */ --int ZEXPORT inflateBack(strm, in, in_desc, out, out_desc) --z_streamp strm; --in_func in; --void FAR *in_desc; --out_func out; --void FAR *out_desc; --{ -- struct inflate_state FAR *state; -- unsigned char FAR *next; /* next input */ -- unsigned char FAR *put; /* next output */ -- unsigned have, left; /* available input and output */ -- unsigned long hold; /* bit buffer */ -- unsigned bits; /* bits in bit buffer */ -- unsigned copy; /* number of stored or match bytes to copy */ -- unsigned char FAR *from; /* where to copy match bytes from */ -- code this; /* current decoding table entry */ -- code last; /* parent table entry */ -- unsigned len; /* length to copy for repeats, bits to drop */ -- int ret; /* return code */ -- static const unsigned short order[19] = /* permutation of code lengths */ -- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; -- -- /* Check that the strm exists and that the state was initialized */ -- if (strm == Z_NULL || strm->state == Z_NULL) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- -- /* Reset the state */ -- strm->msg = Z_NULL; -- state->mode = TYPE; -- state->last = 0; -- state->whave = 0; -- next = strm->next_in; -- have = next != Z_NULL ? strm->avail_in : 0; -- hold = 0; -- bits = 0; -- put = state->window; -- left = state->wsize; -- -- /* Inflate until end of block marked as last */ -- for (;;) -- switch (state->mode) { -- case TYPE: -- /* determine and dispatch block type */ -- if (state->last) { -- BYTEBITS(); -- state->mode = DONE; -- break; -- } -- NEEDBITS(3); -- state->last = BITS(1); -- DROPBITS(1); -- switch (BITS(2)) { -- case 0: /* stored block */ -- Tracev((stderr, "inflate: stored block%s\n", -- state->last ? " (last)" : "")); -- state->mode = STORED; -- break; -- case 1: /* fixed block */ -- fixedtables(state); -- Tracev((stderr, "inflate: fixed codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = LEN; /* decode codes */ -- break; -- case 2: /* dynamic block */ -- Tracev((stderr, "inflate: dynamic codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = TABLE; -- break; -- case 3: -- strm->msg = (char *)"invalid block type"; -- state->mode = BAD; -- } -- DROPBITS(2); -- break; -- -- case STORED: -- /* get and verify stored block length */ -- BYTEBITS(); /* go to byte boundary */ -- NEEDBITS(32); -- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { -- strm->msg = (char *)"invalid stored block lengths"; -- state->mode = BAD; -- break; -- } -- state->length = (unsigned)hold & 0xffff; -- Tracev((stderr, "inflate: stored length %u\n", -- state->length)); -- INITBITS(); -- -- /* copy stored block from input to output */ -- while (state->length != 0) { -- copy = state->length; -- PULL(); -- ROOM(); -- if (copy > have) copy = have; -- if (copy > left) copy = left; -- zmemcpy(put, next, copy); -- have -= copy; -- next += copy; -- left -= copy; -- put += copy; -- state->length -= copy; -- } -- Tracev((stderr, "inflate: stored end\n")); -- state->mode = TYPE; -- break; -- -- case TABLE: -- /* get dynamic table entries descriptor */ -- NEEDBITS(14); -- state->nlen = BITS(5) + 257; -- DROPBITS(5); -- state->ndist = BITS(5) + 1; -- DROPBITS(5); -- state->ncode = BITS(4) + 4; -- DROPBITS(4); --#ifndef PKZIP_BUG_WORKAROUND -- if (state->nlen > 286 || state->ndist > 30) { -- strm->msg = (char *)"too many length or distance symbols"; -- state->mode = BAD; -- break; -- } --#endif -- Tracev((stderr, "inflate: table sizes ok\n")); -- -- /* get code length code lengths (not a typo) */ -- state->have = 0; -- while (state->have < state->ncode) { -- NEEDBITS(3); -- state->lens[order[state->have++]] = (unsigned short)BITS(3); -- DROPBITS(3); -- } -- while (state->have < 19) -- state->lens[order[state->have++]] = 0; -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 7; -- ret = inflate_table(CODES, state->lens, 19, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid code lengths set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: code lengths ok\n")); -- -- /* get length and distance code code lengths */ -- state->have = 0; -- while (state->have < state->nlen + state->ndist) { -- for (;;) { -- this = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if (this.val < 16) { -- NEEDBITS(this.bits); -- DROPBITS(this.bits); -- state->lens[state->have++] = this.val; -- } -- else { -- if (this.val == 16) { -- NEEDBITS(this.bits + 2); -- DROPBITS(this.bits); -- if (state->have == 0) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- len = (unsigned)(state->lens[state->have - 1]); -- copy = 3 + BITS(2); -- DROPBITS(2); -- } -- else if (this.val == 17) { -- NEEDBITS(this.bits + 3); -- DROPBITS(this.bits); -- len = 0; -- copy = 3 + BITS(3); -- DROPBITS(3); -- } -- else { -- NEEDBITS(this.bits + 7); -- DROPBITS(this.bits); -- len = 0; -- copy = 11 + BITS(7); -- DROPBITS(7); -- } -- if (state->have + copy > state->nlen + state->ndist) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- while (copy--) -- state->lens[state->have++] = (unsigned short)len; -- } -- } -- -- /* handle error breaks in while */ -- if (state->mode == BAD) break; -- -- /* build code tables */ -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 9; -- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid literal/lengths set"; -- state->mode = BAD; -- break; -- } -- state->distcode = (code const FAR *)(state->next); -- state->distbits = 6; -- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, -- &(state->next), &(state->distbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid distances set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: codes ok\n")); -- state->mode = LEN; -- -- case LEN: -- /* use inflate_fast() if we have enough input and output */ -- if (have >= 6 && left >= 258) { -- RESTORE(); -- if (state->whave < state->wsize) -- state->whave = state->wsize - left; -- inflate_fast(strm, state->wsize); -- LOAD(); -- break; -- } -- -- /* get a literal, length, or end-of-block code */ -- for (;;) { -- this = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if (this.op && (this.op & 0xf0) == 0) { -- last = this; -- for (;;) { -- this = state->lencode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + this.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(this.bits); -- state->length = (unsigned)this.val; -- -- /* process literal */ -- if (this.op == 0) { -- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", this.val)); -- ROOM(); -- *put++ = (unsigned char)(state->length); -- left--; -- state->mode = LEN; -- break; -- } -- -- /* process end of block */ -- if (this.op & 32) { -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- -- /* invalid code */ -- if (this.op & 64) { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- -- /* length code -- get extra bits, if any */ -- state->extra = (unsigned)(this.op) & 15; -- if (state->extra != 0) { -- NEEDBITS(state->extra); -- state->length += BITS(state->extra); -- DROPBITS(state->extra); -- } -- Tracevv((stderr, "inflate: length %u\n", state->length)); -- -- /* get distance code */ -- for (;;) { -- this = state->distcode[BITS(state->distbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if ((this.op & 0xf0) == 0) { -- last = this; -- for (;;) { -- this = state->distcode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + this.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(this.bits); -- if (this.op & 64) { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- state->offset = (unsigned)this.val; -- -- /* get distance extra bits, if any */ -- state->extra = (unsigned)(this.op) & 15; -- if (state->extra != 0) { -- NEEDBITS(state->extra); -- state->offset += BITS(state->extra); -- DROPBITS(state->extra); -- } -- if (state->offset > state->wsize - (state->whave < state->wsize ? -- left : 0)) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- Tracevv((stderr, "inflate: distance %u\n", state->offset)); -- -- /* copy match from window to output */ -- do { -- ROOM(); -- copy = state->wsize - state->offset; -- if (copy < left) { -- from = put + copy; -- copy = left - copy; -- } -- else { -- from = put - state->offset; -- copy = left; -- } -- if (copy > state->length) copy = state->length; -- state->length -= copy; -- left -= copy; -- do { -- *put++ = *from++; -- } while (--copy); -- } while (state->length != 0); -- break; -- -- case DONE: -- /* inflate stream terminated properly -- write leftover output */ -- ret = Z_STREAM_END; -- if (left < state->wsize) { -- if (out(out_desc, state->window, state->wsize - left)) -- ret = Z_BUF_ERROR; -- } -- goto inf_leave; -- -- case BAD: -- ret = Z_DATA_ERROR; -- goto inf_leave; -- -- default: /* can't happen, but makes compilers happy */ -- ret = Z_STREAM_ERROR; -- goto inf_leave; -- } -- -- /* Return unused input */ -- inf_leave: -- strm->next_in = next; -- strm->avail_in = have; -- return ret; --} -- --int ZEXPORT inflateBackEnd(strm) --z_streamp strm; --{ -- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- Tracev((stderr, "inflate: end\n")); -- return Z_OK; --} -diff -ruN RJaCGH.orig/src/inffast.c RJaCGH/src/inffast.c ---- RJaCGH.orig/src/inffast.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inffast.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,318 +0,0 @@ --/* inffast.c -- fast decoding -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- --#ifndef ASMINF -- --/* Allow machine dependent optimization for post-increment or pre-increment. -- Based on testing to date, -- Pre-increment preferred for: -- - PowerPC G3 (Adler) -- - MIPS R5000 (Randers-Pehrson) -- Post-increment preferred for: -- - none -- No measurable difference: -- - Pentium III (Anderson) -- - M68060 (Nikl) -- */ --#ifdef POSTINC --# define OFF 0 --# define PUP(a) *(a)++ --#else --# define OFF 1 --# define PUP(a) *++(a) --#endif -- --/* -- Decode literal, length, and distance codes and write out the resulting -- literal and match bytes until either not enough input or output is -- available, an end-of-block is encountered, or a data error is encountered. -- When large enough input and output buffers are supplied to inflate(), for -- example, a 16K input buffer and a 64K output buffer, more than 95% of the -- inflate execution time is spent in this routine. -- -- Entry assumptions: -- -- state->mode == LEN -- strm->avail_in >= 6 -- strm->avail_out >= 258 -- start >= strm->avail_out -- state->bits < 8 -- -- On return, state->mode is one of: -- -- LEN -- ran out of enough output space or enough available input -- TYPE -- reached end of block code, inflate() to interpret next block -- BAD -- error in block data -- -- Notes: -- -- - The maximum input bits used by a length/distance pair is 15 bits for the -- length code, 5 bits for the length extra, 15 bits for the distance code, -- and 13 bits for the distance extra. This totals 48 bits, or six bytes. -- Therefore if strm->avail_in >= 6, then there is enough input to avoid -- checking for available input while decoding. -- -- - The maximum bytes that a single length/distance pair can output is 258 -- bytes, which is the maximum length that can be coded. inflate_fast() -- requires strm->avail_out >= 258 for each loop to avoid checking for -- output space. -- */ --void inflate_fast(strm, start) --z_streamp strm; --unsigned start; /* inflate()'s starting value for strm->avail_out */ --{ -- struct inflate_state FAR *state; -- unsigned char FAR *in; /* local strm->next_in */ -- unsigned char FAR *last; /* while in < last, enough input available */ -- unsigned char FAR *out; /* local strm->next_out */ -- unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ -- unsigned char FAR *end; /* while out < end, enough space available */ --#ifdef INFLATE_STRICT -- unsigned dmax; /* maximum distance from zlib header */ --#endif -- unsigned wsize; /* window size or zero if not using window */ -- unsigned whave; /* valid bytes in the window */ -- unsigned write; /* window write index */ -- unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ -- unsigned long hold; /* local strm->hold */ -- unsigned bits; /* local strm->bits */ -- code const FAR *lcode; /* local strm->lencode */ -- code const FAR *dcode; /* local strm->distcode */ -- unsigned lmask; /* mask for first level of length codes */ -- unsigned dmask; /* mask for first level of distance codes */ -- code this; /* retrieved table entry */ -- unsigned op; /* code bits, operation, extra bits, or */ -- /* window position, window bytes to copy */ -- unsigned len; /* match length, unused bytes */ -- unsigned dist; /* match distance */ -- unsigned char FAR *from; /* where to copy match from */ -- -- /* copy state to local variables */ -- state = (struct inflate_state FAR *)strm->state; -- in = strm->next_in - OFF; -- last = in + (strm->avail_in - 5); -- out = strm->next_out - OFF; -- beg = out - (start - strm->avail_out); -- end = out + (strm->avail_out - 257); --#ifdef INFLATE_STRICT -- dmax = state->dmax; --#endif -- wsize = state->wsize; -- whave = state->whave; -- write = state->write; -- window = state->window; -- hold = state->hold; -- bits = state->bits; -- lcode = state->lencode; -- dcode = state->distcode; -- lmask = (1U << state->lenbits) - 1; -- dmask = (1U << state->distbits) - 1; -- -- /* decode literals and length/distances until end-of-block or not enough -- input data or output space */ -- do { -- if (bits < 15) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- this = lcode[hold & lmask]; -- dolen: -- op = (unsigned)(this.bits); -- hold >>= op; -- bits -= op; -- op = (unsigned)(this.op); -- if (op == 0) { /* literal */ -- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", this.val)); -- PUP(out) = (unsigned char)(this.val); -- } -- else if (op & 16) { /* length base */ -- len = (unsigned)(this.val); -- op &= 15; /* number of extra bits */ -- if (op) { -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- len += (unsigned)hold & ((1U << op) - 1); -- hold >>= op; -- bits -= op; -- } -- Tracevv((stderr, "inflate: length %u\n", len)); -- if (bits < 15) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- this = dcode[hold & dmask]; -- dodist: -- op = (unsigned)(this.bits); -- hold >>= op; -- bits -= op; -- op = (unsigned)(this.op); -- if (op & 16) { /* distance base */ -- dist = (unsigned)(this.val); -- op &= 15; /* number of extra bits */ -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- } -- dist += (unsigned)hold & ((1U << op) - 1); --#ifdef INFLATE_STRICT -- if (dist > dmax) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } --#endif -- hold >>= op; -- bits -= op; -- Tracevv((stderr, "inflate: distance %u\n", dist)); -- op = (unsigned)(out - beg); /* max distance in output */ -- if (dist > op) { /* see if copy from window */ -- op = dist - op; /* distance back in window */ -- if (op > whave) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- from = window - OFF; -- if (write == 0) { /* very common case */ -- from += wsize - op; -- if (op < len) { /* some from window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- else if (write < op) { /* wrap around window */ -- from += wsize + write - op; -- op -= write; -- if (op < len) { /* some from end of window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = window - OFF; -- if (write < len) { /* some from start of window */ -- op = write; -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- } -- else { /* contiguous in window */ -- from += write - op; -- if (op < len) { /* some from window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- while (len > 2) { -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- len -= 3; -- } -- if (len) { -- PUP(out) = PUP(from); -- if (len > 1) -- PUP(out) = PUP(from); -- } -- } -- else { -- from = out - dist; /* copy direct from output */ -- do { /* minimum length is three */ -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- len -= 3; -- } while (len > 2); -- if (len) { -- PUP(out) = PUP(from); -- if (len > 1) -- PUP(out) = PUP(from); -- } -- } -- } -- else if ((op & 64) == 0) { /* 2nd level distance code */ -- this = dcode[this.val + (hold & ((1U << op) - 1))]; -- goto dodist; -- } -- else { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- } -- else if ((op & 64) == 0) { /* 2nd level length code */ -- this = lcode[this.val + (hold & ((1U << op) - 1))]; -- goto dolen; -- } -- else if (op & 32) { /* end-of-block */ -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- else { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- } while (in < last && out < end); -- -- /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ -- len = bits >> 3; -- in -= len; -- bits -= len << 3; -- hold &= (1U << bits) - 1; -- -- /* update state and return */ -- strm->next_in = in + OFF; -- strm->next_out = out + OFF; -- strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); -- strm->avail_out = (unsigned)(out < end ? -- 257 + (end - out) : 257 - (out - end)); -- state->hold = hold; -- state->bits = bits; -- return; --} -- --/* -- inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): -- - Using bit fields for code structure -- - Different op definition to avoid & for extra bits (do & for table bits) -- - Three separate decoding do-loops for direct, window, and write == 0 -- - Special case for distance > 1 copies to do overlapped load and store copy -- - Explicit branch predictions (based on measured branch probabilities) -- - Deferring match copy and interspersed it with decoding subsequent codes -- - Swapping literal/length else -- - Swapping window/direct else -- - Larger unrolled copy loops (three is about right) -- - Moving len -= 3 statement into middle of loop -- */ -- --#endif /* !ASMINF */ -diff -ruN RJaCGH.orig/src/inffast.h RJaCGH/src/inffast.h ---- RJaCGH.orig/src/inffast.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inffast.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,11 +0,0 @@ --/* inffast.h -- header to use inffast.c -- * Copyright (C) 1995-2003 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --void inflate_fast OF((z_streamp strm, unsigned start)); -diff -ruN RJaCGH.orig/src/inffixed.h RJaCGH/src/inffixed.h ---- RJaCGH.orig/src/inffixed.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inffixed.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,94 +0,0 @@ -- /* inffixed.h -- table for decoding fixed codes -- * Generated automatically by makefixed(). -- */ -- -- /* WARNING: this file should *not* be used by applications. It -- is part of the implementation of the compression library and -- is subject to change. Applications should only use zlib.h. -- */ -- -- static const code lenfix[512] = { -- {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48}, -- {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128}, -- {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59}, -- {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176}, -- {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20}, -- {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100}, -- {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8}, -- {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216}, -- {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76}, -- {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114}, -- {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2}, -- {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148}, -- {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42}, -- {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86}, -- {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15}, -- {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236}, -- {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62}, -- {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, -- {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31}, -- {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162}, -- {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25}, -- {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105}, -- {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4}, -- {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202}, -- {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69}, -- {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125}, -- {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13}, -- {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195}, -- {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35}, -- {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91}, -- {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19}, -- {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246}, -- {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55}, -- {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135}, -- {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99}, -- {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190}, -- {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16}, -- {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96}, -- {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6}, -- {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209}, -- {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72}, -- {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116}, -- {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4}, -- {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153}, -- {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44}, -- {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82}, -- {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11}, -- {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, -- {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58}, -- {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138}, -- {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51}, -- {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173}, -- {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30}, -- {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110}, -- {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0}, -- {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195}, -- {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65}, -- {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121}, -- {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9}, -- {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258}, -- {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37}, -- {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93}, -- {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23}, -- {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251}, -- {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51}, -- {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, -- {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67}, -- {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183}, -- {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23}, -- {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103}, -- {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9}, -- {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223}, -- {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79}, -- {0,9,255} -- }; -- -- static const code distfix[32] = { -- {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025}, -- {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193}, -- {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385}, -- {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577}, -- {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073}, -- {22,5,193},{64,5,0} -- }; -diff -ruN RJaCGH.orig/src/inflate.c RJaCGH/src/inflate.c ---- RJaCGH.orig/src/inflate.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inflate.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1368 +0,0 @@ --/* inflate.c -- zlib decompression -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * Change history: -- * -- * 1.2.beta0 24 Nov 2002 -- * - First version -- complete rewrite of inflate to simplify code, avoid -- * creation of window when not needed, minimize use of window when it is -- * needed, make inffast.c even faster, implement gzip decoding, and to -- * improve code readability and style over the previous zlib inflate code -- * -- * 1.2.beta1 25 Nov 2002 -- * - Use pointers for available input and output checking in inffast.c -- * - Remove input and output counters in inffast.c -- * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 -- * - Remove unnecessary second byte pull from length extra in inffast.c -- * - Unroll direct copy to three copies per loop in inffast.c -- * -- * 1.2.beta2 4 Dec 2002 -- * - Change external routine names to reduce potential conflicts -- * - Correct filename to inffixed.h for fixed tables in inflate.c -- * - Make hbuf[] unsigned char to match parameter type in inflate.c -- * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) -- * to avoid negation problem on Alphas (64 bit) in inflate.c -- * -- * 1.2.beta3 22 Dec 2002 -- * - Add comments on state->bits assertion in inffast.c -- * - Add comments on op field in inftrees.h -- * - Fix bug in reuse of allocated window after inflateReset() -- * - Remove bit fields--back to byte structure for speed -- * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths -- * - Change post-increments to pre-increments in inflate_fast(), PPC biased? -- * - Add compile time option, POSTINC, to use post-increments instead (Intel?) -- * - Make MATCH copy in inflate() much faster for when inflate_fast() not used -- * - Use local copies of stream next and avail values, as well as local bit -- * buffer and bit count in inflate()--for speed when inflate_fast() not used -- * -- * 1.2.beta4 1 Jan 2003 -- * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings -- * - Move a comment on output buffer sizes from inffast.c to inflate.c -- * - Add comments in inffast.c to introduce the inflate_fast() routine -- * - Rearrange window copies in inflate_fast() for speed and simplification -- * - Unroll last copy for window match in inflate_fast() -- * - Use local copies of window variables in inflate_fast() for speed -- * - Pull out common write == 0 case for speed in inflate_fast() -- * - Make op and len in inflate_fast() unsigned for consistency -- * - Add FAR to lcode and dcode declarations in inflate_fast() -- * - Simplified bad distance check in inflate_fast() -- * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new -- * source file infback.c to provide a call-back interface to inflate for -- * programs like gzip and unzip -- uses window as output buffer to avoid -- * window copying -- * -- * 1.2.beta5 1 Jan 2003 -- * - Improved inflateBack() interface to allow the caller to provide initial -- * input in strm. -- * - Fixed stored blocks bug in inflateBack() -- * -- * 1.2.beta6 4 Jan 2003 -- * - Added comments in inffast.c on effectiveness of POSTINC -- * - Typecasting all around to reduce compiler warnings -- * - Changed loops from while (1) or do {} while (1) to for (;;), again to -- * make compilers happy -- * - Changed type of window in inflateBackInit() to unsigned char * -- * -- * 1.2.beta7 27 Jan 2003 -- * - Changed many types to unsigned or unsigned short to avoid warnings -- * - Added inflateCopy() function -- * -- * 1.2.0 9 Mar 2003 -- * - Changed inflateBack() interface to provide separate opaque descriptors -- * for the in() and out() functions -- * - Changed inflateBack() argument and in_func typedef to swap the length -- * and buffer address return values for the input function -- * - Check next_in and next_out for Z_NULL on entry to inflate() -- * -- * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- --#ifdef MAKEFIXED --# ifndef BUILDFIXED --# define BUILDFIXED --# endif --#endif -- --/* function prototypes */ --local void fixedtables OF((struct inflate_state FAR *state)); --local int updatewindow OF((z_streamp strm, unsigned out)); --#ifdef BUILDFIXED -- void makefixed OF((void)); --#endif --local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, -- unsigned len)); -- --int ZEXPORT inflateReset(strm) --z_streamp strm; --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- strm->total_in = strm->total_out = state->total = 0; -- strm->msg = Z_NULL; -- strm->adler = 1; /* to support ill-conceived Java test suite */ -- state->mode = HEAD; -- state->last = 0; -- state->havedict = 0; -- state->dmax = 32768U; -- state->head = Z_NULL; -- state->wsize = 0; -- state->whave = 0; -- state->write = 0; -- state->hold = 0; -- state->bits = 0; -- state->lencode = state->distcode = state->next = state->codes; -- Tracev((stderr, "inflate: reset\n")); -- return Z_OK; --} -- --int ZEXPORT inflatePrime(strm, bits, value) --z_streamp strm; --int bits; --int value; --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR; -- value &= (1L << bits) - 1; -- state->hold += value << state->bits; -- state->bits += bits; -- return Z_OK; --} -- --int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size) --z_streamp strm; --int windowBits; --const char *version; --int stream_size; --{ -- struct inflate_state FAR *state; -- -- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || -- stream_size != (int)(sizeof(z_stream))) -- return Z_VERSION_ERROR; -- if (strm == Z_NULL) return Z_STREAM_ERROR; -- strm->msg = Z_NULL; /* in case we return an error */ -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- state = (struct inflate_state FAR *) -- ZALLOC(strm, 1, sizeof(struct inflate_state)); -- if (state == Z_NULL) return Z_MEM_ERROR; -- Tracev((stderr, "inflate: allocated\n")); -- strm->state = (struct internal_state FAR *)state; -- if (windowBits < 0) { -- state->wrap = 0; -- windowBits = -windowBits; -- } -- else { -- state->wrap = (windowBits >> 4) + 1; --#ifdef GUNZIP -- if (windowBits < 48) windowBits &= 15; --#endif -- } -- if (windowBits < 8 || windowBits > 15) { -- ZFREE(strm, state); -- strm->state = Z_NULL; -- return Z_STREAM_ERROR; -- } -- state->wbits = (unsigned)windowBits; -- state->window = Z_NULL; -- return inflateReset(strm); --} -- --int ZEXPORT inflateInit_(strm, version, stream_size) --z_streamp strm; --const char *version; --int stream_size; --{ -- return inflateInit2_(strm, DEF_WBITS, version, stream_size); --} -- --/* -- Return state with length and distance decoding tables and index sizes set to -- fixed code decoding. Normally this returns fixed tables from inffixed.h. -- If BUILDFIXED is defined, then instead this routine builds the tables the -- first time it's called, and returns those tables the first time and -- thereafter. This reduces the size of the code by about 2K bytes, in -- exchange for a little execution time. However, BUILDFIXED should not be -- used for threaded applications, since the rewriting of the tables and virgin -- may not be thread-safe. -- */ --local void fixedtables(state) --struct inflate_state FAR *state; --{ --#ifdef BUILDFIXED -- static int virgin = 1; -- static code *lenfix, *distfix; -- static code fixed[544]; -- -- /* build fixed huffman tables if first call (may not be thread safe) */ -- if (virgin) { -- unsigned sym, bits; -- static code *next; -- -- /* literal/length table */ -- sym = 0; -- while (sym < 144) state->lens[sym++] = 8; -- while (sym < 256) state->lens[sym++] = 9; -- while (sym < 280) state->lens[sym++] = 7; -- while (sym < 288) state->lens[sym++] = 8; -- next = fixed; -- lenfix = next; -- bits = 9; -- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); -- -- /* distance table */ -- sym = 0; -- while (sym < 32) state->lens[sym++] = 5; -- distfix = next; -- bits = 5; -- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); -- -- /* do this just once */ -- virgin = 0; -- } --#else /* !BUILDFIXED */ --# include "inffixed.h" --#endif /* BUILDFIXED */ -- state->lencode = lenfix; -- state->lenbits = 9; -- state->distcode = distfix; -- state->distbits = 5; --} -- --#ifdef MAKEFIXED --#include -- --/* -- Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also -- defines BUILDFIXED, so the tables are built on the fly. makefixed() writes -- those tables to stdout, which would be piped to inffixed.h. A small program -- can simply call makefixed to do this: -- -- void makefixed(void); -- -- int main(void) -- { -- makefixed(); -- return 0; -- } -- -- Then that can be linked with zlib built with MAKEFIXED defined and run: -- -- a.out > inffixed.h -- */ --void makefixed() --{ -- unsigned low, size; -- struct inflate_state state; -- -- fixedtables(&state); -- puts(" /* inffixed.h -- table for decoding fixed codes"); -- puts(" * Generated automatically by makefixed()."); -- puts(" */"); -- puts(""); -- puts(" /* WARNING: this file should *not* be used by applications."); -- puts(" It is part of the implementation of this library and is"); -- puts(" subject to change. Applications should only use zlib.h."); -- puts(" */"); -- puts(""); -- size = 1U << 9; -- printf(" static const code lenfix[%u] = {", size); -- low = 0; -- for (;;) { -- if ((low % 7) == 0) printf("\n "); -- printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits, -- state.lencode[low].val); -- if (++low == size) break; -- putchar(','); -- } -- puts("\n };"); -- size = 1U << 5; -- printf("\n static const code distfix[%u] = {", size); -- low = 0; -- for (;;) { -- if ((low % 6) == 0) printf("\n "); -- printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, -- state.distcode[low].val); -- if (++low == size) break; -- putchar(','); -- } -- puts("\n };"); --} --#endif /* MAKEFIXED */ -- --/* -- Update the window with the last wsize (normally 32K) bytes written before -- returning. If window does not exist yet, create it. This is only called -- when a window is already in use, or when output has been written during this -- inflate call, but the end of the deflate stream has not been reached yet. -- It is also called to create a window for dictionary data when a dictionary -- is loaded. -- -- Providing output buffers larger than 32K to inflate() should provide a speed -- advantage, since only the last 32K of output is copied to the sliding window -- upon return from inflate(), and since all distances after the first 32K of -- output will fall in the output data, making match copies simpler and faster. -- The advantage may be dependent on the size of the processor's data caches. -- */ --local int updatewindow(strm, out) --z_streamp strm; --unsigned out; --{ -- struct inflate_state FAR *state; -- unsigned copy, dist; -- -- state = (struct inflate_state FAR *)strm->state; -- -- /* if it hasn't been done already, allocate space for the window */ -- if (state->window == Z_NULL) { -- state->window = (unsigned char FAR *) -- ZALLOC(strm, 1U << state->wbits, -- sizeof(unsigned char)); -- if (state->window == Z_NULL) return 1; -- } -- -- /* if window not in use yet, initialize */ -- if (state->wsize == 0) { -- state->wsize = 1U << state->wbits; -- state->write = 0; -- state->whave = 0; -- } -- -- /* copy state->wsize or less output bytes into the circular window */ -- copy = out - strm->avail_out; -- if (copy >= state->wsize) { -- zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); -- state->write = 0; -- state->whave = state->wsize; -- } -- else { -- dist = state->wsize - state->write; -- if (dist > copy) dist = copy; -- zmemcpy(state->window + state->write, strm->next_out - copy, dist); -- copy -= dist; -- if (copy) { -- zmemcpy(state->window, strm->next_out - copy, copy); -- state->write = copy; -- state->whave = state->wsize; -- } -- else { -- state->write += dist; -- if (state->write == state->wsize) state->write = 0; -- if (state->whave < state->wsize) state->whave += dist; -- } -- } -- return 0; --} -- --/* Macros for inflate(): */ -- --/* check function to use adler32() for zlib or crc32() for gzip */ --#ifdef GUNZIP --# define UPDATE(check, buf, len) \ -- (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) --#else --# define UPDATE(check, buf, len) adler32(check, buf, len) --#endif -- --/* check macros for header crc */ --#ifdef GUNZIP --# define CRC2(check, word) \ -- do { \ -- hbuf[0] = (unsigned char)(word); \ -- hbuf[1] = (unsigned char)((word) >> 8); \ -- check = crc32(check, hbuf, 2); \ -- } while (0) -- --# define CRC4(check, word) \ -- do { \ -- hbuf[0] = (unsigned char)(word); \ -- hbuf[1] = (unsigned char)((word) >> 8); \ -- hbuf[2] = (unsigned char)((word) >> 16); \ -- hbuf[3] = (unsigned char)((word) >> 24); \ -- check = crc32(check, hbuf, 4); \ -- } while (0) --#endif -- --/* Load registers with state in inflate() for speed */ --#define LOAD() \ -- do { \ -- put = strm->next_out; \ -- left = strm->avail_out; \ -- next = strm->next_in; \ -- have = strm->avail_in; \ -- hold = state->hold; \ -- bits = state->bits; \ -- } while (0) -- --/* Restore state from registers in inflate() */ --#define RESTORE() \ -- do { \ -- strm->next_out = put; \ -- strm->avail_out = left; \ -- strm->next_in = next; \ -- strm->avail_in = have; \ -- state->hold = hold; \ -- state->bits = bits; \ -- } while (0) -- --/* Clear the input bit accumulator */ --#define INITBITS() \ -- do { \ -- hold = 0; \ -- bits = 0; \ -- } while (0) -- --/* Get a byte of input into the bit accumulator, or return from inflate() -- if there is no input available. */ --#define PULLBYTE() \ -- do { \ -- if (have == 0) goto inf_leave; \ -- have--; \ -- hold += (unsigned long)(*next++) << bits; \ -- bits += 8; \ -- } while (0) -- --/* Assure that there are at least n bits in the bit accumulator. If there is -- not enough available input to do that, then return from inflate(). */ --#define NEEDBITS(n) \ -- do { \ -- while (bits < (unsigned)(n)) \ -- PULLBYTE(); \ -- } while (0) -- --/* Return the low n bits of the bit accumulator (n < 16) */ --#define BITS(n) \ -- ((unsigned)hold & ((1U << (n)) - 1)) -- --/* Remove n bits from the bit accumulator */ --#define DROPBITS(n) \ -- do { \ -- hold >>= (n); \ -- bits -= (unsigned)(n); \ -- } while (0) -- --/* Remove zero to seven bits as needed to go to a byte boundary */ --#define BYTEBITS() \ -- do { \ -- hold >>= bits & 7; \ -- bits -= bits & 7; \ -- } while (0) -- --/* Reverse the bytes in a 32-bit value */ --#define REVERSE(q) \ -- ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ -- (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) -- --/* -- inflate() uses a state machine to process as much input data and generate as -- much output data as possible before returning. The state machine is -- structured roughly as follows: -- -- for (;;) switch (state) { -- ... -- case STATEn: -- if (not enough input data or output space to make progress) -- return; -- ... make progress ... -- state = STATEm; -- break; -- ... -- } -- -- so when inflate() is called again, the same case is attempted again, and -- if the appropriate resources are provided, the machine proceeds to the -- next state. The NEEDBITS() macro is usually the way the state evaluates -- whether it can proceed or should return. NEEDBITS() does the return if -- the requested bits are not available. The typical use of the BITS macros -- is: -- -- NEEDBITS(n); -- ... do something with BITS(n) ... -- DROPBITS(n); -- -- where NEEDBITS(n) either returns from inflate() if there isn't enough -- input left to load n bits into the accumulator, or it continues. BITS(n) -- gives the low n bits in the accumulator. When done, DROPBITS(n) drops -- the low n bits off the accumulator. INITBITS() clears the accumulator -- and sets the number of available bits to zero. BYTEBITS() discards just -- enough bits to put the accumulator on a byte boundary. After BYTEBITS() -- and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. -- -- NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return -- if there is no input available. The decoding of variable length codes uses -- PULLBYTE() directly in order to pull just enough bytes to decode the next -- code, and no more. -- -- Some states loop until they get enough input, making sure that enough -- state information is maintained to continue the loop where it left off -- if NEEDBITS() returns in the loop. For example, want, need, and keep -- would all have to actually be part of the saved state in case NEEDBITS() -- returns: -- -- case STATEw: -- while (want < need) { -- NEEDBITS(n); -- keep[want++] = BITS(n); -- DROPBITS(n); -- } -- state = STATEx; -- case STATEx: -- -- As shown above, if the next state is also the next case, then the break -- is omitted. -- -- A state may also return if there is not enough output space available to -- complete that state. Those states are copying stored data, writing a -- literal byte, and copying a matching string. -- -- When returning, a "goto inf_leave" is used to update the total counters, -- update the check value, and determine whether any progress has been made -- during that inflate() call in order to return the proper return code. -- Progress is defined as a change in either strm->avail_in or strm->avail_out. -- When there is a window, goto inf_leave will update the window with the last -- output written. If a goto inf_leave occurs in the middle of decompression -- and there is no window currently, goto inf_leave will create one and copy -- output to the window for the next call of inflate(). -- -- In this implementation, the flush parameter of inflate() only affects the -- return code (per zlib.h). inflate() always writes as much as possible to -- strm->next_out, given the space available and the provided input--the effect -- documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers -- the allocation of and copying into a sliding window until necessary, which -- provides the effect documented in zlib.h for Z_FINISH when the entire input -- stream available. So the only thing the flush parameter actually does is: -- when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it -- will return Z_BUF_ERROR if it has not reached the end of the stream. -- */ -- --int ZEXPORT inflate(strm, flush) --z_streamp strm; --int flush; --{ -- struct inflate_state FAR *state; -- unsigned char FAR *next; /* next input */ -- unsigned char FAR *put; /* next output */ -- unsigned have, left; /* available input and output */ -- unsigned long hold; /* bit buffer */ -- unsigned bits; /* bits in bit buffer */ -- unsigned in, out; /* save starting available input and output */ -- unsigned copy; /* number of stored or match bytes to copy */ -- unsigned char FAR *from; /* where to copy match bytes from */ -- code this; /* current decoding table entry */ -- code last; /* parent table entry */ -- unsigned len; /* length to copy for repeats, bits to drop */ -- int ret; /* return code */ --#ifdef GUNZIP -- unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ --#endif -- static const unsigned short order[19] = /* permutation of code lengths */ -- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; -- -- if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL || -- (strm->next_in == Z_NULL && strm->avail_in != 0)) -- return Z_STREAM_ERROR; -- -- state = (struct inflate_state FAR *)strm->state; -- if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ -- LOAD(); -- in = have; -- out = left; -- ret = Z_OK; -- for (;;) -- switch (state->mode) { -- case HEAD: -- if (state->wrap == 0) { -- state->mode = TYPEDO; -- break; -- } -- NEEDBITS(16); --#ifdef GUNZIP -- if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ -- state->check = crc32(0L, Z_NULL, 0); -- CRC2(state->check, hold); -- INITBITS(); -- state->mode = FLAGS; -- break; -- } -- state->flags = 0; /* expect zlib header */ -- if (state->head != Z_NULL) -- state->head->done = -1; -- if (!(state->wrap & 1) || /* check if zlib header allowed */ --#else -- if ( --#endif -- ((BITS(8) << 8) + (hold >> 8)) % 31) { -- strm->msg = (char *)"incorrect header check"; -- state->mode = BAD; -- break; -- } -- if (BITS(4) != Z_DEFLATED) { -- strm->msg = (char *)"unknown compression method"; -- state->mode = BAD; -- break; -- } -- DROPBITS(4); -- len = BITS(4) + 8; -- if (len > state->wbits) { -- strm->msg = (char *)"invalid window size"; -- state->mode = BAD; -- break; -- } -- state->dmax = 1U << len; -- Tracev((stderr, "inflate: zlib header ok\n")); -- strm->adler = state->check = adler32(0L, Z_NULL, 0); -- state->mode = hold & 0x200 ? DICTID : TYPE; -- INITBITS(); -- break; --#ifdef GUNZIP -- case FLAGS: -- NEEDBITS(16); -- state->flags = (int)(hold); -- if ((state->flags & 0xff) != Z_DEFLATED) { -- strm->msg = (char *)"unknown compression method"; -- state->mode = BAD; -- break; -- } -- if (state->flags & 0xe000) { -- strm->msg = (char *)"unknown header flags set"; -- state->mode = BAD; -- break; -- } -- if (state->head != Z_NULL) -- state->head->text = (int)((hold >> 8) & 1); -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- state->mode = TIME; -- case TIME: -- NEEDBITS(32); -- if (state->head != Z_NULL) -- state->head->time = hold; -- if (state->flags & 0x0200) CRC4(state->check, hold); -- INITBITS(); -- state->mode = OS; -- case OS: -- NEEDBITS(16); -- if (state->head != Z_NULL) { -- state->head->xflags = (int)(hold & 0xff); -- state->head->os = (int)(hold >> 8); -- } -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- state->mode = EXLEN; -- case EXLEN: -- if (state->flags & 0x0400) { -- NEEDBITS(16); -- state->length = (unsigned)(hold); -- if (state->head != Z_NULL) -- state->head->extra_len = (unsigned)hold; -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- } -- else if (state->head != Z_NULL) -- state->head->extra = Z_NULL; -- state->mode = EXTRA; -- case EXTRA: -- if (state->flags & 0x0400) { -- copy = state->length; -- if (copy > have) copy = have; -- if (copy) { -- if (state->head != Z_NULL && -- state->head->extra != Z_NULL) { -- len = state->head->extra_len - state->length; -- zmemcpy(state->head->extra + len, next, -- len + copy > state->head->extra_max ? -- state->head->extra_max - len : copy); -- } -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- state->length -= copy; -- } -- if (state->length) goto inf_leave; -- } -- state->length = 0; -- state->mode = NAME; -- case NAME: -- if (state->flags & 0x0800) { -- if (have == 0) goto inf_leave; -- copy = 0; -- do { -- len = (unsigned)(next[copy++]); -- if (state->head != Z_NULL && -- state->head->name != Z_NULL && -- state->length < state->head->name_max) -- state->head->name[state->length++] = len; -- } while (len && copy < have); -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- if (len) goto inf_leave; -- } -- else if (state->head != Z_NULL) -- state->head->name = Z_NULL; -- state->length = 0; -- state->mode = COMMENT; -- case COMMENT: -- if (state->flags & 0x1000) { -- if (have == 0) goto inf_leave; -- copy = 0; -- do { -- len = (unsigned)(next[copy++]); -- if (state->head != Z_NULL && -- state->head->comment != Z_NULL && -- state->length < state->head->comm_max) -- state->head->comment[state->length++] = len; -- } while (len && copy < have); -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- if (len) goto inf_leave; -- } -- else if (state->head != Z_NULL) -- state->head->comment = Z_NULL; -- state->mode = HCRC; -- case HCRC: -- if (state->flags & 0x0200) { -- NEEDBITS(16); -- if (hold != (state->check & 0xffff)) { -- strm->msg = (char *)"header crc mismatch"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- } -- if (state->head != Z_NULL) { -- state->head->hcrc = (int)((state->flags >> 9) & 1); -- state->head->done = 1; -- } -- strm->adler = state->check = crc32(0L, Z_NULL, 0); -- state->mode = TYPE; -- break; --#endif -- case DICTID: -- NEEDBITS(32); -- strm->adler = state->check = REVERSE(hold); -- INITBITS(); -- state->mode = DICT; -- case DICT: -- if (state->havedict == 0) { -- RESTORE(); -- return Z_NEED_DICT; -- } -- strm->adler = state->check = adler32(0L, Z_NULL, 0); -- state->mode = TYPE; -- case TYPE: -- if (flush == Z_BLOCK) goto inf_leave; -- case TYPEDO: -- if (state->last) { -- BYTEBITS(); -- state->mode = CHECK; -- break; -- } -- NEEDBITS(3); -- state->last = BITS(1); -- DROPBITS(1); -- switch (BITS(2)) { -- case 0: /* stored block */ -- Tracev((stderr, "inflate: stored block%s\n", -- state->last ? " (last)" : "")); -- state->mode = STORED; -- break; -- case 1: /* fixed block */ -- fixedtables(state); -- Tracev((stderr, "inflate: fixed codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = LEN; /* decode codes */ -- break; -- case 2: /* dynamic block */ -- Tracev((stderr, "inflate: dynamic codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = TABLE; -- break; -- case 3: -- strm->msg = (char *)"invalid block type"; -- state->mode = BAD; -- } -- DROPBITS(2); -- break; -- case STORED: -- BYTEBITS(); /* go to byte boundary */ -- NEEDBITS(32); -- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { -- strm->msg = (char *)"invalid stored block lengths"; -- state->mode = BAD; -- break; -- } -- state->length = (unsigned)hold & 0xffff; -- Tracev((stderr, "inflate: stored length %u\n", -- state->length)); -- INITBITS(); -- state->mode = COPY; -- case COPY: -- copy = state->length; -- if (copy) { -- if (copy > have) copy = have; -- if (copy > left) copy = left; -- if (copy == 0) goto inf_leave; -- zmemcpy(put, next, copy); -- have -= copy; -- next += copy; -- left -= copy; -- put += copy; -- state->length -= copy; -- break; -- } -- Tracev((stderr, "inflate: stored end\n")); -- state->mode = TYPE; -- break; -- case TABLE: -- NEEDBITS(14); -- state->nlen = BITS(5) + 257; -- DROPBITS(5); -- state->ndist = BITS(5) + 1; -- DROPBITS(5); -- state->ncode = BITS(4) + 4; -- DROPBITS(4); --#ifndef PKZIP_BUG_WORKAROUND -- if (state->nlen > 286 || state->ndist > 30) { -- strm->msg = (char *)"too many length or distance symbols"; -- state->mode = BAD; -- break; -- } --#endif -- Tracev((stderr, "inflate: table sizes ok\n")); -- state->have = 0; -- state->mode = LENLENS; -- case LENLENS: -- while (state->have < state->ncode) { -- NEEDBITS(3); -- state->lens[order[state->have++]] = (unsigned short)BITS(3); -- DROPBITS(3); -- } -- while (state->have < 19) -- state->lens[order[state->have++]] = 0; -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 7; -- ret = inflate_table(CODES, state->lens, 19, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid code lengths set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: code lengths ok\n")); -- state->have = 0; -- state->mode = CODELENS; -- case CODELENS: -- while (state->have < state->nlen + state->ndist) { -- for (;;) { -- this = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if (this.val < 16) { -- NEEDBITS(this.bits); -- DROPBITS(this.bits); -- state->lens[state->have++] = this.val; -- } -- else { -- if (this.val == 16) { -- NEEDBITS(this.bits + 2); -- DROPBITS(this.bits); -- if (state->have == 0) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- len = state->lens[state->have - 1]; -- copy = 3 + BITS(2); -- DROPBITS(2); -- } -- else if (this.val == 17) { -- NEEDBITS(this.bits + 3); -- DROPBITS(this.bits); -- len = 0; -- copy = 3 + BITS(3); -- DROPBITS(3); -- } -- else { -- NEEDBITS(this.bits + 7); -- DROPBITS(this.bits); -- len = 0; -- copy = 11 + BITS(7); -- DROPBITS(7); -- } -- if (state->have + copy > state->nlen + state->ndist) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- while (copy--) -- state->lens[state->have++] = (unsigned short)len; -- } -- } -- -- /* handle error breaks in while */ -- if (state->mode == BAD) break; -- -- /* build code tables */ -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 9; -- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid literal/lengths set"; -- state->mode = BAD; -- break; -- } -- state->distcode = (code const FAR *)(state->next); -- state->distbits = 6; -- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, -- &(state->next), &(state->distbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid distances set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: codes ok\n")); -- state->mode = LEN; -- case LEN: -- if (have >= 6 && left >= 258) { -- RESTORE(); -- inflate_fast(strm, out); -- LOAD(); -- break; -- } -- for (;;) { -- this = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if (this.op && (this.op & 0xf0) == 0) { -- last = this; -- for (;;) { -- this = state->lencode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + this.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(this.bits); -- state->length = (unsigned)this.val; -- if ((int)(this.op) == 0) { -- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", this.val)); -- state->mode = LIT; -- break; -- } -- if (this.op & 32) { -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- if (this.op & 64) { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- state->extra = (unsigned)(this.op) & 15; -- state->mode = LENEXT; -- case LENEXT: -- if (state->extra) { -- NEEDBITS(state->extra); -- state->length += BITS(state->extra); -- DROPBITS(state->extra); -- } -- Tracevv((stderr, "inflate: length %u\n", state->length)); -- state->mode = DIST; -- case DIST: -- for (;;) { -- this = state->distcode[BITS(state->distbits)]; -- if ((unsigned)(this.bits) <= bits) break; -- PULLBYTE(); -- } -- if ((this.op & 0xf0) == 0) { -- last = this; -- for (;;) { -- this = state->distcode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + this.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(this.bits); -- if (this.op & 64) { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- state->offset = (unsigned)this.val; -- state->extra = (unsigned)(this.op) & 15; -- state->mode = DISTEXT; -- case DISTEXT: -- if (state->extra) { -- NEEDBITS(state->extra); -- state->offset += BITS(state->extra); -- DROPBITS(state->extra); -- } --#ifdef INFLATE_STRICT -- if (state->offset > state->dmax) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } --#endif -- if (state->offset > state->whave + out - left) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- Tracevv((stderr, "inflate: distance %u\n", state->offset)); -- state->mode = MATCH; -- case MATCH: -- if (left == 0) goto inf_leave; -- copy = out - left; -- if (state->offset > copy) { /* copy from window */ -- copy = state->offset - copy; -- if (copy > state->write) { -- copy -= state->write; -- from = state->window + (state->wsize - copy); -- } -- else -- from = state->window + (state->write - copy); -- if (copy > state->length) copy = state->length; -- } -- else { /* copy from output */ -- from = put - state->offset; -- copy = state->length; -- } -- if (copy > left) copy = left; -- left -= copy; -- state->length -= copy; -- do { -- *put++ = *from++; -- } while (--copy); -- if (state->length == 0) state->mode = LEN; -- break; -- case LIT: -- if (left == 0) goto inf_leave; -- *put++ = (unsigned char)(state->length); -- left--; -- state->mode = LEN; -- break; -- case CHECK: -- if (state->wrap) { -- NEEDBITS(32); -- out -= left; -- strm->total_out += out; -- state->total += out; -- if (out) -- strm->adler = state->check = -- UPDATE(state->check, put - out, out); -- out = left; -- if (( --#ifdef GUNZIP -- state->flags ? hold : --#endif -- REVERSE(hold)) != state->check) { -- strm->msg = (char *)"incorrect data check"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- Tracev((stderr, "inflate: check matches trailer\n")); -- } --#ifdef GUNZIP -- state->mode = LENGTH; -- case LENGTH: -- if (state->wrap && state->flags) { -- NEEDBITS(32); -- if (hold != (state->total & 0xffffffffUL)) { -- strm->msg = (char *)"incorrect length check"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- Tracev((stderr, "inflate: length matches trailer\n")); -- } --#endif -- state->mode = DONE; -- case DONE: -- ret = Z_STREAM_END; -- goto inf_leave; -- case BAD: -- ret = Z_DATA_ERROR; -- goto inf_leave; -- case MEM: -- return Z_MEM_ERROR; -- case SYNC: -- default: -- return Z_STREAM_ERROR; -- } -- -- /* -- Return from inflate(), updating the total counts and the check value. -- If there was no progress during the inflate() call, return a buffer -- error. Call updatewindow() to create and/or update the window state. -- Note: a memory error from inflate() is non-recoverable. -- */ -- inf_leave: -- RESTORE(); -- if (state->wsize || (state->mode < CHECK && out != strm->avail_out)) -- if (updatewindow(strm, out)) { -- state->mode = MEM; -- return Z_MEM_ERROR; -- } -- in -= strm->avail_in; -- out -= strm->avail_out; -- strm->total_in += in; -- strm->total_out += out; -- state->total += out; -- if (state->wrap && out) -- strm->adler = state->check = -- UPDATE(state->check, strm->next_out - out, out); -- strm->data_type = state->bits + (state->last ? 64 : 0) + -- (state->mode == TYPE ? 128 : 0); -- if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) -- ret = Z_BUF_ERROR; -- return ret; --} -- --int ZEXPORT inflateEnd(strm) --z_streamp strm; --{ -- struct inflate_state FAR *state; -- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (state->window != Z_NULL) ZFREE(strm, state->window); -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- Tracev((stderr, "inflate: end\n")); -- return Z_OK; --} -- --int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength) --z_streamp strm; --const Bytef *dictionary; --uInt dictLength; --{ -- struct inflate_state FAR *state; -- unsigned long id; -- -- /* check state */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (state->wrap != 0 && state->mode != DICT) -- return Z_STREAM_ERROR; -- -- /* check for correct dictionary id */ -- if (state->mode == DICT) { -- id = adler32(0L, Z_NULL, 0); -- id = adler32(id, dictionary, dictLength); -- if (id != state->check) -- return Z_DATA_ERROR; -- } -- -- /* copy dictionary to window */ -- if (updatewindow(strm, strm->avail_out)) { -- state->mode = MEM; -- return Z_MEM_ERROR; -- } -- if (dictLength > state->wsize) { -- zmemcpy(state->window, dictionary + dictLength - state->wsize, -- state->wsize); -- state->whave = state->wsize; -- } -- else { -- zmemcpy(state->window + state->wsize - dictLength, dictionary, -- dictLength); -- state->whave = dictLength; -- } -- state->havedict = 1; -- Tracev((stderr, "inflate: dictionary set\n")); -- return Z_OK; --} -- --int ZEXPORT inflateGetHeader(strm, head) --z_streamp strm; --gz_headerp head; --{ -- struct inflate_state FAR *state; -- -- /* check state */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; -- -- /* save header structure */ -- state->head = head; -- head->done = 0; -- return Z_OK; --} -- --/* -- Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found -- or when out of input. When called, *have is the number of pattern bytes -- found in order so far, in 0..3. On return *have is updated to the new -- state. If on return *have equals four, then the pattern was found and the -- return value is how many bytes were read including the last byte of the -- pattern. If *have is less than four, then the pattern has not been found -- yet and the return value is len. In the latter case, syncsearch() can be -- called again with more data and the *have state. *have is initialized to -- zero for the first call. -- */ --local unsigned syncsearch(have, buf, len) --unsigned FAR *have; --unsigned char FAR *buf; --unsigned len; --{ -- unsigned got; -- unsigned next; -- -- got = *have; -- next = 0; -- while (next < len && got < 4) { -- if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) -- got++; -- else if (buf[next]) -- got = 0; -- else -- got = 4 - got; -- next++; -- } -- *have = got; -- return next; --} -- --int ZEXPORT inflateSync(strm) --z_streamp strm; --{ -- unsigned len; /* number of bytes to look at or looked at */ -- unsigned long in, out; /* temporary to save total_in and total_out */ -- unsigned char buf[4]; /* to restore bit buffer to byte string */ -- struct inflate_state FAR *state; -- -- /* check parameters */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; -- -- /* if first time, start search in bit buffer */ -- if (state->mode != SYNC) { -- state->mode = SYNC; -- state->hold <<= state->bits & 7; -- state->bits -= state->bits & 7; -- len = 0; -- while (state->bits >= 8) { -- buf[len++] = (unsigned char)(state->hold); -- state->hold >>= 8; -- state->bits -= 8; -- } -- state->have = 0; -- syncsearch(&(state->have), buf, len); -- } -- -- /* search available input */ -- len = syncsearch(&(state->have), strm->next_in, strm->avail_in); -- strm->avail_in -= len; -- strm->next_in += len; -- strm->total_in += len; -- -- /* return no joy or set up to restart inflate() on a new block */ -- if (state->have != 4) return Z_DATA_ERROR; -- in = strm->total_in; out = strm->total_out; -- inflateReset(strm); -- strm->total_in = in; strm->total_out = out; -- state->mode = TYPE; -- return Z_OK; --} -- --/* -- Returns true if inflate is currently at the end of a block generated by -- Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP -- implementation to provide an additional safety check. PPP uses -- Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored -- block. When decompressing, PPP checks that at the end of input packet, -- inflate is waiting for these length bytes. -- */ --int ZEXPORT inflateSyncPoint(strm) --z_streamp strm; --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- return state->mode == STORED && state->bits == 0; --} -- --int ZEXPORT inflateCopy(dest, source) --z_streamp dest; --z_streamp source; --{ -- struct inflate_state FAR *state; -- struct inflate_state FAR *copy; -- unsigned char FAR *window; -- unsigned wsize; -- -- /* check input */ -- if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL || -- source->zalloc == (alloc_func)0 || source->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)source->state; -- -- /* allocate space */ -- copy = (struct inflate_state FAR *) -- ZALLOC(source, 1, sizeof(struct inflate_state)); -- if (copy == Z_NULL) return Z_MEM_ERROR; -- window = Z_NULL; -- if (state->window != Z_NULL) { -- window = (unsigned char FAR *) -- ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); -- if (window == Z_NULL) { -- ZFREE(source, copy); -- return Z_MEM_ERROR; -- } -- } -- -- /* copy state */ -- zmemcpy(dest, source, sizeof(z_stream)); -- zmemcpy(copy, state, sizeof(struct inflate_state)); -- if (state->lencode >= state->codes && -- state->lencode <= state->codes + ENOUGH - 1) { -- copy->lencode = copy->codes + (state->lencode - state->codes); -- copy->distcode = copy->codes + (state->distcode - state->codes); -- } -- copy->next = copy->codes + (state->next - state->codes); -- if (window != Z_NULL) { -- wsize = 1U << state->wbits; -- zmemcpy(window, state->window, wsize); -- } -- copy->window = window; -- dest->state = (struct internal_state FAR *)copy; -- return Z_OK; --} -diff -ruN RJaCGH.orig/src/inflate.h RJaCGH/src/inflate.h ---- RJaCGH.orig/src/inflate.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inflate.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,115 +0,0 @@ --/* inflate.h -- internal inflate state definition -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* define NO_GZIP when compiling if you want to disable gzip header and -- trailer decoding by inflate(). NO_GZIP would be used to avoid linking in -- the crc code when it is not needed. For shared libraries, gzip decoding -- should be left enabled. */ --#ifndef NO_GZIP --# define GUNZIP --#endif -- --/* Possible inflate modes between inflate() calls */ --typedef enum { -- HEAD, /* i: waiting for magic header */ -- FLAGS, /* i: waiting for method and flags (gzip) */ -- TIME, /* i: waiting for modification time (gzip) */ -- OS, /* i: waiting for extra flags and operating system (gzip) */ -- EXLEN, /* i: waiting for extra length (gzip) */ -- EXTRA, /* i: waiting for extra bytes (gzip) */ -- NAME, /* i: waiting for end of file name (gzip) */ -- COMMENT, /* i: waiting for end of comment (gzip) */ -- HCRC, /* i: waiting for header crc (gzip) */ -- DICTID, /* i: waiting for dictionary check value */ -- DICT, /* waiting for inflateSetDictionary() call */ -- TYPE, /* i: waiting for type bits, including last-flag bit */ -- TYPEDO, /* i: same, but skip check to exit inflate on new block */ -- STORED, /* i: waiting for stored size (length and complement) */ -- COPY, /* i/o: waiting for input or output to copy stored block */ -- TABLE, /* i: waiting for dynamic block table lengths */ -- LENLENS, /* i: waiting for code length code lengths */ -- CODELENS, /* i: waiting for length/lit and distance code lengths */ -- LEN, /* i: waiting for length/lit code */ -- LENEXT, /* i: waiting for length extra bits */ -- DIST, /* i: waiting for distance code */ -- DISTEXT, /* i: waiting for distance extra bits */ -- MATCH, /* o: waiting for output space to copy string */ -- LIT, /* o: waiting for output space to write literal */ -- CHECK, /* i: waiting for 32-bit check value */ -- LENGTH, /* i: waiting for 32-bit length (gzip) */ -- DONE, /* finished check, done -- remain here until reset */ -- BAD, /* got a data error -- remain here until reset */ -- MEM, /* got an inflate() memory error -- remain here until reset */ -- SYNC /* looking for synchronization bytes to restart inflate() */ --} inflate_mode; -- --/* -- State transitions between above modes - -- -- (most modes can go to the BAD or MEM mode -- not shown for clarity) -- -- Process header: -- HEAD -> (gzip) or (zlib) -- (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -- NAME -> COMMENT -> HCRC -> TYPE -- (zlib) -> DICTID or TYPE -- DICTID -> DICT -> TYPE -- Read deflate blocks: -- TYPE -> STORED or TABLE or LEN or CHECK -- STORED -> COPY -> TYPE -- TABLE -> LENLENS -> CODELENS -> LEN -- Read deflate codes: -- LEN -> LENEXT or LIT or TYPE -- LENEXT -> DIST -> DISTEXT -> MATCH -> LEN -- LIT -> LEN -- Process trailer: -- CHECK -> LENGTH -> DONE -- */ -- --/* state maintained between inflate() calls. Approximately 7K bytes. */ --struct inflate_state { -- inflate_mode mode; /* current inflate mode */ -- int last; /* true if processing last block */ -- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ -- int havedict; /* true if dictionary provided */ -- int flags; /* gzip header method and flags (0 if zlib) */ -- unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ -- unsigned long check; /* protected copy of check value */ -- unsigned long total; /* protected copy of output count */ -- gz_headerp head; /* where to save gzip header information */ -- /* sliding window */ -- unsigned wbits; /* log base 2 of requested window size */ -- unsigned wsize; /* window size or zero if not using window */ -- unsigned whave; /* valid bytes in the window */ -- unsigned write; /* window write index */ -- unsigned char FAR *window; /* allocated sliding window, if needed */ -- /* bit accumulator */ -- unsigned long hold; /* input bit accumulator */ -- unsigned bits; /* number of bits in "in" */ -- /* for string and stored block copying */ -- unsigned length; /* literal or length of data to copy */ -- unsigned offset; /* distance back to copy string from */ -- /* for table and code decoding */ -- unsigned extra; /* extra bits needed */ -- /* fixed and dynamic code tables */ -- code const FAR *lencode; /* starting table for length/literal codes */ -- code const FAR *distcode; /* starting table for distance codes */ -- unsigned lenbits; /* index bits for lencode */ -- unsigned distbits; /* index bits for distcode */ -- /* dynamic table building */ -- unsigned ncode; /* number of code length code lengths */ -- unsigned nlen; /* number of length code lengths */ -- unsigned ndist; /* number of distance code lengths */ -- unsigned have; /* number of code lengths in lens[] */ -- code FAR *next; /* next available space in codes[] */ -- unsigned short lens[320]; /* temporary storage for code lengths */ -- unsigned short work[288]; /* work area for code table building */ -- code codes[ENOUGH]; /* space for code tables */ --}; -diff -ruN RJaCGH.orig/src/inftrees.c RJaCGH/src/inftrees.c ---- RJaCGH.orig/src/inftrees.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inftrees.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,329 +0,0 @@ --/* inftrees.c -- generate Huffman trees for efficient decoding -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --#include "zutil.h" --#include "inftrees.h" -- --#define MAXBITS 15 -- --const char inflate_copyright[] = -- " inflate 1.2.3 Copyright 1995-2005 Mark Adler "; --/* -- If you use the zlib library in a product, an acknowledgment is welcome -- in the documentation of your product. If for some reason you cannot -- include such an acknowledgment, I would appreciate that you keep this -- copyright string in the executable of your product. -- */ -- --/* -- Build a set of tables to decode the provided canonical Huffman code. -- The code lengths are lens[0..codes-1]. The result starts at *table, -- whose indices are 0..2^bits-1. work is a writable array of at least -- lens shorts, which is used as a work area. type is the type of code -- to be generated, CODES, LENS, or DISTS. On return, zero is success, -- -1 is an invalid code, and +1 means that ENOUGH isn't enough. table -- on return points to the next available entry's address. bits is the -- requested root table index bits, and on return it is the actual root -- table index bits. It will differ if the request is greater than the -- longest code or if it is less than the shortest code. -- */ --int inflate_table(type, lens, codes, table, bits, work) --codetype type; --unsigned short FAR *lens; --unsigned codes; --code FAR * FAR *table; --unsigned FAR *bits; --unsigned short FAR *work; --{ -- unsigned len; /* a code's length in bits */ -- unsigned sym; /* index of code symbols */ -- unsigned min, max; /* minimum and maximum code lengths */ -- unsigned root; /* number of index bits for root table */ -- unsigned curr; /* number of index bits for current table */ -- unsigned drop; /* code bits to drop for sub-table */ -- int left; /* number of prefix codes available */ -- unsigned used; /* code entries in table used */ -- unsigned huff; /* Huffman code */ -- unsigned incr; /* for incrementing code, index */ -- unsigned fill; /* index for replicating entries */ -- unsigned low; /* low bits for current root entry */ -- unsigned mask; /* mask for low root bits */ -- code this; /* table entry for duplication */ -- code FAR *next; /* next available space in table */ -- const unsigned short FAR *base; /* base value table to use */ -- const unsigned short FAR *extra; /* extra bits table to use */ -- int end; /* use base and extra for symbol > end */ -- unsigned short count[MAXBITS+1]; /* number of codes of each length */ -- unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ -- static const unsigned short lbase[31] = { /* Length codes 257..285 base */ -- 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, -- 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; -- static const unsigned short lext[31] = { /* Length codes 257..285 extra */ -- 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, -- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 201, 196}; -- static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ -- 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, -- 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, -- 8193, 12289, 16385, 24577, 0, 0}; -- static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ -- 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, -- 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, -- 28, 28, 29, 29, 64, 64}; -- -- /* -- Process a set of code lengths to create a canonical Huffman code. The -- code lengths are lens[0..codes-1]. Each length corresponds to the -- symbols 0..codes-1. The Huffman code is generated by first sorting the -- symbols by length from short to long, and retaining the symbol order -- for codes with equal lengths. Then the code starts with all zero bits -- for the first code of the shortest length, and the codes are integer -- increments for the same length, and zeros are appended as the length -- increases. For the deflate format, these bits are stored backwards -- from their more natural integer increment ordering, and so when the -- decoding tables are built in the large loop below, the integer codes -- are incremented backwards. -- -- This routine assumes, but does not check, that all of the entries in -- lens[] are in the range 0..MAXBITS. The caller must assure this. -- 1..MAXBITS is interpreted as that code length. zero means that that -- symbol does not occur in this code. -- -- The codes are sorted by computing a count of codes for each length, -- creating from that a table of starting indices for each length in the -- sorted table, and then entering the symbols in order in the sorted -- table. The sorted table is work[], with that space being provided by -- the caller. -- -- The length counts are used for other purposes as well, i.e. finding -- the minimum and maximum length codes, determining if there are any -- codes at all, checking for a valid set of lengths, and looking ahead -- at length counts to determine sub-table sizes when building the -- decoding tables. -- */ -- -- /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ -- for (len = 0; len <= MAXBITS; len++) -- count[len] = 0; -- for (sym = 0; sym < codes; sym++) -- count[lens[sym]]++; -- -- /* bound code lengths, force root to be within code lengths */ -- root = *bits; -- for (max = MAXBITS; max >= 1; max--) -- if (count[max] != 0) break; -- if (root > max) root = max; -- if (max == 0) { /* no symbols to code at all */ -- this.op = (unsigned char)64; /* invalid code marker */ -- this.bits = (unsigned char)1; -- this.val = (unsigned short)0; -- *(*table)++ = this; /* make a table to force an error */ -- *(*table)++ = this; -- *bits = 1; -- return 0; /* no symbols, but wait for decoding to report error */ -- } -- for (min = 1; min <= MAXBITS; min++) -- if (count[min] != 0) break; -- if (root < min) root = min; -- -- /* check for an over-subscribed or incomplete set of lengths */ -- left = 1; -- for (len = 1; len <= MAXBITS; len++) { -- left <<= 1; -- left -= count[len]; -- if (left < 0) return -1; /* over-subscribed */ -- } -- if (left > 0 && (type == CODES || max != 1)) -- return -1; /* incomplete set */ -- -- /* generate offsets into symbol table for each length for sorting */ -- offs[1] = 0; -- for (len = 1; len < MAXBITS; len++) -- offs[len + 1] = offs[len] + count[len]; -- -- /* sort symbols by length, by symbol order within each length */ -- for (sym = 0; sym < codes; sym++) -- if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; -- -- /* -- Create and fill in decoding tables. In this loop, the table being -- filled is at next and has curr index bits. The code being used is huff -- with length len. That code is converted to an index by dropping drop -- bits off of the bottom. For codes where len is less than drop + curr, -- those top drop + curr - len bits are incremented through all values to -- fill the table with replicated entries. -- -- root is the number of index bits for the root table. When len exceeds -- root, sub-tables are created pointed to by the root entry with an index -- of the low root bits of huff. This is saved in low to check for when a -- new sub-table should be started. drop is zero when the root table is -- being filled, and drop is root when sub-tables are being filled. -- -- When a new sub-table is needed, it is necessary to look ahead in the -- code lengths to determine what size sub-table is needed. The length -- counts are used for this, and so count[] is decremented as codes are -- entered in the tables. -- -- used keeps track of how many table entries have been allocated from the -- provided *table space. It is checked when a LENS table is being made -- against the space in *table, ENOUGH, minus the maximum space needed by -- the worst case distance code, MAXD. This should never happen, but the -- sufficiency of ENOUGH has not been proven exhaustively, hence the check. -- This assumes that when type == LENS, bits == 9. -- -- sym increments through all symbols, and the loop terminates when -- all codes of length max, i.e. all codes, have been processed. This -- routine permits incomplete codes, so another loop after this one fills -- in the rest of the decoding tables with invalid code markers. -- */ -- -- /* set up for code type */ -- switch (type) { -- case CODES: -- base = extra = work; /* dummy value--not used */ -- end = 19; -- break; -- case LENS: -- base = lbase; -- base -= 257; -- extra = lext; -- extra -= 257; -- end = 256; -- break; -- default: /* DISTS */ -- base = dbase; -- extra = dext; -- end = -1; -- } -- -- /* initialize state for loop */ -- huff = 0; /* starting code */ -- sym = 0; /* starting code symbol */ -- len = min; /* starting code length */ -- next = *table; /* current table to fill in */ -- curr = root; /* current table index bits */ -- drop = 0; /* current bits to drop from code for index */ -- low = (unsigned)(-1); /* trigger new sub-table when len > root */ -- used = 1U << root; /* use root table entries */ -- mask = used - 1; /* mask for comparing low */ -- -- /* check available table space */ -- if (type == LENS && used >= ENOUGH - MAXD) -- return 1; -- -- /* process all codes and make table entries */ -- for (;;) { -- /* create table entry */ -- this.bits = (unsigned char)(len - drop); -- if ((int)(work[sym]) < end) { -- this.op = (unsigned char)0; -- this.val = work[sym]; -- } -- else if ((int)(work[sym]) > end) { -- this.op = (unsigned char)(extra[work[sym]]); -- this.val = base[work[sym]]; -- } -- else { -- this.op = (unsigned char)(32 + 64); /* end of block */ -- this.val = 0; -- } -- -- /* replicate for those indices with low len bits equal to huff */ -- incr = 1U << (len - drop); -- fill = 1U << curr; -- min = fill; /* save offset to next table */ -- do { -- fill -= incr; -- next[(huff >> drop) + fill] = this; -- } while (fill != 0); -- -- /* backwards increment the len-bit code huff */ -- incr = 1U << (len - 1); -- while (huff & incr) -- incr >>= 1; -- if (incr != 0) { -- huff &= incr - 1; -- huff += incr; -- } -- else -- huff = 0; -- -- /* go to next symbol, update count, len */ -- sym++; -- if (--(count[len]) == 0) { -- if (len == max) break; -- len = lens[work[sym]]; -- } -- -- /* create new sub-table if needed */ -- if (len > root && (huff & mask) != low) { -- /* if first time, transition to sub-tables */ -- if (drop == 0) -- drop = root; -- -- /* increment past last table */ -- next += min; /* here min is 1 << curr */ -- -- /* determine length of next table */ -- curr = len - drop; -- left = (int)(1 << curr); -- while (curr + drop < max) { -- left -= count[curr + drop]; -- if (left <= 0) break; -- curr++; -- left <<= 1; -- } -- -- /* check for enough space */ -- used += 1U << curr; -- if (type == LENS && used >= ENOUGH - MAXD) -- return 1; -- -- /* point entry in root table to sub-table */ -- low = huff & mask; -- (*table)[low].op = (unsigned char)curr; -- (*table)[low].bits = (unsigned char)root; -- (*table)[low].val = (unsigned short)(next - *table); -- } -- } -- -- /* -- Fill in rest of table for incomplete codes. This loop is similar to the -- loop above in incrementing huff for table indices. It is assumed that -- len is equal to curr + drop, so there is no loop needed to increment -- through high index bits. When the current sub-table is filled, the loop -- drops back to the root table to fill in any remaining entries there. -- */ -- this.op = (unsigned char)64; /* invalid code marker */ -- this.bits = (unsigned char)(len - drop); -- this.val = (unsigned short)0; -- while (huff != 0) { -- /* when done with sub-table, drop back to root table */ -- if (drop != 0 && (huff & mask) != low) { -- drop = 0; -- len = root; -- next = *table; -- this.bits = (unsigned char)len; -- } -- -- /* put invalid code marker in table */ -- next[huff >> drop] = this; -- -- /* backwards increment the len-bit code huff */ -- incr = 1U << (len - 1); -- while (huff & incr) -- incr >>= 1; -- if (incr != 0) { -- huff &= incr - 1; -- huff += incr; -- } -- else -- huff = 0; -- } -- -- /* set return parameters */ -- *table += used; -- *bits = root; -- return 0; --} -diff -ruN RJaCGH.orig/src/inftrees.h RJaCGH/src/inftrees.h ---- RJaCGH.orig/src/inftrees.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/inftrees.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,55 +0,0 @@ --/* inftrees.h -- header to use inftrees.c -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* Structure for decoding tables. Each entry provides either the -- information needed to do the operation requested by the code that -- indexed that table entry, or it provides a pointer to another -- table that indexes more bits of the code. op indicates whether -- the entry is a pointer to another table, a literal, a length or -- distance, an end-of-block, or an invalid code. For a table -- pointer, the low four bits of op is the number of index bits of -- that table. For a length or distance, the low four bits of op -- is the number of extra bits to get after the code. bits is -- the number of bits in this code or part of the code to drop off -- of the bit buffer. val is the actual byte to output in the case -- of a literal, the base length or distance, or the offset from -- the current table to the next table. Each entry is four bytes. */ --typedef struct { -- unsigned char op; /* operation, extra bits, table bits */ -- unsigned char bits; /* bits in this part of the code */ -- unsigned short val; /* offset in table or code value */ --} code; -- --/* op values as set by inflate_table(): -- 00000000 - literal -- 0000tttt - table link, tttt != 0 is the number of table index bits -- 0001eeee - length or distance, eeee is the number of extra bits -- 01100000 - end of block -- 01000000 - invalid code -- */ -- --/* Maximum size of dynamic tree. The maximum found in a long but non- -- exhaustive search was 1444 code structures (852 for length/literals -- and 592 for distances, the latter actually the result of an -- exhaustive search). The true maximum is not known, but the value -- below is more than safe. */ --#define ENOUGH 2048 --#define MAXD 592 -- --/* Type of code to build for inftable() */ --typedef enum { -- CODES, -- LENS, -- DISTS --} codetype; -- --extern int inflate_table OF((codetype type, unsigned short FAR *lens, -- unsigned codes, code FAR * FAR *table, -- unsigned FAR *bits, unsigned short FAR *work)); -diff -ruN RJaCGH.orig/src/Makevars RJaCGH/src/Makevars ---- RJaCGH.orig/src/Makevars 1970-01-01 01:00:00.000000000 +0100 -+++ RJaCGH/src/Makevars 2009-05-17 21:17:23.000000000 +0200 -@@ -0,0 +1 @@ -+PKG_LIBS=-lz -\ No newline at end of file -diff -ruN RJaCGH.orig/src/trees.c RJaCGH/src/trees.c ---- RJaCGH.orig/src/trees.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/trees.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1219 +0,0 @@ --/* trees.c -- output deflated data using Huffman coding -- * Copyright (C) 1995-2005 Jean-loup Gailly -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * ALGORITHM -- * -- * The "deflation" process uses several Huffman trees. The more -- * common source values are represented by shorter bit sequences. -- * -- * Each code tree is stored in a compressed form which is itself -- * a Huffman encoding of the lengths of all the code strings (in -- * ascending order by source values). The actual code strings are -- * reconstructed from the lengths in the inflate process, as described -- * in the deflate specification. -- * -- * REFERENCES -- * -- * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". -- * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc -- * -- * Storer, James A. -- * Data Compression: Methods and Theory, pp. 49-50. -- * Computer Science Press, 1988. ISBN 0-7167-8156-5. -- * -- * Sedgewick, R. -- * Algorithms, p290. -- * Addison-Wesley, 1983. ISBN 0-201-06672-6. -- */ -- --/* @(#) $Id$ */ -- --/* #define GEN_TREES_H */ -- --#include "deflate.h" -- --#ifdef DEBUG --# include --#endif -- --/* =========================================================================== -- * Constants -- */ -- --#define MAX_BL_BITS 7 --/* Bit length codes must not exceed MAX_BL_BITS bits */ -- --#define END_BLOCK 256 --/* end of block literal code */ -- --#define REP_3_6 16 --/* repeat previous bit length 3-6 times (2 bits of repeat count) */ -- --#define REPZ_3_10 17 --/* repeat a zero length 3-10 times (3 bits of repeat count) */ -- --#define REPZ_11_138 18 --/* repeat a zero length 11-138 times (7 bits of repeat count) */ -- --local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ -- = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; -- --local const int extra_dbits[D_CODES] /* extra bits for each distance code */ -- = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; -- --local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ -- = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; -- --local const uch bl_order[BL_CODES] -- = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; --/* The lengths of the bit length codes are sent in order of decreasing -- * probability, to avoid transmitting the lengths for unused bit length codes. -- */ -- --#define Buf_size (8 * 2*sizeof(char)) --/* Number of bits used within bi_buf. (bi_buf might be implemented on -- * more than 16 bits on some systems.) -- */ -- --/* =========================================================================== -- * Local data. These are initialized only once. -- */ -- --#define DIST_CODE_LEN 512 /* see definition of array dist_code below */ -- --#if defined(GEN_TREES_H) || !defined(STDC) --/* non ANSI compilers may not accept trees.h */ -- --local ct_data static_ltree[L_CODES+2]; --/* The static literal tree. Since the bit lengths are imposed, there is no -- * need for the L_CODES extra codes used during heap construction. However -- * The codes 286 and 287 are needed to build a canonical tree (see _tr_init -- * below). -- */ -- --local ct_data static_dtree[D_CODES]; --/* The static distance tree. (Actually a trivial tree since all codes use -- * 5 bits.) -- */ -- --uch _dist_code[DIST_CODE_LEN]; --/* Distance codes. The first 256 values correspond to the distances -- * 3 .. 258, the last 256 values correspond to the top 8 bits of -- * the 15 bit distances. -- */ -- --uch _length_code[MAX_MATCH-MIN_MATCH+1]; --/* length code for each normalized match length (0 == MIN_MATCH) */ -- --local int base_length[LENGTH_CODES]; --/* First normalized length for each code (0 = MIN_MATCH) */ -- --local int base_dist[D_CODES]; --/* First normalized distance for each code (0 = distance of 1) */ -- --#else --# include "trees.h" --#endif /* GEN_TREES_H */ -- --struct static_tree_desc_s { -- const ct_data *static_tree; /* static tree or NULL */ -- const intf *extra_bits; /* extra bits for each code or NULL */ -- int extra_base; /* base index for extra_bits */ -- int elems; /* max number of elements in the tree */ -- int max_length; /* max bit length for the codes */ --}; -- --local static_tree_desc static_l_desc = --{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; -- --local static_tree_desc static_d_desc = --{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; -- --local static_tree_desc static_bl_desc = --{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; -- --/* =========================================================================== -- * Local (static) routines in this file. -- */ -- --local void tr_static_init OF((void)); --local void init_block OF((deflate_state *s)); --local void pqdownheap OF((deflate_state *s, ct_data *tree, int k)); --local void gen_bitlen OF((deflate_state *s, tree_desc *desc)); --local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count)); --local void build_tree OF((deflate_state *s, tree_desc *desc)); --local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code)); --local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); --local int build_bl_tree OF((deflate_state *s)); --local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, -- int blcodes)); --local void compress_block OF((deflate_state *s, ct_data *ltree, -- ct_data *dtree)); --local void set_data_type OF((deflate_state *s)); --local unsigned bi_reverse OF((unsigned value, int length)); --local void bi_windup OF((deflate_state *s)); --local void bi_flush OF((deflate_state *s)); --local void copy_block OF((deflate_state *s, charf *buf, unsigned len, -- int header)); -- --#ifdef GEN_TREES_H --local void gen_trees_header OF((void)); --#endif -- --#ifndef DEBUG --# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) -- /* Send a code of the given tree. c and tree must not have side effects */ -- --#else /* DEBUG */ --# define send_code(s, c, tree) \ -- { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ -- send_bits(s, tree[c].Code, tree[c].Len); } --#endif -- --/* =========================================================================== -- * Output a short LSB first on the stream. -- * IN assertion: there is enough room in pendingBuf. -- */ --#define put_short(s, w) { \ -- put_byte(s, (uch)((w) & 0xff)); \ -- put_byte(s, (uch)((ush)(w) >> 8)); \ --} -- --/* =========================================================================== -- * Send a value on a given number of bits. -- * IN assertion: length <= 16 and value fits in length bits. -- */ --#ifdef DEBUG --local void send_bits OF((deflate_state *s, int value, int length)); -- --local void send_bits(s, value, length) -- deflate_state *s; -- int value; /* value to send */ -- int length; /* number of bits */ --{ -- Tracevv((stderr," l %2d v %4x ", length, value)); -- Assert(length > 0 && length <= 15, "invalid length"); -- s->bits_sent += (ulg)length; -- -- /* If not enough room in bi_buf, use (valid) bits from bi_buf and -- * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) -- * unused bits in value. -- */ -- if (s->bi_valid > (int)Buf_size - length) { -- s->bi_buf |= (value << s->bi_valid); -- put_short(s, s->bi_buf); -- s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); -- s->bi_valid += length - Buf_size; -- } else { -- s->bi_buf |= value << s->bi_valid; -- s->bi_valid += length; -- } --} --#else /* !DEBUG */ -- --#define send_bits(s, value, length) \ --{ int len = length;\ -- if (s->bi_valid > (int)Buf_size - len) {\ -- int val = value;\ -- s->bi_buf |= (val << s->bi_valid);\ -- put_short(s, s->bi_buf);\ -- s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ -- s->bi_valid += len - Buf_size;\ -- } else {\ -- s->bi_buf |= (value) << s->bi_valid;\ -- s->bi_valid += len;\ -- }\ --} --#endif /* DEBUG */ -- -- --/* the arguments must not have side effects */ -- --/* =========================================================================== -- * Initialize the various 'constant' tables. -- */ --local void tr_static_init() --{ --#if defined(GEN_TREES_H) || !defined(STDC) -- static int static_init_done = 0; -- int n; /* iterates over tree elements */ -- int bits; /* bit counter */ -- int length; /* length value */ -- int code; /* code value */ -- int dist; /* distance index */ -- ush bl_count[MAX_BITS+1]; -- /* number of codes at each bit length for an optimal tree */ -- -- if (static_init_done) return; -- -- /* For some embedded targets, global variables are not initialized: */ -- static_l_desc.static_tree = static_ltree; -- static_l_desc.extra_bits = extra_lbits; -- static_d_desc.static_tree = static_dtree; -- static_d_desc.extra_bits = extra_dbits; -- static_bl_desc.extra_bits = extra_blbits; -- -- /* Initialize the mapping length (0..255) -> length code (0..28) */ -- length = 0; -- for (code = 0; code < LENGTH_CODES-1; code++) { -- base_length[code] = length; -- for (n = 0; n < (1< dist code (0..29) */ -- dist = 0; -- for (code = 0 ; code < 16; code++) { -- base_dist[code] = dist; -- for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ -- for ( ; code < D_CODES; code++) { -- base_dist[code] = dist << 7; -- for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { -- _dist_code[256 + dist++] = (uch)code; -- } -- } -- Assert (dist == 256, "tr_static_init: 256+dist != 512"); -- -- /* Construct the codes of the static literal tree */ -- for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; -- n = 0; -- while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; -- while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; -- while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; -- while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; -- /* Codes 286 and 287 do not exist, but we must include them in the -- * tree construction to get a canonical Huffman tree (longest code -- * all ones) -- */ -- gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); -- -- /* The static distance tree is trivial: */ -- for (n = 0; n < D_CODES; n++) { -- static_dtree[n].Len = 5; -- static_dtree[n].Code = bi_reverse((unsigned)n, 5); -- } -- static_init_done = 1; -- --# ifdef GEN_TREES_H -- gen_trees_header(); --# endif --#endif /* defined(GEN_TREES_H) || !defined(STDC) */ --} -- --/* =========================================================================== -- * Genererate the file trees.h describing the static trees. -- */ --#ifdef GEN_TREES_H --# ifndef DEBUG --# include --# endif -- --# define SEPARATOR(i, last, width) \ -- ((i) == (last)? "\n};\n\n" : \ -- ((i) % (width) == (width)-1 ? ",\n" : ", ")) -- --void gen_trees_header() --{ -- FILE *header = fopen("trees.h", "w"); -- int i; -- -- Assert (header != NULL, "Can't open trees.h"); -- fprintf(header, -- "/* header created automatically with -DGEN_TREES_H */\n\n"); -- -- fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); -- for (i = 0; i < L_CODES+2; i++) { -- fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, -- static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); -- } -- -- fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); -- for (i = 0; i < D_CODES; i++) { -- fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, -- static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); -- } -- -- fprintf(header, "const uch _dist_code[DIST_CODE_LEN] = {\n"); -- for (i = 0; i < DIST_CODE_LEN; i++) { -- fprintf(header, "%2u%s", _dist_code[i], -- SEPARATOR(i, DIST_CODE_LEN-1, 20)); -- } -- -- fprintf(header, "const uch _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); -- for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { -- fprintf(header, "%2u%s", _length_code[i], -- SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); -- } -- -- fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); -- for (i = 0; i < LENGTH_CODES; i++) { -- fprintf(header, "%1u%s", base_length[i], -- SEPARATOR(i, LENGTH_CODES-1, 20)); -- } -- -- fprintf(header, "local const int base_dist[D_CODES] = {\n"); -- for (i = 0; i < D_CODES; i++) { -- fprintf(header, "%5u%s", base_dist[i], -- SEPARATOR(i, D_CODES-1, 10)); -- } -- -- fclose(header); --} --#endif /* GEN_TREES_H */ -- --/* =========================================================================== -- * Initialize the tree data structures for a new zlib stream. -- */ --void _tr_init(s) -- deflate_state *s; --{ -- tr_static_init(); -- -- s->l_desc.dyn_tree = s->dyn_ltree; -- s->l_desc.stat_desc = &static_l_desc; -- -- s->d_desc.dyn_tree = s->dyn_dtree; -- s->d_desc.stat_desc = &static_d_desc; -- -- s->bl_desc.dyn_tree = s->bl_tree; -- s->bl_desc.stat_desc = &static_bl_desc; -- -- s->bi_buf = 0; -- s->bi_valid = 0; -- s->last_eob_len = 8; /* enough lookahead for inflate */ --#ifdef DEBUG -- s->compressed_len = 0L; -- s->bits_sent = 0L; --#endif -- -- /* Initialize the first block of the first file: */ -- init_block(s); --} -- --/* =========================================================================== -- * Initialize a new block. -- */ --local void init_block(s) -- deflate_state *s; --{ -- int n; /* iterates over tree elements */ -- -- /* Initialize the trees. */ -- for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; -- for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; -- for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; -- -- s->dyn_ltree[END_BLOCK].Freq = 1; -- s->opt_len = s->static_len = 0L; -- s->last_lit = s->matches = 0; --} -- --#define SMALLEST 1 --/* Index within the heap array of least frequent node in the Huffman tree */ -- -- --/* =========================================================================== -- * Remove the smallest element from the heap and recreate the heap with -- * one less element. Updates heap and heap_len. -- */ --#define pqremove(s, tree, top) \ --{\ -- top = s->heap[SMALLEST]; \ -- s->heap[SMALLEST] = s->heap[s->heap_len--]; \ -- pqdownheap(s, tree, SMALLEST); \ --} -- --/* =========================================================================== -- * Compares to subtrees, using the tree depth as tie breaker when -- * the subtrees have equal frequency. This minimizes the worst case length. -- */ --#define smaller(tree, n, m, depth) \ -- (tree[n].Freq < tree[m].Freq || \ -- (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) -- --/* =========================================================================== -- * Restore the heap property by moving down the tree starting at node k, -- * exchanging a node with the smallest of its two sons if necessary, stopping -- * when the heap property is re-established (each father smaller than its -- * two sons). -- */ --local void pqdownheap(s, tree, k) -- deflate_state *s; -- ct_data *tree; /* the tree to restore */ -- int k; /* node to move down */ --{ -- int v = s->heap[k]; -- int j = k << 1; /* left son of k */ -- while (j <= s->heap_len) { -- /* Set j to the smallest of the two sons: */ -- if (j < s->heap_len && -- smaller(tree, s->heap[j+1], s->heap[j], s->depth)) { -- j++; -- } -- /* Exit if v is smaller than both sons */ -- if (smaller(tree, v, s->heap[j], s->depth)) break; -- -- /* Exchange v with the smallest son */ -- s->heap[k] = s->heap[j]; k = j; -- -- /* And continue down the tree, setting j to the left son of k */ -- j <<= 1; -- } -- s->heap[k] = v; --} -- --/* =========================================================================== -- * Compute the optimal bit lengths for a tree and update the total bit length -- * for the current block. -- * IN assertion: the fields freq and dad are set, heap[heap_max] and -- * above are the tree nodes sorted by increasing frequency. -- * OUT assertions: the field len is set to the optimal bit length, the -- * array bl_count contains the frequencies for each bit length. -- * The length opt_len is updated; static_len is also updated if stree is -- * not null. -- */ --local void gen_bitlen(s, desc) -- deflate_state *s; -- tree_desc *desc; /* the tree descriptor */ --{ -- ct_data *tree = desc->dyn_tree; -- int max_code = desc->max_code; -- const ct_data *stree = desc->stat_desc->static_tree; -- const intf *extra = desc->stat_desc->extra_bits; -- int base = desc->stat_desc->extra_base; -- int max_length = desc->stat_desc->max_length; -- int h; /* heap index */ -- int n, m; /* iterate over the tree elements */ -- int bits; /* bit length */ -- int xbits; /* extra bits */ -- ush f; /* frequency */ -- int overflow = 0; /* number of elements with bit length too large */ -- -- for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; -- -- /* In a first pass, compute the optimal bit lengths (which may -- * overflow in the case of the bit length tree). -- */ -- tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ -- -- for (h = s->heap_max+1; h < HEAP_SIZE; h++) { -- n = s->heap[h]; -- bits = tree[tree[n].Dad].Len + 1; -- if (bits > max_length) bits = max_length, overflow++; -- tree[n].Len = (ush)bits; -- /* We overwrite tree[n].Dad which is no longer needed */ -- -- if (n > max_code) continue; /* not a leaf node */ -- -- s->bl_count[bits]++; -- xbits = 0; -- if (n >= base) xbits = extra[n-base]; -- f = tree[n].Freq; -- s->opt_len += (ulg)f * (bits + xbits); -- if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits); -- } -- if (overflow == 0) return; -- -- Trace((stderr,"\nbit length overflow\n")); -- /* This happens for example on obj2 and pic of the Calgary corpus */ -- -- /* Find the first bit length which could increase: */ -- do { -- bits = max_length-1; -- while (s->bl_count[bits] == 0) bits--; -- s->bl_count[bits]--; /* move one leaf down the tree */ -- s->bl_count[bits+1] += 2; /* move one overflow item as its brother */ -- s->bl_count[max_length]--; -- /* The brother of the overflow item also moves one step up, -- * but this does not affect bl_count[max_length] -- */ -- overflow -= 2; -- } while (overflow > 0); -- -- /* Now recompute all bit lengths, scanning in increasing frequency. -- * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all -- * lengths instead of fixing only the wrong ones. This idea is taken -- * from 'ar' written by Haruhiko Okumura.) -- */ -- for (bits = max_length; bits != 0; bits--) { -- n = s->bl_count[bits]; -- while (n != 0) { -- m = s->heap[--h]; -- if (m > max_code) continue; -- if ((unsigned) tree[m].Len != (unsigned) bits) { -- Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); -- s->opt_len += ((long)bits - (long)tree[m].Len) -- *(long)tree[m].Freq; -- tree[m].Len = (ush)bits; -- } -- n--; -- } -- } --} -- --/* =========================================================================== -- * Generate the codes for a given tree and bit counts (which need not be -- * optimal). -- * IN assertion: the array bl_count contains the bit length statistics for -- * the given tree and the field len is set for all tree elements. -- * OUT assertion: the field code is set for all tree elements of non -- * zero code length. -- */ --local void gen_codes (tree, max_code, bl_count) -- ct_data *tree; /* the tree to decorate */ -- int max_code; /* largest code with non zero frequency */ -- ushf *bl_count; /* number of codes at each bit length */ --{ -- ush next_code[MAX_BITS+1]; /* next code value for each bit length */ -- ush code = 0; /* running code value */ -- int bits; /* bit index */ -- int n; /* code index */ -- -- /* The distribution counts are first used to generate the code values -- * without bit reversal. -- */ -- for (bits = 1; bits <= MAX_BITS; bits++) { -- next_code[bits] = code = (code + bl_count[bits-1]) << 1; -- } -- /* Check that the bit counts in bl_count are consistent. The last code -- * must be all ones. -- */ -- Assert (code + bl_count[MAX_BITS]-1 == (1<dyn_tree; -- const ct_data *stree = desc->stat_desc->static_tree; -- int elems = desc->stat_desc->elems; -- int n, m; /* iterate over heap elements */ -- int max_code = -1; /* largest code with non zero frequency */ -- int node; /* new node being created */ -- -- /* Construct the initial heap, with least frequent element in -- * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. -- * heap[0] is not used. -- */ -- s->heap_len = 0, s->heap_max = HEAP_SIZE; -- -- for (n = 0; n < elems; n++) { -- if (tree[n].Freq != 0) { -- s->heap[++(s->heap_len)] = max_code = n; -- s->depth[n] = 0; -- } else { -- tree[n].Len = 0; -- } -- } -- -- /* The pkzip format requires that at least one distance code exists, -- * and that at least one bit should be sent even if there is only one -- * possible code. So to avoid special checks later on we force at least -- * two codes of non zero frequency. -- */ -- while (s->heap_len < 2) { -- node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); -- tree[node].Freq = 1; -- s->depth[node] = 0; -- s->opt_len--; if (stree) s->static_len -= stree[node].Len; -- /* node is 0 or 1 so it does not have extra bits */ -- } -- desc->max_code = max_code; -- -- /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, -- * establish sub-heaps of increasing lengths: -- */ -- for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); -- -- /* Construct the Huffman tree by repeatedly combining the least two -- * frequent nodes. -- */ -- node = elems; /* next internal node of the tree */ -- do { -- pqremove(s, tree, n); /* n = node of least frequency */ -- m = s->heap[SMALLEST]; /* m = node of next least frequency */ -- -- s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ -- s->heap[--(s->heap_max)] = m; -- -- /* Create a new node father of n and m */ -- tree[node].Freq = tree[n].Freq + tree[m].Freq; -- s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? -- s->depth[n] : s->depth[m]) + 1); -- tree[n].Dad = tree[m].Dad = (ush)node; --#ifdef DUMP_BL_TREE -- if (tree == s->bl_tree) { -- fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", -- node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); -- } --#endif -- /* and insert the new node in the heap */ -- s->heap[SMALLEST] = node++; -- pqdownheap(s, tree, SMALLEST); -- -- } while (s->heap_len >= 2); -- -- s->heap[--(s->heap_max)] = s->heap[SMALLEST]; -- -- /* At this point, the fields freq and dad are set. We can now -- * generate the bit lengths. -- */ -- gen_bitlen(s, (tree_desc *)desc); -- -- /* The field len is now set, we can generate the bit codes */ -- gen_codes ((ct_data *)tree, max_code, s->bl_count); --} -- --/* =========================================================================== -- * Scan a literal or distance tree to determine the frequencies of the codes -- * in the bit length tree. -- */ --local void scan_tree (s, tree, max_code) -- deflate_state *s; -- ct_data *tree; /* the tree to be scanned */ -- int max_code; /* and its largest code of non zero frequency */ --{ -- int n; /* iterates over all tree elements */ -- int prevlen = -1; /* last emitted length */ -- int curlen; /* length of current code */ -- int nextlen = tree[0].Len; /* length of next code */ -- int count = 0; /* repeat count of the current code */ -- int max_count = 7; /* max repeat count */ -- int min_count = 4; /* min repeat count */ -- -- if (nextlen == 0) max_count = 138, min_count = 3; -- tree[max_code+1].Len = (ush)0xffff; /* guard */ -- -- for (n = 0; n <= max_code; n++) { -- curlen = nextlen; nextlen = tree[n+1].Len; -- if (++count < max_count && curlen == nextlen) { -- continue; -- } else if (count < min_count) { -- s->bl_tree[curlen].Freq += count; -- } else if (curlen != 0) { -- if (curlen != prevlen) s->bl_tree[curlen].Freq++; -- s->bl_tree[REP_3_6].Freq++; -- } else if (count <= 10) { -- s->bl_tree[REPZ_3_10].Freq++; -- } else { -- s->bl_tree[REPZ_11_138].Freq++; -- } -- count = 0; prevlen = curlen; -- if (nextlen == 0) { -- max_count = 138, min_count = 3; -- } else if (curlen == nextlen) { -- max_count = 6, min_count = 3; -- } else { -- max_count = 7, min_count = 4; -- } -- } --} -- --/* =========================================================================== -- * Send a literal or distance tree in compressed form, using the codes in -- * bl_tree. -- */ --local void send_tree (s, tree, max_code) -- deflate_state *s; -- ct_data *tree; /* the tree to be scanned */ -- int max_code; /* and its largest code of non zero frequency */ --{ -- int n; /* iterates over all tree elements */ -- int prevlen = -1; /* last emitted length */ -- int curlen; /* length of current code */ -- int nextlen = tree[0].Len; /* length of next code */ -- int count = 0; /* repeat count of the current code */ -- int max_count = 7; /* max repeat count */ -- int min_count = 4; /* min repeat count */ -- -- /* tree[max_code+1].Len = -1; */ /* guard already set */ -- if (nextlen == 0) max_count = 138, min_count = 3; -- -- for (n = 0; n <= max_code; n++) { -- curlen = nextlen; nextlen = tree[n+1].Len; -- if (++count < max_count && curlen == nextlen) { -- continue; -- } else if (count < min_count) { -- do { send_code(s, curlen, s->bl_tree); } while (--count != 0); -- -- } else if (curlen != 0) { -- if (curlen != prevlen) { -- send_code(s, curlen, s->bl_tree); count--; -- } -- Assert(count >= 3 && count <= 6, " 3_6?"); -- send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2); -- -- } else if (count <= 10) { -- send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3); -- -- } else { -- send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7); -- } -- count = 0; prevlen = curlen; -- if (nextlen == 0) { -- max_count = 138, min_count = 3; -- } else if (curlen == nextlen) { -- max_count = 6, min_count = 3; -- } else { -- max_count = 7, min_count = 4; -- } -- } --} -- --/* =========================================================================== -- * Construct the Huffman tree for the bit lengths and return the index in -- * bl_order of the last bit length code to send. -- */ --local int build_bl_tree(s) -- deflate_state *s; --{ -- int max_blindex; /* index of last bit length code of non zero freq */ -- -- /* Determine the bit length frequencies for literal and distance trees */ -- scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); -- scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); -- -- /* Build the bit length tree: */ -- build_tree(s, (tree_desc *)(&(s->bl_desc))); -- /* opt_len now includes the length of the tree representations, except -- * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. -- */ -- -- /* Determine the number of bit length codes to send. The pkzip format -- * requires that at least 4 bit length codes be sent. (appnote.txt says -- * 3 but the actual value used is 4.) -- */ -- for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { -- if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; -- } -- /* Update opt_len to include the bit length tree and counts */ -- s->opt_len += 3*(max_blindex+1) + 5+5+4; -- Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", -- s->opt_len, s->static_len)); -- -- return max_blindex; --} -- --/* =========================================================================== -- * Send the header for a block using dynamic Huffman trees: the counts, the -- * lengths of the bit length codes, the literal tree and the distance tree. -- * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. -- */ --local void send_all_trees(s, lcodes, dcodes, blcodes) -- deflate_state *s; -- int lcodes, dcodes, blcodes; /* number of codes for each tree */ --{ -- int rank; /* index in bl_order */ -- -- Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); -- Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, -- "too many codes"); -- Tracev((stderr, "\nbl counts: ")); -- send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */ -- send_bits(s, dcodes-1, 5); -- send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */ -- for (rank = 0; rank < blcodes; rank++) { -- Tracev((stderr, "\nbl code %2d ", bl_order[rank])); -- send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); -- } -- Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); -- -- send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */ -- Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); -- -- send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */ -- Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); --} -- --/* =========================================================================== -- * Send a stored block -- */ --void _tr_stored_block(s, buf, stored_len, eof) -- deflate_state *s; -- charf *buf; /* input block */ -- ulg stored_len; /* length of input block */ -- int eof; /* true if this is the last block for a file */ --{ -- send_bits(s, (STORED_BLOCK<<1)+eof, 3); /* send block type */ --#ifdef DEBUG -- s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; -- s->compressed_len += (stored_len + 4) << 3; --#endif -- copy_block(s, buf, (unsigned)stored_len, 1); /* with header */ --} -- --/* =========================================================================== -- * Send one empty static block to give enough lookahead for inflate. -- * This takes 10 bits, of which 7 may remain in the bit buffer. -- * The current inflate code requires 9 bits of lookahead. If the -- * last two codes for the previous block (real code plus EOB) were coded -- * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode -- * the last real code. In this case we send two empty static blocks instead -- * of one. (There are no problems if the previous block is stored or fixed.) -- * To simplify the code, we assume the worst case of last real code encoded -- * on one bit only. -- */ --void _tr_align(s) -- deflate_state *s; --{ -- send_bits(s, STATIC_TREES<<1, 3); -- send_code(s, END_BLOCK, static_ltree); --#ifdef DEBUG -- s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ --#endif -- bi_flush(s); -- /* Of the 10 bits for the empty block, we have already sent -- * (10 - bi_valid) bits. The lookahead for the last real code (before -- * the EOB of the previous block) was thus at least one plus the length -- * of the EOB plus what we have just sent of the empty static block. -- */ -- if (1 + s->last_eob_len + 10 - s->bi_valid < 9) { -- send_bits(s, STATIC_TREES<<1, 3); -- send_code(s, END_BLOCK, static_ltree); --#ifdef DEBUG -- s->compressed_len += 10L; --#endif -- bi_flush(s); -- } -- s->last_eob_len = 7; --} -- --/* =========================================================================== -- * Determine the best encoding for the current block: dynamic trees, static -- * trees or store, and output the encoded block to the zip file. -- */ --void _tr_flush_block(s, buf, stored_len, eof) -- deflate_state *s; -- charf *buf; /* input block, or NULL if too old */ -- ulg stored_len; /* length of input block */ -- int eof; /* true if this is the last block for a file */ --{ -- ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ -- int max_blindex = 0; /* index of last bit length code of non zero freq */ -- -- /* Build the Huffman trees unless a stored block is forced */ -- if (s->level > 0) { -- -- /* Check if the file is binary or text */ -- if (stored_len > 0 && s->strm->data_type == Z_UNKNOWN) -- set_data_type(s); -- -- /* Construct the literal and distance trees */ -- build_tree(s, (tree_desc *)(&(s->l_desc))); -- Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, -- s->static_len)); -- -- build_tree(s, (tree_desc *)(&(s->d_desc))); -- Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, -- s->static_len)); -- /* At this point, opt_len and static_len are the total bit lengths of -- * the compressed block data, excluding the tree representations. -- */ -- -- /* Build the bit length tree for the above two trees, and get the index -- * in bl_order of the last bit length code to send. -- */ -- max_blindex = build_bl_tree(s); -- -- /* Determine the best encoding. Compute the block lengths in bytes. */ -- opt_lenb = (s->opt_len+3+7)>>3; -- static_lenb = (s->static_len+3+7)>>3; -- -- Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", -- opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, -- s->last_lit)); -- -- if (static_lenb <= opt_lenb) opt_lenb = static_lenb; -- -- } else { -- Assert(buf != (char*)0, "lost buf"); -- opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ -- } -- --#ifdef FORCE_STORED -- if (buf != (char*)0) { /* force stored block */ --#else -- if (stored_len+4 <= opt_lenb && buf != (char*)0) { -- /* 4: two words for the lengths */ --#endif -- /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. -- * Otherwise we can't have processed more than WSIZE input bytes since -- * the last block flush, because compression would have been -- * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to -- * transform a block into a stored block. -- */ -- _tr_stored_block(s, buf, stored_len, eof); -- --#ifdef FORCE_STATIC -- } else if (static_lenb >= 0) { /* force static trees */ --#else -- } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { --#endif -- send_bits(s, (STATIC_TREES<<1)+eof, 3); -- compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); --#ifdef DEBUG -- s->compressed_len += 3 + s->static_len; --#endif -- } else { -- send_bits(s, (DYN_TREES<<1)+eof, 3); -- send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, -- max_blindex+1); -- compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); --#ifdef DEBUG -- s->compressed_len += 3 + s->opt_len; --#endif -- } -- Assert (s->compressed_len == s->bits_sent, "bad compressed size"); -- /* The above check is made mod 2^32, for files larger than 512 MB -- * and uLong implemented on 32 bits. -- */ -- init_block(s); -- -- if (eof) { -- bi_windup(s); --#ifdef DEBUG -- s->compressed_len += 7; /* align on byte boundary */ --#endif -- } -- Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3, -- s->compressed_len-7*eof)); --} -- --/* =========================================================================== -- * Save the match info and tally the frequency counts. Return true if -- * the current block must be flushed. -- */ --int _tr_tally (s, dist, lc) -- deflate_state *s; -- unsigned dist; /* distance of matched string */ -- unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ --{ -- s->d_buf[s->last_lit] = (ush)dist; -- s->l_buf[s->last_lit++] = (uch)lc; -- if (dist == 0) { -- /* lc is the unmatched char */ -- s->dyn_ltree[lc].Freq++; -- } else { -- s->matches++; -- /* Here, lc is the match length - MIN_MATCH */ -- dist--; /* dist = match distance - 1 */ -- Assert((ush)dist < (ush)MAX_DIST(s) && -- (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && -- (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); -- -- s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++; -- s->dyn_dtree[d_code(dist)].Freq++; -- } -- --#ifdef TRUNCATE_BLOCK -- /* Try to guess if it is profitable to stop the current block here */ -- if ((s->last_lit & 0x1fff) == 0 && s->level > 2) { -- /* Compute an upper bound for the compressed length */ -- ulg out_length = (ulg)s->last_lit*8L; -- ulg in_length = (ulg)((long)s->strstart - s->block_start); -- int dcode; -- for (dcode = 0; dcode < D_CODES; dcode++) { -- out_length += (ulg)s->dyn_dtree[dcode].Freq * -- (5L+extra_dbits[dcode]); -- } -- out_length >>= 3; -- Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ", -- s->last_lit, in_length, out_length, -- 100L - out_length*100L/in_length)); -- if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1; -- } --#endif -- return (s->last_lit == s->lit_bufsize-1); -- /* We avoid equality with lit_bufsize because of wraparound at 64K -- * on 16 bit machines and because stored blocks are restricted to -- * 64K-1 bytes. -- */ --} -- --/* =========================================================================== -- * Send the block data compressed using the given Huffman trees -- */ --local void compress_block(s, ltree, dtree) -- deflate_state *s; -- ct_data *ltree; /* literal tree */ -- ct_data *dtree; /* distance tree */ --{ -- unsigned dist; /* distance of matched string */ -- int lc; /* match length or unmatched char (if dist == 0) */ -- unsigned lx = 0; /* running index in l_buf */ -- unsigned code; /* the code to send */ -- int extra; /* number of extra bits to send */ -- -- if (s->last_lit != 0) do { -- dist = s->d_buf[lx]; -- lc = s->l_buf[lx++]; -- if (dist == 0) { -- send_code(s, lc, ltree); /* send a literal byte */ -- Tracecv(isgraph(lc), (stderr," '%c' ", lc)); -- } else { -- /* Here, lc is the match length - MIN_MATCH */ -- code = _length_code[lc]; -- send_code(s, code+LITERALS+1, ltree); /* send the length code */ -- extra = extra_lbits[code]; -- if (extra != 0) { -- lc -= base_length[code]; -- send_bits(s, lc, extra); /* send the extra length bits */ -- } -- dist--; /* dist is now the match distance - 1 */ -- code = d_code(dist); -- Assert (code < D_CODES, "bad d_code"); -- -- send_code(s, code, dtree); /* send the distance code */ -- extra = extra_dbits[code]; -- if (extra != 0) { -- dist -= base_dist[code]; -- send_bits(s, dist, extra); /* send the extra distance bits */ -- } -- } /* literal or match pair ? */ -- -- /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */ -- Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx, -- "pendingBuf overflow"); -- -- } while (lx < s->last_lit); -- -- send_code(s, END_BLOCK, ltree); -- s->last_eob_len = ltree[END_BLOCK].Len; --} -- --/* =========================================================================== -- * Set the data type to BINARY or TEXT, using a crude approximation: -- * set it to Z_TEXT if all symbols are either printable characters (33 to 255) -- * or white spaces (9 to 13, or 32); or set it to Z_BINARY otherwise. -- * IN assertion: the fields Freq of dyn_ltree are set. -- */ --local void set_data_type(s) -- deflate_state *s; --{ -- int n; -- -- for (n = 0; n < 9; n++) -- if (s->dyn_ltree[n].Freq != 0) -- break; -- if (n == 9) -- for (n = 14; n < 32; n++) -- if (s->dyn_ltree[n].Freq != 0) -- break; -- s->strm->data_type = (n == 32) ? Z_TEXT : Z_BINARY; --} -- --/* =========================================================================== -- * Reverse the first len bits of a code, using straightforward code (a faster -- * method would use a table) -- * IN assertion: 1 <= len <= 15 -- */ --local unsigned bi_reverse(code, len) -- unsigned code; /* the value to invert */ -- int len; /* its bit length */ --{ -- register unsigned res = 0; -- do { -- res |= code & 1; -- code >>= 1, res <<= 1; -- } while (--len > 0); -- return res >> 1; --} -- --/* =========================================================================== -- * Flush the bit buffer, keeping at most 7 bits in it. -- */ --local void bi_flush(s) -- deflate_state *s; --{ -- if (s->bi_valid == 16) { -- put_short(s, s->bi_buf); -- s->bi_buf = 0; -- s->bi_valid = 0; -- } else if (s->bi_valid >= 8) { -- put_byte(s, (Byte)s->bi_buf); -- s->bi_buf >>= 8; -- s->bi_valid -= 8; -- } --} -- --/* =========================================================================== -- * Flush the bit buffer and align the output on a byte boundary -- */ --local void bi_windup(s) -- deflate_state *s; --{ -- if (s->bi_valid > 8) { -- put_short(s, s->bi_buf); -- } else if (s->bi_valid > 0) { -- put_byte(s, (Byte)s->bi_buf); -- } -- s->bi_buf = 0; -- s->bi_valid = 0; --#ifdef DEBUG -- s->bits_sent = (s->bits_sent+7) & ~7; --#endif --} -- --/* =========================================================================== -- * Copy a stored block, storing first the length and its -- * one's complement if requested. -- */ --local void copy_block(s, buf, len, header) -- deflate_state *s; -- charf *buf; /* the input data */ -- unsigned len; /* its length */ -- int header; /* true if block header must be written */ --{ -- bi_windup(s); /* align on byte boundary */ -- s->last_eob_len = 8; /* enough lookahead for inflate */ -- -- if (header) { -- put_short(s, (ush)len); -- put_short(s, (ush)~len); --#ifdef DEBUG -- s->bits_sent += 2*16; --#endif -- } --#ifdef DEBUG -- s->bits_sent += (ulg)len<<3; --#endif -- while (len--) { -- put_byte(s, *buf++); -- } --} -diff -ruN RJaCGH.orig/src/trees.h RJaCGH/src/trees.h ---- RJaCGH.orig/src/trees.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/trees.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,128 +0,0 @@ --/* header created automatically with -DGEN_TREES_H */ -- --local const ct_data static_ltree[L_CODES+2] = { --{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, --{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, --{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, --{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, --{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, --{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, --{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, --{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, --{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, --{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, --{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, --{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, --{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, --{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, --{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, --{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, --{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, --{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, --{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, --{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, --{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, --{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, --{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, --{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, --{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, --{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, --{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, --{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, --{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, --{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, --{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, --{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, --{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, --{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, --{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, --{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, --{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, --{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, --{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, --{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, --{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, --{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, --{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, --{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, --{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, --{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, --{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, --{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, --{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, --{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, --{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, --{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, --{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, --{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, --{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, --{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, --{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, --{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} --}; -- --local const ct_data static_dtree[D_CODES] = { --{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, --{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, --{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, --{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, --{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, --{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} --}; -- --const uch _dist_code[DIST_CODE_LEN] = { -- 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, -- 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, --10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, --11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, --12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, --13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, --13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, --18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, --23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 --}; -- --const uch _length_code[MAX_MATCH-MIN_MATCH+1]= { -- 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, --13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, --17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, --19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, --21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, --22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, --23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, --25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 --}; -- --local const int base_length[LENGTH_CODES] = { --0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, --64, 80, 96, 112, 128, 160, 192, 224, 0 --}; -- --local const int base_dist[D_CODES] = { -- 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, -- 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, -- 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 --}; -- -diff -ruN RJaCGH.orig/src/uncompr.c RJaCGH/src/uncompr.c ---- RJaCGH.orig/src/uncompr.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/uncompr.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,61 +0,0 @@ --/* uncompr.c -- decompress a memory buffer -- * Copyright (C) 1995-2003 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --/* =========================================================================== -- Decompresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be large enough to hold the -- entire uncompressed data. (The size of the uncompressed data must have -- been saved previously by the compressor and transmitted to the decompressor -- by some mechanism outside the scope of this compression library.) -- Upon exit, destLen is the actual size of the compressed buffer. -- This function can be used to decompress a whole file at once if the -- input file is mmap'ed. -- -- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer, or Z_DATA_ERROR if the input data was corrupted. --*/ --int ZEXPORT uncompress (dest, destLen, source, sourceLen) -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; --{ -- z_stream stream; -- int err; -- -- stream.next_in = (Bytef*)source; -- stream.avail_in = (uInt)sourceLen; -- /* Check for source > 64K on 16-bit machine: */ -- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; -- -- stream.next_out = dest; -- stream.avail_out = (uInt)*destLen; -- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; -- -- stream.zalloc = (alloc_func)0; -- stream.zfree = (free_func)0; -- -- err = inflateInit(&stream); -- if (err != Z_OK) return err; -- -- err = inflate(&stream, Z_FINISH); -- if (err != Z_STREAM_END) { -- inflateEnd(&stream); -- if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) -- return Z_DATA_ERROR; -- return err; -- } -- *destLen = stream.total_out; -- -- err = inflateEnd(&stream); -- return err; --} -diff -ruN RJaCGH.orig/src/zconf.h RJaCGH/src/zconf.h ---- RJaCGH.orig/src/zconf.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/zconf.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,332 +0,0 @@ --/* zconf.h -- configuration of the zlib compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#ifndef ZCONF_H --#define ZCONF_H -- --/* -- * If you *really* need a unique prefix for all types and library functions, -- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. -- */ --#ifdef Z_PREFIX --# define deflateInit_ z_deflateInit_ --# define deflate z_deflate --# define deflateEnd z_deflateEnd --# define inflateInit_ z_inflateInit_ --# define inflate z_inflate --# define inflateEnd z_inflateEnd --# define deflateInit2_ z_deflateInit2_ --# define deflateSetDictionary z_deflateSetDictionary --# define deflateCopy z_deflateCopy --# define deflateReset z_deflateReset --# define deflateParams z_deflateParams --# define deflateBound z_deflateBound --# define deflatePrime z_deflatePrime --# define inflateInit2_ z_inflateInit2_ --# define inflateSetDictionary z_inflateSetDictionary --# define inflateSync z_inflateSync --# define inflateSyncPoint z_inflateSyncPoint --# define inflateCopy z_inflateCopy --# define inflateReset z_inflateReset --# define inflateBack z_inflateBack --# define inflateBackEnd z_inflateBackEnd --# define compress z_compress --# define compress2 z_compress2 --# define compressBound z_compressBound --# define uncompress z_uncompress --# define adler32 z_adler32 --# define crc32 z_crc32 --# define get_crc_table z_get_crc_table --# define zError z_zError -- --# define alloc_func z_alloc_func --# define free_func z_free_func --# define in_func z_in_func --# define out_func z_out_func --# define Byte z_Byte --# define uInt z_uInt --# define uLong z_uLong --# define Bytef z_Bytef --# define charf z_charf --# define intf z_intf --# define uIntf z_uIntf --# define uLongf z_uLongf --# define voidpf z_voidpf --# define voidp z_voidp --#endif -- --#if defined(__MSDOS__) && !defined(MSDOS) --# define MSDOS --#endif --#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) --# define OS2 --#endif --#if defined(_WINDOWS) && !defined(WINDOWS) --# define WINDOWS --#endif --#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) --# ifndef WIN32 --# define WIN32 --# endif --#endif --#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) --# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) --# ifndef SYS16BIT --# define SYS16BIT --# endif --# endif --#endif -- --/* -- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more -- * than 64k bytes at a time (needed on systems with 16-bit int). -- */ --#ifdef SYS16BIT --# define MAXSEG_64K --#endif --#ifdef MSDOS --# define UNALIGNED_OK --#endif -- --#ifdef __STDC_VERSION__ --# ifndef STDC --# define STDC --# endif --# if __STDC_VERSION__ >= 199901L --# ifndef STDC99 --# define STDC99 --# endif --# endif --#endif --#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) --# define STDC --#endif --#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) --# define STDC --#endif --#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) --# define STDC --#endif --#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) --# define STDC --#endif -- --#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ --# define STDC --#endif -- --#ifndef STDC --# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ --# define const /* note: need a more gentle solution here */ --# endif --#endif -- --/* Some Mac compilers merge all .h files incorrectly: */ --#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) --# define NO_DUMMY_DECL --#endif -- --/* Maximum value for memLevel in deflateInit2 */ --#ifndef MAX_MEM_LEVEL --# ifdef MAXSEG_64K --# define MAX_MEM_LEVEL 8 --# else --# define MAX_MEM_LEVEL 9 --# endif --#endif -- --/* Maximum value for windowBits in deflateInit2 and inflateInit2. -- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files -- * created by gzip. (Files created by minigzip can still be extracted by -- * gzip.) -- */ --#ifndef MAX_WBITS --# define MAX_WBITS 15 /* 32K LZ77 window */ --#endif -- --/* The memory requirements for deflate are (in bytes): -- (1 << (windowBits+2)) + (1 << (memLevel+9)) -- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) -- plus a few kilobytes for small objects. For example, if you want to reduce -- the default memory requirements from 256K to 128K, compile with -- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" -- Of course this will generally degrade compression (there's no free lunch). -- -- The memory requirements for inflate are (in bytes) 1 << windowBits -- that is, 32K for windowBits=15 (default value) plus a few kilobytes -- for small objects. --*/ -- -- /* Type declarations */ -- --#ifndef OF /* function prototypes */ --# ifdef STDC --# define OF(args) args --# else --# define OF(args) () --# endif --#endif -- --/* The following definitions for FAR are needed only for MSDOS mixed -- * model programming (small or medium model with some far allocations). -- * This was tested only with MSC; for other MSDOS compilers you may have -- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, -- * just define FAR to be empty. -- */ --#ifdef SYS16BIT --# if defined(M_I86SM) || defined(M_I86MM) -- /* MSC small or medium model */ --# define SMALL_MEDIUM --# ifdef _MSC_VER --# define FAR _far --# else --# define FAR far --# endif --# endif --# if (defined(__SMALL__) || defined(__MEDIUM__)) -- /* Turbo C small or medium model */ --# define SMALL_MEDIUM --# ifdef __BORLANDC__ --# define FAR _far --# else --# define FAR far --# endif --# endif --#endif -- --#if defined(WINDOWS) || defined(WIN32) -- /* If building or using zlib as a DLL, define ZLIB_DLL. -- * This is not mandatory, but it offers a little performance increase. -- */ --# ifdef ZLIB_DLL --# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) --# ifdef ZLIB_INTERNAL --# define ZEXTERN extern __declspec(dllexport) --# else --# define ZEXTERN extern __declspec(dllimport) --# endif --# endif --# endif /* ZLIB_DLL */ -- /* If building or using zlib with the WINAPI/WINAPIV calling convention, -- * define ZLIB_WINAPI. -- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. -- */ --# ifdef ZLIB_WINAPI --# ifdef FAR --# undef FAR --# endif --# include -- /* No need for _export, use ZLIB.DEF instead. */ -- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ --# define ZEXPORT WINAPI --# ifdef WIN32 --# define ZEXPORTVA WINAPIV --# else --# define ZEXPORTVA FAR CDECL --# endif --# endif --#endif -- --#if defined (__BEOS__) --# ifdef ZLIB_DLL --# ifdef ZLIB_INTERNAL --# define ZEXPORT __declspec(dllexport) --# define ZEXPORTVA __declspec(dllexport) --# else --# define ZEXPORT __declspec(dllimport) --# define ZEXPORTVA __declspec(dllimport) --# endif --# endif --#endif -- --#ifndef ZEXTERN --# define ZEXTERN extern --#endif --#ifndef ZEXPORT --# define ZEXPORT --#endif --#ifndef ZEXPORTVA --# define ZEXPORTVA --#endif -- --#ifndef FAR --# define FAR --#endif -- --#if !defined(__MACTYPES__) --typedef unsigned char Byte; /* 8 bits */ --#endif --typedef unsigned int uInt; /* 16 bits or more */ --typedef unsigned long uLong; /* 32 bits or more */ -- --#ifdef SMALL_MEDIUM -- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ --# define Bytef Byte FAR --#else -- typedef Byte FAR Bytef; --#endif --typedef char FAR charf; --typedef int FAR intf; --typedef uInt FAR uIntf; --typedef uLong FAR uLongf; -- --#ifdef STDC -- typedef void const *voidpc; -- typedef void FAR *voidpf; -- typedef void *voidp; --#else -- typedef Byte const *voidpc; -- typedef Byte FAR *voidpf; -- typedef Byte *voidp; --#endif -- --#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ --# include /* for off_t */ --# include /* for SEEK_* and off_t */ --# ifdef VMS --# include /* for off_t */ --# endif --# define z_off_t off_t --#endif --#ifndef SEEK_SET --# define SEEK_SET 0 /* Seek from beginning of file. */ --# define SEEK_CUR 1 /* Seek from current position. */ --# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ --#endif --#ifndef z_off_t --# define z_off_t long --#endif -- --#if defined(__OS400__) --# define NO_vsnprintf --#endif -- --#if defined(__MVS__) --# define NO_vsnprintf --# ifdef FAR --# undef FAR --# endif --#endif -- --/* MVS linker does not support external names larger than 8 bytes */ --#if defined(__MVS__) --# pragma map(deflateInit_,"DEIN") --# pragma map(deflateInit2_,"DEIN2") --# pragma map(deflateEnd,"DEEND") --# pragma map(deflateBound,"DEBND") --# pragma map(inflateInit_,"ININ") --# pragma map(inflateInit2_,"ININ2") --# pragma map(inflateEnd,"INEND") --# pragma map(inflateSync,"INSY") --# pragma map(inflateSetDictionary,"INSEDI") --# pragma map(compressBound,"CMBND") --# pragma map(inflate_table,"INTABL") --# pragma map(inflate_fast,"INFA") --# pragma map(inflate_copyright,"INCOPY") --#endif -- --#endif /* ZCONF_H */ -diff -ruN RJaCGH.orig/src/zconf.in.h RJaCGH/src/zconf.in.h ---- RJaCGH.orig/src/zconf.in.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/zconf.in.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,332 +0,0 @@ --/* zconf.h -- configuration of the zlib compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#ifndef ZCONF_H --#define ZCONF_H -- --/* -- * If you *really* need a unique prefix for all types and library functions, -- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. -- */ --#ifdef Z_PREFIX --# define deflateInit_ z_deflateInit_ --# define deflate z_deflate --# define deflateEnd z_deflateEnd --# define inflateInit_ z_inflateInit_ --# define inflate z_inflate --# define inflateEnd z_inflateEnd --# define deflateInit2_ z_deflateInit2_ --# define deflateSetDictionary z_deflateSetDictionary --# define deflateCopy z_deflateCopy --# define deflateReset z_deflateReset --# define deflateParams z_deflateParams --# define deflateBound z_deflateBound --# define deflatePrime z_deflatePrime --# define inflateInit2_ z_inflateInit2_ --# define inflateSetDictionary z_inflateSetDictionary --# define inflateSync z_inflateSync --# define inflateSyncPoint z_inflateSyncPoint --# define inflateCopy z_inflateCopy --# define inflateReset z_inflateReset --# define inflateBack z_inflateBack --# define inflateBackEnd z_inflateBackEnd --# define compress z_compress --# define compress2 z_compress2 --# define compressBound z_compressBound --# define uncompress z_uncompress --# define adler32 z_adler32 --# define crc32 z_crc32 --# define get_crc_table z_get_crc_table --# define zError z_zError -- --# define alloc_func z_alloc_func --# define free_func z_free_func --# define in_func z_in_func --# define out_func z_out_func --# define Byte z_Byte --# define uInt z_uInt --# define uLong z_uLong --# define Bytef z_Bytef --# define charf z_charf --# define intf z_intf --# define uIntf z_uIntf --# define uLongf z_uLongf --# define voidpf z_voidpf --# define voidp z_voidp --#endif -- --#if defined(__MSDOS__) && !defined(MSDOS) --# define MSDOS --#endif --#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) --# define OS2 --#endif --#if defined(_WINDOWS) && !defined(WINDOWS) --# define WINDOWS --#endif --#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) --# ifndef WIN32 --# define WIN32 --# endif --#endif --#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) --# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) --# ifndef SYS16BIT --# define SYS16BIT --# endif --# endif --#endif -- --/* -- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more -- * than 64k bytes at a time (needed on systems with 16-bit int). -- */ --#ifdef SYS16BIT --# define MAXSEG_64K --#endif --#ifdef MSDOS --# define UNALIGNED_OK --#endif -- --#ifdef __STDC_VERSION__ --# ifndef STDC --# define STDC --# endif --# if __STDC_VERSION__ >= 199901L --# ifndef STDC99 --# define STDC99 --# endif --# endif --#endif --#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) --# define STDC --#endif --#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) --# define STDC --#endif --#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) --# define STDC --#endif --#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) --# define STDC --#endif -- --#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ --# define STDC --#endif -- --#ifndef STDC --# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ --# define const /* note: need a more gentle solution here */ --# endif --#endif -- --/* Some Mac compilers merge all .h files incorrectly: */ --#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) --# define NO_DUMMY_DECL --#endif -- --/* Maximum value for memLevel in deflateInit2 */ --#ifndef MAX_MEM_LEVEL --# ifdef MAXSEG_64K --# define MAX_MEM_LEVEL 8 --# else --# define MAX_MEM_LEVEL 9 --# endif --#endif -- --/* Maximum value for windowBits in deflateInit2 and inflateInit2. -- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files -- * created by gzip. (Files created by minigzip can still be extracted by -- * gzip.) -- */ --#ifndef MAX_WBITS --# define MAX_WBITS 15 /* 32K LZ77 window */ --#endif -- --/* The memory requirements for deflate are (in bytes): -- (1 << (windowBits+2)) + (1 << (memLevel+9)) -- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) -- plus a few kilobytes for small objects. For example, if you want to reduce -- the default memory requirements from 256K to 128K, compile with -- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" -- Of course this will generally degrade compression (there's no free lunch). -- -- The memory requirements for inflate are (in bytes) 1 << windowBits -- that is, 32K for windowBits=15 (default value) plus a few kilobytes -- for small objects. --*/ -- -- /* Type declarations */ -- --#ifndef OF /* function prototypes */ --# ifdef STDC --# define OF(args) args --# else --# define OF(args) () --# endif --#endif -- --/* The following definitions for FAR are needed only for MSDOS mixed -- * model programming (small or medium model with some far allocations). -- * This was tested only with MSC; for other MSDOS compilers you may have -- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, -- * just define FAR to be empty. -- */ --#ifdef SYS16BIT --# if defined(M_I86SM) || defined(M_I86MM) -- /* MSC small or medium model */ --# define SMALL_MEDIUM --# ifdef _MSC_VER --# define FAR _far --# else --# define FAR far --# endif --# endif --# if (defined(__SMALL__) || defined(__MEDIUM__)) -- /* Turbo C small or medium model */ --# define SMALL_MEDIUM --# ifdef __BORLANDC__ --# define FAR _far --# else --# define FAR far --# endif --# endif --#endif -- --#if defined(WINDOWS) || defined(WIN32) -- /* If building or using zlib as a DLL, define ZLIB_DLL. -- * This is not mandatory, but it offers a little performance increase. -- */ --# ifdef ZLIB_DLL --# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) --# ifdef ZLIB_INTERNAL --# define ZEXTERN extern __declspec(dllexport) --# else --# define ZEXTERN extern __declspec(dllimport) --# endif --# endif --# endif /* ZLIB_DLL */ -- /* If building or using zlib with the WINAPI/WINAPIV calling convention, -- * define ZLIB_WINAPI. -- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. -- */ --# ifdef ZLIB_WINAPI --# ifdef FAR --# undef FAR --# endif --# include -- /* No need for _export, use ZLIB.DEF instead. */ -- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ --# define ZEXPORT WINAPI --# ifdef WIN32 --# define ZEXPORTVA WINAPIV --# else --# define ZEXPORTVA FAR CDECL --# endif --# endif --#endif -- --#if defined (__BEOS__) --# ifdef ZLIB_DLL --# ifdef ZLIB_INTERNAL --# define ZEXPORT __declspec(dllexport) --# define ZEXPORTVA __declspec(dllexport) --# else --# define ZEXPORT __declspec(dllimport) --# define ZEXPORTVA __declspec(dllimport) --# endif --# endif --#endif -- --#ifndef ZEXTERN --# define ZEXTERN extern --#endif --#ifndef ZEXPORT --# define ZEXPORT --#endif --#ifndef ZEXPORTVA --# define ZEXPORTVA --#endif -- --#ifndef FAR --# define FAR --#endif -- --#if !defined(__MACTYPES__) --typedef unsigned char Byte; /* 8 bits */ --#endif --typedef unsigned int uInt; /* 16 bits or more */ --typedef unsigned long uLong; /* 32 bits or more */ -- --#ifdef SMALL_MEDIUM -- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ --# define Bytef Byte FAR --#else -- typedef Byte FAR Bytef; --#endif --typedef char FAR charf; --typedef int FAR intf; --typedef uInt FAR uIntf; --typedef uLong FAR uLongf; -- --#ifdef STDC -- typedef void const *voidpc; -- typedef void FAR *voidpf; -- typedef void *voidp; --#else -- typedef Byte const *voidpc; -- typedef Byte FAR *voidpf; -- typedef Byte *voidp; --#endif -- --#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ --# include /* for off_t */ --# include /* for SEEK_* and off_t */ --# ifdef VMS --# include /* for off_t */ --# endif --# define z_off_t off_t --#endif --#ifndef SEEK_SET --# define SEEK_SET 0 /* Seek from beginning of file. */ --# define SEEK_CUR 1 /* Seek from current position. */ --# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ --#endif --#ifndef z_off_t --# define z_off_t long --#endif -- --#if defined(__OS400__) --# define NO_vsnprintf --#endif -- --#if defined(__MVS__) --# define NO_vsnprintf --# ifdef FAR --# undef FAR --# endif --#endif -- --/* MVS linker does not support external names larger than 8 bytes */ --#if defined(__MVS__) --# pragma map(deflateInit_,"DEIN") --# pragma map(deflateInit2_,"DEIN2") --# pragma map(deflateEnd,"DEEND") --# pragma map(deflateBound,"DEBND") --# pragma map(inflateInit_,"ININ") --# pragma map(inflateInit2_,"ININ2") --# pragma map(inflateEnd,"INEND") --# pragma map(inflateSync,"INSY") --# pragma map(inflateSetDictionary,"INSEDI") --# pragma map(compressBound,"CMBND") --# pragma map(inflate_table,"INTABL") --# pragma map(inflate_fast,"INFA") --# pragma map(inflate_copyright,"INCOPY") --#endif -- --#endif /* ZCONF_H */ -diff -ruN RJaCGH.orig/src/zlib.h RJaCGH/src/zlib.h ---- RJaCGH.orig/src/zlib.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/zlib.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1357 +0,0 @@ --/* zlib.h -- interface of the 'zlib' general purpose compression library -- version 1.2.3, July 18th, 2005 -- -- Copyright (C) 1995-2005 Jean-loup Gailly and Mark Adler -- -- This software is provided 'as-is', without any express or implied -- warranty. In no event will the authors be held liable for any damages -- arising from the use of this software. -- -- Permission is granted to anyone to use this software for any purpose, -- including commercial applications, and to alter it and redistribute it -- freely, subject to the following restrictions: -- -- 1. The origin of this software must not be misrepresented; you must not -- claim that you wrote the original software. If you use this software -- in a product, an acknowledgment in the product documentation would be -- appreciated but is not required. -- 2. Altered source versions must be plainly marked as such, and must not be -- misrepresented as being the original software. -- 3. This notice may not be removed or altered from any source distribution. -- -- Jean-loup Gailly Mark Adler -- jloup@gzip.org madler@alumni.caltech.edu -- -- -- The data format used by the zlib library is described by RFCs (Request for -- Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt -- (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). --*/ -- --#ifndef ZLIB_H --#define ZLIB_H -- --#include "zconf.h" -- --#ifdef __cplusplus --extern "C" { --#endif -- --#define ZLIB_VERSION "1.2.3" --#define ZLIB_VERNUM 0x1230 -- --/* -- The 'zlib' compression library provides in-memory compression and -- decompression functions, including integrity checks of the uncompressed -- data. This version of the library supports only one compression method -- (deflation) but other algorithms will be added later and will have the same -- stream interface. -- -- Compression can be done in a single step if the buffers are large -- enough (for example if an input file is mmap'ed), or can be done by -- repeated calls of the compression function. In the latter case, the -- application must provide more input and/or consume the output -- (providing more output space) before each call. -- -- The compressed data format used by default by the in-memory functions is -- the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped -- around a deflate stream, which is itself documented in RFC 1951. -- -- The library also supports reading and writing files in gzip (.gz) format -- with an interface similar to that of stdio using the functions that start -- with "gz". The gzip format is different from the zlib format. gzip is a -- gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. -- -- This library can optionally read and write gzip streams in memory as well. -- -- The zlib format was designed to be compact and fast for use in memory -- and on communications channels. The gzip format was designed for single- -- file compression on file systems, has a larger header than zlib to maintain -- directory information, and uses a different, slower check method than zlib. -- -- The library does not install any signal handler. The decoder checks -- the consistency of the compressed data, so the library should never -- crash even in case of corrupted input. --*/ -- --typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); --typedef void (*free_func) OF((voidpf opaque, voidpf address)); -- --struct internal_state; -- --typedef struct z_stream_s { -- Bytef *next_in; /* next input byte */ -- uInt avail_in; /* number of bytes available at next_in */ -- uLong total_in; /* total nb of input bytes read so far */ -- -- Bytef *next_out; /* next output byte should be put there */ -- uInt avail_out; /* remaining free space at next_out */ -- uLong total_out; /* total nb of bytes output so far */ -- -- char *msg; /* last error message, NULL if no error */ -- struct internal_state FAR *state; /* not visible by applications */ -- -- alloc_func zalloc; /* used to allocate the internal state */ -- free_func zfree; /* used to free the internal state */ -- voidpf opaque; /* private data object passed to zalloc and zfree */ -- -- int data_type; /* best guess about the data type: binary or text */ -- uLong adler; /* adler32 value of the uncompressed data */ -- uLong reserved; /* reserved for future use */ --} z_stream; -- --typedef z_stream FAR *z_streamp; -- --/* -- gzip header information passed to and from zlib routines. See RFC 1952 -- for more details on the meanings of these fields. --*/ --typedef struct gz_header_s { -- int text; /* true if compressed data believed to be text */ -- uLong time; /* modification time */ -- int xflags; /* extra flags (not used when writing a gzip file) */ -- int os; /* operating system */ -- Bytef *extra; /* pointer to extra field or Z_NULL if none */ -- uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ -- uInt extra_max; /* space at extra (only when reading header) */ -- Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ -- uInt name_max; /* space at name (only when reading header) */ -- Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ -- uInt comm_max; /* space at comment (only when reading header) */ -- int hcrc; /* true if there was or will be a header crc */ -- int done; /* true when done reading gzip header (not used -- when writing a gzip file) */ --} gz_header; -- --typedef gz_header FAR *gz_headerp; -- --/* -- 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 -- has dropped to zero. The application must initialize zalloc, zfree and -- opaque before calling the init function. All other fields are set by the -- compression library and must not be updated by the application. -- -- The opaque value provided by the application will be passed as the first -- parameter for calls of zalloc and zfree. This can be useful for custom -- memory management. The compression library attaches no meaning to the -- opaque value. -- -- zalloc must return Z_NULL if there is not enough memory for the object. -- If zlib is used in a multi-threaded application, zalloc and zfree must be -- thread safe. -- -- On 16-bit systems, the functions zalloc and zfree must be able to allocate -- exactly 65536 bytes, but will not be required to allocate more than this -- if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, -- pointers returned by zalloc for objects of exactly 65536 bytes *must* -- have their offset normalized to zero. The default allocation function -- provided by this library ensures this (see zutil.c). To reduce memory -- requirements and avoid any allocation of 64K objects, at the expense of -- compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). -- -- The fields total_in and total_out can be used for statistics or -- progress reports. After compression, total_in holds the total size of -- the uncompressed data and may be saved for use in the decompressor -- (particularly if the decompressor wants to decompress everything in -- a single step). --*/ -- -- /* constants */ -- --#define Z_NO_FLUSH 0 --#define Z_PARTIAL_FLUSH 1 /* will be removed, use Z_SYNC_FLUSH instead */ --#define Z_SYNC_FLUSH 2 --#define Z_FULL_FLUSH 3 --#define Z_FINISH 4 --#define Z_BLOCK 5 --/* Allowed flush values; see deflate() and inflate() below for details */ -- --#define Z_OK 0 --#define Z_STREAM_END 1 --#define Z_NEED_DICT 2 --#define Z_ERRNO (-1) --#define Z_STREAM_ERROR (-2) --#define Z_DATA_ERROR (-3) --#define Z_MEM_ERROR (-4) --#define Z_BUF_ERROR (-5) --#define Z_VERSION_ERROR (-6) --/* Return codes for the compression/decompression functions. Negative -- * values are errors, positive values are used for special but normal events. -- */ -- --#define Z_NO_COMPRESSION 0 --#define Z_BEST_SPEED 1 --#define Z_BEST_COMPRESSION 9 --#define Z_DEFAULT_COMPRESSION (-1) --/* compression levels */ -- --#define Z_FILTERED 1 --#define Z_HUFFMAN_ONLY 2 --#define Z_RLE 3 --#define Z_FIXED 4 --#define Z_DEFAULT_STRATEGY 0 --/* compression strategy; see deflateInit2() below for details */ -- --#define Z_BINARY 0 --#define Z_TEXT 1 --#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ --#define Z_UNKNOWN 2 --/* Possible values of the data_type field (though see inflate()) */ -- --#define Z_DEFLATED 8 --/* The deflate compression method (the only one supported in this version) */ -- --#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ -- --#define zlib_version zlibVersion() --/* for compatibility with versions < 1.0.2 */ -- -- /* basic functions */ -- --ZEXTERN const char * ZEXPORT zlibVersion OF((void)); --/* The application can compare zlibVersion and ZLIB_VERSION for consistency. -- If the first character differs, the library code actually used is -- not compatible with the zlib.h header file used by the application. -- This check is automatically made by deflateInit and inflateInit. -- */ -- --/* --ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); -- -- Initializes the internal stream state for compression. The fields -- zalloc, zfree and opaque must be initialized before by the caller. -- If zalloc and zfree are set to Z_NULL, deflateInit updates them to -- use default allocation functions. -- -- The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: -- 1 gives best speed, 9 gives best compression, 0 gives no compression at -- all (the input data is simply copied a block at a time). -- Z_DEFAULT_COMPRESSION requests a default compromise between speed and -- compression (currently equivalent to level 6). -- -- deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if level is not a valid compression level, -- Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible -- with the version assumed by the caller (ZLIB_VERSION). -- msg is set to null if there is no error message. deflateInit does not -- perform any compression: this will be done by deflate(). --*/ -- -- --ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); --/* -- deflate compresses as much data as possible, and stops when the input -- buffer becomes empty or the output buffer becomes full. It may introduce some -- output latency (reading input without producing any output) except when -- forced to flush. -- -- The detailed semantics are as follows. deflate performs one or both of the -- following actions: -- -- - Compress more input starting at next_in and update next_in and avail_in -- accordingly. If not all input can be processed (because there is not -- enough room in the output buffer), next_in and avail_in are updated and -- processing will resume at this point for the next call of deflate(). -- -- - Provide more output starting at next_out and update next_out and avail_out -- accordingly. This action is forced if the parameter flush is non zero. -- Forcing flush frequently degrades the compression ratio, so this parameter -- should be set only when necessary (in interactive applications). -- Some output may be provided even if flush is not set. -- -- Before the call of deflate(), the application should ensure that at least -- one of the actions is possible, by providing more input and/or consuming -- more output, and updating avail_in or avail_out accordingly; avail_out -- should never be zero before the call. The application can consume the -- compressed output when it wants, for example when the output buffer is full -- (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK -- and with zero avail_out, it must be called again after making room in the -- output buffer because there might be more output pending. -- -- Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to -- decide how much data to accumualte before producing output, in order to -- maximize compression. -- -- If the parameter flush is set to Z_SYNC_FLUSH, all pending output is -- flushed to the output buffer and the output is aligned on a byte boundary, so -- that the decompressor can get all input data available so far. (In particular -- avail_in is zero after the call if enough output space has been provided -- before the call.) Flushing may degrade compression for some compression -- algorithms and so it should be used only when necessary. -- -- If flush is set to Z_FULL_FLUSH, all output is flushed as with -- Z_SYNC_FLUSH, and the compression state is reset so that decompression can -- restart from this point if previous compressed data has been damaged or if -- random access is desired. Using Z_FULL_FLUSH too often can seriously degrade -- compression. -- -- If deflate returns with avail_out == 0, this function must be called again -- with the same value of the flush parameter and more output space (updated -- avail_out), until the flush is complete (deflate returns with non-zero -- avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that -- avail_out is greater than six to avoid repeated flush markers due to -- avail_out == 0 on return. -- -- If the parameter flush is set to Z_FINISH, pending input is processed, -- pending output is flushed and deflate returns with Z_STREAM_END if there -- was enough output space; if deflate returns with Z_OK, this function must be -- called again with Z_FINISH and more output space (updated avail_out) but no -- more input data, until it returns with Z_STREAM_END or an error. After -- deflate has returned Z_STREAM_END, the only possible operations on the -- stream are deflateReset or deflateEnd. -- -- Z_FINISH can be used immediately after deflateInit if all the compression -- is to be done in a single step. In this case, avail_out must be at least -- the value returned by deflateBound (see below). If deflate does not return -- Z_STREAM_END, then it must be called again as described above. -- -- deflate() sets strm->adler to the adler32 checksum of all input read -- so far (that is, total_in bytes). -- -- deflate() may update strm->data_type if it can make a good guess about -- the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered -- binary. This field is only for information purposes and does not affect -- the compression algorithm in any manner. -- -- deflate() returns Z_OK if some progress has been made (more input -- processed or more output produced), Z_STREAM_END if all input has been -- consumed and all output has been produced (only when flush is set to -- Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example -- if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible -- (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not -- fatal, and deflate() can be called again with more input and more output -- space to continue compressing. --*/ -- -- --ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); --/* -- All dynamically allocated data structures for this stream are freed. -- This function discards any unprocessed input and does not flush any -- pending output. -- -- deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the -- stream state was inconsistent, Z_DATA_ERROR if the stream was freed -- prematurely (some input or output was discarded). In the error case, -- msg may be set but then points to a static string (which must not be -- deallocated). --*/ -- -- --/* --ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); -- -- Initializes the internal stream state for decompression. The fields -- next_in, avail_in, zalloc, zfree and opaque must be initialized before by -- the caller. If next_in is not Z_NULL and avail_in is large enough (the exact -- value depends on the compression method), inflateInit determines the -- compression method from the zlib header and allocates all data structures -- accordingly; otherwise the allocation will be deferred to the first call of -- inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to -- use default allocation functions. -- -- inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_VERSION_ERROR if the zlib library version is incompatible with the -- version assumed by the caller. msg is set to null if there is no error -- message. inflateInit does not perform any decompression apart from reading -- the zlib header if present: this will be done by inflate(). (So next_in and -- avail_in may be modified, but next_out and avail_out are unchanged.) --*/ -- -- --ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); --/* -- inflate decompresses as much data as possible, and stops when the input -- buffer becomes empty or the output buffer becomes full. It may introduce -- some output latency (reading input without producing any output) except when -- forced to flush. -- -- The detailed semantics are as follows. inflate performs one or both of the -- following actions: -- -- - Decompress more input starting at next_in and update next_in and avail_in -- accordingly. If not all input can be processed (because there is not -- enough room in the output buffer), next_in is updated and processing -- will resume at this point for the next call of inflate(). -- -- - Provide more output starting at next_out and update next_out and avail_out -- accordingly. inflate() provides as much output as possible, until there -- is no more input data or no more space in the output buffer (see below -- about the flush parameter). -- -- Before the call of inflate(), the application should ensure that at least -- one of the actions is possible, by providing more input and/or consuming -- more output, and updating the next_* and avail_* values accordingly. -- The application can consume the uncompressed output when it wants, for -- example when the output buffer is full (avail_out == 0), or after each -- call of inflate(). If inflate returns Z_OK and with zero avail_out, it -- must be called again after making room in the output buffer because there -- might be more output pending. -- -- The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, -- Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much -- output as possible to the output buffer. Z_BLOCK requests that inflate() stop -- if and when it gets to the next deflate block boundary. When decoding the -- zlib or gzip format, this will cause inflate() to return immediately after -- the header and before the first block. When doing a raw inflate, inflate() -- will go ahead and process the first block, and will return when it gets to -- the end of that block, or when it runs out of data. -- -- The Z_BLOCK option assists in appending to or combining deflate streams. -- Also to assist in this, on return inflate() will set strm->data_type to the -- number of unused bits in the last byte taken from strm->next_in, plus 64 -- if inflate() is currently decoding the last block in the deflate stream, -- plus 128 if inflate() returned immediately after decoding an end-of-block -- code or decoding the complete header up to just before the first byte of the -- deflate stream. The end-of-block will not be indicated until all of the -- uncompressed data from that block has been written to strm->next_out. The -- number of unused bits may in general be greater than seven, except when -- bit 7 of data_type is set, in which case the number of unused bits will be -- less than eight. -- -- inflate() should normally be called until it returns Z_STREAM_END or an -- error. However if all decompression is to be performed in a single step -- (a single call of inflate), the parameter flush should be set to -- Z_FINISH. In this case all pending input is processed and all pending -- output is flushed; avail_out must be large enough to hold all the -- uncompressed data. (The size of the uncompressed data may have been saved -- by the compressor for this purpose.) The next operation on this stream must -- be inflateEnd to deallocate the decompression state. The use of Z_FINISH -- is never required, but can be used to inform inflate that a faster approach -- may be used for the single inflate() call. -- -- In this implementation, inflate() always flushes as much output as -- possible to the output buffer, and always uses the faster approach on the -- first call. So the only effect of the flush parameter in this implementation -- is on the return value of inflate(), as noted below, or when it returns early -- because Z_BLOCK is used. -- -- If a preset dictionary is needed after this call (see inflateSetDictionary -- below), inflate sets strm->adler to the adler32 checksum of the 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() checks that its computed adler32 -- checksum is equal to that saved by the compressor and returns Z_STREAM_END -- only if the checksum is correct. -- -- inflate() will decompress and check either zlib-wrapped or gzip-wrapped -- deflate data. The header type is detected automatically. Any information -- contained in the gzip header is not retained, so applications that need that -- information should instead use raw inflate, see inflateInit2() below, or -- inflateBack() and perform their own processing of the gzip header and -- trailer. -- -- inflate() returns Z_OK if some progress has been made (more input processed -- or more output produced), Z_STREAM_END if the end of the compressed data has -- been reached and all uncompressed output has been produced, Z_NEED_DICT if a -- preset dictionary is needed at this point, Z_DATA_ERROR if the input data was -- corrupted (input stream not conforming to the zlib format or incorrect check -- value), Z_STREAM_ERROR if the stream structure was inconsistent (for example -- if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, -- Z_BUF_ERROR if no progress is possible or if there was not enough room in the -- output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and -- inflate() can be called again with more input and more output space to -- continue decompressing. If Z_DATA_ERROR is returned, the application may then -- call inflateSync() to look for a good compression block if a partial recovery -- of the data is desired. --*/ -- -- --ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); --/* -- All dynamically allocated data structures for this stream are freed. -- This function discards any unprocessed input and does not flush any -- pending output. -- -- inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state -- was inconsistent. In the error case, msg may be set but then points to a -- static string (which must not be deallocated). --*/ -- -- /* Advanced functions */ -- --/* -- The following functions are needed only in some special applications. --*/ -- --/* --ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, -- int level, -- int method, -- int windowBits, -- int memLevel, -- int strategy)); -- -- This is another version of deflateInit with more compression options. The -- fields next_in, zalloc, zfree and opaque must be initialized before by -- the caller. -- -- The method parameter is the compression method. It must be Z_DEFLATED in -- this version of the library. -- -- The windowBits parameter is the base two logarithm of the window size -- (the size of the history buffer). It should be in the range 8..15 for this -- version of the library. Larger values of this parameter result in better -- compression at the expense of memory usage. The default value is 15 if -- deflateInit is used instead. -- -- windowBits can also be -8..-15 for raw deflate. In this case, -windowBits -- determines the window size. deflate() will then generate raw deflate data -- with no zlib header or trailer, and will not compute an adler32 check value. -- -- windowBits can also be greater than 15 for optional gzip encoding. Add -- 16 to windowBits to write a simple gzip header and trailer around the -- compressed data instead of a zlib wrapper. The gzip header will have no -- file name, no extra data, no comment, no modification time (set to zero), -- no header crc, and the operating system will be set to 255 (unknown). If a -- gzip stream is being written, strm->adler is a crc32 instead of an adler32. -- -- The memLevel parameter specifies how much memory should be allocated -- for the internal compression state. memLevel=1 uses minimum memory but -- is slow and reduces compression ratio; memLevel=9 uses maximum memory -- for optimal speed. The default value is 8. See zconf.h for total memory -- usage as a function of windowBits and memLevel. -- -- The strategy parameter is used to tune the compression algorithm. Use the -- value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a -- filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no -- string match), or Z_RLE to limit match distances to one (run-length -- encoding). Filtered data consists mostly of small values with a somewhat -- random distribution. In this case, the compression algorithm is tuned to -- compress them better. The effect of Z_FILTERED is to force more Huffman -- coding and less string matching; it is somewhat intermediate between -- Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as -- Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy -- parameter only affects the compression ratio but not the correctness of the -- compressed output even if it is not set appropriately. Z_FIXED prevents the -- use of dynamic Huffman codes, allowing for a simpler decoder for special -- applications. -- -- deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid -- method). msg is set to null if there is no error message. deflateInit2 does -- not perform any compression: this will be done by deflate(). --*/ -- --ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, -- const Bytef *dictionary, -- uInt dictLength)); --/* -- Initializes the compression dictionary from the given byte sequence -- without producing any compressed output. This function must be called -- immediately after deflateInit, deflateInit2 or deflateReset, before any -- call of deflate. The compressor and decompressor must use exactly the same -- dictionary (see inflateSetDictionary). -- -- The dictionary should consist of strings (byte sequences) that are likely -- to be encountered later in the data to be compressed, with the most commonly -- used strings preferably put towards the end of the dictionary. Using a -- dictionary is most useful when the data to be compressed is short and can be -- predicted with good accuracy; the data can then be compressed better than -- with the default empty dictionary. -- -- Depending on the size of the compression data structures selected by -- deflateInit or deflateInit2, a part of the dictionary may in effect be -- discarded, for example if the dictionary is larger than the window size in -- deflate or deflate2. Thus the strings most likely to be useful should be -- put at the end of the dictionary, not at the front. In addition, the -- current implementation of deflate will use at most the window size minus -- 262 bytes of the provided dictionary. -- -- Upon return of this function, strm->adler is set to the adler32 value -- of the dictionary; the decompressor may later use this value to determine -- which dictionary has been used by the compressor. (The adler32 value -- applies to the whole dictionary even if only a subset of the dictionary is -- actually used by the compressor.) If a raw deflate was requested, then the -- adler32 value is not computed and strm->adler is not set. -- -- deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a -- parameter is invalid (such as NULL dictionary) or the stream state is -- inconsistent (for example if deflate has already been called for this stream -- or if the compression method is bsort). deflateSetDictionary does not -- perform any compression: this will be done by deflate(). --*/ -- --ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, -- z_streamp source)); --/* -- Sets the destination stream as a complete copy of the source stream. -- -- This function can be useful when several compression strategies will be -- tried, for example when there are several ways of pre-processing the input -- data with a filter. The streams that will be discarded should then be freed -- by calling deflateEnd. Note that deflateCopy duplicates the internal -- compression state which can be quite large, so this strategy is slow and -- can consume lots of memory. -- -- deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent -- (such as zalloc being NULL). msg is left unchanged in both source and -- destination. --*/ -- --ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); --/* -- This function is equivalent to deflateEnd followed by deflateInit, -- but does not free and reallocate all the internal compression state. -- The stream will keep the same compression level and any other attributes -- that may have been set by deflateInit2. -- -- deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent (such as zalloc or state being NULL). --*/ -- --ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, -- int level, -- int strategy)); --/* -- Dynamically update the compression level and compression strategy. The -- interpretation of level and strategy is as in deflateInit2. This can be -- used to switch between compression and straight copy of the input data, or -- to switch to a different kind of input data requiring a different -- strategy. If the compression level is changed, the input available so far -- is compressed with the old level (and may be flushed); the new level will -- take effect only at the next call of deflate(). -- -- Before the call of deflateParams, the stream state must be set as for -- a call of deflate(), since the currently available input may have to -- be compressed and flushed. In particular, strm->avail_out must be non-zero. -- -- deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source -- stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR -- if strm->avail_out was zero. --*/ -- --ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, -- int good_length, -- int max_lazy, -- int nice_length, -- int max_chain)); --/* -- Fine tune deflate's internal compression parameters. This should only be -- used by someone who understands the algorithm used by zlib's deflate for -- searching for the best matching string, and even then only by the most -- fanatic optimizer trying to squeeze out the last compressed bit for their -- specific input data. Read the deflate.c source code for the meaning of the -- max_lazy, good_length, nice_length, and max_chain parameters. -- -- deflateTune() can be called after deflateInit() or deflateInit2(), and -- returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. -- */ -- --ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, -- uLong sourceLen)); --/* -- deflateBound() returns an upper bound on the compressed size after -- deflation of sourceLen bytes. It must be called after deflateInit() -- or deflateInit2(). This would be used to allocate an output buffer -- for deflation in a single pass, and so would be called before deflate(). --*/ -- --ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, -- int bits, -- int value)); --/* -- deflatePrime() inserts bits in the deflate output stream. The intent -- is that this function is used to start off the deflate output with the -- bits leftover from a previous deflate stream when appending to it. As such, -- this function can only be used for raw deflate, and must be used before the -- first deflate() call after a deflateInit2() or deflateReset(). bits must be -- less than or equal to 16, and that many of the least significant bits of -- value will be inserted in the output. -- -- deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, -- gz_headerp head)); --/* -- deflateSetHeader() provides gzip header information for when a gzip -- stream is requested by deflateInit2(). deflateSetHeader() may be called -- after deflateInit2() or deflateReset() and before the first call of -- deflate(). The text, time, os, extra field, name, and comment information -- in the provided gz_header structure are written to the gzip header (xflag is -- ignored -- the extra flags are set according to the compression level). The -- caller must assure that, if not Z_NULL, name and comment are terminated with -- a zero byte, and that if extra is not Z_NULL, that extra_len bytes are -- available there. If hcrc is true, a gzip header crc is included. Note that -- the current versions of the command-line version of gzip (up through version -- 1.3.x) do not support header crc's, and will report that it is a "multi-part -- gzip file" and give up. -- -- If deflateSetHeader is not used, the default gzip header has text false, -- the time set to zero, and os set to 255, with no extra, name, or comment -- fields. The gzip header is returned to the default state by deflateReset(). -- -- deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --/* --ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, -- int windowBits)); -- -- This is another version of inflateInit with an extra parameter. The -- fields next_in, avail_in, zalloc, zfree and opaque must be initialized -- before by the caller. -- -- The windowBits parameter is the base two logarithm of the maximum window -- size (the size of the history buffer). It should be in the range 8..15 for -- this version of the library. The default value is 15 if inflateInit is used -- instead. windowBits must be greater than or equal to the windowBits value -- provided to deflateInit2() while compressing, or it must be equal to 15 if -- deflateInit2() was not used. If a compressed stream with a larger window -- size is given as input, inflate() will return with the error code -- Z_DATA_ERROR instead of trying to allocate a larger window. -- -- windowBits can also be -8..-15 for raw inflate. In this case, -windowBits -- determines the window size. inflate() will then process raw deflate data, -- not looking for a zlib or gzip header, not generating a check value, and not -- looking for any check values for comparison at the end of the stream. This -- is for use with other formats that use the deflate compressed data format -- such as zip. Those formats provide their own check values. If a custom -- format is developed using the raw deflate format for compressed data, it is -- recommended that a check value such as an adler32 or a crc32 be applied to -- the uncompressed data as is done in the zlib, gzip, and zip formats. For -- most applications, the zlib format should be used as is. Note that comments -- above on the use in deflateInit2() applies to the magnitude of windowBits. -- -- windowBits can also be greater than 15 for optional gzip decoding. Add -- 32 to windowBits to enable zlib and gzip decoding with automatic header -- detection, or add 16 to decode only the gzip format (the zlib format will -- return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is -- a crc32 instead of an adler32. -- -- inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). msg -- is set to null if there is no error message. inflateInit2 does not perform -- any decompression apart from reading the zlib header if present: this will -- be done by inflate(). (So next_in and avail_in may be modified, but next_out -- and avail_out are unchanged.) --*/ -- --ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, -- const Bytef *dictionary, -- uInt dictLength)); --/* -- Initializes the decompression dictionary from the given uncompressed byte -- sequence. This function must be called immediately after a call of inflate, -- if that call returned Z_NEED_DICT. The dictionary chosen by the compressor -- can be determined from the adler32 value returned by that call of inflate. -- The compressor and decompressor must use exactly the same dictionary (see -- deflateSetDictionary). For raw inflate, this function can be called -- immediately after inflateInit2() or inflateReset() and before any call of -- inflate() to set the dictionary. The application must insure that the -- dictionary that was used for compression is provided. -- -- inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a -- parameter is invalid (such as NULL dictionary) or the stream state is -- inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the -- expected one (incorrect adler32 value). inflateSetDictionary does not -- perform any decompression: this will be done by subsequent calls of -- inflate(). --*/ -- --ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); --/* -- Skips invalid compressed data until a full flush point (see above the -- description of deflate with Z_FULL_FLUSH) can be found, or until all -- available input is skipped. No output is provided. -- -- inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR -- if no more input was provided, Z_DATA_ERROR if no flush point has been found, -- or Z_STREAM_ERROR if the stream structure was inconsistent. In the success -- case, the application may save the current current value of total_in which -- indicates where valid compressed data was found. In the error case, the -- application may repeatedly call inflateSync, providing more input each time, -- until success or end of the input data. --*/ -- --ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, -- z_streamp source)); --/* -- Sets the destination stream as a complete copy of the source stream. -- -- This function can be useful when randomly accessing a large stream. The -- first pass through the stream can periodically record the inflate state, -- allowing restarting inflate at those points when randomly accessing the -- stream. -- -- inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent -- (such as zalloc being NULL). msg is left unchanged in both source and -- destination. --*/ -- --ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); --/* -- This function is equivalent to inflateEnd followed by inflateInit, -- but does not free and reallocate all the internal decompression state. -- The stream will keep attributes that may have been set by inflateInit2. -- -- inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent (such as zalloc or state being NULL). --*/ -- --ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, -- int bits, -- int value)); --/* -- This function inserts bits in the inflate input stream. The intent is -- that this function is used to start inflating at a bit position in the -- middle of a byte. The provided bits will be used before any bytes are used -- from next_in. This function should only be used with raw inflate, and -- should be used before the first inflate() call after inflateInit2() or -- inflateReset(). bits must be less than or equal to 16, and that many of the -- least significant bits of value will be inserted in the input. -- -- inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, -- gz_headerp head)); --/* -- inflateGetHeader() requests that gzip header information be stored in the -- provided gz_header structure. inflateGetHeader() may be called after -- inflateInit2() or inflateReset(), and before the first call of inflate(). -- As inflate() processes the gzip stream, head->done is zero until the header -- is completed, at which time head->done is set to one. If a zlib stream is -- being decoded, then head->done is set to -1 to indicate that there will be -- no gzip header information forthcoming. Note that Z_BLOCK can be used to -- force inflate() to return immediately after header processing is complete -- and before any actual data is decompressed. -- -- The text, time, xflags, and os fields are filled in with the gzip header -- contents. hcrc is set to true if there is a header CRC. (The header CRC -- was valid if done is set to one.) If extra is not Z_NULL, then extra_max -- contains the maximum number of bytes to write to extra. Once done is true, -- extra_len contains the actual extra field length, and extra contains the -- extra field, or that field truncated if extra_max is less than extra_len. -- If name is not Z_NULL, then up to name_max characters are written there, -- terminated with a zero unless the length is greater than name_max. If -- comment is not Z_NULL, then up to comm_max characters are written there, -- terminated with a zero unless the length is greater than comm_max. When -- any of extra, name, or comment are not Z_NULL and the respective field is -- not present in the header, then that field is set to Z_NULL to signal its -- absence. This allows the use of deflateSetHeader() with the returned -- structure to duplicate the header. However if those fields are set to -- allocated memory, then the application will need to save those pointers -- elsewhere so that they can be eventually freed. -- -- If inflateGetHeader is not used, then the header information is simply -- discarded. The header is always checked for validity, including the header -- CRC if present. inflateReset() will reset the process to discard the header -- information. The application would need to call inflateGetHeader() again to -- retrieve the header from the next gzip stream. -- -- inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --/* --ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, -- unsigned char FAR *window)); -- -- Initialize the internal stream state for decompression using inflateBack() -- calls. The fields zalloc, zfree and opaque in strm must be initialized -- before the call. If zalloc and zfree are Z_NULL, then the default library- -- derived memory allocation routines are used. windowBits is the base two -- logarithm of the window size, in the range 8..15. window is a caller -- supplied buffer of that size. Except for special applications where it is -- assured that deflate was used with small window sizes, windowBits must be 15 -- and a 32K byte window must be supplied to be able to decompress general -- deflate streams. -- -- See inflateBack() for the usage of these routines. -- -- inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of -- the paramaters are invalid, Z_MEM_ERROR if the internal state could not -- be allocated, or Z_VERSION_ERROR if the version of the library does not -- match the version of the header file. --*/ -- --typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); --typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); -- --ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, -- in_func in, void FAR *in_desc, -- out_func out, void FAR *out_desc)); --/* -- inflateBack() does a raw inflate with a single call using a call-back -- interface for input and output. This is more efficient than inflate() for -- file i/o applications in that it avoids copying between the output and the -- sliding window by simply making the window itself the output buffer. This -- function trusts the application to not change the output buffer passed by -- the output function, at least until inflateBack() returns. -- -- inflateBackInit() must be called first to allocate the internal state -- and to initialize the state with the user-provided window buffer. -- inflateBack() may then be used multiple times to inflate a complete, raw -- deflate stream with each call. inflateBackEnd() is then called to free -- the allocated state. -- -- A raw deflate stream is one with no zlib or gzip header or trailer. -- This routine would normally be used in a utility that reads zip or gzip -- files and writes out uncompressed files. The utility would decode the -- header and process the trailer on its own, hence this routine expects -- only the raw deflate stream to decompress. This is different from the -- normal behavior of inflate(), which expects either a zlib or gzip header and -- trailer around the deflate stream. -- -- inflateBack() uses two subroutines supplied by the caller that are then -- called by inflateBack() for input and output. inflateBack() calls those -- routines until it reads a complete deflate stream and writes out all of the -- uncompressed data, or until it encounters an error. The function's -- parameters and return types are defined above in the in_func and out_func -- typedefs. inflateBack() will call in(in_desc, &buf) which should return the -- number of bytes of provided input, and a pointer to that input in buf. If -- there is no input available, in() must return zero--buf is ignored in that -- case--and inflateBack() will return a buffer error. inflateBack() will call -- out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() -- should return zero on success, or non-zero on failure. If out() returns -- non-zero, inflateBack() will return with an error. Neither in() nor out() -- are permitted to change the contents of the window provided to -- inflateBackInit(), which is also the buffer that out() uses to write from. -- The length written by out() will be at most the window size. Any non-zero -- amount of input may be provided by in(). -- -- For convenience, inflateBack() can be provided input on the first call by -- setting strm->next_in and strm->avail_in. If that input is exhausted, then -- in() will be called. Therefore strm->next_in must be initialized before -- calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called -- immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in -- must also be initialized, and then if strm->avail_in is not zero, input will -- initially be taken from strm->next_in[0 .. strm->avail_in - 1]. -- -- The in_desc and out_desc parameters of inflateBack() is passed as the -- first parameter of in() and out() respectively when they are called. These -- descriptors can be optionally used to pass any information that the caller- -- supplied in() and out() functions need to do their job. -- -- On return, inflateBack() will set strm->next_in and strm->avail_in to -- pass back any unused input that was provided by the last in() call. The -- return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR -- if in() or out() returned an error, Z_DATA_ERROR if there was a format -- error in the deflate stream (in which case strm->msg is set to indicate the -- nature of the error), or Z_STREAM_ERROR if the stream was not properly -- initialized. In the case of Z_BUF_ERROR, an input or output error can be -- distinguished using strm->next_in which will be Z_NULL only if in() returned -- an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to -- out() returning non-zero. (in() will always be called before out(), so -- strm->next_in is assured to be defined if out() returns non-zero.) Note -- that inflateBack() cannot return Z_OK. --*/ -- --ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); --/* -- All memory allocated by inflateBackInit() is freed. -- -- inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream -- state was inconsistent. --*/ -- --ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); --/* Return flags indicating compile-time options. -- -- Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: -- 1.0: size of uInt -- 3.2: size of uLong -- 5.4: size of voidpf (pointer) -- 7.6: size of z_off_t -- -- Compiler, assembler, and debug options: -- 8: DEBUG -- 9: ASMV or ASMINF -- use ASM code -- 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention -- 11: 0 (reserved) -- -- One-time table building (smaller code, but not thread-safe if true): -- 12: BUILDFIXED -- build static block decoding tables when needed -- 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed -- 14,15: 0 (reserved) -- -- Library content (indicates missing functionality): -- 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking -- deflate code when not needed) -- 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect -- and decode gzip streams (to avoid linking crc code) -- 18-19: 0 (reserved) -- -- Operation variations (changes in library functionality): -- 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate -- 21: FASTEST -- deflate algorithm with only one, lowest compression level -- 22,23: 0 (reserved) -- -- The sprintf variant used by gzprintf (zero is best): -- 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format -- 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! -- 26: 0 = returns value, 1 = void -- 1 means inferred string length returned -- -- Remainder: -- 27-31: 0 (reserved) -- */ -- -- -- /* utility functions */ -- --/* -- The following utility functions are implemented on top of the -- basic stream-oriented functions. To simplify the interface, some -- default options are assumed (compression level and memory usage, -- standard memory allocation functions). The source code of these -- utility functions can easily be modified if you need special options. --*/ -- --ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen)); --/* -- Compresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be at least the value returned -- by compressBound(sourceLen). Upon exit, destLen is the actual size of the -- compressed buffer. -- This function can be used to compress a whole file at once if the -- input file is mmap'ed. -- compress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer. --*/ -- --ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen, -- int level)); --/* -- Compresses the source buffer into the destination buffer. The level -- parameter has the same meaning as in deflateInit. sourceLen is the byte -- length of the source buffer. Upon entry, destLen is the total size of the -- destination buffer, which must be at least the value returned by -- compressBound(sourceLen). Upon exit, destLen is the actual size of the -- compressed buffer. -- -- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_BUF_ERROR if there was not enough room in the output buffer, -- Z_STREAM_ERROR if the level parameter is invalid. --*/ -- --ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); --/* -- compressBound() returns an upper bound on the compressed size after -- compress() or compress2() on sourceLen bytes. It would be used before -- a compress() or compress2() call to allocate the destination buffer. --*/ -- --ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen)); --/* -- Decompresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be large enough to hold the -- entire uncompressed data. (The size of the uncompressed data must have -- been saved previously by the compressor and transmitted to the decompressor -- by some mechanism outside the scope of this compression library.) -- Upon exit, destLen is the actual size of the compressed buffer. -- This function can be used to decompress a whole file at once if the -- input file is mmap'ed. -- -- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. --*/ -- -- --typedef voidp gzFile; -- --ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); --/* -- Opens a gzip (.gz) file for reading or writing. The mode parameter -- is as in fopen ("rb" or "wb") but can also include a compression level -- ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for -- Huffman only compression as in "wb1h", or 'R' for run-length encoding -- as in "wb1R". (See the description of deflateInit2 for more information -- about the strategy parameter.) -- -- gzopen can be used to read a file which is not in gzip format; in this -- case gzread will directly read from the file without decompression. -- -- gzopen returns NULL if the file could not be opened or if there was -- insufficient memory to allocate the (de)compression state; errno -- can be checked to distinguish the two cases (if errno is zero, the -- zlib error is Z_MEM_ERROR). */ -- --ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); --/* -- gzdopen() associates a gzFile with the file descriptor fd. File -- descriptors are obtained from calls like open, dup, creat, pipe or -- fileno (in the file has been previously opened with fopen). -- The mode parameter is as in gzopen. -- The next call of gzclose on the returned gzFile will also close the -- file descriptor fd, just like fclose(fdopen(fd), mode) closes the file -- descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). -- gzdopen returns NULL if there was insufficient memory to allocate -- the (de)compression state. --*/ -- --ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); --/* -- Dynamically update the compression level or strategy. See the description -- of deflateInit2 for the meaning of these parameters. -- gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not -- opened for writing. --*/ -- --ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); --/* -- Reads the given number of uncompressed bytes from the compressed file. -- If the input file was not in gzip format, gzread copies the given number -- of bytes into the buffer. -- gzread returns the number of uncompressed bytes actually read (0 for -- end of file, -1 for error). */ -- --ZEXTERN int ZEXPORT gzwrite OF((gzFile file, -- voidpc buf, unsigned len)); --/* -- Writes the given number of uncompressed bytes into the compressed file. -- gzwrite returns the number of uncompressed bytes actually written -- (0 in case of error). --*/ -- --ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); --/* -- Converts, formats, and writes the args to the compressed file under -- control of the format string, as in fprintf. gzprintf returns the number of -- uncompressed bytes actually written (0 in case of error). The number of -- uncompressed bytes written is limited to 4095. The caller should assure that -- this limit is not exceeded. If it is exceeded, then gzprintf() will return -- return an error (0) with nothing written. In this case, there may also be a -- buffer overflow with unpredictable consequences, which is possible only if -- zlib was compiled with the insecure functions sprintf() or vsprintf() -- because the secure snprintf() or vsnprintf() functions were not available. --*/ -- --ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); --/* -- Writes the given null-terminated string to the compressed file, excluding -- the terminating null character. -- gzputs returns the number of characters written, or -1 in case of error. --*/ -- --ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); --/* -- Reads bytes from the compressed file until len-1 characters are read, or -- a newline character is read and transferred to buf, or an end-of-file -- condition is encountered. The string is then terminated with a null -- character. -- gzgets returns buf, or Z_NULL in case of error. --*/ -- --ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); --/* -- Writes c, converted to an unsigned char, into the compressed file. -- gzputc returns the value that was written, or -1 in case of error. --*/ -- --ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); --/* -- Reads one byte from the compressed file. gzgetc returns this byte -- or -1 in case of end of file or error. --*/ -- --ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); --/* -- Push one character back onto the stream to be read again later. -- Only one character of push-back is allowed. gzungetc() returns the -- character pushed, or -1 on failure. gzungetc() will fail if a -- character has been pushed but not read yet, or if c is -1. The pushed -- character will be discarded if the stream is repositioned with gzseek() -- or gzrewind(). --*/ -- --ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); --/* -- Flushes all pending output into the compressed file. The parameter -- flush is as in the deflate() function. The return value is the zlib -- error number (see function gzerror below). gzflush returns Z_OK if -- the flush parameter is Z_FINISH and all output could be flushed. -- gzflush should be called only when strictly necessary because it can -- degrade compression. --*/ -- --ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, -- z_off_t offset, int whence)); --/* -- Sets the starting position for the next gzread or gzwrite on the -- given compressed file. The offset represents a number of bytes in the -- uncompressed data stream. The whence parameter is defined as in lseek(2); -- the value SEEK_END is not supported. -- If the file is opened for reading, this function is emulated but can be -- extremely slow. If the file is opened for writing, only forward seeks are -- supported; gzseek then compresses a sequence of zeroes up to the new -- starting position. -- -- gzseek returns the resulting offset location as measured in bytes from -- the beginning of the uncompressed stream, or -1 in case of error, in -- particular if the file is opened for writing and the new starting position -- would be before the current position. --*/ -- --ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); --/* -- Rewinds the given file. This function is supported only for reading. -- -- gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) --*/ -- --ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); --/* -- Returns the starting position for the next gzread or gzwrite on the -- given compressed file. This position represents a number of bytes in the -- uncompressed data stream. -- -- gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) --*/ -- --ZEXTERN int ZEXPORT gzeof OF((gzFile file)); --/* -- Returns 1 when EOF has previously been detected reading the given -- input stream, otherwise zero. --*/ -- --ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); --/* -- Returns 1 if file is being read directly without decompression, otherwise -- zero. --*/ -- --ZEXTERN int ZEXPORT gzclose OF((gzFile file)); --/* -- Flushes all pending output if necessary, closes the compressed file -- and deallocates all the (de)compression state. The return value is the zlib -- error number (see function gzerror below). --*/ -- --ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); --/* -- Returns the error message for the last error which occurred on the -- given compressed file. errnum is set to zlib error number. If an -- error occurred in the file system and not in the compression library, -- errnum is set to Z_ERRNO and the application may consult errno -- to get the exact error code. --*/ -- --ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); --/* -- Clears the error and end-of-file flags for file. This is analogous to the -- clearerr() function in stdio. This is useful for continuing to read a gzip -- file that is being written concurrently. --*/ -- -- /* checksum functions */ -- --/* -- These functions are not related to compression but are exported -- anyway because they might be useful in applications using the -- compression library. --*/ -- --ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); --/* -- Update a running Adler-32 checksum with the bytes buf[0..len-1] and -- return the updated checksum. If buf is NULL, this function returns -- the required initial value for the checksum. -- An Adler-32 checksum is almost as reliable as a CRC32 but can be computed -- much faster. Usage example: -- -- uLong adler = adler32(0L, Z_NULL, 0); -- -- while (read_buffer(buffer, length) != EOF) { -- adler = adler32(adler, buffer, length); -- } -- if (adler != original_adler) error(); --*/ -- --ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, -- z_off_t len2)); --/* -- Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 -- and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for -- each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of -- seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. --*/ -- --ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); --/* -- Update a running CRC-32 with the bytes buf[0..len-1] and return the -- updated CRC-32. If buf is NULL, this function returns the required initial -- value for the 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: -- -- uLong crc = crc32(0L, Z_NULL, 0); -- -- while (read_buffer(buffer, length) != EOF) { -- crc = crc32(crc, buffer, length); -- } -- if (crc != original_crc) error(); --*/ -- --ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); -- --/* -- Combine two CRC-32 check values into one. For two sequences of bytes, -- seq1 and seq2 with lengths len1 and len2, CRC-32 check values were -- calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 -- check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and -- len2. --*/ -- -- -- /* various hacks, don't look :) */ -- --/* deflateInit and inflateInit are macros to allow checking the zlib version -- * and the compiler's view of z_stream: -- */ --ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, -- int windowBits, int memLevel, -- int strategy, const char *version, -- int stream_size)); --ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, -- unsigned char FAR *window, -- const char *version, -- int stream_size)); --#define deflateInit(strm, level) \ -- deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) --#define inflateInit(strm) \ -- inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) --#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ -- deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ -- (strategy), ZLIB_VERSION, sizeof(z_stream)) --#define inflateInit2(strm, windowBits) \ -- inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) --#define inflateBackInit(strm, windowBits, window) \ -- inflateBackInit_((strm), (windowBits), (window), \ -- ZLIB_VERSION, sizeof(z_stream)) -- -- --#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) -- struct internal_state {int dummy;}; /* hack for buggy compilers */ --#endif -- --ZEXTERN const char * ZEXPORT zError OF((int)); --ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); --ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); -- --#ifdef __cplusplus --} --#endif -- --#endif /* ZLIB_H */ -diff -ruN RJaCGH.orig/src/zutil.c RJaCGH/src/zutil.c ---- RJaCGH.orig/src/zutil.c 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/zutil.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,318 +0,0 @@ --/* zutil.c -- target dependent utility functions for the compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id$ */ -- --#include "zutil.h" -- --#ifndef NO_DUMMY_DECL --struct internal_state {int dummy;}; /* for buggy compilers */ --#endif -- --const char * const z_errmsg[10] = { --"need dictionary", /* Z_NEED_DICT 2 */ --"stream end", /* Z_STREAM_END 1 */ --"", /* Z_OK 0 */ --"file error", /* Z_ERRNO (-1) */ --"stream error", /* Z_STREAM_ERROR (-2) */ --"data error", /* Z_DATA_ERROR (-3) */ --"insufficient memory", /* Z_MEM_ERROR (-4) */ --"buffer error", /* Z_BUF_ERROR (-5) */ --"incompatible version",/* Z_VERSION_ERROR (-6) */ --""}; -- -- --const char * ZEXPORT zlibVersion() --{ -- return ZLIB_VERSION; --} -- --uLong ZEXPORT zlibCompileFlags() --{ -- uLong flags; -- -- flags = 0; -- switch (sizeof(uInt)) { -- case 2: break; -- case 4: flags += 1; break; -- case 8: flags += 2; break; -- default: flags += 3; -- } -- switch (sizeof(uLong)) { -- case 2: break; -- case 4: flags += 1 << 2; break; -- case 8: flags += 2 << 2; break; -- default: flags += 3 << 2; -- } -- switch (sizeof(voidpf)) { -- case 2: break; -- case 4: flags += 1 << 4; break; -- case 8: flags += 2 << 4; break; -- default: flags += 3 << 4; -- } -- switch (sizeof(z_off_t)) { -- case 2: break; -- case 4: flags += 1 << 6; break; -- case 8: flags += 2 << 6; break; -- default: flags += 3 << 6; -- } --#ifdef DEBUG -- flags += 1 << 8; --#endif --#if defined(ASMV) || defined(ASMINF) -- flags += 1 << 9; --#endif --#ifdef ZLIB_WINAPI -- flags += 1 << 10; --#endif --#ifdef BUILDFIXED -- flags += 1 << 12; --#endif --#ifdef DYNAMIC_CRC_TABLE -- flags += 1 << 13; --#endif --#ifdef NO_GZCOMPRESS -- flags += 1L << 16; --#endif --#ifdef NO_GZIP -- flags += 1L << 17; --#endif --#ifdef PKZIP_BUG_WORKAROUND -- flags += 1L << 20; --#endif --#ifdef FASTEST -- flags += 1L << 21; --#endif --#ifdef STDC --# ifdef NO_vsnprintf -- flags += 1L << 25; --# ifdef HAS_vsprintf_void -- flags += 1L << 26; --# endif --# else --# ifdef HAS_vsnprintf_void -- flags += 1L << 26; --# endif --# endif --#else -- flags += 1L << 24; --# ifdef NO_snprintf -- flags += 1L << 25; --# ifdef HAS_sprintf_void -- flags += 1L << 26; --# endif --# else --# ifdef HAS_snprintf_void -- flags += 1L << 26; --# endif --# endif --#endif -- return flags; --} -- --#ifdef DEBUG -- --# ifndef verbose --# define verbose 0 --# endif --int z_verbose = verbose; -- --void z_error (m) -- char *m; --{ -- fprintf(stderr, "%s\n", m); -- exit(1); --} --#endif -- --/* exported to allow conversion of error code to string for compress() and -- * uncompress() -- */ --const char * ZEXPORT zError(err) -- int err; --{ -- return ERR_MSG(err); --} -- --#if defined(_WIN32_WCE) -- /* The Microsoft C Run-Time Library for Windows CE doesn't have -- * errno. We define it as a global variable to simplify porting. -- * Its value is always 0 and should not be used. -- */ -- int errno = 0; --#endif -- --#ifndef HAVE_MEMCPY -- --void zmemcpy(dest, source, len) -- Bytef* dest; -- const Bytef* source; -- uInt len; --{ -- if (len == 0) return; -- do { -- *dest++ = *source++; /* ??? to be unrolled */ -- } while (--len != 0); --} -- --int zmemcmp(s1, s2, len) -- const Bytef* s1; -- const Bytef* s2; -- uInt len; --{ -- uInt j; -- -- for (j = 0; j < len; j++) { -- if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1; -- } -- return 0; --} -- --void zmemzero(dest, len) -- Bytef* dest; -- uInt len; --{ -- if (len == 0) return; -- do { -- *dest++ = 0; /* ??? to be unrolled */ -- } while (--len != 0); --} --#endif -- -- --#ifdef SYS16BIT -- --#ifdef __TURBOC__ --/* Turbo C in 16-bit mode */ -- --# define MY_ZCALLOC -- --/* Turbo C malloc() does not allow dynamic allocation of 64K bytes -- * and farmalloc(64K) returns a pointer with an offset of 8, so we -- * must fix the pointer. Warning: the pointer must be put back to its -- * original form in order to free it, use zcfree(). -- */ -- --#define MAX_PTR 10 --/* 10*64K = 640K */ -- --local int next_ptr = 0; -- --typedef struct ptr_table_s { -- voidpf org_ptr; -- voidpf new_ptr; --} ptr_table; -- --local ptr_table table[MAX_PTR]; --/* This table is used to remember the original form of pointers -- * to large buffers (64K). Such pointers are normalized with a zero offset. -- * Since MSDOS is not a preemptive multitasking OS, this table is not -- * protected from concurrent access. This hack doesn't work anyway on -- * a protected system like OS/2. Use Microsoft C instead. -- */ -- --voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) --{ -- voidpf buf = opaque; /* just to make some compilers happy */ -- ulg bsize = (ulg)items*size; -- -- /* If we allocate less than 65520 bytes, we assume that farmalloc -- * will return a usable pointer which doesn't have to be normalized. -- */ -- if (bsize < 65520L) { -- buf = farmalloc(bsize); -- if (*(ush*)&buf != 0) return buf; -- } else { -- buf = farmalloc(bsize + 16L); -- } -- if (buf == NULL || next_ptr >= MAX_PTR) return NULL; -- table[next_ptr].org_ptr = buf; -- -- /* Normalize the pointer to seg:0 */ -- *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4; -- *(ush*)&buf = 0; -- table[next_ptr++].new_ptr = buf; -- return buf; --} -- --void zcfree (voidpf opaque, voidpf ptr) --{ -- int n; -- if (*(ush*)&ptr != 0) { /* object < 64K */ -- farfree(ptr); -- return; -- } -- /* Find the original pointer */ -- for (n = 0; n < next_ptr; n++) { -- if (ptr != table[n].new_ptr) continue; -- -- farfree(table[n].org_ptr); -- while (++n < next_ptr) { -- table[n-1] = table[n]; -- } -- next_ptr--; -- return; -- } -- ptr = opaque; /* just to make some compilers happy */ -- Assert(0, "zcfree: ptr not found"); --} -- --#endif /* __TURBOC__ */ -- -- --#ifdef M_I86 --/* Microsoft C in 16-bit mode */ -- --# define MY_ZCALLOC -- --#if (!defined(_MSC_VER) || (_MSC_VER <= 600)) --# define _halloc halloc --# define _hfree hfree --#endif -- --voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) --{ -- if (opaque) opaque = 0; /* to make compiler happy */ -- return _halloc((long)items, size); --} -- --void zcfree (voidpf opaque, voidpf ptr) --{ -- if (opaque) opaque = 0; /* to make compiler happy */ -- _hfree(ptr); --} -- --#endif /* M_I86 */ -- --#endif /* SYS16BIT */ -- -- --#ifndef MY_ZCALLOC /* Any system without a special alloc function */ -- --#ifndef STDC --extern voidp malloc OF((uInt size)); --extern voidp calloc OF((uInt items, uInt size)); --extern void free OF((voidpf ptr)); --#endif -- --voidpf zcalloc (opaque, items, size) -- voidpf opaque; -- unsigned items; -- unsigned size; --{ -- if (opaque) items += size - size; /* make compiler happy */ -- return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) : -- (voidpf)calloc(items, size); --} -- --void zcfree (opaque, ptr) -- voidpf opaque; -- voidpf ptr; --{ -- free(ptr); -- if (opaque) return; /* make compiler happy */ --} -- --#endif /* MY_ZCALLOC */ -diff -ruN RJaCGH.orig/src/zutil.h RJaCGH/src/zutil.h ---- RJaCGH.orig/src/zutil.h 2009-03-04 12:51:20.000000000 +0100 -+++ RJaCGH/src/zutil.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,269 +0,0 @@ --/* zutil.h -- internal interface and configuration of the compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* @(#) $Id$ */ -- --#ifndef ZUTIL_H --#define ZUTIL_H -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --#ifdef STDC --# ifndef _WIN32_WCE --# include --# endif --# include --# include --#endif --#ifdef NO_ERRNO_H --# ifdef _WIN32_WCE -- /* The Microsoft C Run-Time Library for Windows CE doesn't have -- * errno. We define it as a global variable to simplify porting. -- * Its value is always 0 and should not be used. We rename it to -- * avoid conflict with other libraries that use the same workaround. -- */ --# define errno z_errno --# endif -- extern int errno; --#else --# ifndef _WIN32_WCE --# include --# endif --#endif -- --#ifndef local --# define local static --#endif --/* compile with -Dlocal if your debugger can't find static symbols */ -- --typedef unsigned char uch; --typedef uch FAR uchf; --typedef unsigned short ush; --typedef ush FAR ushf; --typedef unsigned long ulg; -- --extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ --/* (size given to avoid silly warnings with Visual C++) */ -- --#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] -- --#define ERR_RETURN(strm,err) \ -- return (strm->msg = (char*)ERR_MSG(err), (err)) --/* To be used only when the state is known to be valid */ -- -- /* common constants */ -- --#ifndef DEF_WBITS --# define DEF_WBITS MAX_WBITS --#endif --/* default windowBits for decompression. MAX_WBITS is for compression only */ -- --#if MAX_MEM_LEVEL >= 8 --# define DEF_MEM_LEVEL 8 --#else --# define DEF_MEM_LEVEL MAX_MEM_LEVEL --#endif --/* default memLevel */ -- --#define STORED_BLOCK 0 --#define STATIC_TREES 1 --#define DYN_TREES 2 --/* The three kinds of block type */ -- --#define MIN_MATCH 3 --#define MAX_MATCH 258 --/* The minimum and maximum match lengths */ -- --#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ -- -- /* target dependencies */ -- --#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) --# define OS_CODE 0x00 --# if defined(__TURBOC__) || defined(__BORLANDC__) --# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) -- /* Allow compilation with ANSI keywords only enabled */ -- void _Cdecl farfree( void *block ); -- void *_Cdecl farmalloc( unsigned long nbytes ); --# else --# include --# endif --# else /* MSC or DJGPP */ --# include --# endif --#endif -- --#ifdef AMIGA --# define OS_CODE 0x01 --#endif -- --#if defined(VAXC) || defined(VMS) --# define OS_CODE 0x02 --# define F_OPEN(name, mode) \ -- fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") --#endif -- --#if defined(ATARI) || defined(atarist) --# define OS_CODE 0x05 --#endif -- --#ifdef OS2 --# define OS_CODE 0x06 --# ifdef M_I86 -- #include --# endif --#endif -- --#if defined(MACOS) || defined(TARGET_OS_MAC) --# define OS_CODE 0x07 --# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os --# include /* for fdopen */ --# else --# ifndef fdopen --# define fdopen(fd,mode) NULL /* No fdopen() */ --# endif --# endif --#endif -- --#ifdef TOPS20 --# define OS_CODE 0x0a --#endif -- --#ifdef WIN32 --# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ --# define OS_CODE 0x0b --# endif --#endif -- --#ifdef __50SERIES /* Prime/PRIMOS */ --# define OS_CODE 0x0f --#endif -- --#if defined(_BEOS_) || defined(RISCOS) --# define fdopen(fd,mode) NULL /* No fdopen() */ --#endif -- --#if (defined(_MSC_VER) && (_MSC_VER > 600)) --# if defined(_WIN32_WCE) --# define fdopen(fd,mode) NULL /* No fdopen() */ --# ifndef _PTRDIFF_T_DEFINED -- typedef int ptrdiff_t; --# define _PTRDIFF_T_DEFINED --# endif --# else --# define fdopen(fd,type) _fdopen(fd,type) --# endif --#endif -- -- /* common defaults */ -- --#ifndef OS_CODE --# define OS_CODE 0x03 /* assume Unix */ --#endif -- --#ifndef F_OPEN --# define F_OPEN(name, mode) fopen((name), (mode)) --#endif -- -- /* functions */ -- --#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) --# ifndef HAVE_VSNPRINTF --# define HAVE_VSNPRINTF --# endif --#endif --#if defined(__CYGWIN__) --# ifndef HAVE_VSNPRINTF --# define HAVE_VSNPRINTF --# endif --#endif --#ifndef HAVE_VSNPRINTF --# ifdef MSDOS -- /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), -- but for now we just assume it doesn't. */ --# define NO_vsnprintf --# endif --# ifdef __TURBOC__ --# define NO_vsnprintf --# endif --# ifdef WIN32 -- /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ --# if !defined(vsnprintf) && !defined(NO_vsnprintf) --# define vsnprintf _vsnprintf --# endif --# endif --# ifdef __SASC --# define NO_vsnprintf --# endif --#endif --#ifdef VMS --# define NO_vsnprintf --#endif -- --#if defined(pyr) --# define NO_MEMCPY --#endif --#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) -- /* Use our own functions for small and medium model with MSC <= 5.0. -- * You may have to use the same strategy for Borland C (untested). -- * The __SC__ check is for Symantec. -- */ --# define NO_MEMCPY --#endif --#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) --# define HAVE_MEMCPY --#endif --#ifdef HAVE_MEMCPY --# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ --# define zmemcpy _fmemcpy --# define zmemcmp _fmemcmp --# define zmemzero(dest, len) _fmemset(dest, 0, len) --# else --# define zmemcpy memcpy --# define zmemcmp memcmp --# define zmemzero(dest, len) memset(dest, 0, len) --# endif --#else -- extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); -- extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); -- extern void zmemzero OF((Bytef* dest, uInt len)); --#endif -- --/* Diagnostic functions */ --#ifdef DEBUG --# include -- extern int z_verbose; -- extern void z_error OF((char *m)); --# define Assert(cond,msg) {if(!(cond)) z_error(msg);} --# define Trace(x) {if (z_verbose>=0) fprintf x ;} --# define Tracev(x) {if (z_verbose>0) fprintf x ;} --# define Tracevv(x) {if (z_verbose>1) fprintf x ;} --# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} --# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} --#else --# define Assert(cond,msg) --# define Trace(x) --# define Tracev(x) --# define Tracevv(x) --# define Tracec(c,x) --# define Tracecv(c,x) --#endif -- -- --voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); --void zcfree OF((voidpf opaque, voidpf ptr)); -- --#define ZALLOC(strm, items, size) \ -- (*((strm)->zalloc))((strm)->opaque, (items), (size)) --#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) --#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} -- --#endif /* ZUTIL_H */ diff --git a/branch/double_build/inst/etc/patches/RLadyBug/00list b/branch/double_build/inst/etc/patches/RLadyBug/00list deleted file mode 100644 index 914fc88..0000000 --- a/branch/double_build/inst/etc/patches/RLadyBug/00list +++ /dev/null @@ -1,2 +0,0 @@ -00list -01_bash_path.patch diff --git a/branch/double_build/inst/etc/patches/RLadyBug/01_bash_path.patch b/branch/double_build/inst/etc/patches/RLadyBug/01_bash_path.patch deleted file mode 100644 index 0881a0b..0000000 --- a/branch/double_build/inst/etc/patches/RLadyBug/01_bash_path.patch +++ /dev/null @@ -1,26 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_bash_path.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Correct bash path - -@DPATCH@ - -diff -ru RLadyBug.orig/inst/LadyBug/bin/ladybug.sh RLadyBug/inst/LadyBug/bin/ladybug.sh ---- RLadyBug.orig/inst/LadyBug/bin/ladybug.sh 2008-01-04 11:01:24.000000000 +0100 -+++ RLadyBug/inst/LadyBug/bin/ladybug.sh 2009-05-12 03:34:02.000000000 +0200 -@@ -1,4 +1,4 @@ --#!/usr/bin/bash -+#!/bin/bash - - #The "executable" version just uses the jar files in the bin directory - #In case you made modifications to the LadyBug source and -diff -ru RLadyBug.orig/inst/LadyBug/bin/simsellke.sh RLadyBug/inst/LadyBug/bin/simsellke.sh ---- RLadyBug.orig/inst/LadyBug/bin/simsellke.sh 2008-01-04 11:01:24.000000000 +0100 -+++ RLadyBug/inst/LadyBug/bin/simsellke.sh 2009-05-12 03:34:19.000000000 +0200 -@@ -1,4 +1,4 @@ --#!/usr/bin/bash -+#!/bin/bash - - #The exec version just uses the jar files in the bin directory - #In case you made modifications to the LadyBug source and diff --git a/branch/double_build/inst/etc/patches/Rpad/00list b/branch/double_build/inst/etc/patches/Rpad/00list deleted file mode 100644 index e7ce1d4..0000000 --- a/branch/double_build/inst/etc/patches/Rpad/00list +++ /dev/null @@ -1 +0,0 @@ -01_installRpadWWW.sh_conversion.patch diff --git a/branch/double_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch b/branch/double_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch deleted file mode 100644 index 402836a..0000000 --- a/branch/double_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch +++ /dev/null @@ -1,176 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_installRpadWWW.sh_conversion.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: dos to unix fileconversion - -@DPATCH@ - -diff -Naur Rpad.orig/inst/serverversion/installRpadWWW.sh Rpad/inst/serverversion/installRpadWWW.sh ---- Rpad.orig/inst/serverversion/installRpadWWW.sh 2007-04-24 17:47:26.000000000 +0200 -+++ Rpad/inst/serverversion/installRpadWWW.sh 2009-04-09 04:25:13.000000000 +0200 -@@ -1,82 +1,82 @@ --#!/bin/sh --# This installs the extra server files for Rpad on Debian. --# The defaults are to install to /var/www/Rpad. --# usage: --# installRpadWWW.sh directory tree --# examples: --# installRpadWWW.sh /var/www/Rpad --# installRpadWWW.sh /var/www/Rpad /testingdir --# installRpadWWW.sh /var/www/anotherdir -- --RPAD=/var/www/Rpad --TREE=/. --if [ $# -eq 1 ]; then -- RPAD=$1 --fi --if [ $# -eq 2 ]; then -- RPAD=$1 -- TREE=$2 --fi -- --# copy the base files --mkdir -p $RPAD --cp -r ../basehtml/* $RPAD --cp -r ../basehtml/.RpadStartup.R $RPAD -- --# fix the directory permissions --chmod a+w $TREE$RPAD --chmod a+w $TREE$RPAD/server --chmod a+x $TREE$RPAD/server/*.pl -- --# this link makes the help menu work --ln -s /usr/lib/R $TREE$RPAD/R -- --# make a name for the apache config file --conf_d_name=`echo $RPAD | sed s^/^.^g` -- --# apache configuration file (cgi or mod_perl) --mkdir -p $TREE/etc/apache2/conf.d --cat >> $TREE/etc/apache2/conf.d/Rpad$conf_d_name << EOF -- -- -- # requires mod_perl -- SetHandler perl-script -- PerlResponseHandler ModPerl::PerlRun -- PerlOptions +ParseHeaders -- Options -Indexes +ExecCGI -- -- -- Options +ExecCGI -- AddHandler cgi-script .pl -- -- ExpiresActive on -- ExpiresDefault "now plus 0 seconds" -- -- --AddType text/x-component .htc --AddType text/html .Rpad --EOF -- --# apache2 configuration file (cgi or mod_perl) --mkdir -p $TREE/etc/apache/conf.d --cat >> $TREE/etc/apache/conf.d/Rpad$conf_d_name << EOF -- -- -- # requires mod_perl -- SetHandler perl-script -- PerlHandler Apache::Registry -- Options +ExecCGI -- PerlSendHeader ON -- -- -- Options +ExecCGI -- AddHandler cgi-script .pl -- -- ExpiresActive on -- ExpiresDefault "now plus 0 seconds" -- -- --AddType text/x-component .htc --AddType text/html .Rpad --EOF -- -+#!/bin/sh -+# This installs the extra server files for Rpad on Debian. -+# The defaults are to install to /var/www/Rpad. -+# usage: -+# installRpadWWW.sh directory tree -+# examples: -+# installRpadWWW.sh /var/www/Rpad -+# installRpadWWW.sh /var/www/Rpad /testingdir -+# installRpadWWW.sh /var/www/anotherdir -+ -+RPAD=/var/www/Rpad -+TREE=/. -+if [ $# -eq 1 ]; then -+ RPAD=$1 -+fi -+if [ $# -eq 2 ]; then -+ RPAD=$1 -+ TREE=$2 -+fi -+ -+# copy the base files -+mkdir -p $RPAD -+cp -r ../basehtml/* $RPAD -+cp -r ../basehtml/.RpadStartup.R $RPAD -+ -+# fix the directory permissions -+chmod a+w $TREE$RPAD -+chmod a+w $TREE$RPAD/server -+chmod a+x $TREE$RPAD/server/*.pl -+ -+# this link makes the help menu work -+ln -s /usr/lib/R $TREE$RPAD/R -+ -+# make a name for the apache config file -+conf_d_name=`echo $RPAD | sed s^/^.^g` -+ -+# apache configuration file (cgi or mod_perl) -+mkdir -p $TREE/etc/apache2/conf.d -+cat >> $TREE/etc/apache2/conf.d/Rpad$conf_d_name << EOF -+ -+ -+ # requires mod_perl -+ SetHandler perl-script -+ PerlResponseHandler ModPerl::PerlRun -+ PerlOptions +ParseHeaders -+ Options -Indexes +ExecCGI -+ -+ -+ Options +ExecCGI -+ AddHandler cgi-script .pl -+ -+ ExpiresActive on -+ ExpiresDefault "now plus 0 seconds" -+ -+ -+AddType text/x-component .htc -+AddType text/html .Rpad -+EOF -+ -+# apache2 configuration file (cgi or mod_perl) -+mkdir -p $TREE/etc/apache/conf.d -+cat >> $TREE/etc/apache/conf.d/Rpad$conf_d_name << EOF -+ -+ -+ # requires mod_perl -+ SetHandler perl-script -+ PerlHandler Apache::Registry -+ Options +ExecCGI -+ PerlSendHeader ON -+ -+ -+ Options +ExecCGI -+ AddHandler cgi-script .pl -+ -+ ExpiresActive on -+ ExpiresDefault "now plus 0 seconds" -+ -+ -+AddType text/x-component .htc -+AddType text/html .Rpad -+EOF -+ diff --git a/branch/double_build/inst/etc/patches/SuppDists/00list b/branch/double_build/inst/etc/patches/SuppDists/00list deleted file mode 100644 index e562cca..0000000 --- a/branch/double_build/inst/etc/patches/SuppDists/00list +++ /dev/null @@ -1,2 +0,0 @@ -00list -01_DESCRIPTION.patch diff --git a/branch/double_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch b/branch/double_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch deleted file mode 100644 index 7637a37..0000000 --- a/branch/double_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch +++ /dev/null @@ -1,17 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_DESCRIPTION.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Add a space to separate Package: and SuppDists - -@DPATCH@ - -diff -ru SuppDists.orig/DESCRIPTION SuppDists/DESCRIPTION ---- SuppDists.orig/DESCRIPTION 2008-03-05 17:23:55.000000000 +0100 -+++ SuppDists/DESCRIPTION 2009-05-11 04:57:47.000000000 +0200 -@@ -1,4 +1,4 @@ --Package:SuppDists -+Package: SuppDists - Version: 1.1-2 - Date: 2008/03/05 - Title: Supplementary distributions diff --git a/branch/double_build/inst/etc/patches/dlmap/00list b/branch/double_build/inst/etc/patches/dlmap/00list deleted file mode 100644 index 288e6b7..0000000 --- a/branch/double_build/inst/etc/patches/dlmap/00list +++ /dev/null @@ -1 +0,0 @@ -01_DESCRIPTION.patch diff --git a/branch/double_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch b/branch/double_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch deleted file mode 100644 index 83ca8db..0000000 --- a/branch/double_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch +++ /dev/null @@ -1,21 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_DESCRIPTION.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Add extended Description - -@DPATCH@ - -diff -ru dlmap.orig/DESCRIPTION dlmap/DESCRIPTION ---- dlmap.orig/DESCRIPTION 2008-11-14 11:15:01.000000000 +0100 -+++ dlmap/DESCRIPTION 2009-05-18 04:13:29.000000000 +0200 -@@ -5,7 +5,8 @@ - Date: 2008-11-11 - Author: Emma Huang and Andrew George - Maintainer: Emma Huang --Description: -+Description: Detection Localization -+ Mapping for QTL - License: GPL 2 - Depends: qtl, ibdreg - Suggests: nlme, asreml diff --git a/branch/double_build/inst/etc/patches/rSymPy/00list b/branch/double_build/inst/etc/patches/rSymPy/00list deleted file mode 100644 index 4589bc4..0000000 --- a/branch/double_build/inst/etc/patches/rSymPy/00list +++ /dev/null @@ -1 +0,0 @@ -01_python_path.patch diff --git a/branch/double_build/inst/etc/patches/rSymPy/01_python_path.patch b/branch/double_build/inst/etc/patches/rSymPy/01_python_path.patch deleted file mode 100644 index b6561a5..0000000 --- a/branch/double_build/inst/etc/patches/rSymPy/01_python_path.patch +++ /dev/null @@ -1,17 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_python_path.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Correct python path - -@DPATCH@ - -diff -ru rSymPy.orig/inst/jython/Lib/cgi.py rSymPy/inst/jython/Lib/cgi.py ---- rSymPy.orig/inst/jython/Lib/cgi.py 2009-01-09 22:02:24.000000000 +0100 -+++ rSymPy/inst/jython/Lib/cgi.py 2009-05-17 21:45:54.000000000 +0200 -@@ -1,4 +1,4 @@ --#! /usr/local/bin/python -+#! /usr/bin/python - - # NOTE: the above "/usr/local/bin/python" is NOT a mistake. It is - # intentionally NOT "/usr/bin/env python". On many systems diff --git a/branch/double_build/inst/etc/patches/seqinr/00list b/branch/double_build/inst/etc/patches/seqinr/00list deleted file mode 100644 index 428554e..0000000 --- a/branch/double_build/inst/etc/patches/seqinr/00list +++ /dev/null @@ -1 +0,0 @@ -01_remove_zlib.patch diff --git a/branch/double_build/inst/etc/patches/seqinr/01_remove_zlib.patch b/branch/double_build/inst/etc/patches/seqinr/01_remove_zlib.patch deleted file mode 100644 index b2cae05..0000000 --- a/branch/double_build/inst/etc/patches/seqinr/01_remove_zlib.patch +++ /dev/null @@ -1,11059 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_remove_zlib_src.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Remove zlib - -@DPATCH@ - -diff -ruN seqinr.orig/src/adler32.c seqinr/src/adler32.c ---- seqinr.orig/src/adler32.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/adler32.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,153 +0,0 @@ --/* adler32.c -- compute the Adler-32 checksum of a data stream -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id: adler32.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --#define BASE 65521UL /* largest prime smaller than 65536 */ --#define NMAX 5552 --/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */ -- --#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;} --#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); --#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); --#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); --#define DO16(buf) DO8(buf,0); DO8(buf,8); -- --/* use NO_DIVIDE if your processor does not do division in hardware */ --#ifdef NO_DIVIDE --# define MOD(a) \ -- do { \ -- if (a >= (BASE << 16)) a -= (BASE << 16); \ -- if (a >= (BASE << 15)) a -= (BASE << 15); \ -- if (a >= (BASE << 14)) a -= (BASE << 14); \ -- if (a >= (BASE << 13)) a -= (BASE << 13); \ -- if (a >= (BASE << 12)) a -= (BASE << 12); \ -- if (a >= (BASE << 11)) a -= (BASE << 11); \ -- if (a >= (BASE << 10)) a -= (BASE << 10); \ -- if (a >= (BASE << 9)) a -= (BASE << 9); \ -- if (a >= (BASE << 8)) a -= (BASE << 8); \ -- if (a >= (BASE << 7)) a -= (BASE << 7); \ -- if (a >= (BASE << 6)) a -= (BASE << 6); \ -- if (a >= (BASE << 5)) a -= (BASE << 5); \ -- if (a >= (BASE << 4)) a -= (BASE << 4); \ -- if (a >= (BASE << 3)) a -= (BASE << 3); \ -- if (a >= (BASE << 2)) a -= (BASE << 2); \ -- if (a >= (BASE << 1)) a -= (BASE << 1); \ -- if (a >= BASE) a -= BASE; \ -- } while (0) --# define MOD4(a) \ -- do { \ -- if (a >= (BASE << 4)) a -= (BASE << 4); \ -- if (a >= (BASE << 3)) a -= (BASE << 3); \ -- if (a >= (BASE << 2)) a -= (BASE << 2); \ -- if (a >= (BASE << 1)) a -= (BASE << 1); \ -- if (a >= BASE) a -= BASE; \ -- } while (0) --#else --# define MOD(a) a %= BASE --# define MOD4(a) a %= BASE --#endif -- --/* ========================================================================= */ --uLong ZEXPORT adler32(uLong adler, const Bytef *buf, uInt len) --/* -- uLong adler; -- const Bytef *buf; -- uInt len; --*/ --{ -- unsigned long sum2; -- unsigned n; -- -- /* split Adler-32 into component sums */ -- sum2 = (adler >> 16) & 0xffff; -- adler &= 0xffff; -- -- /* in case user likes doing a byte at a time, keep it fast */ -- if (len == 1) { -- adler += buf[0]; -- if (adler >= BASE) -- adler -= BASE; -- sum2 += adler; -- if (sum2 >= BASE) -- sum2 -= BASE; -- return adler | (sum2 << 16); -- } -- -- /* initial Adler-32 value (deferred check for len == 1 speed) */ -- if (buf == Z_NULL) -- return 1L; -- -- /* in case short lengths are provided, keep it somewhat fast */ -- if (len < 16) { -- while (len--) { -- adler += *buf++; -- sum2 += adler; -- } -- if (adler >= BASE) -- adler -= BASE; -- MOD4(sum2); /* only added so many BASE's */ -- return adler | (sum2 << 16); -- } -- -- /* do length NMAX blocks -- requires just one modulo operation */ -- while (len >= NMAX) { -- len -= NMAX; -- n = NMAX / 16; /* NMAX is divisible by 16 */ -- do { -- DO16(buf); /* 16 sums unrolled */ -- buf += 16; -- } while (--n); -- MOD(adler); -- MOD(sum2); -- } -- -- /* do remaining bytes (less than NMAX, still just one modulo) */ -- if (len) { /* avoid modulos if none remaining */ -- while (len >= 16) { -- len -= 16; -- DO16(buf); -- buf += 16; -- } -- while (len--) { -- adler += *buf++; -- sum2 += adler; -- } -- MOD(adler); -- MOD(sum2); -- } -- -- /* return recombined sums */ -- return adler | (sum2 << 16); --} -- --/* ========================================================================= */ --uLong ZEXPORT adler32_combine(uLong adler1, uLong adler2, z_off_t len2) --/* -- uLong adler1; -- uLong adler2; -- z_off_t len2; --*/ --{ -- unsigned long sum1; -- unsigned long sum2; -- unsigned rem; -- -- /* the derivation of this formula is left as an exercise for the reader */ -- rem = (unsigned)(len2 % BASE); -- sum1 = adler1 & 0xffff; -- sum2 = rem * sum1; -- MOD(sum2); -- sum1 += (adler2 & 0xffff) + BASE - 1; -- sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem; -- if (sum1 > BASE) sum1 -= BASE; -- if (sum1 > BASE) sum1 -= BASE; -- if (sum2 > (BASE << 1)) sum2 -= (BASE << 1); -- if (sum2 > BASE) sum2 -= BASE; -- return sum1 | (sum2 << 16); --} -diff -ruN seqinr.orig/src/compress.c seqinr/src/compress.c ---- seqinr.orig/src/compress.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/compress.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,84 +0,0 @@ --/* compress.c -- compress a memory buffer -- * Copyright (C) 1995-2003 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id: compress.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --/* =========================================================================== -- Compresses the source buffer into the destination buffer. The level -- parameter has the same meaning as in deflateInit. sourceLen is the byte -- length of the source buffer. Upon entry, destLen is the total size of the -- destination buffer, which must be at least 0.1% larger than sourceLen plus -- 12 bytes. Upon exit, destLen is the actual size of the compressed buffer. -- -- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_BUF_ERROR if there was not enough room in the output buffer, -- Z_STREAM_ERROR if the level parameter is invalid. --*/ --int ZEXPORT compress2 (Bytef *dest, uLongf *destLen, const Bytef *source, -- uLong sourceLen, int level) --/* -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; -- int level; --*/ --{ -- z_stream stream; -- int err; -- -- stream.next_in = (Bytef*)source; -- stream.avail_in = (uInt)sourceLen; --#ifdef MAXSEG_64K -- /* Check for source > 64K on 16-bit machine: */ -- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; --#endif -- stream.next_out = dest; -- stream.avail_out = (uInt)*destLen; -- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; -- -- stream.zalloc = (alloc_func)0; -- stream.zfree = (free_func)0; -- stream.opaque = (voidpf)0; -- -- err = deflateInit(&stream, level); -- if (err != Z_OK) return err; -- -- err = deflate(&stream, Z_FINISH); -- if (err != Z_STREAM_END) { -- deflateEnd(&stream); -- return err == Z_OK ? Z_BUF_ERROR : err; -- } -- *destLen = stream.total_out; -- -- err = deflateEnd(&stream); -- return err; --} -- --/* =========================================================================== -- */ --int ZEXPORT compress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) --/* -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; --*/ --{ -- return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION); --} -- --/* =========================================================================== -- If the default memLevel or windowBits for deflateInit() is changed, then -- this function needs to be updated. -- */ --uLong ZEXPORT compressBound (uLong sourceLen) --/* uLong sourceLen; */ --{ -- return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + 11; --} -diff -ruN seqinr.orig/src/crc32.c seqinr/src/crc32.c ---- seqinr.orig/src/crc32.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/crc32.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,437 +0,0 @@ --/* crc32.c -- compute the CRC-32 of a data stream -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- * -- * Thanks to Rodney Brown for his contribution of faster -- * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing -- * tables for updating the shift register in one step with three exclusive-ors -- * instead of four steps with four exclusive-ors. This results in about a -- * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3. -- */ -- --/* @(#) $Id: crc32.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ -- --/* -- Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore -- protection on the static variables used to control the first-use generation -- of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should -- first call get_crc_table() to initialize the tables before allowing more than -- one thread to use crc32(). -- */ -- --#ifdef MAKECRCH --# include --# ifndef DYNAMIC_CRC_TABLE --# define DYNAMIC_CRC_TABLE --# endif /* !DYNAMIC_CRC_TABLE */ --#endif /* MAKECRCH */ -- --#include "zutil.h" /* for STDC and FAR definitions */ -- --#define local static -- --/* Find a four-byte integer type for crc32_little() and crc32_big(). */ --#ifndef NOBYFOUR --# ifdef STDC /* need ANSI C limits.h to determine sizes */ --# include --# define BYFOUR --# if (UINT_MAX == 0xffffffffUL) -- typedef unsigned int u4; --# else --# if (ULONG_MAX == 0xffffffffUL) -- typedef unsigned long u4; --# else --# if (USHRT_MAX == 0xffffffffUL) -- typedef unsigned short u4; --# else --# undef BYFOUR /* can't find a four-byte integer type! */ --# endif --# endif --# endif --# endif /* STDC */ --#endif /* !NOBYFOUR */ -- --/* Definitions for doing the crc four data bytes at a time. */ --#ifdef BYFOUR --# define REV(w) (((w)>>24)+(((w)>>8)&0xff00)+ \ -- (((w)&0xff00)<<8)+(((w)&0xff)<<24)) -- local unsigned long crc32_little OF((unsigned long, -- const unsigned char FAR *, unsigned)); -- local unsigned long crc32_big OF((unsigned long, -- const unsigned char FAR *, unsigned)); --# define TBLS 8 --#else --# define TBLS 1 --#endif /* BYFOUR */ -- --/* Local functions for crc concatenation */ --local unsigned long gf2_matrix_times OF((unsigned long *mat, -- unsigned long vec)); --local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat)); -- --#ifdef DYNAMIC_CRC_TABLE -- --local volatile int crc_table_empty = 1; --local unsigned long FAR crc_table[TBLS][256]; --local void make_crc_table OF((void)); --#ifdef MAKECRCH -- local void write_table OF((FILE *, const unsigned long FAR *)); --#endif /* MAKECRCH */ --/* -- Generate tables 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 first table is simply the CRC of all possible eight bit values. This is -- all the information needed to generate CRCs on data a byte at a time for all -- combinations of CRC register values and incoming bytes. The remaining tables -- allow for word-at-a-time CRC calculation for both big-endian and little- -- endian machines, where a word is four bytes. --*/ --local void make_crc_table() --{ -- unsigned long c; -- int n, k; -- unsigned long poly; /* polynomial exclusive-or pattern */ -- /* terms of polynomial defining this crc (except x^32): */ -- static volatile int first = 1; /* flag to limit concurrent making */ -- static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26}; -- -- /* See if another task is already doing this (not thread-safe, but better -- than nothing -- significantly reduces duration of vulnerability in -- case the advice about DYNAMIC_CRC_TABLE is ignored) */ -- if (first) { -- first = 0; -- -- /* make exclusive-or pattern from polynomial (0xedb88320UL) */ -- poly = 0UL; -- for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++) -- poly |= 1UL << (31 - p[n]); -- -- /* generate a crc for every 8-bit value */ -- for (n = 0; n < 256; n++) { -- c = (unsigned long)n; -- for (k = 0; k < 8; k++) -- c = c & 1 ? poly ^ (c >> 1) : c >> 1; -- crc_table[0][n] = c; -- } -- --#ifdef BYFOUR -- /* generate crc for each value followed by one, two, and three zeros, -- and then the byte reversal of those as well as the first table */ -- for (n = 0; n < 256; n++) { -- c = crc_table[0][n]; -- crc_table[4][n] = REV(c); -- for (k = 1; k < 4; k++) { -- c = crc_table[0][c & 0xff] ^ (c >> 8); -- crc_table[k][n] = c; -- crc_table[k + 4][n] = REV(c); -- } -- } --#endif /* BYFOUR */ -- -- crc_table_empty = 0; -- } -- else { /* not first */ -- /* wait for the other guy to finish (not efficient, but rare) */ -- while (crc_table_empty) -- ; -- } -- --#ifdef MAKECRCH -- /* write out CRC tables to crc32.h */ -- { -- FILE *out; -- -- out = fopen("crc32.h", "w"); -- if (out == NULL) return; -- fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n"); -- fprintf(out, " * Generated automatically by crc32.c\n */\n\n"); -- fprintf(out, "local const unsigned long FAR "); -- fprintf(out, "crc_table[TBLS][256] =\n{\n {\n"); -- write_table(out, crc_table[0]); --# ifdef BYFOUR -- fprintf(out, "#ifdef BYFOUR\n"); -- for (k = 1; k < 8; k++) { -- fprintf(out, " },\n {\n"); -- write_table(out, crc_table[k]); -- } -- fprintf(out, "#endif\n"); --# endif /* BYFOUR */ -- fprintf(out, " }\n};\n"); -- fclose(out); -- } --#endif /* MAKECRCH */ --} -- --#ifdef MAKECRCH --local void write_table(out, table) -- FILE *out; -- const unsigned long FAR *table; --{ -- int n; -- -- for (n = 0; n < 256; n++) -- fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n], -- n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", ")); --} --#endif /* MAKECRCH */ -- --#else /* !DYNAMIC_CRC_TABLE */ --/* ======================================================================== -- * Tables of CRC-32s of all single-byte values, made by make_crc_table(). -- */ --#include "crc32.h" --#endif /* DYNAMIC_CRC_TABLE */ -- --/* ========================================================================= -- * This function can be used by asm versions of crc32() -- */ --const unsigned long FAR * ZEXPORT get_crc_table() --{ --#ifdef DYNAMIC_CRC_TABLE -- if (crc_table_empty) -- make_crc_table(); --#endif /* DYNAMIC_CRC_TABLE */ -- return (const unsigned long FAR *)crc_table; --} -- --/* ========================================================================= */ --#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8) --#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1 -- --/* ========================================================================= */ --unsigned long ZEXPORT crc32(unsigned long crc, const unsigned char FAR *buf, -- unsigned len) --/* -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --*/ --{ -- if (buf == Z_NULL) return 0UL; -- --#ifdef DYNAMIC_CRC_TABLE -- if (crc_table_empty) -- make_crc_table(); --#endif /* DYNAMIC_CRC_TABLE */ -- --#ifdef BYFOUR -- if (sizeof(void *) == sizeof(ptrdiff_t)) { -- u4 endian; -- -- endian = 1; -- if (*((unsigned char *)(&endian))) -- return crc32_little(crc, buf, len); -- else -- return crc32_big(crc, buf, len); -- } --#endif /* BYFOUR */ -- crc = crc ^ 0xffffffffUL; -- while (len >= 8) { -- DO8; -- len -= 8; -- } -- if (len) do { -- DO1; -- } while (--len); -- return crc ^ 0xffffffffUL; --} -- --#ifdef BYFOUR -- --/* ========================================================================= */ --#define DOLIT4 c ^= *buf4++; \ -- c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \ -- crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24] --#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4 -- --/* ========================================================================= */ --local unsigned long crc32_little(unsigned long crc, const unsigned char FAR *buf, unsigned len) --/* -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --*/ --{ -- register u4 c; -- register const u4 FAR *buf4; -- -- c = (u4)crc; -- c = ~c; -- while (len && ((ptrdiff_t)buf & 3)) { -- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); -- len--; -- } -- -- buf4 = (const u4 FAR *)(const void FAR *)buf; -- while (len >= 32) { -- DOLIT32; -- len -= 32; -- } -- while (len >= 4) { -- DOLIT4; -- len -= 4; -- } -- buf = (const unsigned char FAR *)buf4; -- -- if (len) do { -- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); -- } while (--len); -- c = ~c; -- return (unsigned long)c; --} -- --/* ========================================================================= */ --#define DOBIG4 c ^= *++buf4; \ -- c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \ -- crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24] --#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4 -- --/* ========================================================================= */ --local unsigned long crc32_big(unsigned long crc, -- const unsigned char FAR *buf, unsigned len) --/* -- unsigned long crc; -- const unsigned char FAR *buf; -- unsigned len; --*/ --{ -- register u4 c; -- register const u4 FAR *buf4; -- -- c = REV((u4)crc); -- c = ~c; -- while (len && ((ptrdiff_t)buf & 3)) { -- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); -- len--; -- } -- -- buf4 = (const u4 FAR *)(const void FAR *)buf; -- buf4--; -- while (len >= 32) { -- DOBIG32; -- len -= 32; -- } -- while (len >= 4) { -- DOBIG4; -- len -= 4; -- } -- buf4++; -- buf = (const unsigned char FAR *)buf4; -- -- if (len) do { -- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); -- } while (--len); -- c = ~c; -- return (unsigned long)(REV(c)); --} -- --#endif /* BYFOUR */ -- --#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */ -- --/* ========================================================================= */ --local unsigned long gf2_matrix_times(unsigned long *mat, unsigned long vec) --/* -- unsigned long *mat; -- unsigned long vec; --*/ --{ -- unsigned long sum; -- -- sum = 0; -- while (vec) { -- if (vec & 1) -- sum ^= *mat; -- vec >>= 1; -- mat++; -- } -- return sum; --} -- --/* ========================================================================= */ --local void gf2_matrix_square(unsigned long *square, unsigned long *mat) --/* -- unsigned long *square; -- unsigned long *mat; --*/ --{ -- int n; -- -- for (n = 0; n < GF2_DIM; n++) -- square[n] = gf2_matrix_times(mat, mat[n]); --} -- --/* ========================================================================= */ --uLong ZEXPORT crc32_combine(uLong crc1, uLong crc2, z_off_t len2) --/* -- uLong crc1; -- uLong crc2; -- z_off_t len2; --*/ --{ -- int n; -- unsigned long row; -- unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */ -- unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */ -- -- /* degenerate case */ -- if (len2 == 0) -- return crc1; -- -- /* put operator for one zero bit in odd */ -- odd[0] = 0xedb88320L; /* CRC-32 polynomial */ -- row = 1; -- for (n = 1; n < GF2_DIM; n++) { -- odd[n] = row; -- row <<= 1; -- } -- -- /* put operator for two zero bits in even */ -- gf2_matrix_square(even, odd); -- -- /* put operator for four zero bits in odd */ -- gf2_matrix_square(odd, even); -- -- /* apply len2 zeros to crc1 (first square will put the operator for one -- zero byte, eight zero bits, in even) */ -- do { -- /* apply zeros operator for this bit of len2 */ -- gf2_matrix_square(even, odd); -- if (len2 & 1) -- crc1 = gf2_matrix_times(even, crc1); -- len2 >>= 1; -- -- /* if no more bits set, then done */ -- if (len2 == 0) -- break; -- -- /* another iteration of the loop with odd and even swapped */ -- gf2_matrix_square(odd, even); -- if (len2 & 1) -- crc1 = gf2_matrix_times(odd, crc1); -- len2 >>= 1; -- -- /* if no more bits set, then done */ -- } while (len2 != 0); -- -- /* return combined crc */ -- crc1 ^= crc2; -- return crc1; --} -diff -ruN seqinr.orig/src/crc32.h seqinr/src/crc32.h ---- seqinr.orig/src/crc32.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/crc32.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,441 +0,0 @@ --/* crc32.h -- tables for rapid CRC calculation -- * Generated automatically by crc32.c -- */ -- --local const unsigned long FAR crc_table[TBLS][256] = --{ -- { -- 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL, -- 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL, -- 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, -- 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL, -- 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL, -- 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL, -- 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, -- 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL, -- 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL, -- 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL, -- 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, -- 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL, -- 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL, -- 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL, -- 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, -- 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL, -- 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL, -- 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL, -- 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, -- 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL, -- 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL, -- 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL, -- 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, -- 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL, -- 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL, -- 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL, -- 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, -- 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL, -- 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL, -- 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL, -- 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, -- 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL, -- 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL, -- 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL, -- 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, -- 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL, -- 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL, -- 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL, -- 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, -- 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL, -- 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL, -- 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL, -- 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, -- 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL, -- 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL, -- 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL, -- 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, -- 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL, -- 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL, -- 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL, -- 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, -- 0x2d02ef8dUL --#ifdef BYFOUR -- }, -- { -- 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL, -- 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL, -- 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL, -- 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL, -- 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL, -- 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL, -- 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL, -- 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL, -- 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL, -- 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL, -- 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL, -- 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL, -- 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL, -- 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL, -- 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL, -- 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL, -- 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL, -- 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL, -- 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL, -- 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL, -- 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL, -- 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL, -- 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL, -- 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL, -- 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL, -- 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL, -- 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL, -- 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL, -- 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL, -- 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL, -- 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL, -- 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL, -- 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL, -- 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL, -- 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL, -- 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL, -- 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL, -- 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL, -- 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL, -- 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL, -- 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL, -- 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL, -- 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL, -- 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL, -- 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL, -- 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL, -- 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL, -- 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL, -- 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL, -- 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL, -- 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL, -- 0x9324fd72UL -- }, -- { -- 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL, -- 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL, -- 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL, -- 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL, -- 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL, -- 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL, -- 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL, -- 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL, -- 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL, -- 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL, -- 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL, -- 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL, -- 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL, -- 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL, -- 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL, -- 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL, -- 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL, -- 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL, -- 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL, -- 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL, -- 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL, -- 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL, -- 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL, -- 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL, -- 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL, -- 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL, -- 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL, -- 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL, -- 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL, -- 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL, -- 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL, -- 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL, -- 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL, -- 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL, -- 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL, -- 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL, -- 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL, -- 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL, -- 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL, -- 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL, -- 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL, -- 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL, -- 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL, -- 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL, -- 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL, -- 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL, -- 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL, -- 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL, -- 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL, -- 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL, -- 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL, -- 0xbe9834edUL -- }, -- { -- 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL, -- 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL, -- 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL, -- 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL, -- 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL, -- 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL, -- 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL, -- 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL, -- 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL, -- 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL, -- 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL, -- 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL, -- 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL, -- 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL, -- 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL, -- 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL, -- 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL, -- 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL, -- 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL, -- 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL, -- 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL, -- 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL, -- 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL, -- 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL, -- 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL, -- 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL, -- 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL, -- 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL, -- 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL, -- 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL, -- 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL, -- 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL, -- 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL, -- 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL, -- 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL, -- 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL, -- 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL, -- 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL, -- 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL, -- 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL, -- 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL, -- 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL, -- 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL, -- 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL, -- 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL, -- 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL, -- 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL, -- 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL, -- 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL, -- 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL, -- 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL, -- 0xde0506f1UL -- }, -- { -- 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL, -- 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL, -- 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL, -- 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL, -- 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL, -- 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL, -- 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL, -- 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL, -- 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL, -- 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL, -- 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL, -- 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL, -- 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL, -- 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL, -- 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL, -- 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL, -- 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL, -- 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL, -- 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL, -- 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL, -- 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL, -- 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL, -- 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL, -- 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL, -- 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL, -- 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL, -- 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL, -- 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL, -- 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL, -- 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL, -- 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL, -- 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL, -- 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL, -- 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL, -- 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL, -- 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL, -- 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL, -- 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL, -- 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL, -- 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL, -- 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL, -- 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL, -- 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL, -- 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL, -- 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL, -- 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL, -- 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL, -- 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL, -- 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL, -- 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL, -- 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL, -- 0x8def022dUL -- }, -- { -- 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL, -- 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL, -- 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL, -- 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL, -- 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL, -- 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL, -- 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL, -- 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL, -- 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL, -- 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL, -- 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL, -- 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL, -- 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL, -- 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL, -- 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL, -- 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL, -- 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL, -- 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL, -- 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL, -- 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL, -- 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL, -- 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL, -- 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL, -- 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL, -- 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL, -- 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL, -- 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL, -- 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL, -- 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL, -- 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL, -- 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL, -- 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL, -- 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL, -- 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL, -- 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL, -- 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL, -- 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL, -- 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL, -- 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL, -- 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL, -- 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL, -- 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL, -- 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL, -- 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL, -- 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL, -- 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL, -- 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL, -- 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL, -- 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL, -- 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL, -- 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL, -- 0x72fd2493UL -- }, -- { -- 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL, -- 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL, -- 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL, -- 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL, -- 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL, -- 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL, -- 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL, -- 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL, -- 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL, -- 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL, -- 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL, -- 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL, -- 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL, -- 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL, -- 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL, -- 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL, -- 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL, -- 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL, -- 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL, -- 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL, -- 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL, -- 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL, -- 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL, -- 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL, -- 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL, -- 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL, -- 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL, -- 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL, -- 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL, -- 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL, -- 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL, -- 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL, -- 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL, -- 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL, -- 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL, -- 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL, -- 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL, -- 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL, -- 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL, -- 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL, -- 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL, -- 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL, -- 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL, -- 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL, -- 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL, -- 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL, -- 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL, -- 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL, -- 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL, -- 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL, -- 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL, -- 0xed3498beUL -- }, -- { -- 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL, -- 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL, -- 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL, -- 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL, -- 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL, -- 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL, -- 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL, -- 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL, -- 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL, -- 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL, -- 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL, -- 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL, -- 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL, -- 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL, -- 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL, -- 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL, -- 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL, -- 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL, -- 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL, -- 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL, -- 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL, -- 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL, -- 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL, -- 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL, -- 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL, -- 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL, -- 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL, -- 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL, -- 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL, -- 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL, -- 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL, -- 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL, -- 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL, -- 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL, -- 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL, -- 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL, -- 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL, -- 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL, -- 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL, -- 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL, -- 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL, -- 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL, -- 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL, -- 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL, -- 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL, -- 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL, -- 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL, -- 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL, -- 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL, -- 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL, -- 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL, -- 0xf10605deUL --#endif -- } --}; -diff -ruN seqinr.orig/src/deflate.c seqinr/src/deflate.c ---- seqinr.orig/src/deflate.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/deflate.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1711 +0,0 @@ --/* deflate.c -- compress data using the deflation algorithm -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * ALGORITHM -- * -- * The "deflation" process depends on being able to identify portions -- * of the input text which are identical to earlier input (within a -- * sliding window trailing behind the input currently being processed). -- * -- * The most straightforward technique turns out to be the fastest for -- * most input files: try all possible matches and select the longest. -- * The key feature of this algorithm is that insertions into the string -- * dictionary are very simple and thus fast, and deletions are avoided -- * completely. Insertions are performed at each input character, whereas -- * string matches are performed only when the previous match ends. So it -- * is preferable to spend more time in matches to allow very fast string -- * insertions and avoid deletions. The matching algorithm for small -- * strings is inspired from that of Rabin & Karp. A brute force approach -- * is used to find longer strings when a small match has been found. -- * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze -- * (by Leonid Broukhis). -- * A previous version of this file used a more sophisticated algorithm -- * (by Fiala and Greene) which is guaranteed to run in linear amortized -- * time, but has a larger average cost, uses more memory and is patented. -- * However the F&G algorithm may be faster for some highly redundant -- * files if the parameter max_chain_length (described below) is too large. -- * -- * ACKNOWLEDGEMENTS -- * -- * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and -- * I found it in 'freeze' written by Leonid Broukhis. -- * Thanks to many people for bug reports and testing. -- * -- * REFERENCES -- * -- * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". -- * Available in http://www.ietf.org/rfc/rfc1951.txt -- * -- * A description of the Rabin and Karp algorithm is given in the book -- * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. -- * -- * Fiala,E.R., and Greene,D.H. -- * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 -- * -- */ -- --/* @(#) $Id: deflate.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ -- --#include "deflate.h" -- --const char deflate_copyright[] = -- " deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly "; --/* -- If you use the zlib library in a product, an acknowledgment is welcome -- in the documentation of your product. If for some reason you cannot -- include such an acknowledgment, I would appreciate that you keep this -- copyright string in the executable of your product. -- */ -- --/* =========================================================================== -- * Function prototypes. -- */ --typedef enum { -- need_more, /* block not completed, need more input or more output */ -- block_done, /* block flush performed */ -- finish_started, /* finish started, need only more output at next deflate */ -- finish_done /* finish done, accept no more input or output */ --} block_state; -- --typedef block_state (*compress_func) OF((deflate_state *s, int flush)); --/* Compression function. Returns the block state after the call. */ -- --local void fill_window OF((deflate_state *s)); --local block_state deflate_stored OF((deflate_state *s, int flush)); --local block_state deflate_fast OF((deflate_state *s, int flush)); --#ifndef FASTEST --local block_state deflate_slow OF((deflate_state *s, int flush)); --#endif --local void lm_init OF((deflate_state *s)); --local void putShortMSB OF((deflate_state *s, uInt b)); --local void flush_pending OF((z_streamp strm)); --local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size)); --#ifndef FASTEST --#ifdef ASMV -- void match_init OF((void)); /* asm code initialization */ -- uInt longest_match OF((deflate_state *s, IPos cur_match)); --#else --local uInt longest_match OF((deflate_state *s, IPos cur_match)); --#endif --#endif --local uInt longest_match_fast OF((deflate_state *s, IPos cur_match)); -- --#ifdef DEBUG --local void check_match OF((deflate_state *s, IPos start, IPos match, -- int length)); --#endif -- --/* =========================================================================== -- * Local data -- */ -- --#define NIL 0 --/* Tail of hash chains */ -- --#ifndef TOO_FAR --# define TOO_FAR 4096 --#endif --/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ -- --#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) --/* Minimum amount of lookahead, except at the end of the input file. -- * See deflate.c for comments about the MIN_MATCH+1. -- */ -- --/* Values for max_lazy_match, good_match and max_chain_length, depending on -- * the desired pack level (0..9). The values given below have been tuned to -- * exclude worst case performance for pathological files. Better values may be -- * found for specific files. -- */ --typedef struct config_s { -- ush good_length; /* reduce lazy search above this match length */ -- ush max_lazy; /* do not perform lazy search above this match length */ -- ush nice_length; /* quit search above this match length */ -- ush max_chain; -- compress_func func; --} config; -- --#ifdef FASTEST --local const config configuration_table[2] = { --/* good lazy nice chain */ --/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ --/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ --#else --local const config configuration_table[10] = { --/* good lazy nice chain */ --/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ --/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ --/* 2 */ {4, 5, 16, 8, deflate_fast}, --/* 3 */ {4, 6, 32, 32, deflate_fast}, -- --/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ --/* 5 */ {8, 16, 32, 32, deflate_slow}, --/* 6 */ {8, 16, 128, 128, deflate_slow}, --/* 7 */ {8, 32, 128, 256, deflate_slow}, --/* 8 */ {32, 128, 258, 1024, deflate_slow}, --/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ --#endif -- --/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 -- * For deflate_fast() (levels <= 3) good is ignored and lazy has a different -- * meaning. -- */ -- --#define EQUAL 0 --/* result of memcmp for equal strings */ -- --#ifndef NO_DUMMY_DECL --struct static_tree_desc_s {int dummy;}; /* for buggy compilers */ --#endif -- --/* =========================================================================== -- * Update a hash value with the given input byte -- * IN assertion: all calls to to UPDATE_HASH are made with consecutive -- * input characters, so that a running hash key can be computed from the -- * previous key instead of complete recalculation each time. -- */ --#define UPDATE_HASH(s,h,c) (h = (((h)<hash_shift) ^ (c)) & s->hash_mask) -- -- --/* =========================================================================== -- * Insert string str in the dictionary and set match_head to the previous head -- * of the hash chain (the most recent string with same hash key). Return -- * the previous length of the hash chain. -- * If this file is compiled with -DFASTEST, the compression level is forced -- * to 1, and no hash chains are maintained. -- * IN assertion: all calls to to INSERT_STRING are made with consecutive -- * input characters and the first MIN_MATCH bytes of str are valid -- * (except for the last MIN_MATCH-1 bytes of the input file). -- */ --#ifdef FASTEST --#define INSERT_STRING(s, str, match_head) \ -- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ -- match_head = s->head[s->ins_h], \ -- s->head[s->ins_h] = (Pos)(str)) --#else --#define INSERT_STRING(s, str, match_head) \ -- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ -- match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ -- s->head[s->ins_h] = (Pos)(str)) --#endif -- --/* =========================================================================== -- * Initialize the hash table (avoiding 64K overflow for 16 bit systems). -- * prev[] will be initialized on the fly. -- */ --#define CLEAR_HASH(s) \ -- s->head[s->hash_size-1] = NIL; \ -- zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head)); -- --/* ========================================================================= */ --int ZEXPORT deflateInit_(z_streamp strm, int level, const char *version, -- int stream_size) --/* -- z_streamp strm; -- int level; -- const char *version; -- int stream_size; --*/ --{ -- return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, -- Z_DEFAULT_STRATEGY, version, stream_size); -- /* To do: ignore strm->next_in if we use it as window */ --} -- --/* ========================================================================= */ --int ZEXPORT deflateInit2_(z_streamp strm, int level, int method, -- int windowBits, int memLevel, int strategy, -- const char *version, int stream_size) --/* -- z_streamp strm; -- int level; -- int method; -- int windowBits; -- int memLevel; -- int strategy; -- const char *version; -- int stream_size; --*/ --{ -- deflate_state *s; -- int wrap = 1; -- static const char my_version[] = ZLIB_VERSION; -- -- ushf *overlay; -- /* We overlay pending_buf and d_buf+l_buf. This works since the average -- * output size for (length,distance) codes is <= 24 bits. -- */ -- -- if (version == Z_NULL || version[0] != my_version[0] || -- stream_size != sizeof(z_stream)) { -- return Z_VERSION_ERROR; -- } -- if (strm == Z_NULL) return Z_STREAM_ERROR; -- -- strm->msg = Z_NULL; -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- --#ifdef FASTEST -- if (level != 0) level = 1; --#else -- if (level == Z_DEFAULT_COMPRESSION) level = 6; --#endif -- -- if (windowBits < 0) { /* suppress zlib wrapper */ -- wrap = 0; -- windowBits = -windowBits; -- } --#ifdef GZIP -- else if (windowBits > 15) { -- wrap = 2; /* write gzip wrapper instead */ -- windowBits -= 16; -- } --#endif -- if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || -- windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || -- strategy < 0 || strategy > Z_FIXED) { -- return Z_STREAM_ERROR; -- } -- if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ -- s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); -- if (s == Z_NULL) return Z_MEM_ERROR; -- strm->state = (struct internal_state FAR *)s; -- s->strm = strm; -- -- s->wrap = wrap; -- s->gzhead = Z_NULL; -- s->w_bits = windowBits; -- s->w_size = 1 << s->w_bits; -- s->w_mask = s->w_size - 1; -- -- s->hash_bits = memLevel + 7; -- s->hash_size = 1 << s->hash_bits; -- s->hash_mask = s->hash_size - 1; -- s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH); -- -- s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); -- s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); -- s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); -- -- s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ -- -- overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2); -- s->pending_buf = (uchf *) overlay; -- s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L); -- -- if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || -- s->pending_buf == Z_NULL) { -- s->status = FINISH_STATE; -- strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); -- deflateEnd (strm); -- return Z_MEM_ERROR; -- } -- s->d_buf = overlay + s->lit_bufsize/sizeof(ush); -- s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize; -- -- s->level = level; -- s->strategy = strategy; -- s->method = (Byte)method; -- -- return deflateReset(strm); --} -- --/* ========================================================================= */ --int ZEXPORT deflateSetDictionary (z_streamp strm, const Bytef *dictionary, -- uInt dictLength) --/* -- z_streamp strm; -- const Bytef *dictionary; -- uInt dictLength; --*/ --{ -- deflate_state *s; -- uInt length = dictLength; -- uInt n; -- IPos hash_head = 0; -- -- if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL || -- strm->state->wrap == 2 || -- (strm->state->wrap == 1 && strm->state->status != INIT_STATE)) -- return Z_STREAM_ERROR; -- -- s = strm->state; -- if (s->wrap) -- strm->adler = adler32(strm->adler, dictionary, dictLength); -- -- if (length < MIN_MATCH) return Z_OK; -- if (length > MAX_DIST(s)) { -- length = MAX_DIST(s); -- dictionary += dictLength - length; /* use the tail of the dictionary */ -- } -- zmemcpy(s->window, dictionary, length); -- s->strstart = length; -- s->block_start = (long)length; -- -- /* Insert all strings in the hash table (except for the last two bytes). -- * s->lookahead stays null, so s->ins_h will be recomputed at the next -- * call of fill_window. -- */ -- s->ins_h = s->window[0]; -- UPDATE_HASH(s, s->ins_h, s->window[1]); -- for (n = 0; n <= length - MIN_MATCH; n++) { -- INSERT_STRING(s, n, hash_head); -- } -- if (hash_head) hash_head = 0; /* to make compiler happy */ -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateReset (z_streamp strm) --/* z_streamp strm; */ --{ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL || -- strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) { -- return Z_STREAM_ERROR; -- } -- -- strm->total_in = strm->total_out = 0; -- strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ -- strm->data_type = Z_UNKNOWN; -- -- s = (deflate_state *)strm->state; -- s->pending = 0; -- s->pending_out = s->pending_buf; -- -- if (s->wrap < 0) { -- s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ -- } -- s->status = s->wrap ? INIT_STATE : BUSY_STATE; -- strm->adler = --#ifdef GZIP -- s->wrap == 2 ? crc32(0L, Z_NULL, 0) : --#endif -- adler32(0L, Z_NULL, 0); -- s->last_flush = Z_NO_FLUSH; -- -- _tr_init(s); -- lm_init(s); -- -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateSetHeader (z_streamp strm, gz_headerp head) --/* -- z_streamp strm; -- gz_headerp head; --*/ --{ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- if (strm->state->wrap != 2) return Z_STREAM_ERROR; -- strm->state->gzhead = head; -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflatePrime (z_streamp strm, int bits, int value) --{ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- strm->state->bi_valid = bits; -- strm->state->bi_buf = (ush)(value & ((1 << bits) - 1)); -- return Z_OK; --} -- --/* ========================================================================= */ --int ZEXPORT deflateParams(z_streamp strm, int level, int strategy) --{ -- deflate_state *s; -- compress_func func; -- int err = Z_OK; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- s = strm->state; -- --#ifdef FASTEST -- if (level != 0) level = 1; --#else -- if (level == Z_DEFAULT_COMPRESSION) level = 6; --#endif -- if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { -- return Z_STREAM_ERROR; -- } -- func = configuration_table[s->level].func; -- -- if (func != configuration_table[level].func && strm->total_in != 0) { -- /* Flush the last buffer: */ -- err = deflate(strm, Z_PARTIAL_FLUSH); -- } -- if (s->level != level) { -- s->level = level; -- s->max_lazy_match = configuration_table[level].max_lazy; -- s->good_match = configuration_table[level].good_length; -- s->nice_match = configuration_table[level].nice_length; -- s->max_chain_length = configuration_table[level].max_chain; -- } -- s->strategy = strategy; -- return err; --} -- --/* ========================================================================= */ --int ZEXPORT deflateTune(z_streamp strm, int good_length, int max_lazy, -- int nice_length, int max_chain) --{ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- s = strm->state; -- s->good_match = good_length; -- s->max_lazy_match = max_lazy; -- s->nice_match = nice_length; -- s->max_chain_length = max_chain; -- return Z_OK; --} -- --/* ========================================================================= -- * For the default windowBits of 15 and memLevel of 8, this function returns -- * a close to exact, as well as small, upper bound on the compressed size. -- * They are coded as constants here for a reason--if the #define's are -- * changed, then this function needs to be changed as well. The return -- * value for 15 and 8 only works for those exact settings. -- * -- * For any setting other than those defaults for windowBits and memLevel, -- * the value returned is a conservative worst case for the maximum expansion -- * resulting from using fixed blocks instead of stored blocks, which deflate -- * can emit on compressed data for some combinations of the parameters. -- * -- * This function could be more sophisticated to provide closer upper bounds -- * for every combination of windowBits and memLevel, as well as wrap. -- * But even the conservative upper bound of about 14% expansion does not -- * seem onerous for output buffer allocation. -- */ --uLong ZEXPORT deflateBound(z_streamp strm, uLong sourceLen) --{ -- deflate_state *s; -- uLong destLen; -- -- /* conservative upper bound */ -- destLen = sourceLen + -- ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 11; -- -- /* if can't get parameters, return conservative bound */ -- if (strm == Z_NULL || strm->state == Z_NULL) -- return destLen; -- -- /* if not default parameters, return conservative bound */ -- s = strm->state; -- if (s->w_bits != 15 || s->hash_bits != 8 + 7) -- return destLen; -- -- /* default settings: return tight bound for that case */ -- return compressBound(sourceLen); --} -- --/* ========================================================================= -- * Put a short in the pending buffer. The 16-bit value is put in MSB order. -- * IN assertion: the stream state is correct and there is enough room in -- * pending_buf. -- */ --local void putShortMSB (deflate_state *s, uInt b) --{ -- put_byte(s, (Byte)(b >> 8)); -- put_byte(s, (Byte)(b & 0xff)); --} -- --/* ========================================================================= -- * Flush as much pending output as possible. All deflate() output goes -- * through this function so some applications may wish to modify it -- * to avoid allocating a large strm->next_out buffer and copying into it. -- * (See also read_buf()). -- */ --local void flush_pending(z_streamp strm) --{ -- unsigned len = strm->state->pending; -- -- if (len > strm->avail_out) len = strm->avail_out; -- if (len == 0) return; -- -- zmemcpy(strm->next_out, strm->state->pending_out, len); -- strm->next_out += len; -- strm->state->pending_out += len; -- strm->total_out += len; -- strm->avail_out -= len; -- strm->state->pending -= len; -- if (strm->state->pending == 0) { -- strm->state->pending_out = strm->state->pending_buf; -- } --} -- --/* ========================================================================= */ --int ZEXPORT deflate (z_streamp strm, int flush) --{ -- int old_flush; /* value of flush param for previous deflate call */ -- deflate_state *s; -- -- if (strm == Z_NULL || strm->state == Z_NULL || -- flush > Z_FINISH || flush < 0) { -- return Z_STREAM_ERROR; -- } -- s = strm->state; -- -- if (strm->next_out == Z_NULL || -- (strm->next_in == Z_NULL && strm->avail_in != 0) || -- (s->status == FINISH_STATE && flush != Z_FINISH)) { -- ERR_RETURN(strm, Z_STREAM_ERROR); -- } -- if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); -- -- s->strm = strm; /* just in case */ -- old_flush = s->last_flush; -- s->last_flush = flush; -- -- /* Write the header */ -- if (s->status == INIT_STATE) { --#ifdef GZIP -- if (s->wrap == 2) { -- strm->adler = crc32(0L, Z_NULL, 0); -- put_byte(s, 31); -- put_byte(s, 139); -- put_byte(s, 8); -- if (s->gzhead == NULL) { -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, 0); -- put_byte(s, s->level == 9 ? 2 : -- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? -- 4 : 0)); -- put_byte(s, OS_CODE); -- s->status = BUSY_STATE; -- } -- else { -- put_byte(s, (s->gzhead->text ? 1 : 0) + -- (s->gzhead->hcrc ? 2 : 0) + -- (s->gzhead->extra == Z_NULL ? 0 : 4) + -- (s->gzhead->name == Z_NULL ? 0 : 8) + -- (s->gzhead->comment == Z_NULL ? 0 : 16) -- ); -- put_byte(s, (Byte)(s->gzhead->time & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); -- put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); -- put_byte(s, s->level == 9 ? 2 : -- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? -- 4 : 0)); -- put_byte(s, s->gzhead->os & 0xff); -- if (s->gzhead->extra != NULL) { -- put_byte(s, s->gzhead->extra_len & 0xff); -- put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); -- } -- if (s->gzhead->hcrc) -- strm->adler = crc32(strm->adler, s->pending_buf, -- s->pending); -- s->gzindex = 0; -- s->status = EXTRA_STATE; -- } -- } -- else --#endif -- { -- uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; -- uInt level_flags; -- -- if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) -- level_flags = 0; -- else if (s->level < 6) -- level_flags = 1; -- else if (s->level == 6) -- level_flags = 2; -- else -- level_flags = 3; -- header |= (level_flags << 6); -- if (s->strstart != 0) header |= PRESET_DICT; -- header += 31 - (header % 31); -- -- s->status = BUSY_STATE; -- putShortMSB(s, header); -- -- /* Save the adler32 of the preset dictionary: */ -- if (s->strstart != 0) { -- putShortMSB(s, (uInt)(strm->adler >> 16)); -- putShortMSB(s, (uInt)(strm->adler & 0xffff)); -- } -- strm->adler = adler32(0L, Z_NULL, 0); -- } -- } --#ifdef GZIP -- if (s->status == EXTRA_STATE) { -- if (s->gzhead->extra != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- -- while (s->gzindex < (s->gzhead->extra_len & 0xffff)) { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) -- break; -- } -- put_byte(s, s->gzhead->extra[s->gzindex]); -- s->gzindex++; -- } -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (s->gzindex == s->gzhead->extra_len) { -- s->gzindex = 0; -- s->status = NAME_STATE; -- } -- } -- else -- s->status = NAME_STATE; -- } -- if (s->status == NAME_STATE) { -- if (s->gzhead->name != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- int val; -- -- do { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) { -- val = 1; -- break; -- } -- } -- val = s->gzhead->name[s->gzindex++]; -- put_byte(s, val); -- } while (val != 0); -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (val == 0) { -- s->gzindex = 0; -- s->status = COMMENT_STATE; -- } -- } -- else -- s->status = COMMENT_STATE; -- } -- if (s->status == COMMENT_STATE) { -- if (s->gzhead->comment != NULL) { -- uInt beg = s->pending; /* start of bytes to update crc */ -- int val; -- -- do { -- if (s->pending == s->pending_buf_size) { -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- flush_pending(strm); -- beg = s->pending; -- if (s->pending == s->pending_buf_size) { -- val = 1; -- break; -- } -- } -- val = s->gzhead->comment[s->gzindex++]; -- put_byte(s, val); -- } while (val != 0); -- if (s->gzhead->hcrc && s->pending > beg) -- strm->adler = crc32(strm->adler, s->pending_buf + beg, -- s->pending - beg); -- if (val == 0) -- s->status = HCRC_STATE; -- } -- else -- s->status = HCRC_STATE; -- } -- if (s->status == HCRC_STATE) { -- if (s->gzhead->hcrc) { -- if (s->pending + 2 > s->pending_buf_size) -- flush_pending(strm); -- if (s->pending + 2 <= s->pending_buf_size) { -- put_byte(s, (Byte)(strm->adler & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); -- strm->adler = crc32(0L, Z_NULL, 0); -- s->status = BUSY_STATE; -- } -- } -- else -- s->status = BUSY_STATE; -- } --#endif -- -- /* Flush as much pending output as possible */ -- if (s->pending != 0) { -- flush_pending(strm); -- if (strm->avail_out == 0) { -- /* 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: -- */ -- s->last_flush = -1; -- return Z_OK; -- } -- -- /* Make sure there is something to do and avoid duplicate consecutive -- * flushes. For repeated and useless calls with Z_FINISH, we keep -- * returning Z_STREAM_END instead of Z_BUF_ERROR. -- */ -- } else if (strm->avail_in == 0 && flush <= old_flush && -- flush != Z_FINISH) { -- ERR_RETURN(strm, Z_BUF_ERROR); -- } -- -- /* User must not provide more input after the first FINISH: */ -- if (s->status == FINISH_STATE && strm->avail_in != 0) { -- ERR_RETURN(strm, Z_BUF_ERROR); -- } -- -- /* Start a new block or continue the current one. -- */ -- if (strm->avail_in != 0 || s->lookahead != 0 || -- (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { -- block_state bstate; -- -- bstate = (*(configuration_table[s->level].func))(s, flush); -- -- if (bstate == finish_started || bstate == finish_done) { -- s->status = FINISH_STATE; -- } -- if (bstate == need_more || bstate == finish_started) { -- if (strm->avail_out == 0) { -- s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ -- } -- return Z_OK; -- /* 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. -- */ -- } -- if (bstate == block_done) { -- if (flush == Z_PARTIAL_FLUSH) { -- _tr_align(s); -- } else { /* FULL_FLUSH or SYNC_FLUSH */ -- _tr_stored_block(s, (char*)0, 0L, 0); -- /* For a full flush, this empty block will be recognized -- * as a special marker by inflate_sync(). -- */ -- if (flush == Z_FULL_FLUSH) { -- CLEAR_HASH(s); /* forget history */ -- } -- } -- flush_pending(strm); -- if (strm->avail_out == 0) { -- s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ -- return Z_OK; -- } -- } -- } -- Assert(strm->avail_out > 0, "bug2"); -- -- if (flush != Z_FINISH) return Z_OK; -- if (s->wrap <= 0) return Z_STREAM_END; -- -- /* Write the trailer */ --#ifdef GZIP -- if (s->wrap == 2) { -- put_byte(s, (Byte)(strm->adler & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); -- put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); -- put_byte(s, (Byte)(strm->total_in & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); -- put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); -- } -- else --#endif -- { -- putShortMSB(s, (uInt)(strm->adler >> 16)); -- putShortMSB(s, (uInt)(strm->adler & 0xffff)); -- } -- flush_pending(strm); -- /* If avail_out is zero, the application will call deflate again -- * to flush the rest. -- */ -- if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ -- return s->pending != 0 ? Z_OK : Z_STREAM_END; --} -- --/* ========================================================================= */ --int ZEXPORT deflateEnd (z_streamp strm) --{ -- int status; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- -- status = strm->state->status; -- if (status != INIT_STATE && -- status != EXTRA_STATE && -- status != NAME_STATE && -- status != COMMENT_STATE && -- status != HCRC_STATE && -- status != BUSY_STATE && -- status != FINISH_STATE) { -- return Z_STREAM_ERROR; -- } -- -- /* Deallocate in reverse order of allocations: */ -- TRY_FREE(strm, strm->state->pending_buf); -- TRY_FREE(strm, strm->state->head); -- TRY_FREE(strm, strm->state->prev); -- TRY_FREE(strm, strm->state->window); -- -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- -- return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; --} -- --/* ========================================================================= -- * Copy the source state to the destination state. -- * To simplify the source, this is not supported for 16-bit MSDOS (which -- * doesn't have enough memory anyway to duplicate compression states). -- */ --int ZEXPORT deflateCopy (z_streamp dest, z_streamp source) --{ --#ifdef MAXSEG_64K -- return Z_STREAM_ERROR; --#else -- deflate_state *ds; -- deflate_state *ss; -- ushf *overlay; -- -- -- if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) { -- return Z_STREAM_ERROR; -- } -- -- ss = source->state; -- -- zmemcpy(dest, source, sizeof(z_stream)); -- -- ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); -- if (ds == Z_NULL) return Z_MEM_ERROR; -- dest->state = (struct internal_state FAR *) ds; -- zmemcpy(ds, ss, sizeof(deflate_state)); -- ds->strm = dest; -- -- ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); -- ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); -- ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); -- overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2); -- ds->pending_buf = (uchf *) overlay; -- -- if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || -- ds->pending_buf == Z_NULL) { -- deflateEnd (dest); -- return Z_MEM_ERROR; -- } -- /* following zmemcpy do not work for 16-bit MSDOS */ -- zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); -- zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos)); -- zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos)); -- zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size); -- -- ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); -- ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush); -- ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize; -- -- ds->l_desc.dyn_tree = ds->dyn_ltree; -- ds->d_desc.dyn_tree = ds->dyn_dtree; -- ds->bl_desc.dyn_tree = ds->bl_tree; -- -- return Z_OK; --#endif /* MAXSEG_64K */ --} -- --/* =========================================================================== -- * Read a new buffer from the current input stream, update the adler32 -- * and total number of bytes read. All deflate() input goes through -- * this function so some applications may wish to modify it to avoid -- * allocating a large strm->next_in buffer and copying from it. -- * (See also flush_pending()). -- */ --local int read_buf(z_streamp strm, Bytef *buf, unsigned size) --{ -- unsigned len = strm->avail_in; -- -- if (len > size) len = size; -- if (len == 0) return 0; -- -- strm->avail_in -= len; -- -- if (strm->state->wrap == 1) { -- strm->adler = adler32(strm->adler, strm->next_in, len); -- } --#ifdef GZIP -- else if (strm->state->wrap == 2) { -- strm->adler = crc32(strm->adler, strm->next_in, len); -- } --#endif -- zmemcpy(buf, strm->next_in, len); -- strm->next_in += len; -- strm->total_in += len; -- -- return (int)len; --} -- --/* =========================================================================== -- * Initialize the "longest match" routines for a new zlib stream -- */ --local void lm_init (deflate_state *s) --{ -- s->window_size = (ulg)2L*s->w_size; -- -- CLEAR_HASH(s); -- -- /* Set the default configuration parameters: -- */ -- s->max_lazy_match = configuration_table[s->level].max_lazy; -- s->good_match = configuration_table[s->level].good_length; -- s->nice_match = configuration_table[s->level].nice_length; -- s->max_chain_length = configuration_table[s->level].max_chain; -- -- s->strstart = 0; -- s->block_start = 0L; -- s->lookahead = 0; -- s->match_length = s->prev_length = MIN_MATCH-1; -- s->match_available = 0; -- s->ins_h = 0; --#ifndef FASTEST --#ifdef ASMV -- match_init(); /* initialize the asm code */ --#endif --#endif --} -- --#ifndef FASTEST --/* =========================================================================== -- * Set match_start to the longest match starting at the given string and -- * return its length. Matches shorter or equal to prev_length are discarded, -- * in which case the result is equal to prev_length and match_start is -- * garbage. -- * IN assertions: cur_match is the head of the hash chain for the current -- * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 -- * OUT assertion: the match length is not greater than s->lookahead. -- */ --#ifndef ASMV --/* For 80x86 and 680x0, an optimized version will be provided in match.asm or -- * match.S. The code will be functionally equivalent. -- */ --local uInt longest_match(deflate_state *s, IPos cur_match) -- /* cur_match current match */ --{ -- unsigned chain_length = s->max_chain_length;/* max hash chain length */ -- register Bytef *scan = s->window + s->strstart; /* current string */ -- register Bytef *match; /* matched string */ -- register int len; /* length of current match */ -- int best_len = s->prev_length; /* best match length so far */ -- int nice_match = s->nice_match; /* stop if match long enough */ -- IPos limit = s->strstart > (IPos)MAX_DIST(s) ? -- s->strstart - (IPos)MAX_DIST(s) : NIL; -- /* Stop when cur_match becomes <= limit. To simplify the code, -- * we prevent matches with the string of window index 0. -- */ -- Posf *prev = s->prev; -- uInt wmask = s->w_mask; -- --#ifdef UNALIGNED_OK -- /* Compare two bytes at a time. Note: this is not always beneficial. -- * Try with and without -DUNALIGNED_OK to check. -- */ -- register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; -- register ush scan_start = *(ushf*)scan; -- register ush scan_end = *(ushf*)(scan+best_len-1); --#else -- register Bytef *strend = s->window + s->strstart + MAX_MATCH; -- register Byte scan_end1 = scan[best_len-1]; -- register Byte scan_end = scan[best_len]; --#endif -- -- /* 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. -- */ -- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); -- -- /* Do not waste too much time if we already have a good match: */ -- if (s->prev_length >= s->good_match) { -- chain_length >>= 2; -- } -- /* Do not look for matches beyond the end of the input. This is necessary -- * to make deflate deterministic. -- */ -- if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; -- -- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); -- -- do { -- Assert(cur_match < s->strstart, "no future"); -- match = s->window + cur_match; -- -- /* Skip to next match if the match length cannot increase -- * or if the match length is less than 2. Note that the checks below -- * for insufficient lookahead only occur occasionally for performance -- * reasons. Therefore uninitialized memory will be accessed, and -- * conditional jumps will be made that depend on those values. -- * However the length of the match is limited to the lookahead, so -- * the output of deflate is not affected by the uninitialized values. -- */ --#if (defined(UNALIGNED_OK) && MAX_MATCH == 258) -- /* This code assumes sizeof(unsigned short) == 2. Do not use -- * UNALIGNED_OK if your compiler uses a different size. -- */ -- if (*(ushf*)(match+best_len-1) != scan_end || -- *(ushf*)match != scan_start) continue; -- -- /* It is not necessary to compare scan[2] and match[2] since they are -- * always equal when the other bytes match, given that the hash keys -- * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at -- * strstart+3, +5, ... up to strstart+257. We check for insufficient -- * lookahead only every 4th comparison; the 128th check will be made -- * 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 -- * to check more often for insufficient lookahead. -- */ -- Assert(scan[2] == match[2], "scan[2]?"); -- scan++, match++; -- do { -- } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && -- scan < strend); -- /* The funny "do {}" generates better code on most compilers */ -- -- /* Here, scan <= window+strstart+257 */ -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- if (*scan == *match) scan++; -- -- len = (MAX_MATCH - 1) - (int)(strend-scan); -- scan = strend - (MAX_MATCH-1); -- --#else /* UNALIGNED_OK */ -- -- if (match[best_len] != scan_end || -- match[best_len-1] != scan_end1 || -- *match != *scan || -- *++match != scan[1]) continue; -- -- /* The check at best_len-1 can be removed because it will be made -- * again later. (This heuristic is not always a win.) -- * It is not necessary to compare scan[2] and match[2] since they -- * are always equal when the other bytes match, given that -- * the hash keys are equal and that HASH_BITS >= 8. -- */ -- scan += 2, match++; -- Assert(*scan == *match, "match[2]?"); -- -- /* We check for insufficient lookahead only every 8th comparison; -- * the 256th check will be made at strstart+258. -- */ -- do { -- } while (*++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- scan < strend); -- -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- -- len = MAX_MATCH - (int)(strend - scan); -- scan = strend - MAX_MATCH; -- --#endif /* UNALIGNED_OK */ -- -- if (len > best_len) { -- s->match_start = cur_match; -- best_len = len; -- if (len >= nice_match) break; --#ifdef UNALIGNED_OK -- scan_end = *(ushf*)(scan+best_len-1); --#else -- scan_end1 = scan[best_len-1]; -- scan_end = scan[best_len]; --#endif -- } -- } while ((cur_match = prev[cur_match & wmask]) > limit -- && --chain_length != 0); -- -- if ((uInt)best_len <= s->lookahead) return (uInt)best_len; -- return s->lookahead; --} --#endif /* ASMV */ --#endif /* FASTEST */ -- --/* --------------------------------------------------------------------------- -- * Optimized version for level == 1 or strategy == Z_RLE only -- */ --local uInt longest_match_fast(deflate_state *s, IPos cur_match) --{ -- register Bytef *scan = s->window + s->strstart; /* current string */ -- register Bytef *match; /* matched string */ -- register int len; /* length of current match */ -- register Bytef *strend = s->window + s->strstart + MAX_MATCH; -- -- /* 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. -- */ -- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); -- -- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); -- -- Assert(cur_match < s->strstart, "no future"); -- -- match = s->window + cur_match; -- -- /* Return failure if the match length is less than 2: -- */ -- if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; -- -- /* The check at best_len-1 can be removed because it will be made -- * again later. (This heuristic is not always a win.) -- * It is not necessary to compare scan[2] and match[2] since they -- * are always equal when the other bytes match, given that -- * the hash keys are equal and that HASH_BITS >= 8. -- */ -- scan += 2, match += 2; -- Assert(*scan == *match, "match[2]?"); -- -- /* We check for insufficient lookahead only every 8th comparison; -- * the 256th check will be made at strstart+258. -- */ -- do { -- } while (*++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- *++scan == *++match && *++scan == *++match && -- scan < strend); -- -- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); -- -- len = MAX_MATCH - (int)(strend - scan); -- -- if (len < MIN_MATCH) return MIN_MATCH - 1; -- -- s->match_start = cur_match; -- return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; --} -- --#ifdef DEBUG --/* =========================================================================== -- * Check that the match at match_start is indeed a match. -- */ --local void check_match(s, start, match, length) -- deflate_state *s; -- IPos start, match; -- int length; --{ -- /* check that the match is indeed a match */ -- if (zmemcmp(s->window + match, -- s->window + start, length) != EQUAL) { -- fprintf(stderr, " start %u, match %u, length %d\n", -- start, match, length); -- do { -- fprintf(stderr, "%c%c", s->window[match++], s->window[start++]); -- } while (--length != 0); -- z_error("invalid match"); -- } -- if (z_verbose > 1) { -- fprintf(stderr,"\\[%d,%d]", start-match, length); -- do { putc(s->window[start++], stderr); } while (--length != 0); -- } --} --#else --# define check_match(s, start, match, length) --#endif /* DEBUG */ -- --/* =========================================================================== -- * Fill the window when the lookahead becomes insufficient. -- * Updates strstart and lookahead. -- * -- * IN assertion: lookahead < MIN_LOOKAHEAD -- * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD -- * At least one byte has been read, or avail_in == 0; reads are -- * performed for at least two bytes (required for the zip translate_eol -- * option -- not supported here). -- */ --local void fill_window(deflate_state *s) --{ -- register unsigned n, m; -- register Posf *p; -- unsigned more; /* Amount of free space at the end of the window. */ -- uInt wsize = s->w_size; -- -- do { -- more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); -- -- /* Deal with !@#$% 64K limit: */ -- if (sizeof(int) <= 2) { -- if (more == 0 && s->strstart == 0 && s->lookahead == 0) { -- more = wsize; -- -- } else if (more == (unsigned)(-1)) { -- /* Very unlikely, but possible on 16 bit machine if -- * strstart == 0 && lookahead == 1 (input done a byte at time) -- */ -- more--; -- } -- } -- -- /* If the window is almost full and there is insufficient lookahead, -- * move the upper half to the lower one to make room in the upper half. -- */ -- if (s->strstart >= wsize+MAX_DIST(s)) { -- -- zmemcpy(s->window, s->window+wsize, (unsigned)wsize); -- s->match_start -= wsize; -- s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ -- s->block_start -= (long) wsize; -- -- /* Slide the hash table (could be avoided with 32 bit values -- at the expense of memory usage). We slide even when level == 0 -- to keep the hash table consistent if we switch back to level > 0 -- later. (Using level 0 permanently is not an optimal usage of -- zlib, so we don't care about this pathological case.) -- */ -- /* %%% avoid this when Z_RLE */ -- n = s->hash_size; -- p = &s->head[n]; -- do { -- m = *--p; -- *p = (Pos)(m >= wsize ? m-wsize : NIL); -- } while (--n); -- -- n = wsize; --#ifndef FASTEST -- p = &s->prev[n]; -- do { -- m = *--p; -- *p = (Pos)(m >= wsize ? m-wsize : NIL); -- /* If n is not on any hash chain, prev[n] is garbage but -- * its value will never be used. -- */ -- } while (--n); --#endif -- more += wsize; -- } -- if (s->strm->avail_in == 0) return; -- -- /* If there was no sliding: -- * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && -- * more == window_size - lookahead - strstart -- * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) -- * => more >= window_size - 2*WSIZE + 2 -- * In the BIG_MEM or MMAP case (not yet supported), -- * window_size == input_size + MIN_LOOKAHEAD && -- * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. -- * Otherwise, window_size == 2*WSIZE so more >= 2. -- * If there was sliding, more >= WSIZE. So in all cases, more >= 2. -- */ -- Assert(more >= 2, "more < 2"); -- -- n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); -- s->lookahead += n; -- -- /* Initialize the hash value now that we have some input: */ -- if (s->lookahead >= MIN_MATCH) { -- s->ins_h = s->window[s->strstart]; -- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); --#if MIN_MATCH != 3 -- Call UPDATE_HASH() MIN_MATCH-3 more times --#endif -- } -- /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, -- * but this is not important since only literal bytes will be emitted. -- */ -- -- } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); --} -- --/* =========================================================================== -- * Flush the current block, with given end-of-file flag. -- * IN assertion: strstart is set to the end of the current match. -- */ --#define FLUSH_BLOCK_ONLY(s, eof) { \ -- _tr_flush_block(s, (s->block_start >= 0L ? \ -- (charf *)&s->window[(unsigned)s->block_start] : \ -- (charf *)Z_NULL), \ -- (ulg)((long)s->strstart - s->block_start), \ -- (eof)); \ -- s->block_start = s->strstart; \ -- flush_pending(s->strm); \ -- Tracev((stderr,"[FLUSH]")); \ --} -- --/* Same but force premature exit if necessary. */ --#define FLUSH_BLOCK(s, eof) { \ -- FLUSH_BLOCK_ONLY(s, eof); \ -- if (s->strm->avail_out == 0) return (eof) ? finish_started : need_more; \ --} -- --/* =========================================================================== -- * Copy without compression as much as possible from the input stream, return -- * the current block state. -- * This function does not insert new strings in the dictionary since -- * uncompressible data is probably not useful. This function is used -- * only for the level=0 compression option. -- * NOTE: this function should be optimized to avoid extra copying from -- * window to pending_buf. -- */ --local block_state deflate_stored(deflate_state *s, int flush) --{ -- /* Stored blocks are limited to 0xffff bytes, pending_buf is limited -- * to pending_buf_size, and each stored block has a 5 byte header: -- */ -- ulg max_block_size = 0xffff; -- ulg max_start; -- -- if (max_block_size > s->pending_buf_size - 5) { -- max_block_size = s->pending_buf_size - 5; -- } -- -- /* Copy as much as possible from input to output: */ -- for (;;) { -- /* Fill the window as much as possible: */ -- if (s->lookahead <= 1) { -- -- Assert(s->strstart < s->w_size+MAX_DIST(s) || -- s->block_start >= (long)s->w_size, "slide too late"); -- -- fill_window(s); -- if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more; -- -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- Assert(s->block_start >= 0L, "block gone"); -- -- s->strstart += s->lookahead; -- s->lookahead = 0; -- -- /* Emit a stored block if pending_buf will be full: */ -- max_start = s->block_start + max_block_size; -- if (s->strstart == 0 || (ulg)s->strstart >= max_start) { -- /* strstart == 0 is possible when wraparound on 16-bit machine */ -- s->lookahead = (uInt)(s->strstart - max_start); -- s->strstart = (uInt)max_start; -- FLUSH_BLOCK(s, 0); -- } -- /* Flush if we may have to slide, otherwise block_start may become -- * negative and the data will be gone: -- */ -- if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) { -- FLUSH_BLOCK(s, 0); -- } -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} -- --/* =========================================================================== -- * Compress as much as possible from the input stream, return the current -- * block state. -- * This function does not perform lazy evaluation of matches and inserts -- * new strings in the dictionary only for unmatched strings or for short -- * matches. It is used only for the fast compression options. -- */ --local block_state deflate_fast(deflate_state *s, int flush) --{ -- IPos hash_head = NIL; /* head of the hash chain */ -- int bflush; /* set if current block must be flushed */ -- -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the next match, plus MIN_MATCH bytes to insert the -- * string following the next match. -- */ -- if (s->lookahead < MIN_LOOKAHEAD) { -- fill_window(s); -- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* Insert the string window[strstart .. strstart+2] in the -- * dictionary, and set hash_head to the head of the hash chain: -- */ -- if (s->lookahead >= MIN_MATCH) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- -- /* Find the longest match, discarding those <= prev_length. -- * At this point we have always match_length < MIN_MATCH -- */ -- if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { -- /* To simplify the code, we prevent matches with the string -- * of window index 0 (in particular we have to avoid a match -- * of the string with itself at the start of the input file). -- */ --#ifdef FASTEST -- if ((s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) || -- (s->strategy == Z_RLE && s->strstart - hash_head == 1)) { -- s->match_length = longest_match_fast (s, hash_head); -- } --#else -- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { -- s->match_length = longest_match (s, hash_head); -- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { -- s->match_length = longest_match_fast (s, hash_head); -- } --#endif -- /* longest_match() or longest_match_fast() sets match_start */ -- } -- if (s->match_length >= MIN_MATCH) { -- check_match(s, s->strstart, s->match_start, s->match_length); -- -- _tr_tally_dist(s, s->strstart - s->match_start, -- s->match_length - MIN_MATCH, bflush); -- -- s->lookahead -= s->match_length; -- -- /* Insert new strings in the hash table only if the match length -- * is not too large. This saves time but degrades compression. -- */ --#ifndef FASTEST -- if (s->match_length <= s->max_insert_length && -- s->lookahead >= MIN_MATCH) { -- s->match_length--; /* string at strstart already in table */ -- do { -- s->strstart++; -- INSERT_STRING(s, s->strstart, hash_head); -- /* strstart never exceeds WSIZE-MAX_MATCH, so there are -- * always MIN_MATCH bytes ahead. -- */ -- } while (--s->match_length != 0); -- s->strstart++; -- } else --#endif -- { -- s->strstart += s->match_length; -- s->match_length = 0; -- s->ins_h = s->window[s->strstart]; -- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); --#if MIN_MATCH != 3 -- Call UPDATE_HASH() MIN_MATCH-3 more times --#endif -- /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not -- * matter since it will be recomputed at next deflate call. -- */ -- } -- } else { -- /* No match, output a literal byte */ -- Tracevv((stderr,"%c", s->window[s->strstart])); -- _tr_tally_lit (s, s->window[s->strstart], bflush); -- s->lookahead--; -- s->strstart++; -- } -- if (bflush) FLUSH_BLOCK(s, 0); -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} -- --#ifndef FASTEST --/* =========================================================================== -- * Same as above, but achieves better compression. We use a lazy -- * evaluation for matches: a match is finally adopted only if there is -- * no better match at the next window position. -- */ --local block_state deflate_slow(deflate_state *s, int flush) --{ -- IPos hash_head = NIL; /* head of hash chain */ -- int bflush; /* set if current block must be flushed */ -- -- /* Process the input block. */ -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the next match, plus MIN_MATCH bytes to insert the -- * string following the next match. -- */ -- if (s->lookahead < MIN_LOOKAHEAD) { -- fill_window(s); -- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* Insert the string window[strstart .. strstart+2] in the -- * dictionary, and set hash_head to the head of the hash chain: -- */ -- if (s->lookahead >= MIN_MATCH) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- -- /* Find the longest match, discarding those <= prev_length. -- */ -- s->prev_length = s->match_length, s->prev_match = s->match_start; -- s->match_length = MIN_MATCH-1; -- -- if (hash_head != NIL && s->prev_length < s->max_lazy_match && -- s->strstart - hash_head <= MAX_DIST(s)) { -- /* To simplify the code, we prevent matches with the string -- * of window index 0 (in particular we have to avoid a match -- * of the string with itself at the start of the input file). -- */ -- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { -- s->match_length = longest_match (s, hash_head); -- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { -- s->match_length = longest_match_fast (s, hash_head); -- } -- /* longest_match() or longest_match_fast() sets match_start */ -- -- if (s->match_length <= 5 && (s->strategy == Z_FILTERED --#if TOO_FAR <= 32767 -- || (s->match_length == MIN_MATCH && -- s->strstart - s->match_start > TOO_FAR) --#endif -- )) { -- -- /* If prev_match is also MIN_MATCH, match_start is garbage -- * but we will ignore the current match anyway. -- */ -- s->match_length = MIN_MATCH-1; -- } -- } -- /* If there was a match at the previous step and the current -- * match is not better, output the previous match: -- */ -- if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { -- uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; -- /* Do not insert strings in hash table beyond this. */ -- -- check_match(s, s->strstart-1, s->prev_match, s->prev_length); -- -- _tr_tally_dist(s, s->strstart -1 - s->prev_match, -- s->prev_length - MIN_MATCH, bflush); -- -- /* Insert in hash table all strings up to the end of the match. -- * strstart-1 and strstart are already inserted. If there is not -- * enough lookahead, the last two strings are not inserted in -- * the hash table. -- */ -- s->lookahead -= s->prev_length-1; -- s->prev_length -= 2; -- do { -- if (++s->strstart <= max_insert) { -- INSERT_STRING(s, s->strstart, hash_head); -- } -- } while (--s->prev_length != 0); -- s->match_available = 0; -- s->match_length = MIN_MATCH-1; -- s->strstart++; -- -- if (bflush) FLUSH_BLOCK(s, 0); -- -- } else if (s->match_available) { -- /* 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. -- */ -- Tracevv((stderr,"%c", s->window[s->strstart-1])); -- _tr_tally_lit(s, s->window[s->strstart-1], bflush); -- if (bflush) { -- FLUSH_BLOCK_ONLY(s, 0); -- } -- s->strstart++; -- s->lookahead--; -- if (s->strm->avail_out == 0) return need_more; -- } else { -- /* There is no previous match to compare with, wait for -- * the next step to decide. -- */ -- s->match_available = 1; -- s->strstart++; -- s->lookahead--; -- } -- } -- Assert (flush != Z_NO_FLUSH, "no flush?"); -- if (s->match_available) { -- Tracevv((stderr,"%c", s->window[s->strstart-1])); -- _tr_tally_lit(s, s->window[s->strstart-1], bflush); -- s->match_available = 0; -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} --#endif /* FASTEST */ -- --#if 0 --/* =========================================================================== -- * For Z_RLE, simply look for runs of bytes, generate matches only of distance -- * one. Do not maintain a hash table. (It will be regenerated if this run of -- * deflate switches away from Z_RLE.) -- */ --local block_state deflate_rle(deflate_state *s, int flush) --{ -- int bflush; /* set if current block must be flushed */ -- uInt run; /* length of run */ -- uInt max; /* maximum length of run */ -- uInt prev; /* byte at distance one to match */ -- Bytef *scan; /* scan for end of run */ -- -- for (;;) { -- /* Make sure that we always have enough lookahead, except -- * at the end of the input file. We need MAX_MATCH bytes -- * for the longest encodable run. -- */ -- if (s->lookahead < MAX_MATCH) { -- fill_window(s); -- if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) { -- return need_more; -- } -- if (s->lookahead == 0) break; /* flush the current block */ -- } -- -- /* See how many times the previous byte repeats */ -- run = 0; -- if (s->strstart > 0) { /* if there is a previous byte, that is */ -- max = s->lookahead < MAX_MATCH ? s->lookahead : MAX_MATCH; -- scan = s->window + s->strstart - 1; -- prev = *scan++; -- do { -- if (*scan++ != prev) -- break; -- } while (++run < max); -- } -- -- /* Emit match if have run of MIN_MATCH or longer, else emit literal */ -- if (run >= MIN_MATCH) { -- check_match(s, s->strstart, s->strstart - 1, run); -- _tr_tally_dist(s, 1, run - MIN_MATCH, bflush); -- s->lookahead -= run; -- s->strstart += run; -- } else { -- /* No match, output a literal byte */ -- Tracevv((stderr,"%c", s->window[s->strstart])); -- _tr_tally_lit (s, s->window[s->strstart], bflush); -- s->lookahead--; -- s->strstart++; -- } -- if (bflush) FLUSH_BLOCK(s, 0); -- } -- FLUSH_BLOCK(s, flush == Z_FINISH); -- return flush == Z_FINISH ? finish_done : block_done; --} --#endif -diff -ruN seqinr.orig/src/deflate.h seqinr/src/deflate.h ---- seqinr.orig/src/deflate.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/deflate.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,331 +0,0 @@ --/* deflate.h -- internal compression state -- * Copyright (C) 1995-2004 Jean-loup Gailly -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* @(#) $Id: deflate.h,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ -- --#ifndef DEFLATE_H --#define DEFLATE_H -- --#include "zutil.h" -- --/* define NO_GZIP when compiling if you want to disable gzip header and -- trailer creation by deflate(). NO_GZIP would be used to avoid linking in -- the crc code when it is not needed. For shared libraries, gzip encoding -- should be left enabled. */ --#ifndef NO_GZIP --# define GZIP --#endif -- --/* =========================================================================== -- * Internal compression state. -- */ -- --#define LENGTH_CODES 29 --/* number of length codes, not counting the special END_BLOCK code */ -- --#define LITERALS 256 --/* number of literal bytes 0..255 */ -- --#define L_CODES (LITERALS+1+LENGTH_CODES) --/* number of Literal or Length codes, including the END_BLOCK code */ -- --#define D_CODES 30 --/* number of distance codes */ -- --#define BL_CODES 19 --/* number of codes used to transfer the bit lengths */ -- --#define HEAP_SIZE (2*L_CODES+1) --/* maximum heap size */ -- --#define MAX_BITS 15 --/* All codes must not exceed MAX_BITS bits */ -- --#define INIT_STATE 42 --#define EXTRA_STATE 69 --#define NAME_STATE 73 --#define COMMENT_STATE 91 --#define HCRC_STATE 103 --#define BUSY_STATE 113 --#define FINISH_STATE 666 --/* Stream status */ -- -- --/* Data structure describing a single value and its code string. */ --typedef struct ct_data_s { -- union { -- ush freq; /* frequency count */ -- ush code; /* bit string */ -- } fc; -- union { -- ush dad; /* father node in Huffman tree */ -- ush len; /* length of bit string */ -- } dl; --} FAR ct_data; -- --#define Freq fc.freq --#define Code fc.code --#define Dad dl.dad --#define Len dl.len -- --typedef struct static_tree_desc_s static_tree_desc; -- --typedef struct tree_desc_s { -- ct_data *dyn_tree; /* the dynamic tree */ -- int max_code; /* largest code with non zero frequency */ -- static_tree_desc *stat_desc; /* the corresponding static tree */ --} FAR tree_desc; -- --typedef ush Pos; --typedef Pos FAR Posf; --typedef unsigned IPos; -- --/* A Pos is an index in the character window. We use short instead of int to -- * save space in the various tables. IPos is used only for parameter passing. -- */ -- --typedef struct internal_state { -- z_streamp strm; /* pointer back to this zlib stream */ -- int status; /* as the name implies */ -- Bytef *pending_buf; /* output still pending */ -- ulg pending_buf_size; /* size of pending_buf */ -- Bytef *pending_out; /* next pending byte to output to the stream */ -- uInt pending; /* nb of bytes in the pending buffer */ -- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ -- gz_headerp gzhead; /* gzip header information to write */ -- uInt gzindex; /* where in extra, name, or comment */ -- Byte method; /* STORED (for zip only) or DEFLATED */ -- int last_flush; /* value of flush param for previous deflate call */ -- -- /* used by deflate.c: */ -- -- uInt w_size; /* LZ77 window size (32K by default) */ -- uInt w_bits; /* log2(w_size) (8..16) */ -- uInt w_mask; /* w_size - 1 */ -- -- Bytef *window; -- /* Sliding window. Input bytes are read into the second half of the window, -- * and move to the first half later to keep a dictionary of at least wSize -- * bytes. With this organization, matches are limited to a distance of -- * wSize-MAX_MATCH bytes, but this ensures that IO is always -- * performed with a length multiple of the block size. Also, it limits -- * the window size to 64K, which is quite useful on MSDOS. -- * To do: use the user input buffer as sliding window. -- */ -- -- ulg window_size; -- /* Actual size of window: 2*wSize, except when the user input buffer -- * is directly used as sliding window. -- */ -- -- Posf *prev; -- /* Link to older string with same hash index. To limit the size of this -- * array to 64K, this link is maintained only for the last 32K strings. -- * An index in this array is thus a window index modulo 32K. -- */ -- -- Posf *head; /* Heads of the hash chains or NIL. */ -- -- uInt ins_h; /* hash index of string to be inserted */ -- uInt hash_size; /* number of elements in hash table */ -- uInt hash_bits; /* log2(hash_size) */ -- uInt hash_mask; /* hash_size-1 */ -- -- uInt hash_shift; -- /* Number of bits by which ins_h must be shifted at each input -- * step. It must be such that after MIN_MATCH steps, the oldest -- * byte no longer takes part in the hash key, that is: -- * hash_shift * MIN_MATCH >= hash_bits -- */ -- -- long block_start; -- /* Window position at the beginning of the current output block. Gets -- * negative when the window is moved backwards. -- */ -- -- uInt match_length; /* length of best match */ -- IPos prev_match; /* previous match */ -- int match_available; /* set if previous match exists */ -- uInt strstart; /* start of string to insert */ -- uInt match_start; /* start of matching string */ -- uInt lookahead; /* number of valid bytes ahead in window */ -- -- uInt prev_length; -- /* Length of the best match at previous step. Matches not greater than this -- * are discarded. This is used in the lazy match evaluation. -- */ -- -- uInt max_chain_length; -- /* To speed up deflation, hash chains are never searched beyond this -- * length. A higher limit improves compression ratio but degrades the -- * speed. -- */ -- -- uInt max_lazy_match; -- /* Attempt to find a better match only when the current match is strictly -- * smaller than this value. This mechanism is used only for compression -- * levels >= 4. -- */ --# define max_insert_length max_lazy_match -- /* Insert new strings in the hash table only if the match length is not -- * greater than this length. This saves time but degrades compression. -- * max_insert_length is used only for compression levels <= 3. -- */ -- -- int level; /* compression level (1..9) */ -- int strategy; /* favor or force Huffman coding*/ -- -- uInt good_match; -- /* Use a faster search when the previous match is longer than this */ -- -- int nice_match; /* Stop searching when current match exceeds this */ -- -- /* used by trees.c: */ -- /* Didn't use ct_data typedef below to supress compiler warning */ -- struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */ -- struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */ -- struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */ -- -- struct tree_desc_s l_desc; /* desc. for literal tree */ -- struct tree_desc_s d_desc; /* desc. for distance tree */ -- struct tree_desc_s bl_desc; /* desc. for bit length tree */ -- -- ush bl_count[MAX_BITS+1]; -- /* number of codes at each bit length for an optimal tree */ -- -- int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ -- int heap_len; /* number of elements in the heap */ -- int heap_max; /* element of largest frequency */ -- /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. -- * The same heap array is used to build all trees. -- */ -- -- uch depth[2*L_CODES+1]; -- /* Depth of each subtree used as tie breaker for trees of equal frequency -- */ -- -- uchf *l_buf; /* buffer for literals or lengths */ -- -- uInt lit_bufsize; -- /* Size of match buffer for literals/lengths. There are 4 reasons for -- * limiting lit_bufsize to 64K: -- * - frequencies can be kept in 16 bit counters -- * - if compression is not successful for the first block, all input -- * data is still in the window so we can still emit a stored block even -- * when input comes from standard input. (This can also be done for -- * all blocks if lit_bufsize is not greater than 32K.) -- * - if compression is not successful for a file smaller than 64K, we can -- * even emit a stored file instead of a stored block (saving 5 bytes). -- * This is applicable only for zip (not gzip or zlib). -- * - creating new Huffman trees less frequently may not provide fast -- * adaptation to changes in the input data statistics. (Take for -- * example a binary file with poorly compressible code followed by -- * a highly compressible string table.) Smaller buffer sizes give -- * fast adaptation but have of course the overhead of transmitting -- * trees more frequently. -- * - I can't count above 4 -- */ -- -- uInt last_lit; /* running index in l_buf */ -- -- ushf *d_buf; -- /* Buffer for distances. To simplify the code, d_buf and l_buf have -- * the same number of elements. To use different lengths, an extra flag -- * array would be necessary. -- */ -- -- ulg opt_len; /* bit length of current block with optimal trees */ -- ulg static_len; /* bit length of current block with static trees */ -- uInt matches; /* number of string matches in current block */ -- int last_eob_len; /* bit length of EOB code for last block */ -- --#ifdef DEBUG -- ulg compressed_len; /* total bit length of compressed file mod 2^32 */ -- ulg bits_sent; /* bit length of compressed data sent mod 2^32 */ --#endif -- -- ush bi_buf; -- /* Output buffer. bits are inserted starting at the bottom (least -- * significant bits). -- */ -- int bi_valid; -- /* Number of valid bits in bi_buf. All bits above the last valid bit -- * are always zero. -- */ -- --} FAR deflate_state; -- --/* Output a byte on the stream. -- * IN assertion: there is enough room in pending_buf. -- */ --#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);} -- -- --#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) --/* Minimum amount of lookahead, except at the end of the input file. -- * See deflate.c for comments about the MIN_MATCH+1. -- */ -- --#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD) --/* In order to simplify the code, particularly on 16 bit machines, match -- * distances are limited to MAX_DIST instead of WSIZE. -- */ -- -- /* in trees.c */ --void _tr_init OF((deflate_state *s)); --int _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc)); --void _tr_flush_block OF((deflate_state *s, charf *buf, ulg stored_len, -- int eof)); --void _tr_align OF((deflate_state *s)); --void _tr_stored_block OF((deflate_state *s, charf *buf, ulg stored_len, -- int eof)); -- --#define d_code(dist) \ -- ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)]) --/* Mapping from a distance to a distance code. dist is the distance - 1 and -- * must not have side effects. _dist_code[256] and _dist_code[257] are never -- * used. -- */ -- --#ifndef DEBUG --/* Inline versions of _tr_tally for speed: */ -- --#if defined(GEN_TREES_H) || !defined(STDC) -- extern uch _length_code[]; -- extern uch _dist_code[]; --#else -- extern const uch _length_code[]; -- extern const uch _dist_code[]; --#endif -- --# define _tr_tally_lit(s, c, flush) \ -- { uch cc = (c); \ -- s->d_buf[s->last_lit] = 0; \ -- s->l_buf[s->last_lit++] = cc; \ -- s->dyn_ltree[cc].Freq++; \ -- flush = (s->last_lit == s->lit_bufsize-1); \ -- } --# define _tr_tally_dist(s, distance, length, flush) \ -- { uch len = (length); \ -- ush dist = (distance); \ -- s->d_buf[s->last_lit] = dist; \ -- s->l_buf[s->last_lit++] = len; \ -- dist--; \ -- s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \ -- s->dyn_dtree[d_code(dist)].Freq++; \ -- flush = (s->last_lit == s->lit_bufsize-1); \ -- } --#else --# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c) --# define _tr_tally_dist(s, distance, length, flush) \ -- flush = _tr_tally(s, distance, length) --#endif -- --#endif /* DEFLATE_H */ -diff -ruN seqinr.orig/src/gzio.c seqinr/src/gzio.c ---- seqinr.orig/src/gzio.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/gzio.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1007 +0,0 @@ --/* gzio.c -- IO on .gz files -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- * -- * Compile this file with -DNO_GZCOMPRESS to avoid the compression code. -- */ -- --/* @(#) $Id: gzio.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ -- --#ifdef HAVE_CONFIG_H --#include --#endif -- --#include -- --/***Supprime #if !defined(fdopen) && !defined(HAVE_FDOPEN) --not used in R --static FILE *fdopen(int fildes, const char *mode) --{ --} --#endif --**/ -- --#include "zutil.h" -- --/* R ADDITION */ --#if defined(HAVE_OFF_T) && defined(HAVE_SEEKO) --#define f_seek fseeko --#define f_tell ftello --#else --#ifdef Win32 --#define f_seek fseeko64 --#define f_tell ftello64 --#else --#define f_seek fseek --#define f_tell ftell --#endif --#endif -- --#ifdef NO_DEFLATE /* for compatibility with old definition */ --# define NO_GZCOMPRESS --#endif -- --#ifndef NO_DUMMY_DECL --struct internal_state {int dummy;}; /* for buggy compilers */ --#endif -- --#ifndef Z_BUFSIZE --# ifdef MAXSEG_64K --# define Z_BUFSIZE 4096 /* minimize memory usage for 16-bit DOS */ --# else --# define Z_BUFSIZE 16384 --# endif --#endif --#ifndef Z_PRINTF_BUFSIZE --# define Z_PRINTF_BUFSIZE 4096 --#endif -- --#ifdef __MVS__ --# pragma map (fdopen , "\174\174FDOPEN") -- FILE *fdopen(int, const char *); --#endif -- --#ifndef STDC --extern voidp malloc OF((uInt size)); --extern void free OF((voidpf ptr)); --#endif -- --#define ALLOC(size) malloc(size) --#define TRYFREE(p) {if (p) free(p);} -- --static int const gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ -- --/* gzip flag byte */ --#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ --#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ --#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ --#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ --#define COMMENT 0x10 /* bit 4 set: file comment present */ --#define RESERVED 0xE0 /* bits 5..7: reserved */ -- --typedef struct gz_stream { -- z_stream stream; -- int z_err; /* error code for last stream operation */ -- int z_eof; /* set if end of input file */ -- FILE *file; /* .gz file */ -- Byte *inbuf; /* input buffer */ -- Byte *outbuf; /* output buffer */ -- uLong crc; /* crc32 of uncompressed data */ -- char *msg; /* error message */ -- char *path; /* path name for debugging only */ -- int transparent; /* 1 if input file is not a .gz file */ -- char mode; /* 'w' or 'r' */ -- z_off_t start; /* start of compressed data in file (header skipped) */ -- z_off_t in; /* bytes into deflate or inflate */ -- z_off_t out; /* bytes out of deflate or inflate */ -- int back; /* one character push-back */ -- int last; /* true if push-back is last character */ --} gz_stream; -- -- --local gzFile gz_open OF((const char *path, const char *mode, int fd)); --local int do_flush OF((gzFile file, int flush)); --local int get_byte OF((gz_stream *s)); --local void check_header OF((gz_stream *s)); --local int destroy OF((gz_stream *s)); --local void putLong OF((FILE *file, uLong x)); --local uLong getLong OF((gz_stream *s)); -- --/* =========================================================================== -- Opens a gzip (.gz) file for reading or writing. The mode parameter -- is as in fopen ("rb" or "wb"). The file is given either by file descriptor -- or path name (if fd == -1). -- gz_open returns NULL if the file could not be opened or if there was -- insufficient memory to allocate the (de)compression state; errno -- can be checked to distinguish the two cases (if errno is zero, the -- zlib error is Z_MEM_ERROR). --*/ --local gzFile gz_open (const char *path, const char *mode, int fd) --{ -- int err; -- int level = Z_DEFAULT_COMPRESSION; /* compression level */ -- int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */ -- char *p = (char*)mode; -- gz_stream *s; -- char fmode[80]; /* copy of mode, without the compression level */ -- char *m = fmode; -- -- if (!path || !mode) return Z_NULL; -- -- s = (gz_stream *)ALLOC(sizeof(gz_stream)); -- if (!s) return Z_NULL; -- -- s->stream.zalloc = (alloc_func)0; -- s->stream.zfree = (free_func)0; -- s->stream.opaque = (voidpf)0; -- s->stream.next_in = s->inbuf = Z_NULL; -- s->stream.next_out = s->outbuf = Z_NULL; -- s->stream.avail_in = s->stream.avail_out = 0; -- s->file = NULL; -- s->z_err = Z_OK; -- s->z_eof = 0; -- s->in = 0; -- s->out = 0; -- s->back = EOF; -- s->crc = crc32(0L, Z_NULL, 0); -- s->msg = NULL; -- s->transparent = 0; -- -- s->path = (char*)ALLOC(strlen(path)+1); -- if (s->path == NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- strcpy(s->path, path); /* do this early for debugging */ -- -- s->mode = '\0'; -- do { -- if (*p == 'r') s->mode = 'r'; -- if (*p == 'w' || *p == 'a') s->mode = 'w'; -- if (*p >= '0' && *p <= '9') { -- level = *p - '0'; -- } else if (*p == 'f') { -- strategy = Z_FILTERED; -- } else if (*p == 'h') { -- strategy = Z_HUFFMAN_ONLY; -- } else if (*p == 'R') { -- strategy = Z_RLE; -- } else { -- *m++ = *p; /* copy the mode */ -- } -- } while (*p++ && m != fmode + sizeof(fmode)); -- if (s->mode == '\0') return destroy(s), (gzFile)Z_NULL; -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- err = Z_STREAM_ERROR; --#else -- err = deflateInit2(&(s->stream), level, -- Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, strategy); -- /* windowBits is passed < 0 to suppress zlib header */ -- -- s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); --#endif -- if (err != Z_OK || s->outbuf == Z_NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- } else { -- s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); -- -- err = inflateInit2(&(s->stream), -MAX_WBITS); -- /* windowBits is passed < 0 to tell that there is no zlib header. -- * Note that in this case inflate *requires* an extra "dummy" byte -- * after the compressed stream in order to complete decompression and -- * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are -- * present after the compressed stream. -- */ -- if (err != Z_OK || s->inbuf == Z_NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- } -- s->stream.avail_out = Z_BUFSIZE; -- -- errno = 0; -- s->file = fd < 0 ? F_OPEN(path, fmode) : (FILE*)fdopen(fd, fmode); -- -- if (s->file == NULL) { -- return destroy(s), (gzFile)Z_NULL; -- } -- if (s->mode == 'w') { -- /* Write a very simple .gz header: -- */ -- fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], -- Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, OS_CODE); -- s->start = 10L; -- /* We use 10L instead of ftell(s->file) to because ftell causes an -- * fflush on some systems. This version of the library doesn't use -- * start anyway in write mode, so this initialization is not -- * necessary. -- */ -- } else { -- check_header(s); /* skip the .gz header */ -- s->start = f_tell(s->file) - s->stream.avail_in; -- } -- -- return (gzFile)s; --} -- --/* =========================================================================== -- Opens a gzip (.gz) file for reading or writing. --*/ --gzFile ZEXPORT gzopen (const char *path, const char *mode) --{ -- return gz_open (path, mode, -1); --} -- --/* =========================================================================== -- Associate a gzFile with the file descriptor fd. fd is not dup'ed here -- to mimic the behavio(u)r of fdopen. --*/ --gzFile ZEXPORT gzdopen (int fd, const char *mode) --{ -- char name[46]; /* allow for up to 128-bit integers */ -- -- if (fd < 0) return (gzFile)Z_NULL; -- sprintf(name, "", fd); /* for debugging */ -- -- return gz_open (name, mode, fd); --} -- --/* =========================================================================== -- * Update the compression level and strategy -- */ --int ZEXPORT gzsetparams (gzFile file, int level, int strategy) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- /* Make room to allow flushing */ -- if (s->stream.avail_out == 0) { -- -- s->stream.next_out = s->outbuf; -- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { -- s->z_err = Z_ERRNO; -- } -- s->stream.avail_out = Z_BUFSIZE; -- } -- -- return deflateParams (&(s->stream), level, strategy); --} -- --/* =========================================================================== -- Read a byte from a gz_stream; update next_in and avail_in. Return EOF -- for end of file. -- IN assertion: the stream s has been sucessfully opened for reading. --*/ --local int get_byte(gz_stream *s) --{ -- if (s->z_eof) return EOF; -- if (s->stream.avail_in == 0) { -- errno = 0; -- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); -- if (s->stream.avail_in == 0) { -- s->z_eof = 1; -- if (ferror(s->file)) s->z_err = Z_ERRNO; -- return EOF; -- } -- s->stream.next_in = s->inbuf; -- } -- s->stream.avail_in--; -- return *(s->stream.next_in)++; --} -- --/* =========================================================================== -- Check the gzip header of a gz_stream opened for reading. Set the stream -- mode to transparent if the gzip magic header is not present; set s->err -- to Z_DATA_ERROR if the magic header is present but the rest of the header -- is incorrect. -- IN assertion: the stream s has already been created sucessfully; -- s->stream.avail_in is zero for the first time, but may be non-zero -- for concatenated .gz files. --*/ --local void check_header(gz_stream *s) --{ -- int method; /* method byte */ -- int flags; /* flags byte */ -- uInt len; -- int c; -- -- /* Assure two bytes in the buffer so we can peek ahead -- handle case -- where first byte of header is at the end of the buffer after the last -- gzip segment */ -- len = s->stream.avail_in; -- if (len < 2) { -- if (len) s->inbuf[0] = s->stream.next_in[0]; -- errno = 0; -- len = (uInt)fread(s->inbuf + len, 1, Z_BUFSIZE >> len, s->file); -- if (len == 0 && ferror(s->file)) s->z_err = Z_ERRNO; -- s->stream.avail_in += len; -- s->stream.next_in = s->inbuf; -- if (s->stream.avail_in < 2) { -- s->transparent = s->stream.avail_in; -- return; -- } -- } -- -- /* Peek ahead to check the gzip magic header */ -- if (s->stream.next_in[0] != gz_magic[0] || -- s->stream.next_in[1] != gz_magic[1]) { -- s->transparent = 1; -- return; -- } -- s->stream.avail_in -= 2; -- s->stream.next_in += 2; -- -- /* Check the rest of the gzip header */ -- method = get_byte(s); -- flags = get_byte(s); -- if (method != Z_DEFLATED || (flags & RESERVED) != 0) { -- s->z_err = Z_DATA_ERROR; -- return; -- } -- -- /* Discard time, xflags and OS code: */ -- for (len = 0; len < 6; len++) (void)get_byte(s); -- -- if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ -- len = (uInt)get_byte(s); -- len += ((uInt)get_byte(s))<<8; -- /* len is garbage if EOF but the loop below will quit anyway */ -- while (len-- != 0 && get_byte(s) != EOF) ; -- } -- if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ -- while ((c = get_byte(s)) != 0 && c != EOF) ; -- } -- if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ -- while ((c = get_byte(s)) != 0 && c != EOF) ; -- } -- if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ -- for (len = 0; len < 2; len++) (void)get_byte(s); -- } -- s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; --} -- -- /* =========================================================================== -- * Cleanup then free the given gz_stream. Return a zlib error code. -- Try freeing in the reverse order of allocations. -- */ --local int destroy (gz_stream *s) --{ -- int err = Z_OK; -- -- if (!s) return Z_STREAM_ERROR; -- -- TRYFREE(s->msg); -- -- if (s->stream.state != NULL) { -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- err = Z_STREAM_ERROR; --#else -- err = deflateEnd(&(s->stream)); --#endif -- } else if (s->mode == 'r') { -- err = inflateEnd(&(s->stream)); -- } -- } -- if (s->file != NULL && fclose(s->file)) { --#ifdef ESPIPE -- if (errno != ESPIPE) /* fclose is broken for pipes in HP/UX */ --#endif -- err = Z_ERRNO; -- } -- if (s->z_err < 0) err = s->z_err; -- -- TRYFREE(s->inbuf); -- TRYFREE(s->outbuf); -- TRYFREE(s->path); -- TRYFREE(s); -- return err; --} -- --/* =========================================================================== -- Reads the given number of uncompressed bytes from the compressed file. -- gzread returns the number of bytes actually read (0 for end of file). --*/ --int ZEXPORT gzread (gzFile file, voidp buf, unsigned len) --{ -- gz_stream *s = (gz_stream*)file; -- Bytef *start = (Bytef*)buf; /* starting point for crc computation */ -- Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ -- -- if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; -- -- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1; -- if (s->z_err == Z_STREAM_END) return 0; /* EOF */ -- -- next_out = (Byte*)buf; -- s->stream.next_out = (Bytef*)buf; -- s->stream.avail_out = len; -- -- if (s->stream.avail_out && s->back != EOF) { -- *next_out++ = s->back; -- s->stream.next_out++; -- s->stream.avail_out--; -- s->back = EOF; -- s->out++; -- start++; -- if (s->last) { -- s->z_err = Z_STREAM_END; -- return 1; -- } -- } -- -- while (s->stream.avail_out != 0) { -- -- if (s->transparent) { -- /* Copy first the lookahead bytes: */ -- uInt n = s->stream.avail_in; -- if (n > s->stream.avail_out) n = s->stream.avail_out; -- if (n > 0) { -- zmemcpy(s->stream.next_out, s->stream.next_in, n); -- next_out += n; -- s->stream.next_out = next_out; -- s->stream.next_in += n; -- s->stream.avail_out -= n; -- s->stream.avail_in -= n; -- } -- if (s->stream.avail_out > 0) { -- s->stream.avail_out -= -- (uInt)fread(next_out, 1, s->stream.avail_out, s->file); -- } -- len -= s->stream.avail_out; -- s->in += len; -- s->out += len; -- if (len == 0) s->z_eof = 1; -- return (int)len; -- } -- if (s->stream.avail_in == 0 && !s->z_eof) { -- -- errno = 0; -- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); -- if (s->stream.avail_in == 0) { -- s->z_eof = 1; -- if (ferror(s->file)) { -- s->z_err = Z_ERRNO; -- break; -- } -- } -- s->stream.next_in = s->inbuf; -- } -- s->in += s->stream.avail_in; -- s->out += s->stream.avail_out; -- s->z_err = inflate(&(s->stream), Z_NO_FLUSH); -- s->in -= s->stream.avail_in; -- s->out -= s->stream.avail_out; -- -- if (s->z_err == Z_STREAM_END) { -- /* Check CRC and original size */ -- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); -- start = s->stream.next_out; -- -- if (getLong(s) != s->crc) { -- s->z_err = Z_DATA_ERROR; -- } else { -- (void)getLong(s); -- /* The uncompressed length returned by above getlong() may be -- * different from s->out in case of concatenated .gz files. -- * Check for such files: -- */ -- check_header(s); -- if (s->z_err == Z_OK) { -- inflateReset(&(s->stream)); -- s->crc = crc32(0L, Z_NULL, 0); -- } -- } -- } -- if (s->z_err != Z_OK || s->z_eof) break; -- } -- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); -- -- if (len == s->stream.avail_out && -- (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO)) -- return -1; -- return (int)(len - s->stream.avail_out); --} -- -- --/* =========================================================================== -- Reads one byte from the compressed file. gzgetc returns this byte -- or -1 in case of end of file or error. --*/ --int ZEXPORT gzgetc(gzFile file) --{ -- unsigned char c; -- -- return gzread(file, &c, 1) == 1 ? c : -1; --} -- -- --/* =========================================================================== -- Push one byte back onto the stream. --*/ --int ZEXPORT gzungetc(int c, gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r' || c == EOF || s->back != EOF) return EOF; -- s->back = c; -- s->out--; -- s->last = (s->z_err == Z_STREAM_END); -- if (s->last) s->z_err = Z_OK; -- s->z_eof = 0; -- return c; --} -- -- --/* =========================================================================== -- Reads bytes from the compressed file until len-1 characters are -- read, or a newline character is read and transferred to buf, or an -- end-of-file condition is encountered. The string is then terminated -- with a null character. -- gzgets returns buf, or Z_NULL in case of error. -- -- The current implementation is not optimized at all. --*/ --char * ZEXPORT gzgets(gzFile file, char *buf, int len) --{ -- char *b = buf; -- if (buf == Z_NULL || len <= 0) return Z_NULL; -- -- while (--len > 0 && gzread(file, buf, 1) == 1 && *buf++ != '\n') ; -- *buf = '\0'; -- return b == buf && len > 0 ? Z_NULL : b; --} -- -- --#ifndef NO_GZCOMPRESS --/* =========================================================================== -- Writes the given number of uncompressed bytes into the compressed file. -- gzwrite returns the number of bytes actually written (0 in case of error). --*/ --int ZEXPORT gzwrite (gzFile file, voidpc buf, unsigned len) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- s->stream.next_in = (Bytef*)buf; -- s->stream.avail_in = len; -- -- while (s->stream.avail_in != 0) { -- -- if (s->stream.avail_out == 0) { -- -- s->stream.next_out = s->outbuf; -- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { -- s->z_err = Z_ERRNO; -- break; -- } -- s->stream.avail_out = Z_BUFSIZE; -- } -- s->in += s->stream.avail_in; -- s->out += s->stream.avail_out; -- s->z_err = deflate(&(s->stream), Z_NO_FLUSH); -- s->in -= s->stream.avail_in; -- s->out -= s->stream.avail_out; -- if (s->z_err != Z_OK) break; -- } -- s->crc = crc32(s->crc, (const Bytef *)buf, len); -- -- return (int)(len - s->stream.avail_in); --} -- -- --#ifdef UNUSED --/* =========================================================================== -- Converts, formats, and writes the args to the compressed file under -- control of the format string, as in fprintf. gzprintf returns the number of -- uncompressed bytes actually written (0 in case of error). --*/ --#ifdef STDC --#include -- --int ZEXPORTVA gzprintf (gzFile file, const char *format, /* args */ ...) --{ -- char buf[Z_PRINTF_BUFSIZE]; -- va_list va; -- int len; -- -- buf[sizeof(buf) - 1] = 0; -- va_start(va, format); --#ifdef NO_vsnprintf --# ifdef HAS_vsprintf_void -- (void)vsprintf(buf, format, va); -- va_end(va); -- for (len = 0; len < sizeof(buf); len++) -- if (buf[len] == 0) break; --# else -- len = vsprintf(buf, format, va); -- va_end(va); --# endif --#else --# ifdef HAS_vsnprintf_void -- (void)vsnprintf(buf, sizeof(buf), format, va); -- va_end(va); -- len = strlen(buf); --# else -- len = vsnprintf(buf, sizeof(buf), format, va); -- va_end(va); --# endif --#endif -- if (len <= 0 || len >= (int)sizeof(buf) || buf[sizeof(buf) - 1] != 0) -- return 0; -- return gzwrite(file, buf, (unsigned)len); --} --#else /* not ANSI C */ -- --int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, -- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) -- gzFile file; -- const char *format; -- int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, -- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20; --{ -- char buf[Z_PRINTF_BUFSIZE]; -- int len; -- -- buf[sizeof(buf) - 1] = 0; --#ifdef NO_snprintf --# ifdef HAS_sprintf_void -- sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, -- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); -- for (len = 0; len < sizeof(buf); len++) -- if (buf[len] == 0) break; --# else -- len = sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, -- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); --# endif --#else --# ifdef HAS_snprintf_void -- 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); -- len = strlen(buf); --# else -- len = 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); --# endif --#endif -- if (len <= 0 || len >= sizeof(buf) || buf[sizeof(buf) - 1] != 0) -- return 0; -- return gzwrite(file, buf, len); --} --#endif --#endif /* UNUSED */ -- --/* =========================================================================== -- Writes c, converted to an unsigned char, into the compressed file. -- gzputc returns the value that was written, or -1 in case of error. --*/ --int ZEXPORT gzputc(gzFile file, int c) --{ -- unsigned char cc = (unsigned char) c; /* required for big endian systems */ -- -- return gzwrite(file, &cc, 1) == 1 ? (int)cc : -1; --} -- -- --/* =========================================================================== -- Writes the given null-terminated string to the compressed file, excluding -- the terminating null character. -- gzputs returns the number of characters written, or -1 in case of error. --*/ --int ZEXPORT gzputs(gzFile file, const char *s) --{ -- return gzwrite(file, (char*)s, (unsigned)strlen(s)); --} -- -- --/* =========================================================================== -- Flushes all pending output into the compressed file. The parameter -- flush is as in the deflate() function. --*/ --local int do_flush (gzFile file, int flush) --{ -- uInt len; -- int done = 0; -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; -- -- s->stream.avail_in = 0; /* should be zero already anyway */ -- -- for (;;) { -- len = Z_BUFSIZE - s->stream.avail_out; -- -- if (len != 0) { -- if ((uInt)fwrite(s->outbuf, 1, len, s->file) != len) { -- s->z_err = Z_ERRNO; -- return Z_ERRNO; -- } -- s->stream.next_out = s->outbuf; -- s->stream.avail_out = Z_BUFSIZE; -- } -- if (done) break; -- s->out += s->stream.avail_out; -- s->z_err = deflate(&(s->stream), flush); -- s->out -= s->stream.avail_out; -- -- /* Ignore the second of two consecutive flushes: */ -- if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK; -- -- /* deflate has finished flushing only when it hasn't used up -- * all the available space in the output buffer: -- */ -- done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); -- -- if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; -- } -- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; --} -- --int ZEXPORT gzflush (gzFile file, int flush) --{ -- gz_stream *s = (gz_stream*)file; -- int err = do_flush (file, flush); -- -- if (err) return err; -- fflush(s->file); -- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; --} --#endif /* NO_GZCOMPRESS */ -- --/* =========================================================================== -- Sets the starting position for the next gzread or gzwrite on the given -- compressed file. The offset represents a number of bytes in the -- gzseek returns the resulting offset location as measured in bytes from -- the beginning of the uncompressed stream, or -1 in case of error. -- SEEK_END is not implemented, returns error. -- In this version of the library, gzseek can be extremely slow. --*/ --z_off_t ZEXPORT gzseek (gzFile file, z_off_t offset, int whence) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || whence == SEEK_END || -- s->z_err == Z_ERRNO || s->z_err == Z_DATA_ERROR) { -- return -1L; -- } -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- return -1L; --#else -- if (whence == SEEK_SET) { -- offset -= s->in; -- } -- if (offset < 0) return -1L; -- -- /* At this point, offset is the number of zero bytes to write. */ -- if (s->inbuf == Z_NULL) { -- s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); /* for seeking */ -- if (s->inbuf == Z_NULL) return -1L; -- zmemzero(s->inbuf, Z_BUFSIZE); -- } -- while (offset > 0) { -- uInt size = Z_BUFSIZE; -- if (offset < Z_BUFSIZE) size = (uInt)offset; -- -- size = gzwrite(file, s->inbuf, size); -- if (size == 0) return -1L; -- -- offset -= size; -- } -- return s->in; --#endif -- } -- /* Rest of function is for reading only */ -- -- /* compute absolute position */ -- if (whence == SEEK_CUR) { -- offset += s->out; -- } -- if (offset < 0) return -1L; -- -- if (s->transparent) { -- /* map to fseek */ -- s->back = EOF; -- s->stream.avail_in = 0; -- s->stream.next_in = s->inbuf; -- if (f_seek(s->file, offset, SEEK_SET) < 0) return -1L; -- -- s->in = s->out = offset; -- return offset; -- } -- -- /* For a negative seek, rewind and use positive seek */ -- if (offset >= s->out) { -- offset -= s->out; -- } else if (gzrewind(file) < 0) { -- return -1L; -- } -- /* offset is now the number of bytes to skip. */ -- -- if (offset != 0 && s->outbuf == Z_NULL) { -- s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); -- if (s->outbuf == Z_NULL) return -1L; -- } -- if (offset && s->back != EOF) { -- s->back = EOF; -- s->out++; -- offset--; -- if (s->last) s->z_err = Z_STREAM_END; -- } -- while (offset > 0) { -- int size = Z_BUFSIZE; -- if (offset < Z_BUFSIZE) size = (int)offset; -- -- size = gzread(file, s->outbuf, (uInt)size); -- if (size <= 0) return -1L; -- offset -= size; -- } -- return s->out; --} -- --/* =========================================================================== -- Rewinds input file. --*/ --int ZEXPORT gzrewind (gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r') return -1; -- -- s->z_err = Z_OK; -- s->z_eof = 0; -- s->back = EOF; -- s->stream.avail_in = 0; -- s->stream.next_in = s->inbuf; -- s->crc = crc32(0L, Z_NULL, 0); -- if (!s->transparent) (void)inflateReset(&s->stream); -- s->in = 0; -- s->out = 0; -- return f_seek(s->file, s->start, SEEK_SET); --} -- --/* =========================================================================== -- Returns the starting position for the next gzread or gzwrite on the -- given compressed file. This position represents a number of bytes in the -- uncompressed data stream. --*/ --z_off_t ZEXPORT gztell (gzFile file) --{ -- return gzseek(file, 0L, SEEK_CUR); --} -- --/* =========================================================================== -- Returns 1 when EOF has previously been detected reading the given -- input stream, otherwise zero. --*/ --int ZEXPORT gzeof (gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- /* With concatenated compressed files that can have embedded -- * crc trailers, z_eof is no longer the only/best indicator of EOF -- * on a gz_stream. Handle end-of-stream error explicitly here. -- */ -- if (s == NULL || s->mode != 'r') return 0; -- if (s->z_eof) return 1; -- return s->z_err == Z_STREAM_END; --} -- --/* =========================================================================== -- Returns 1 if reading and doing so transparently, otherwise zero. --*/ --int ZEXPORT gzdirect (gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL || s->mode != 'r') return 0; -- return s->transparent; --} -- --/* =========================================================================== -- Outputs a long in LSB order to the given file --*/ --local void putLong (FILE *file, uLong x) --{ -- int n; -- for (n = 0; n < 4; n++) { -- fputc((int)(x & 0xff), file); -- x >>= 8; -- } --} -- --/* =========================================================================== -- Reads a long in LSB order from the given gz_stream. Sets z_err in case -- of error. --*/ --local uLong getLong (gz_stream *s) --{ -- uLong x = (uLong)get_byte(s); -- int c; -- -- x += ((uLong)get_byte(s))<<8; -- x += ((uLong)get_byte(s))<<16; -- c = get_byte(s); -- if (c == EOF) s->z_err = Z_DATA_ERROR; -- x += ((uLong)c)<<24; -- return x; --} -- --/* =========================================================================== -- Flushes all pending output if necessary, closes the compressed file -- and deallocates all the (de)compression state. --*/ --int ZEXPORT gzclose (gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) return Z_STREAM_ERROR; -- -- if (s->mode == 'w') { --#ifdef NO_GZCOMPRESS -- return Z_STREAM_ERROR; --#else -- if (do_flush (file, Z_FINISH) != Z_OK) -- return destroy((gz_stream*)file); -- -- putLong (s->file, s->crc); -- putLong (s->file, (uLong)(s->in & 0xffffffff)); --#endif -- } -- return destroy((gz_stream*)file); --} -- --#ifdef STDC --# define zstrerror(errnum) strerror(errnum) --#else --# define zstrerror(errnum) "" --#endif -- --/* =========================================================================== -- Returns the error message for the last error which occurred on the -- given compressed file. errnum is set to zlib error number. If an -- error occurred in the file system and not in the compression library, -- errnum is set to Z_ERRNO and the application may consult errno -- to get the exact error code. --*/ --const char * ZEXPORT gzerror (gzFile file, int *errnum) --{ -- char *m; -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) { -- *errnum = Z_STREAM_ERROR; -- return (const char*)ERR_MSG(Z_STREAM_ERROR); -- } -- *errnum = s->z_err; -- if (*errnum == Z_OK) return (const char*)""; -- -- m = (char*)(*errnum == Z_ERRNO ? zstrerror(errno) : s->stream.msg); -- -- if (m == NULL || *m == '\0') m = (char*)ERR_MSG(s->z_err); -- -- TRYFREE(s->msg); -- s->msg = (char*)ALLOC(strlen(s->path) + strlen(m) + 3); -- if (s->msg == Z_NULL) return (const char*)ERR_MSG(Z_MEM_ERROR); -- strcpy(s->msg, s->path); -- strcat(s->msg, ": "); -- strcat(s->msg, m); -- return (const char*)s->msg; --} -- --/* =========================================================================== -- Clear the error and end-of-file flags, and do the same for the real file. --*/ --void ZEXPORT gzclearerr (gzFile file) --{ -- gz_stream *s = (gz_stream*)file; -- -- if (s == NULL) return; -- if (s->z_err != Z_STREAM_END) s->z_err = Z_OK; -- s->z_eof = 0; -- clearerr(s->file); --} -diff -ruN seqinr.orig/src/infback.c seqinr/src/infback.c ---- seqinr.orig/src/infback.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/infback.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,628 +0,0 @@ --/* infback.c -- inflate using a call-back interface -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- This code is largely copied from inflate.c. Normally either infback.o or -- inflate.o would be linked into an application--not both. The interface -- with inffast.c is retained so that optimized assembler-coded versions of -- inflate_fast() can be used with either inflate.c or infback.c. -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- --/* function prototypes */ --local void fixedtables OF((struct inflate_state FAR *state)); -- --/* -- strm provides memory allocation functions in zalloc and zfree, or -- Z_NULL to use the library memory allocation functions. -- -- windowBits is in the range 8..15, and window is a user-supplied -- window and output buffer that is 2**windowBits bytes. -- */ --int ZEXPORT inflateBackInit_(z_streamp strm, int windowBits, -- unsigned char *window, const char *version, -- int stream_size) --/* --z_streamp strm; --int windowBits; --unsigned char FAR *window; --const char *version; --int stream_size; --*/ --{ -- struct inflate_state FAR *state; -- -- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || -- stream_size != (int)(sizeof(z_stream))) -- return Z_VERSION_ERROR; -- if (strm == Z_NULL || window == Z_NULL || -- windowBits < 8 || windowBits > 15) -- return Z_STREAM_ERROR; -- strm->msg = Z_NULL; /* in case we return an error */ -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- state = (struct inflate_state FAR *)ZALLOC(strm, 1, -- sizeof(struct inflate_state)); -- if (state == Z_NULL) return Z_MEM_ERROR; -- Tracev((stderr, "inflate: allocated\n")); -- strm->state = (struct internal_state FAR *)state; -- state->dmax = 32768U; -- state->wbits = windowBits; -- state->wsize = 1U << windowBits; -- state->window = window; -- state->write = 0; -- state->whave = 0; -- return Z_OK; --} -- --/* -- Return state with length and distance decoding tables and index sizes set to -- fixed code decoding. Normally this returns fixed tables from inffixed.h. -- If BUILDFIXED is defined, then instead this routine builds the tables the -- first time it's called, and returns those tables the first time and -- thereafter. This reduces the size of the code by about 2K bytes, in -- exchange for a little execution time. However, BUILDFIXED should not be -- used for threaded applications, since the rewriting of the tables and virgin -- may not be thread-safe. -- */ --local void fixedtables(struct inflate_state FAR * state) --{ --#ifdef BUILDFIXED -- static int virgin = 1; -- static code *lenfix, *distfix; -- static code fixed[544]; -- -- /* build fixed huffman tables if first call (may not be thread safe) */ -- if (virgin) { -- unsigned sym, bits; -- static code *next; -- -- /* literal/length table */ -- sym = 0; -- while (sym < 144) state->lens[sym++] = 8; -- while (sym < 256) state->lens[sym++] = 9; -- while (sym < 280) state->lens[sym++] = 7; -- while (sym < 288) state->lens[sym++] = 8; -- next = fixed; -- lenfix = next; -- bits = 9; -- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); -- -- /* distance table */ -- sym = 0; -- while (sym < 32) state->lens[sym++] = 5; -- distfix = next; -- bits = 5; -- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); -- -- /* do this just once */ -- virgin = 0; -- } --#else /* !BUILDFIXED */ --# include "inffixed.h" --#endif /* BUILDFIXED */ -- state->lencode = lenfix; -- state->lenbits = 9; -- state->distcode = distfix; -- state->distbits = 5; --} -- --/* Macros for inflateBack(): */ -- --/* Load returned state from inflate_fast() */ --#define LOAD() \ -- do { \ -- put = strm->next_out; \ -- left = strm->avail_out; \ -- next = strm->next_in; \ -- have = strm->avail_in; \ -- hold = state->hold; \ -- bits = state->bits; \ -- } while (0) -- --/* Set state from registers for inflate_fast() */ --#define RESTORE() \ -- do { \ -- strm->next_out = put; \ -- strm->avail_out = left; \ -- strm->next_in = next; \ -- strm->avail_in = have; \ -- state->hold = hold; \ -- state->bits = bits; \ -- } while (0) -- --/* Clear the input bit accumulator */ --#define INITBITS() \ -- do { \ -- hold = 0; \ -- bits = 0; \ -- } while (0) -- --/* Assure that some input is available. If input is requested, but denied, -- then return a Z_BUF_ERROR from inflateBack(). */ --#define PULL() \ -- do { \ -- if (have == 0) { \ -- have = in(in_desc, &next); \ -- if (have == 0) { \ -- next = Z_NULL; \ -- ret = Z_BUF_ERROR; \ -- goto inf_leave; \ -- } \ -- } \ -- } while (0) -- --/* Get a byte of input into the bit accumulator, or return from inflateBack() -- with an error if there is no input available. */ --#define PULLBYTE() \ -- do { \ -- PULL(); \ -- have--; \ -- hold += (unsigned long)(*next++) << bits; \ -- bits += 8; \ -- } while (0) -- --/* Assure that there are at least n bits in the bit accumulator. If there is -- not enough available input to do that, then return from inflateBack() with -- an error. */ --#define NEEDBITS(n) \ -- do { \ -- while (bits < (unsigned)(n)) \ -- PULLBYTE(); \ -- } while (0) -- --/* Return the low n bits of the bit accumulator (n < 16) */ --#define BITS(n) \ -- ((unsigned)hold & ((1U << (n)) - 1)) -- --/* Remove n bits from the bit accumulator */ --#define DROPBITS(n) \ -- do { \ -- hold >>= (n); \ -- bits -= (unsigned)(n); \ -- } while (0) -- --/* Remove zero to seven bits as needed to go to a byte boundary */ --#define BYTEBITS() \ -- do { \ -- hold >>= bits & 7; \ -- bits -= bits & 7; \ -- } while (0) -- --/* Assure that some output space is available, by writing out the window -- if it's full. If the write fails, return from inflateBack() with a -- Z_BUF_ERROR. */ --#define ROOM() \ -- do { \ -- if (left == 0) { \ -- put = state->window; \ -- left = state->wsize; \ -- state->whave = left; \ -- if (out(out_desc, put, left)) { \ -- ret = Z_BUF_ERROR; \ -- goto inf_leave; \ -- } \ -- } \ -- } while (0) -- --/* -- strm provides the memory allocation functions and window buffer on input, -- and provides information on the unused input on return. For Z_DATA_ERROR -- returns, strm will also provide an error message. -- -- in() and out() are the call-back input and output functions. When -- inflateBack() needs more input, it calls in(). When inflateBack() has -- filled the window with output, or when it completes with data in the -- window, it calls out() to write out the data. The application must not -- change the provided input until in() is called again or inflateBack() -- returns. The application must not change the window/output buffer until -- inflateBack() returns. -- -- in() and out() are called with a descriptor parameter provided in the -- inflateBack() call. This parameter can be a structure that provides the -- information required to do the read or write, as well as accumulated -- information on the input and output such as totals and check values. -- -- in() should return zero on failure. out() should return non-zero on -- failure. If either in() or out() fails, than inflateBack() returns a -- Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it -- was in() or out() that caused in the error. Otherwise, inflateBack() -- returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format -- error, or Z_MEM_ERROR if it could not allocate memory for the state. -- inflateBack() can also return Z_STREAM_ERROR if the input parameters -- are not correct, i.e. strm is Z_NULL or the state was not initialized. -- */ --int ZEXPORT inflateBack(z_streamp strm, in_func in, void FAR *in_desc, -- out_func out, void FAR *out_desc) --/* --z_streamp strm; --in_func in; --void FAR *in_desc; --out_func out; --void FAR *out_desc; --*/ --{ -- struct inflate_state FAR *state; -- unsigned char FAR *next; /* next input */ -- unsigned char FAR *put; /* next output */ -- unsigned have, left; /* available input and output */ -- unsigned long hold; /* bit buffer */ -- unsigned bits; /* bits in bit buffer */ -- unsigned copy; /* number of stored or match bytes to copy */ -- unsigned char FAR *from; /* where to copy match bytes from */ -- code This; /* current decoding table entry */ -- code last; /* parent table entry */ -- unsigned len; /* length to copy for repeats, bits to drop */ -- int ret; /* return code */ -- static const unsigned short order[19] = /* permutation of code lengths */ -- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; -- -- /* Check that the strm exists and that the state was initialized */ -- if (strm == Z_NULL || strm->state == Z_NULL) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- -- /* Reset the state */ -- strm->msg = Z_NULL; -- state->mode = TYPE; -- state->last = 0; -- state->whave = 0; -- next = strm->next_in; -- have = next != Z_NULL ? strm->avail_in : 0; -- hold = 0; -- bits = 0; -- put = state->window; -- left = state->wsize; -- -- /* Inflate until end of block marked as last */ -- for (;;) -- switch (state->mode) { -- case TYPE: -- /* determine and dispatch block type */ -- if (state->last) { -- BYTEBITS(); -- state->mode = DONE; -- break; -- } -- NEEDBITS(3); -- state->last = BITS(1); -- DROPBITS(1); -- switch (BITS(2)) { -- case 0: /* stored block */ -- Tracev((stderr, "inflate: stored block%s\n", -- state->last ? " (last)" : "")); -- state->mode = STORED; -- break; -- case 1: /* fixed block */ -- fixedtables(state); -- Tracev((stderr, "inflate: fixed codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = LEN; /* decode codes */ -- break; -- case 2: /* dynamic block */ -- Tracev((stderr, "inflate: dynamic codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = TABLE; -- break; -- case 3: -- strm->msg = (char *)"invalid block type"; -- state->mode = BAD; -- } -- DROPBITS(2); -- break; -- -- case STORED: -- /* get and verify stored block length */ -- BYTEBITS(); /* go to byte boundary */ -- NEEDBITS(32); -- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { -- strm->msg = (char *)"invalid stored block lengths"; -- state->mode = BAD; -- break; -- } -- state->length = (unsigned)hold & 0xffff; -- Tracev((stderr, "inflate: stored length %u\n", -- state->length)); -- INITBITS(); -- -- /* copy stored block from input to output */ -- while (state->length != 0) { -- copy = state->length; -- PULL(); -- ROOM(); -- if (copy > have) copy = have; -- if (copy > left) copy = left; -- zmemcpy(put, next, copy); -- have -= copy; -- next += copy; -- left -= copy; -- put += copy; -- state->length -= copy; -- } -- Tracev((stderr, "inflate: stored end\n")); -- state->mode = TYPE; -- break; -- -- case TABLE: -- /* get dynamic table entries descriptor */ -- NEEDBITS(14); -- state->nlen = BITS(5) + 257; -- DROPBITS(5); -- state->ndist = BITS(5) + 1; -- DROPBITS(5); -- state->ncode = BITS(4) + 4; -- DROPBITS(4); --#ifndef PKZIP_BUG_WORKAROUND -- if (state->nlen > 286 || state->ndist > 30) { -- strm->msg = (char *)"too many length or distance symbols"; -- state->mode = BAD; -- break; -- } --#endif -- Tracev((stderr, "inflate: table sizes ok\n")); -- -- /* get code length code lengths (not a typo) */ -- state->have = 0; -- while (state->have < state->ncode) { -- NEEDBITS(3); -- state->lens[order[state->have++]] = (unsigned short)BITS(3); -- DROPBITS(3); -- } -- while (state->have < 19) -- state->lens[order[state->have++]] = 0; -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 7; -- ret = inflate_table(CODES, state->lens, 19, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid code lengths set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: code lengths ok\n")); -- -- /* get length and distance code code lengths */ -- state->have = 0; -- while (state->have < state->nlen + state->ndist) { -- for (;;) { -- This = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if (This.val < 16) { -- NEEDBITS(This.bits); -- DROPBITS(This.bits); -- state->lens[state->have++] = This.val; -- } -- else { -- if (This.val == 16) { -- NEEDBITS(This.bits + 2); -- DROPBITS(This.bits); -- if (state->have == 0) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- len = (unsigned)(state->lens[state->have - 1]); -- copy = 3 + BITS(2); -- DROPBITS(2); -- } -- else if (This.val == 17) { -- NEEDBITS(This.bits + 3); -- DROPBITS(This.bits); -- len = 0; -- copy = 3 + BITS(3); -- DROPBITS(3); -- } -- else { -- NEEDBITS(This.bits + 7); -- DROPBITS(This.bits); -- len = 0; -- copy = 11 + BITS(7); -- DROPBITS(7); -- } -- if (state->have + copy > state->nlen + state->ndist) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- while (copy--) -- state->lens[state->have++] = (unsigned short)len; -- } -- } -- -- /* handle error breaks in while */ -- if (state->mode == BAD) break; -- -- /* build code tables */ -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 9; -- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid literal/lengths set"; -- state->mode = BAD; -- break; -- } -- state->distcode = (code const FAR *)(state->next); -- state->distbits = 6; -- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, -- &(state->next), &(state->distbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid distances set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: codes ok\n")); -- state->mode = LEN; -- -- case LEN: -- /* use inflate_fast() if we have enough input and output */ -- if (have >= 6 && left >= 258) { -- RESTORE(); -- if (state->whave < state->wsize) -- state->whave = state->wsize - left; -- inflate_fast(strm, state->wsize); -- LOAD(); -- break; -- } -- -- /* get a literal, length, or end-of-block code */ -- for (;;) { -- This = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if (This.op && (This.op & 0xf0) == 0) { -- last = This; -- for (;;) { -- This = state->lencode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + This.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(This.bits); -- state->length = (unsigned)This.val; -- -- /* process literal */ -- if (This.op == 0) { -- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", This.val)); -- ROOM(); -- *put++ = (unsigned char)(state->length); -- left--; -- state->mode = LEN; -- break; -- } -- -- /* process end of block */ -- if (This.op & 32) { -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- -- /* invalid code */ -- if (This.op & 64) { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- -- /* length code -- get extra bits, if any */ -- state->extra = (unsigned)(This.op) & 15; -- if (state->extra != 0) { -- NEEDBITS(state->extra); -- state->length += BITS(state->extra); -- DROPBITS(state->extra); -- } -- Tracevv((stderr, "inflate: length %u\n", state->length)); -- -- /* get distance code */ -- for (;;) { -- This = state->distcode[BITS(state->distbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if ((This.op & 0xf0) == 0) { -- last = This; -- for (;;) { -- This = state->distcode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + This.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(This.bits); -- if (This.op & 64) { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- state->offset = (unsigned)This.val; -- -- /* get distance extra bits, if any */ -- state->extra = (unsigned)(This.op) & 15; -- if (state->extra != 0) { -- NEEDBITS(state->extra); -- state->offset += BITS(state->extra); -- DROPBITS(state->extra); -- } -- if (state->offset > state->wsize - (state->whave < state->wsize ? -- left : 0)) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- Tracevv((stderr, "inflate: distance %u\n", state->offset)); -- -- /* copy match from window to output */ -- do { -- ROOM(); -- copy = state->wsize - state->offset; -- if (copy < left) { -- from = put + copy; -- copy = left - copy; -- } -- else { -- from = put - state->offset; -- copy = left; -- } -- if (copy > state->length) copy = state->length; -- state->length -= copy; -- left -= copy; -- do { -- *put++ = *from++; -- } while (--copy); -- } while (state->length != 0); -- break; -- -- case DONE: -- /* inflate stream terminated properly -- write leftover output */ -- ret = Z_STREAM_END; -- if (left < state->wsize) { -- if (out(out_desc, state->window, state->wsize - left)) -- ret = Z_BUF_ERROR; -- } -- goto inf_leave; -- -- case BAD: -- ret = Z_DATA_ERROR; -- goto inf_leave; -- -- default: /* can't happen, but makes compilers happy */ -- ret = Z_STREAM_ERROR; -- goto inf_leave; -- } -- -- /* Return unused input */ -- inf_leave: -- strm->next_in = next; -- strm->avail_in = have; -- return ret; --} -- --int ZEXPORT inflateBackEnd(z_streamp strm) --{ -- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- Tracev((stderr, "inflate: end\n")); -- return Z_OK; --} -diff -ruN seqinr.orig/src/inffast.c seqinr/src/inffast.c ---- seqinr.orig/src/inffast.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inffast.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,320 +0,0 @@ --/* inffast.c -- fast decoding -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- --#ifndef ASMINF -- --/* Allow machine dependent optimization for post-increment or pre-increment. -- Based on testing to date, -- Pre-increment preferred for: -- - PowerPC G3 (Adler) -- - MIPS R5000 (Randers-Pehrson) -- Post-increment preferred for: -- - none -- No measurable difference: -- - Pentium III (Anderson) -- - M68060 (Nikl) -- */ --#ifdef POSTINC --# define OFF 0 --# define PUP(a) *(a)++ --#else --# define OFF 1 --# define PUP(a) *++(a) --#endif -- --/* -- Decode literal, length, and distance codes and write out the resulting -- literal and match bytes until either not enough input or output is -- available, an end-of-block is encountered, or a data error is encountered. -- When large enough input and output buffers are supplied to inflate(), for -- example, a 16K input buffer and a 64K output buffer, more than 95% of the -- inflate execution time is spent in this routine. -- -- Entry assumptions: -- -- state->mode == LEN -- strm->avail_in >= 6 -- strm->avail_out >= 258 -- start >= strm->avail_out -- state->bits < 8 -- -- On return, state->mode is one of: -- -- LEN -- ran out of enough output space or enough available input -- TYPE -- reached end of block code, inflate() to interpret next block -- BAD -- error in block data -- -- Notes: -- -- - The maximum input bits used by a length/distance pair is 15 bits for the -- length code, 5 bits for the length extra, 15 bits for the distance code, -- and 13 bits for the distance extra. This totals 48 bits, or six bytes. -- Therefore if strm->avail_in >= 6, then there is enough input to avoid -- checking for available input while decoding. -- -- - The maximum bytes that a single length/distance pair can output is 258 -- bytes, which is the maximum length that can be coded. inflate_fast() -- requires strm->avail_out >= 258 for each loop to avoid checking for -- output space. -- */ --void inflate_fast(z_streamp strm, unsigned start) --#if 0 --z_streamp strm; --unsigned start; /* inflate()'s starting value for strm->avail_out */ --#endif --{ -- struct inflate_state FAR *state; -- unsigned char FAR *in; /* local strm->next_in */ -- unsigned char FAR *last; /* while in < last, enough input available */ -- unsigned char FAR *out; /* local strm->next_out */ -- unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ -- unsigned char FAR *end; /* while out < end, enough space available */ --#ifdef INFLATE_STRICT -- unsigned dmax; /* maximum distance from zlib header */ --#endif -- unsigned wsize; /* window size or zero if not using window */ -- unsigned whave; /* valid bytes in the window */ -- unsigned write; /* window write index */ -- unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ -- unsigned long hold; /* local strm->hold */ -- unsigned bits; /* local strm->bits */ -- code const FAR *lcode; /* local strm->lencode */ -- code const FAR *dcode; /* local strm->distcode */ -- unsigned lmask; /* mask for first level of length codes */ -- unsigned dmask; /* mask for first level of distance codes */ -- code This; /* retrieved table entry */ -- unsigned op; /* code bits, operation, extra bits, or */ -- /* window position, window bytes to copy */ -- unsigned len; /* match length, unused bytes */ -- unsigned dist; /* match distance */ -- unsigned char FAR *from; /* where to copy match from */ -- -- /* copy state to local variables */ -- state = (struct inflate_state FAR *)strm->state; -- in = strm->next_in - OFF; -- last = in + (strm->avail_in - 5); -- out = strm->next_out - OFF; -- beg = out - (start - strm->avail_out); -- end = out + (strm->avail_out - 257); --#ifdef INFLATE_STRICT -- dmax = state->dmax; --#endif -- wsize = state->wsize; -- whave = state->whave; -- write = state->write; -- window = state->window; -- hold = state->hold; -- bits = state->bits; -- lcode = state->lencode; -- dcode = state->distcode; -- lmask = (1U << state->lenbits) - 1; -- dmask = (1U << state->distbits) - 1; -- -- /* decode literals and length/distances until end-of-block or not enough -- input data or output space */ -- do { -- if (bits < 15) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- This = lcode[hold & lmask]; -- dolen: -- op = (unsigned)(This.bits); -- hold >>= op; -- bits -= op; -- op = (unsigned)(This.op); -- if (op == 0) { /* literal */ -- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", This.val)); -- PUP(out) = (unsigned char)(This.val); -- } -- else if (op & 16) { /* length base */ -- len = (unsigned)(This.val); -- op &= 15; /* number of extra bits */ -- if (op) { -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- len += (unsigned)hold & ((1U << op) - 1); -- hold >>= op; -- bits -= op; -- } -- Tracevv((stderr, "inflate: length %u\n", len)); -- if (bits < 15) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- This = dcode[hold & dmask]; -- dodist: -- op = (unsigned)(This.bits); -- hold >>= op; -- bits -= op; -- op = (unsigned)(This.op); -- if (op & 16) { /* distance base */ -- dist = (unsigned)(This.val); -- op &= 15; /* number of extra bits */ -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- if (bits < op) { -- hold += (unsigned long)(PUP(in)) << bits; -- bits += 8; -- } -- } -- dist += (unsigned)hold & ((1U << op) - 1); --#ifdef INFLATE_STRICT -- if (dist > dmax) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } --#endif -- hold >>= op; -- bits -= op; -- Tracevv((stderr, "inflate: distance %u\n", dist)); -- op = (unsigned)(out - beg); /* max distance in output */ -- if (dist > op) { /* see if copy from window */ -- op = dist - op; /* distance back in window */ -- if (op > whave) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- from = window - OFF; -- if (write == 0) { /* very common case */ -- from += wsize - op; -- if (op < len) { /* some from window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- else if (write < op) { /* wrap around window */ -- from += wsize + write - op; -- op -= write; -- if (op < len) { /* some from end of window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = window - OFF; -- if (write < len) { /* some from start of window */ -- op = write; -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- } -- else { /* contiguous in window */ -- from += write - op; -- if (op < len) { /* some from window */ -- len -= op; -- do { -- PUP(out) = PUP(from); -- } while (--op); -- from = out - dist; /* rest from output */ -- } -- } -- while (len > 2) { -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- len -= 3; -- } -- if (len) { -- PUP(out) = PUP(from); -- if (len > 1) -- PUP(out) = PUP(from); -- } -- } -- else { -- from = out - dist; /* copy direct from output */ -- do { /* minimum length is three */ -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- PUP(out) = PUP(from); -- len -= 3; -- } while (len > 2); -- if (len) { -- PUP(out) = PUP(from); -- if (len > 1) -- PUP(out) = PUP(from); -- } -- } -- } -- else if ((op & 64) == 0) { /* 2nd level distance code */ -- This = dcode[This.val + (hold & ((1U << op) - 1))]; -- goto dodist; -- } -- else { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- } -- else if ((op & 64) == 0) { /* 2nd level length code */ -- This = lcode[This.val + (hold & ((1U << op) - 1))]; -- goto dolen; -- } -- else if (op & 32) { /* end-of-block */ -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- else { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- } while (in < last && out < end); -- -- /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ -- len = bits >> 3; -- in -= len; -- bits -= len << 3; -- hold &= (1U << bits) - 1; -- -- /* update state and return */ -- strm->next_in = in + OFF; -- strm->next_out = out + OFF; -- strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); -- strm->avail_out = (unsigned)(out < end ? -- 257 + (end - out) : 257 - (out - end)); -- state->hold = hold; -- state->bits = bits; -- return; --} -- --/* -- inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): -- - Using bit fields for code structure -- - Different op definition to avoid & for extra bits (do & for table bits) -- - Three separate decoding do-loops for direct, window, and write == 0 -- - Special case for distance > 1 copies to do overlapped load and store copy -- - Explicit branch predictions (based on measured branch probabilities) -- - Deferring match copy and interspersed it with decoding subsequent codes -- - Swapping literal/length else -- - Swapping window/direct else -- - Larger unrolled copy loops (three is about right) -- - Moving len -= 3 statement into middle of loop -- */ -- --#endif /* !ASMINF */ -diff -ruN seqinr.orig/src/inffast.h seqinr/src/inffast.h ---- seqinr.orig/src/inffast.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inffast.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,11 +0,0 @@ --/* inffast.h -- header to use inffast.c -- * Copyright (C) 1995-2003 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --void inflate_fast OF((z_streamp strm, unsigned start)); -diff -ruN seqinr.orig/src/inffixed.h seqinr/src/inffixed.h ---- seqinr.orig/src/inffixed.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inffixed.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,94 +0,0 @@ -- /* inffixed.h -- table for decoding fixed codes -- * Generated automatically by makefixed(). -- */ -- -- /* WARNING: this file should *not* be used by applications. It -- is part of the implementation of the compression library and -- is subject to change. Applications should only use zlib.h. -- */ -- -- static const code lenfix[512] = { -- {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48}, -- {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128}, -- {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59}, -- {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176}, -- {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20}, -- {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100}, -- {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8}, -- {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216}, -- {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76}, -- {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114}, -- {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2}, -- {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148}, -- {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42}, -- {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86}, -- {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15}, -- {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236}, -- {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62}, -- {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, -- {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31}, -- {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162}, -- {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25}, -- {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105}, -- {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4}, -- {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202}, -- {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69}, -- {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125}, -- {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13}, -- {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195}, -- {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35}, -- {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91}, -- {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19}, -- {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246}, -- {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55}, -- {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135}, -- {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99}, -- {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190}, -- {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16}, -- {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96}, -- {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6}, -- {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209}, -- {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72}, -- {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116}, -- {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4}, -- {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153}, -- {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44}, -- {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82}, -- {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11}, -- {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, -- {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58}, -- {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138}, -- {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51}, -- {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173}, -- {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30}, -- {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110}, -- {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0}, -- {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195}, -- {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65}, -- {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121}, -- {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9}, -- {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258}, -- {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37}, -- {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93}, -- {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23}, -- {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251}, -- {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51}, -- {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, -- {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67}, -- {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183}, -- {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23}, -- {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103}, -- {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9}, -- {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223}, -- {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79}, -- {0,9,255} -- }; -- -- static const code distfix[32] = { -- {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025}, -- {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193}, -- {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385}, -- {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577}, -- {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073}, -- {22,5,193},{64,5,0} -- }; -diff -ruN seqinr.orig/src/inflate.c seqinr/src/inflate.c ---- seqinr.orig/src/inflate.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inflate.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1341 +0,0 @@ --/* inflate.c -- zlib decompression -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * Change history: -- * -- * 1.2.beta0 24 Nov 2002 -- * - First version -- complete rewrite of inflate to simplify code, avoid -- * creation of window when not needed, minimize use of window when it is -- * needed, make inffast.c even faster, implement gzip decoding, and to -- * improve code readability and style over the previous zlib inflate code -- * -- * 1.2.beta1 25 Nov 2002 -- * - Use pointers for available input and output checking in inffast.c -- * - Remove input and output counters in inffast.c -- * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 -- * - Remove unnecessary second byte pull from length extra in inffast.c -- * - Unroll direct copy to three copies per loop in inffast.c -- * -- * 1.2.beta2 4 Dec 2002 -- * - Change external routine names to reduce potential conflicts -- * - Correct filename to inffixed.h for fixed tables in inflate.c -- * - Make hbuf[] unsigned char to match parameter type in inflate.c -- * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) -- * to avoid negation problem on Alphas (64 bit) in inflate.c -- * -- * 1.2.beta3 22 Dec 2002 -- * - Add comments on state->bits assertion in inffast.c -- * - Add comments on op field in inftrees.h -- * - Fix bug in reuse of allocated window after inflateReset() -- * - Remove bit fields--back to byte structure for speed -- * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths -- * - Change post-increments to pre-increments in inflate_fast(), PPC biased? -- * - Add compile time option, POSTINC, to use post-increments instead (Intel?) -- * - Make MATCH copy in inflate() much faster for when inflate_fast() not used -- * - Use local copies of stream next and avail values, as well as local bit -- * buffer and bit count in inflate()--for speed when inflate_fast() not used -- * -- * 1.2.beta4 1 Jan 2003 -- * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings -- * - Move a comment on output buffer sizes from inffast.c to inflate.c -- * - Add comments in inffast.c to introduce the inflate_fast() routine -- * - Rearrange window copies in inflate_fast() for speed and simplification -- * - Unroll last copy for window match in inflate_fast() -- * - Use local copies of window variables in inflate_fast() for speed -- * - Pull out common write == 0 case for speed in inflate_fast() -- * - Make op and len in inflate_fast() unsigned for consistency -- * - Add FAR to lcode and dcode declarations in inflate_fast() -- * - Simplified bad distance check in inflate_fast() -- * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new -- * source file infback.c to provide a call-back interface to inflate for -- * programs like gzip and unzip -- uses window as output buffer to avoid -- * window copying -- * -- * 1.2.beta5 1 Jan 2003 -- * - Improved inflateBack() interface to allow the caller to provide initial -- * input in strm. -- * - Fixed stored blocks bug in inflateBack() -- * -- * 1.2.beta6 4 Jan 2003 -- * - Added comments in inffast.c on effectiveness of POSTINC -- * - Typecasting all around to reduce compiler warnings -- * - Changed loops from while (1) or do {} while (1) to for (;;), again to -- * make compilers happy -- * - Changed type of window in inflateBackInit() to unsigned char * -- * -- * 1.2.beta7 27 Jan 2003 -- * - Changed many types to unsigned or unsigned short to avoid warnings -- * - Added inflateCopy() function -- * -- * 1.2.0 9 Mar 2003 -- * - Changed inflateBack() interface to provide separate opaque descriptors -- * for the in() and out() functions -- * - Changed inflateBack() argument and in_func typedef to swap the length -- * and buffer address return values for the input function -- * - Check next_in and next_out for Z_NULL on entry to inflate() -- * -- * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. -- */ -- --#include "zutil.h" --#include "inftrees.h" --#include "inflate.h" --#include "inffast.h" -- -- --#ifdef MAKEFIXED --# ifndef BUILDFIXED --# define BUILDFIXED --# endif --#endif -- --/* function prototypes */ --local void fixedtables OF((struct inflate_state FAR *state)); --local int updatewindow OF((z_streamp strm, unsigned out)); --#ifdef BUILDFIXED -- void makefixed OF((void)); --#endif --local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, -- unsigned len)); -- --int ZEXPORT inflateReset(z_streamp strm) --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- strm->total_in = strm->total_out = state->total = 0; -- strm->msg = Z_NULL; -- strm->adler = 1; /* to support ill-conceived Java test suite */ -- state->mode = HEAD; -- state->last = 0; -- state->havedict = 0; -- state->dmax = 32768U; -- state->head = Z_NULL; -- state->wsize = 0; -- state->whave = 0; -- state->write = 0; -- state->hold = 0; -- state->bits = 0; -- state->lencode = state->distcode = state->next = state->codes; -- Tracev((stderr, "inflate: reset\n")); -- return Z_OK; --} -- --int ZEXPORT inflatePrime(z_streamp strm, int bits, int value) --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR; -- value &= (1L << bits) - 1; -- state->hold += value << state->bits; -- state->bits += bits; -- return Z_OK; --} -- --int ZEXPORT inflateInit2_(z_streamp strm, int windowBits, const char *version, -- int stream_size) --{ -- struct inflate_state FAR *state; -- -- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || -- stream_size != (int)(sizeof(z_stream))) -- return Z_VERSION_ERROR; -- if (strm == Z_NULL) return Z_STREAM_ERROR; -- strm->msg = Z_NULL; /* in case we return an error */ -- if (strm->zalloc == (alloc_func)0) { -- strm->zalloc = zcalloc; -- strm->opaque = (voidpf)0; -- } -- if (strm->zfree == (free_func)0) strm->zfree = zcfree; -- state = (struct inflate_state FAR *) -- ZALLOC(strm, 1, sizeof(struct inflate_state)); -- if (state == Z_NULL) return Z_MEM_ERROR; -- Tracev((stderr, "inflate: allocated\n")); -- strm->state = (struct internal_state FAR *)state; -- if (windowBits < 0) { -- state->wrap = 0; -- windowBits = -windowBits; -- } -- else { -- state->wrap = (windowBits >> 4) + 1; --#ifdef GUNZIP -- if (windowBits < 48) windowBits &= 15; --#endif -- } -- if (windowBits < 8 || windowBits > 15) { -- ZFREE(strm, state); -- strm->state = Z_NULL; -- return Z_STREAM_ERROR; -- } -- state->wbits = (unsigned)windowBits; -- state->window = Z_NULL; -- return inflateReset(strm); --} -- --int ZEXPORT inflateInit_(z_streamp strm, const char *version, int stream_size) --{ -- return inflateInit2_(strm, DEF_WBITS, version, stream_size); --} -- --/* -- Return state with length and distance decoding tables and index sizes set to -- fixed code decoding. Normally this returns fixed tables from inffixed.h. -- If BUILDFIXED is defined, then instead this routine builds the tables the -- first time it's called, and returns those tables the first time and -- thereafter. This reduces the size of the code by about 2K bytes, in -- exchange for a little execution time. However, BUILDFIXED should not be -- used for threaded applications, since the rewriting of the tables and virgin -- may not be thread-safe. -- */ --local void fixedtables(struct inflate_state FAR *state) --{ --#ifdef BUILDFIXED -- static int virgin = 1; -- static code *lenfix, *distfix; -- static code fixed[544]; -- -- /* build fixed huffman tables if first call (may not be thread safe) */ -- if (virgin) { -- unsigned sym, bits; -- static code *next; -- -- /* literal/length table */ -- sym = 0; -- while (sym < 144) state->lens[sym++] = 8; -- while (sym < 256) state->lens[sym++] = 9; -- while (sym < 280) state->lens[sym++] = 7; -- while (sym < 288) state->lens[sym++] = 8; -- next = fixed; -- lenfix = next; -- bits = 9; -- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); -- -- /* distance table */ -- sym = 0; -- while (sym < 32) state->lens[sym++] = 5; -- distfix = next; -- bits = 5; -- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); -- -- /* do this just once */ -- virgin = 0; -- } --#else /* !BUILDFIXED */ --# include "inffixed.h" --#endif /* BUILDFIXED */ -- state->lencode = lenfix; -- state->lenbits = 9; -- state->distcode = distfix; -- state->distbits = 5; --} -- --#ifdef MAKEFIXED --#include -- --/* -- Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also -- defines BUILDFIXED, so the tables are built on the fly. makefixed() writes -- those tables to stdout, which would be piped to inffixed.h. A small program -- can simply call makefixed to do this: -- -- void makefixed(void); -- -- int main(void) -- { -- makefixed(); -- return 0; -- } -- -- Then that can be linked with zlib built with MAKEFIXED defined and run: -- -- a.out > inffixed.h -- */ --void makefixed() --{ -- unsigned low, size; -- struct inflate_state state; -- -- fixedtables(&state); -- puts(" /* inffixed.h -- table for decoding fixed codes"); -- puts(" * Generated automatically by makefixed()."); -- puts(" */"); -- puts(""); -- puts(" /* WARNING: this file should *not* be used by applications."); -- puts(" It is part of the implementation of this library and is"); -- puts(" subject to change. Applications should only use zlib.h."); -- puts(" */"); -- puts(""); -- size = 1U << 9; -- printf(" static const code lenfix[%u] = {", size); -- low = 0; -- for (;;) { -- if ((low % 7) == 0) printf("\n "); -- printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits, -- state.lencode[low].val); -- if (++low == size) break; -- putchar(','); -- } -- puts("\n };"); -- size = 1U << 5; -- printf("\n static const code distfix[%u] = {", size); -- low = 0; -- for (;;) { -- if ((low % 6) == 0) printf("\n "); -- printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, -- state.distcode[low].val); -- if (++low == size) break; -- putchar(','); -- } -- puts("\n };"); --} --#endif /* MAKEFIXED */ -- --/* -- Update the window with the last wsize (normally 32K) bytes written before -- returning. If window does not exist yet, create it. This is only called -- when a window is already in use, or when output has been written during this -- inflate call, but the end of the deflate stream has not been reached yet. -- It is also called to create a window for dictionary data when a dictionary -- is loaded. -- -- Providing output buffers larger than 32K to inflate() should provide a speed -- advantage, since only the last 32K of output is copied to the sliding window -- upon return from inflate(), and since all distances after the first 32K of -- output will fall in the output data, making match copies simpler and faster. -- The advantage may be dependent on the size of the processor's data caches. -- */ --local int updatewindow(z_streamp strm, unsigned out) --{ -- struct inflate_state FAR *state; -- unsigned copy, dist; -- -- state = (struct inflate_state FAR *)strm->state; -- -- /* if it hasn't been done already, allocate space for the window */ -- if (state->window == Z_NULL) { -- state->window = (unsigned char FAR *) -- ZALLOC(strm, 1U << state->wbits, -- sizeof(unsigned char)); -- if (state->window == Z_NULL) return 1; -- } -- -- /* if window not in use yet, initialize */ -- if (state->wsize == 0) { -- state->wsize = 1U << state->wbits; -- state->write = 0; -- state->whave = 0; -- } -- -- /* copy state->wsize or less output bytes into the circular window */ -- copy = out - strm->avail_out; -- if (copy >= state->wsize) { -- zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); -- state->write = 0; -- state->whave = state->wsize; -- } -- else { -- dist = state->wsize - state->write; -- if (dist > copy) dist = copy; -- zmemcpy(state->window + state->write, strm->next_out - copy, dist); -- copy -= dist; -- if (copy) { -- zmemcpy(state->window, strm->next_out - copy, copy); -- state->write = copy; -- state->whave = state->wsize; -- } -- else { -- state->write += dist; -- if (state->write == state->wsize) state->write = 0; -- if (state->whave < state->wsize) state->whave += dist; -- } -- } -- return 0; --} -- --/* Macros for inflate(): */ -- --/* check function to use adler32() for zlib or crc32() for gzip */ --#ifdef GUNZIP --# define UPDATE(check, buf, len) \ -- (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) --#else --# define UPDATE(check, buf, len) adler32(check, buf, len) --#endif -- --/* check macros for header crc */ --#ifdef GUNZIP --# define CRC2(check, word) \ -- do { \ -- hbuf[0] = (unsigned char)(word); \ -- hbuf[1] = (unsigned char)((word) >> 8); \ -- check = crc32(check, hbuf, 2); \ -- } while (0) -- --# define CRC4(check, word) \ -- do { \ -- hbuf[0] = (unsigned char)(word); \ -- hbuf[1] = (unsigned char)((word) >> 8); \ -- hbuf[2] = (unsigned char)((word) >> 16); \ -- hbuf[3] = (unsigned char)((word) >> 24); \ -- check = crc32(check, hbuf, 4); \ -- } while (0) --#endif -- --/* Load registers with state in inflate() for speed */ --#define LOAD() \ -- do { \ -- put = strm->next_out; \ -- left = strm->avail_out; \ -- next = strm->next_in; \ -- have = strm->avail_in; \ -- hold = state->hold; \ -- bits = state->bits; \ -- } while (0) -- --/* Restore state from registers in inflate() */ --#define RESTORE() \ -- do { \ -- strm->next_out = put; \ -- strm->avail_out = left; \ -- strm->next_in = next; \ -- strm->avail_in = have; \ -- state->hold = hold; \ -- state->bits = bits; \ -- } while (0) -- --/* Clear the input bit accumulator */ --#define INITBITS() \ -- do { \ -- hold = 0; \ -- bits = 0; \ -- } while (0) -- --/* Get a byte of input into the bit accumulator, or return from inflate() -- if there is no input available. */ --#define PULLBYTE() \ -- do { \ -- if (have == 0) goto inf_leave; \ -- have--; \ -- hold += (unsigned long)(*next++) << bits; \ -- bits += 8; \ -- } while (0) -- --/* Assure that there are at least n bits in the bit accumulator. If there is -- not enough available input to do that, then return from inflate(). */ --#define NEEDBITS(n) \ -- do { \ -- while (bits < (unsigned)(n)) \ -- PULLBYTE(); \ -- } while (0) -- --/* Return the low n bits of the bit accumulator (n < 16) */ --#define BITS(n) \ -- ((unsigned)hold & ((1U << (n)) - 1)) -- --/* Remove n bits from the bit accumulator */ --#define DROPBITS(n) \ -- do { \ -- hold >>= (n); \ -- bits -= (unsigned)(n); \ -- } while (0) -- --/* Remove zero to seven bits as needed to go to a byte boundary */ --#define BYTEBITS() \ -- do { \ -- hold >>= bits & 7; \ -- bits -= bits & 7; \ -- } while (0) -- --/* Reverse the bytes in a 32-bit value */ --#define REVERSE(q) \ -- ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ -- (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) -- --/* -- inflate() uses a state machine to process as much input data and generate as -- much output data as possible before returning. The state machine is -- structured roughly as follows: -- -- for (;;) switch (state) { -- ... -- case STATEn: -- if (not enough input data or output space to make progress) -- return; -- ... make progress ... -- state = STATEm; -- break; -- ... -- } -- -- so when inflate() is called again, the same case is attempted again, and -- if the appropriate resources are provided, the machine proceeds to the -- next state. The NEEDBITS() macro is usually the way the state evaluates -- whether it can proceed or should return. NEEDBITS() does the return if -- the requested bits are not available. The typical use of the BITS macros -- is: -- -- NEEDBITS(n); -- ... do something with BITS(n) ... -- DROPBITS(n); -- -- where NEEDBITS(n) either returns from inflate() if there isn't enough -- input left to load n bits into the accumulator, or it continues. BITS(n) -- gives the low n bits in the accumulator. When done, DROPBITS(n) drops -- the low n bits off the accumulator. INITBITS() clears the accumulator -- and sets the number of available bits to zero. BYTEBITS() discards just -- enough bits to put the accumulator on a byte boundary. After BYTEBITS() -- and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. -- -- NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return -- if there is no input available. The decoding of variable length codes uses -- PULLBYTE() directly in order to pull just enough bytes to decode the next -- code, and no more. -- -- Some states loop until they get enough input, making sure that enough -- state information is maintained to continue the loop where it left off -- if NEEDBITS() returns in the loop. For example, want, need, and keep -- would all have to actually be part of the saved state in case NEEDBITS() -- returns: -- -- case STATEw: -- while (want < need) { -- NEEDBITS(n); -- keep[want++] = BITS(n); -- DROPBITS(n); -- } -- state = STATEx; -- case STATEx: -- -- As shown above, if the next state is also the next case, then the break -- is omitted. -- -- A state may also return if there is not enough output space available to -- complete that state. Those states are copying stored data, writing a -- literal byte, and copying a matching string. -- -- When returning, a "goto inf_leave" is used to update the total counters, -- update the check value, and determine whether any progress has been made -- during that inflate() call in order to return the proper return code. -- Progress is defined as a change in either strm->avail_in or strm->avail_out. -- When there is a window, goto inf_leave will update the window with the last -- output written. If a goto inf_leave occurs in the middle of decompression -- and there is no window currently, goto inf_leave will create one and copy -- output to the window for the next call of inflate(). -- -- In this implementation, the flush parameter of inflate() only affects the -- return code (per zlib.h). inflate() always writes as much as possible to -- strm->next_out, given the space available and the provided input--the effect -- documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers -- the allocation of and copying into a sliding window until necessary, which -- provides the effect documented in zlib.h for Z_FINISH when the entire input -- stream available. So the only thing the flush parameter actually does is: -- when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it -- will return Z_BUF_ERROR if it has not reached the end of the stream. -- */ -- --int ZEXPORT inflate(z_streamp strm, int flush) --{ -- struct inflate_state FAR *state; -- unsigned char FAR *next; /* next input */ -- unsigned char FAR *put; /* next output */ -- unsigned have, left; /* available input and output */ -- unsigned long hold; /* bit buffer */ -- unsigned bits; /* bits in bit buffer */ -- unsigned in, out; /* save starting available input and output */ -- unsigned copy; /* number of stored or match bytes to copy */ -- unsigned char FAR *from; /* where to copy match bytes from */ -- code This; /* current decoding table entry */ -- code last; /* parent table entry */ -- unsigned len; /* length to copy for repeats, bits to drop */ -- int ret; /* return code */ --#ifdef GUNZIP -- unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ --#endif -- static const unsigned short order[19] = /* permutation of code lengths */ -- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; -- -- if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL || -- (strm->next_in == Z_NULL && strm->avail_in != 0)) -- return Z_STREAM_ERROR; -- -- state = (struct inflate_state FAR *)strm->state; -- if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ -- LOAD(); -- in = have; -- out = left; -- ret = Z_OK; -- for (;;) -- switch (state->mode) { -- case HEAD: -- if (state->wrap == 0) { -- state->mode = TYPEDO; -- break; -- } -- NEEDBITS(16); --#ifdef GUNZIP -- if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ -- state->check = crc32(0L, Z_NULL, 0); -- CRC2(state->check, hold); -- INITBITS(); -- state->mode = FLAGS; -- break; -- } -- state->flags = 0; /* expect zlib header */ -- if (state->head != Z_NULL) -- state->head->done = -1; -- if (!(state->wrap & 1) || /* check if zlib header allowed */ --#else -- if ( --#endif -- ((BITS(8) << 8) + (hold >> 8)) % 31) { -- strm->msg = (char *)"incorrect header check"; -- state->mode = BAD; -- break; -- } -- if (BITS(4) != Z_DEFLATED) { -- strm->msg = (char *)"unknown compression method"; -- state->mode = BAD; -- break; -- } -- DROPBITS(4); -- len = BITS(4) + 8; -- if (len > state->wbits) { -- strm->msg = (char *)"invalid window size"; -- state->mode = BAD; -- break; -- } -- state->dmax = 1U << len; -- Tracev((stderr, "inflate: zlib header ok\n")); -- strm->adler = state->check = adler32(0L, Z_NULL, 0); -- state->mode = hold & 0x200 ? DICTID : TYPE; -- INITBITS(); -- break; --#ifdef GUNZIP -- case FLAGS: -- NEEDBITS(16); -- state->flags = (int)(hold); -- if ((state->flags & 0xff) != Z_DEFLATED) { -- strm->msg = (char *)"unknown compression method"; -- state->mode = BAD; -- break; -- } -- if (state->flags & 0xe000) { -- strm->msg = (char *)"unknown header flags set"; -- state->mode = BAD; -- break; -- } -- if (state->head != Z_NULL) -- state->head->text = (int)((hold >> 8) & 1); -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- state->mode = TIME; -- case TIME: -- NEEDBITS(32); -- if (state->head != Z_NULL) -- state->head->time = hold; -- if (state->flags & 0x0200) CRC4(state->check, hold); -- INITBITS(); -- state->mode = OS; -- case OS: -- NEEDBITS(16); -- if (state->head != Z_NULL) { -- state->head->xflags = (int)(hold & 0xff); -- state->head->os = (int)(hold >> 8); -- } -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- state->mode = EXLEN; -- case EXLEN: -- if (state->flags & 0x0400) { -- NEEDBITS(16); -- state->length = (unsigned)(hold); -- if (state->head != Z_NULL) -- state->head->extra_len = (unsigned)hold; -- if (state->flags & 0x0200) CRC2(state->check, hold); -- INITBITS(); -- } -- else if (state->head != Z_NULL) -- state->head->extra = Z_NULL; -- state->mode = EXTRA; -- case EXTRA: -- if (state->flags & 0x0400) { -- copy = state->length; -- if (copy > have) copy = have; -- if (copy) { -- if (state->head != Z_NULL && -- state->head->extra != Z_NULL) { -- len = state->head->extra_len - state->length; -- zmemcpy(state->head->extra + len, next, -- len + copy > state->head->extra_max ? -- state->head->extra_max - len : copy); -- } -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- state->length -= copy; -- } -- if (state->length) goto inf_leave; -- } -- state->length = 0; -- state->mode = NAME; -- case NAME: -- if (state->flags & 0x0800) { -- if (have == 0) goto inf_leave; -- copy = 0; -- do { -- len = (unsigned)(next[copy++]); -- if (state->head != Z_NULL && -- state->head->name != Z_NULL && -- state->length < state->head->name_max) -- state->head->name[state->length++] = len; -- } while (len && copy < have); -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- if (len) goto inf_leave; -- } -- else if (state->head != Z_NULL) -- state->head->name = Z_NULL; -- state->length = 0; -- state->mode = COMMENT; -- case COMMENT: -- if (state->flags & 0x1000) { -- if (have == 0) goto inf_leave; -- copy = 0; -- do { -- len = (unsigned)(next[copy++]); -- if (state->head != Z_NULL && -- state->head->comment != Z_NULL && -- state->length < state->head->comm_max) -- state->head->comment[state->length++] = len; -- } while (len && copy < have); -- if (state->flags & 0x0200) -- state->check = crc32(state->check, next, copy); -- have -= copy; -- next += copy; -- if (len) goto inf_leave; -- } -- else if (state->head != Z_NULL) -- state->head->comment = Z_NULL; -- state->mode = HCRC; -- case HCRC: -- if (state->flags & 0x0200) { -- NEEDBITS(16); -- if (hold != (state->check & 0xffff)) { -- strm->msg = (char *)"header crc mismatch"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- } -- if (state->head != Z_NULL) { -- state->head->hcrc = (int)((state->flags >> 9) & 1); -- state->head->done = 1; -- } -- strm->adler = state->check = crc32(0L, Z_NULL, 0); -- state->mode = TYPE; -- break; --#endif -- case DICTID: -- NEEDBITS(32); -- strm->adler = state->check = REVERSE(hold); -- INITBITS(); -- state->mode = DICT; -- case DICT: -- if (state->havedict == 0) { -- RESTORE(); -- return Z_NEED_DICT; -- } -- strm->adler = state->check = adler32(0L, Z_NULL, 0); -- state->mode = TYPE; -- case TYPE: -- if (flush == Z_BLOCK) goto inf_leave; -- case TYPEDO: -- if (state->last) { -- BYTEBITS(); -- state->mode = CHECK; -- break; -- } -- NEEDBITS(3); -- state->last = BITS(1); -- DROPBITS(1); -- switch (BITS(2)) { -- case 0: /* stored block */ -- Tracev((stderr, "inflate: stored block%s\n", -- state->last ? " (last)" : "")); -- state->mode = STORED; -- break; -- case 1: /* fixed block */ -- fixedtables(state); -- Tracev((stderr, "inflate: fixed codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = LEN; /* decode codes */ -- break; -- case 2: /* dynamic block */ -- Tracev((stderr, "inflate: dynamic codes block%s\n", -- state->last ? " (last)" : "")); -- state->mode = TABLE; -- break; -- case 3: -- strm->msg = (char *)"invalid block type"; -- state->mode = BAD; -- } -- DROPBITS(2); -- break; -- case STORED: -- BYTEBITS(); /* go to byte boundary */ -- NEEDBITS(32); -- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { -- strm->msg = (char *)"invalid stored block lengths"; -- state->mode = BAD; -- break; -- } -- state->length = (unsigned)hold & 0xffff; -- Tracev((stderr, "inflate: stored length %u\n", -- state->length)); -- INITBITS(); -- state->mode = COPY; -- case COPY: -- copy = state->length; -- if (copy) { -- if (copy > have) copy = have; -- if (copy > left) copy = left; -- if (copy == 0) goto inf_leave; -- zmemcpy(put, next, copy); -- have -= copy; -- next += copy; -- left -= copy; -- put += copy; -- state->length -= copy; -- break; -- } -- Tracev((stderr, "inflate: stored end\n")); -- state->mode = TYPE; -- break; -- case TABLE: -- NEEDBITS(14); -- state->nlen = BITS(5) + 257; -- DROPBITS(5); -- state->ndist = BITS(5) + 1; -- DROPBITS(5); -- state->ncode = BITS(4) + 4; -- DROPBITS(4); --#ifndef PKZIP_BUG_WORKAROUND -- if (state->nlen > 286 || state->ndist > 30) { -- strm->msg = (char *)"too many length or distance symbols"; -- state->mode = BAD; -- break; -- } --#endif -- Tracev((stderr, "inflate: table sizes ok\n")); -- state->have = 0; -- state->mode = LENLENS; -- case LENLENS: -- while (state->have < state->ncode) { -- NEEDBITS(3); -- state->lens[order[state->have++]] = (unsigned short)BITS(3); -- DROPBITS(3); -- } -- while (state->have < 19) -- state->lens[order[state->have++]] = 0; -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 7; -- ret = inflate_table(CODES, state->lens, 19, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid code lengths set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: code lengths ok\n")); -- state->have = 0; -- state->mode = CODELENS; -- case CODELENS: -- while (state->have < state->nlen + state->ndist) { -- for (;;) { -- This = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if (This.val < 16) { -- NEEDBITS(This.bits); -- DROPBITS(This.bits); -- state->lens[state->have++] = This.val; -- } -- else { -- if (This.val == 16) { -- NEEDBITS(This.bits + 2); -- DROPBITS(This.bits); -- if (state->have == 0) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- len = state->lens[state->have - 1]; -- copy = 3 + BITS(2); -- DROPBITS(2); -- } -- else if (This.val == 17) { -- NEEDBITS(This.bits + 3); -- DROPBITS(This.bits); -- len = 0; -- copy = 3 + BITS(3); -- DROPBITS(3); -- } -- else { -- NEEDBITS(This.bits + 7); -- DROPBITS(This.bits); -- len = 0; -- copy = 11 + BITS(7); -- DROPBITS(7); -- } -- if (state->have + copy > state->nlen + state->ndist) { -- strm->msg = (char *)"invalid bit length repeat"; -- state->mode = BAD; -- break; -- } -- while (copy--) -- state->lens[state->have++] = (unsigned short)len; -- } -- } -- -- /* handle error breaks in while */ -- if (state->mode == BAD) break; -- -- /* build code tables */ -- state->next = state->codes; -- state->lencode = (code const FAR *)(state->next); -- state->lenbits = 9; -- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), -- &(state->lenbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid literal/lengths set"; -- state->mode = BAD; -- break; -- } -- state->distcode = (code const FAR *)(state->next); -- state->distbits = 6; -- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, -- &(state->next), &(state->distbits), state->work); -- if (ret) { -- strm->msg = (char *)"invalid distances set"; -- state->mode = BAD; -- break; -- } -- Tracev((stderr, "inflate: codes ok\n")); -- state->mode = LEN; -- case LEN: -- if (have >= 6 && left >= 258) { -- RESTORE(); -- inflate_fast(strm, out); -- LOAD(); -- break; -- } -- for (;;) { -- This = state->lencode[BITS(state->lenbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if (This.op && (This.op & 0xf0) == 0) { -- last = This; -- for (;;) { -- This = state->lencode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + This.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(This.bits); -- state->length = (unsigned)This.val; -- if ((int)(This.op) == 0) { -- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? -- "inflate: literal '%c'\n" : -- "inflate: literal 0x%02x\n", This.val)); -- state->mode = LIT; -- break; -- } -- if (This.op & 32) { -- Tracevv((stderr, "inflate: end of block\n")); -- state->mode = TYPE; -- break; -- } -- if (This.op & 64) { -- strm->msg = (char *)"invalid literal/length code"; -- state->mode = BAD; -- break; -- } -- state->extra = (unsigned)(This.op) & 15; -- state->mode = LENEXT; -- case LENEXT: -- if (state->extra) { -- NEEDBITS(state->extra); -- state->length += BITS(state->extra); -- DROPBITS(state->extra); -- } -- Tracevv((stderr, "inflate: length %u\n", state->length)); -- state->mode = DIST; -- case DIST: -- for (;;) { -- This = state->distcode[BITS(state->distbits)]; -- if ((unsigned)(This.bits) <= bits) break; -- PULLBYTE(); -- } -- if ((This.op & 0xf0) == 0) { -- last = This; -- for (;;) { -- This = state->distcode[last.val + -- (BITS(last.bits + last.op) >> last.bits)]; -- if ((unsigned)(last.bits + This.bits) <= bits) break; -- PULLBYTE(); -- } -- DROPBITS(last.bits); -- } -- DROPBITS(This.bits); -- if (This.op & 64) { -- strm->msg = (char *)"invalid distance code"; -- state->mode = BAD; -- break; -- } -- state->offset = (unsigned)This.val; -- state->extra = (unsigned)(This.op) & 15; -- state->mode = DISTEXT; -- case DISTEXT: -- if (state->extra) { -- NEEDBITS(state->extra); -- state->offset += BITS(state->extra); -- DROPBITS(state->extra); -- } --#ifdef INFLATE_STRICT -- if (state->offset > state->dmax) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } --#endif -- if (state->offset > state->whave + out - left) { -- strm->msg = (char *)"invalid distance too far back"; -- state->mode = BAD; -- break; -- } -- Tracevv((stderr, "inflate: distance %u\n", state->offset)); -- state->mode = MATCH; -- case MATCH: -- if (left == 0) goto inf_leave; -- copy = out - left; -- if (state->offset > copy) { /* copy from window */ -- copy = state->offset - copy; -- if (copy > state->write) { -- copy -= state->write; -- from = state->window + (state->wsize - copy); -- } -- else -- from = state->window + (state->write - copy); -- if (copy > state->length) copy = state->length; -- } -- else { /* copy from output */ -- from = put - state->offset; -- copy = state->length; -- } -- if (copy > left) copy = left; -- left -= copy; -- state->length -= copy; -- do { -- *put++ = *from++; -- } while (--copy); -- if (state->length == 0) state->mode = LEN; -- break; -- case LIT: -- if (left == 0) goto inf_leave; -- *put++ = (unsigned char)(state->length); -- left--; -- state->mode = LEN; -- break; -- case CHECK: -- if (state->wrap) { -- NEEDBITS(32); -- out -= left; -- strm->total_out += out; -- state->total += out; -- if (out) -- strm->adler = state->check = -- UPDATE(state->check, put - out, out); -- out = left; -- if (( --#ifdef GUNZIP -- state->flags ? hold : --#endif -- REVERSE(hold)) != state->check) { -- strm->msg = (char *)"incorrect data check"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- Tracev((stderr, "inflate: check matches trailer\n")); -- } --#ifdef GUNZIP -- state->mode = LENGTH; -- case LENGTH: -- if (state->wrap && state->flags) { -- NEEDBITS(32); -- if (hold != (state->total & 0xffffffffUL)) { -- strm->msg = (char *)"incorrect length check"; -- state->mode = BAD; -- break; -- } -- INITBITS(); -- Tracev((stderr, "inflate: length matches trailer\n")); -- } --#endif -- state->mode = DONE; -- case DONE: -- ret = Z_STREAM_END; -- goto inf_leave; -- case BAD: -- ret = Z_DATA_ERROR; -- goto inf_leave; -- case MEM: -- return Z_MEM_ERROR; -- case SYNC: -- default: -- return Z_STREAM_ERROR; -- } -- -- /* -- Return from inflate(), updating the total counts and the check value. -- If there was no progress during the inflate() call, return a buffer -- error. Call updatewindow() to create and/or update the window state. -- Note: a memory error from inflate() is non-recoverable. -- */ -- inf_leave: -- RESTORE(); -- if (state->wsize || (state->mode < CHECK && out != strm->avail_out)) -- if (updatewindow(strm, out)) { -- state->mode = MEM; -- return Z_MEM_ERROR; -- } -- in -= strm->avail_in; -- out -= strm->avail_out; -- strm->total_in += in; -- strm->total_out += out; -- state->total += out; -- if (state->wrap && out) -- strm->adler = state->check = -- UPDATE(state->check, strm->next_out - out, out); -- strm->data_type = state->bits + (state->last ? 64 : 0) + -- (state->mode == TYPE ? 128 : 0); -- if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) -- ret = Z_BUF_ERROR; -- return ret; --} -- --int ZEXPORT inflateEnd(z_streamp strm) --{ -- struct inflate_state FAR *state; -- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (state->window != Z_NULL) ZFREE(strm, state->window); -- ZFREE(strm, strm->state); -- strm->state = Z_NULL; -- Tracev((stderr, "inflate: end\n")); -- return Z_OK; --} -- --int ZEXPORT inflateSetDictionary(z_streamp strm, const Bytef *dictionary, uInt dictLength) --{ -- struct inflate_state FAR *state; -- unsigned long id; -- -- /* check state */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (state->wrap != 0 && state->mode != DICT) -- return Z_STREAM_ERROR; -- -- /* check for correct dictionary id */ -- if (state->mode == DICT) { -- id = adler32(0L, Z_NULL, 0); -- id = adler32(id, dictionary, dictLength); -- if (id != state->check) -- return Z_DATA_ERROR; -- } -- -- /* copy dictionary to window */ -- if (updatewindow(strm, strm->avail_out)) { -- state->mode = MEM; -- return Z_MEM_ERROR; -- } -- if (dictLength > state->wsize) { -- zmemcpy(state->window, dictionary + dictLength - state->wsize, -- state->wsize); -- state->whave = state->wsize; -- } -- else { -- zmemcpy(state->window + state->wsize - dictLength, dictionary, -- dictLength); -- state->whave = dictLength; -- } -- state->havedict = 1; -- Tracev((stderr, "inflate: dictionary set\n")); -- return Z_OK; --} -- --int ZEXPORT inflateGetHeader(z_streamp strm, gz_headerp head) --{ -- struct inflate_state FAR *state; -- -- /* check state */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; -- -- /* save header structure */ -- state->head = head; -- head->done = 0; -- return Z_OK; --} -- --/* -- Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found -- or when out of input. When called, *have is the number of pattern bytes -- found in order so far, in 0..3. On return *have is updated to the new -- state. If on return *have equals four, then the pattern was found and the -- return value is how many bytes were read including the last byte of the -- pattern. If *have is less than four, then the pattern has not been found -- yet and the return value is len. In the latter case, syncsearch() can be -- called again with more data and the *have state. *have is initialized to -- zero for the first call. -- */ --local unsigned syncsearch(unsigned FAR *have, unsigned char FAR *buf, unsigned len) --{ -- unsigned got; -- unsigned next; -- -- got = *have; -- next = 0; -- while (next < len && got < 4) { -- if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) -- got++; -- else if (buf[next]) -- got = 0; -- else -- got = 4 - got; -- next++; -- } -- *have = got; -- return next; --} -- --int ZEXPORT inflateSync(z_streamp strm) --{ -- unsigned len; /* number of bytes to look at or looked at */ -- unsigned long in, out; /* temporary to save total_in and total_out */ -- unsigned char buf[4]; /* to restore bit buffer to byte string */ -- struct inflate_state FAR *state; -- -- /* check parameters */ -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; -- -- /* if first time, start search in bit buffer */ -- if (state->mode != SYNC) { -- state->mode = SYNC; -- state->hold <<= state->bits & 7; -- state->bits -= state->bits & 7; -- len = 0; -- while (state->bits >= 8) { -- buf[len++] = (unsigned char)(state->hold); -- state->hold >>= 8; -- state->bits -= 8; -- } -- state->have = 0; -- syncsearch(&(state->have), buf, len); -- } -- -- /* search available input */ -- len = syncsearch(&(state->have), strm->next_in, strm->avail_in); -- strm->avail_in -= len; -- strm->next_in += len; -- strm->total_in += len; -- -- /* return no joy or set up to restart inflate() on a new block */ -- if (state->have != 4) return Z_DATA_ERROR; -- in = strm->total_in; out = strm->total_out; -- inflateReset(strm); -- strm->total_in = in; strm->total_out = out; -- state->mode = TYPE; -- return Z_OK; --} -- --/* -- Returns true if inflate is currently at the end of a block generated by -- Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP -- implementation to provide an additional safety check. PPP uses -- Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored -- block. When decompressing, PPP checks that at the end of input packet, -- inflate is waiting for these length bytes. -- */ --int ZEXPORT inflateSyncPoint(z_streamp strm) --{ -- struct inflate_state FAR *state; -- -- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)strm->state; -- return state->mode == STORED && state->bits == 0; --} -- --int ZEXPORT inflateCopy(z_streamp dest, z_streamp source) --{ -- struct inflate_state FAR *state; -- struct inflate_state FAR *copy; -- unsigned char FAR *window; -- unsigned wsize; -- -- /* check input */ -- if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL || -- source->zalloc == (alloc_func)0 || source->zfree == (free_func)0) -- return Z_STREAM_ERROR; -- state = (struct inflate_state FAR *)source->state; -- -- /* allocate space */ -- copy = (struct inflate_state FAR *) -- ZALLOC(source, 1, sizeof(struct inflate_state)); -- if (copy == Z_NULL) return Z_MEM_ERROR; -- window = Z_NULL; -- if (state->window != Z_NULL) { -- window = (unsigned char FAR *) -- ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); -- if (window == Z_NULL) { -- ZFREE(source, copy); -- return Z_MEM_ERROR; -- } -- } -- -- /* copy state */ -- zmemcpy(dest, source, sizeof(z_stream)); -- zmemcpy(copy, state, sizeof(struct inflate_state)); -- if (state->lencode >= state->codes && -- state->lencode <= state->codes + ENOUGH - 1) { -- copy->lencode = copy->codes + (state->lencode - state->codes); -- copy->distcode = copy->codes + (state->distcode - state->codes); -- } -- copy->next = copy->codes + (state->next - state->codes); -- if (window != Z_NULL) { -- wsize = 1U << state->wbits; -- zmemcpy(window, state->window, wsize); -- } -- copy->window = window; -- dest->state = (struct internal_state FAR *)copy; -- return Z_OK; --} -diff -ruN seqinr.orig/src/inflate.h seqinr/src/inflate.h ---- seqinr.orig/src/inflate.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inflate.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,115 +0,0 @@ --/* inflate.h -- internal inflate state definition -- * Copyright (C) 1995-2004 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* define NO_GZIP when compiling if you want to disable gzip header and -- trailer decoding by inflate(). NO_GZIP would be used to avoid linking in -- the crc code when it is not needed. For shared libraries, gzip decoding -- should be left enabled. */ --#ifndef NO_GZIP --# define GUNZIP --#endif -- --/* Possible inflate modes between inflate() calls */ --typedef enum { -- HEAD, /* i: waiting for magic header */ -- FLAGS, /* i: waiting for method and flags (gzip) */ -- TIME, /* i: waiting for modification time (gzip) */ -- OS, /* i: waiting for extra flags and operating system (gzip) */ -- EXLEN, /* i: waiting for extra length (gzip) */ -- EXTRA, /* i: waiting for extra bytes (gzip) */ -- NAME, /* i: waiting for end of file name (gzip) */ -- COMMENT, /* i: waiting for end of comment (gzip) */ -- HCRC, /* i: waiting for header crc (gzip) */ -- DICTID, /* i: waiting for dictionary check value */ -- DICT, /* waiting for inflateSetDictionary() call */ -- TYPE, /* i: waiting for type bits, including last-flag bit */ -- TYPEDO, /* i: same, but skip check to exit inflate on new block */ -- STORED, /* i: waiting for stored size (length and complement) */ -- COPY, /* i/o: waiting for input or output to copy stored block */ -- TABLE, /* i: waiting for dynamic block table lengths */ -- LENLENS, /* i: waiting for code length code lengths */ -- CODELENS, /* i: waiting for length/lit and distance code lengths */ -- LEN, /* i: waiting for length/lit code */ -- LENEXT, /* i: waiting for length extra bits */ -- DIST, /* i: waiting for distance code */ -- DISTEXT, /* i: waiting for distance extra bits */ -- MATCH, /* o: waiting for output space to copy string */ -- LIT, /* o: waiting for output space to write literal */ -- CHECK, /* i: waiting for 32-bit check value */ -- LENGTH, /* i: waiting for 32-bit length (gzip) */ -- DONE, /* finished check, done -- remain here until reset */ -- BAD, /* got a data error -- remain here until reset */ -- MEM, /* got an inflate() memory error -- remain here until reset */ -- SYNC /* looking for synchronization bytes to restart inflate() */ --} inflate_mode; -- --/* -- State transitions between above modes - -- -- (most modes can go to the BAD or MEM mode -- not shown for clarity) -- -- Process header: -- HEAD -> (gzip) or (zlib) -- (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -- NAME -> COMMENT -> HCRC -> TYPE -- (zlib) -> DICTID or TYPE -- DICTID -> DICT -> TYPE -- Read deflate blocks: -- TYPE -> STORED or TABLE or LEN or CHECK -- STORED -> COPY -> TYPE -- TABLE -> LENLENS -> CODELENS -> LEN -- Read deflate codes: -- LEN -> LENEXT or LIT or TYPE -- LENEXT -> DIST -> DISTEXT -> MATCH -> LEN -- LIT -> LEN -- Process trailer: -- CHECK -> LENGTH -> DONE -- */ -- --/* state maintained between inflate() calls. Approximately 7K bytes. */ --struct inflate_state { -- inflate_mode mode; /* current inflate mode */ -- int last; /* true if processing last block */ -- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ -- int havedict; /* true if dictionary provided */ -- int flags; /* gzip header method and flags (0 if zlib) */ -- unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ -- unsigned long check; /* protected copy of check value */ -- unsigned long total; /* protected copy of output count */ -- gz_headerp head; /* where to save gzip header information */ -- /* sliding window */ -- unsigned wbits; /* log base 2 of requested window size */ -- unsigned wsize; /* window size or zero if not using window */ -- unsigned whave; /* valid bytes in the window */ -- unsigned write; /* window write index */ -- unsigned char FAR *window; /* allocated sliding window, if needed */ -- /* bit accumulator */ -- unsigned long hold; /* input bit accumulator */ -- unsigned bits; /* number of bits in "in" */ -- /* for string and stored block copying */ -- unsigned length; /* literal or length of data to copy */ -- unsigned offset; /* distance back to copy string from */ -- /* for table and code decoding */ -- unsigned extra; /* extra bits needed */ -- /* fixed and dynamic code tables */ -- code const FAR *lencode; /* starting table for length/literal codes */ -- code const FAR *distcode; /* starting table for distance codes */ -- unsigned lenbits; /* index bits for lencode */ -- unsigned distbits; /* index bits for distcode */ -- /* dynamic table building */ -- unsigned ncode; /* number of code length code lengths */ -- unsigned nlen; /* number of length code lengths */ -- unsigned ndist; /* number of distance code lengths */ -- unsigned have; /* number of code lengths in lens[] */ -- code FAR *next; /* next available space in codes[] */ -- unsigned short lens[320]; /* temporary storage for code lengths */ -- unsigned short work[288]; /* work area for code table building */ -- code codes[ENOUGH]; /* space for code tables */ --}; -diff -ruN seqinr.orig/src/inftrees.c seqinr/src/inftrees.c ---- seqinr.orig/src/inftrees.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inftrees.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,333 +0,0 @@ --/* inftrees.c -- generate Huffman trees for efficient decoding -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --#include "zutil.h" --#include "inftrees.h" -- --#define MAXBITS 15 -- --const char inflate_copyright[] = -- " inflate 1.2.3 Copyright 1995-2005 Mark Adler "; --/* -- If you use the zlib library in a product, an acknowledgment is welcome -- in the documentation of your product. If for some reason you cannot -- include such an acknowledgment, I would appreciate that you keep this -- copyright string in the executable of your product. -- */ -- --/* -- Build a set of tables to decode the provided canonical Huffman code. -- The code lengths are lens[0..codes-1]. The result starts at *table, -- whose indices are 0..2^bits-1. work is a writable array of at least -- lens shorts, which is used as a work area. type is the type of code -- to be generated, CODES, LENS, or DISTS. On return, zero is success, -- -1 is an invalid code, and +1 means that ENOUGH isn't enough. table -- on return points to the next available entry's address. bits is the -- requested root table index bits, and on return it is the actual root -- table index bits. It will differ if the request is greater than the -- longest code or if it is less than the shortest code. -- */ --int inflate_table(codetype type, unsigned short FAR *lens, unsigned codes, -- code FAR * FAR * table, unsigned FAR *bits, -- unsigned short FAR *work) --/* --codetype type; --unsigned short FAR *lens; --unsigned codes; --code FAR * FAR *table; --unsigned FAR *bits; --unsigned short FAR *work; --*/ --{ -- unsigned len; /* a code's length in bits */ -- unsigned sym; /* index of code symbols */ -- unsigned min, max; /* minimum and maximum code lengths */ -- unsigned root; /* number of index bits for root table */ -- unsigned curr; /* number of index bits for current table */ -- unsigned drop; /* code bits to drop for sub-table */ -- int left; /* number of prefix codes available */ -- unsigned used; /* code entries in table used */ -- unsigned huff; /* Huffman code */ -- unsigned incr; /* for incrementing code, index */ -- unsigned fill; /* index for replicating entries */ -- unsigned low; /* low bits for current root entry */ -- unsigned mask; /* mask for low root bits */ -- code This; /* table entry for duplication */ -- code FAR *next; /* next available space in table */ -- const unsigned short FAR *base; /* base value table to use */ -- const unsigned short FAR *extra; /* extra bits table to use */ -- int end; /* use base and extra for symbol > end */ -- unsigned short count[MAXBITS+1]; /* number of codes of each length */ -- unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ -- static const unsigned short lbase[31] = { /* Length codes 257..285 base */ -- 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, -- 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; -- static const unsigned short lext[31] = { /* Length codes 257..285 extra */ -- 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, -- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 201, 196}; -- static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ -- 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, -- 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, -- 8193, 12289, 16385, 24577, 0, 0}; -- static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ -- 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, -- 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, -- 28, 28, 29, 29, 64, 64}; -- -- /* -- Process a set of code lengths to create a canonical Huffman code. The -- code lengths are lens[0..codes-1]. Each length corresponds to the -- symbols 0..codes-1. The Huffman code is generated by first sorting the -- symbols by length from short to long, and retaining the symbol order -- for codes with equal lengths. Then the code starts with all zero bits -- for the first code of the shortest length, and the codes are integer -- increments for the same length, and zeros are appended as the length -- increases. For the deflate format, these bits are stored backwards -- from their more natural integer increment ordering, and so when the -- decoding tables are built in the large loop below, the integer codes -- are incremented backwards. -- -- This routine assumes, but does not check, that all of the entries in -- lens[] are in the range 0..MAXBITS. The caller must assure this. -- 1..MAXBITS is interpreted as that code length. zero means that that -- symbol does not occur in this code. -- -- The codes are sorted by computing a count of codes for each length, -- creating from that a table of starting indices for each length in the -- sorted table, and then entering the symbols in order in the sorted -- table. The sorted table is work[], with that space being provided by -- the caller. -- -- The length counts are used for other purposes as well, i.e. finding -- the minimum and maximum length codes, determining if there are any -- codes at all, checking for a valid set of lengths, and looking ahead -- at length counts to determine sub-table sizes when building the -- decoding tables. -- */ -- -- /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ -- for (len = 0; len <= MAXBITS; len++) -- count[len] = 0; -- for (sym = 0; sym < codes; sym++) -- count[lens[sym]]++; -- -- /* bound code lengths, force root to be within code lengths */ -- root = *bits; -- for (max = MAXBITS; max >= 1; max--) -- if (count[max] != 0) break; -- if (root > max) root = max; -- if (max == 0) { /* no symbols to code at all */ -- This.op = (unsigned char)64; /* invalid code marker */ -- This.bits = (unsigned char)1; -- This.val = (unsigned short)0; -- *(*table)++ = This; /* make a table to force an error */ -- *(*table)++ = This; -- *bits = 1; -- return 0; /* no symbols, but wait for decoding to report error */ -- } -- for (min = 1; min <= MAXBITS; min++) -- if (count[min] != 0) break; -- if (root < min) root = min; -- -- /* check for an over-subscribed or incomplete set of lengths */ -- left = 1; -- for (len = 1; len <= MAXBITS; len++) { -- left <<= 1; -- left -= count[len]; -- if (left < 0) return -1; /* over-subscribed */ -- } -- if (left > 0 && (type == CODES || max != 1)) -- return -1; /* incomplete set */ -- -- /* generate offsets into symbol table for each length for sorting */ -- offs[1] = 0; -- for (len = 1; len < MAXBITS; len++) -- offs[len + 1] = offs[len] + count[len]; -- -- /* sort symbols by length, by symbol order within each length */ -- for (sym = 0; sym < codes; sym++) -- if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; -- -- /* -- Create and fill in decoding tables. In this loop, the table being -- filled is at next and has curr index bits. The code being used is huff -- with length len. That code is converted to an index by dropping drop -- bits off of the bottom. For codes where len is less than drop + curr, -- those top drop + curr - len bits are incremented through all values to -- fill the table with replicated entries. -- -- root is the number of index bits for the root table. When len exceeds -- root, sub-tables are created pointed to by the root entry with an index -- of the low root bits of huff. This is saved in low to check for when a -- new sub-table should be started. drop is zero when the root table is -- being filled, and drop is root when sub-tables are being filled. -- -- When a new sub-table is needed, it is necessary to look ahead in the -- code lengths to determine what size sub-table is needed. The length -- counts are used for this, and so count[] is decremented as codes are -- entered in the tables. -- -- used keeps track of how many table entries have been allocated from the -- provided *table space. It is checked when a LENS table is being made -- against the space in *table, ENOUGH, minus the maximum space needed by -- the worst case distance code, MAXD. This should never happen, but the -- sufficiency of ENOUGH has not been proven exhaustively, hence the check. -- This assumes that when type == LENS, bits == 9. -- -- sym increments through all symbols, and the loop terminates when -- all codes of length max, i.e. all codes, have been processed. This -- routine permits incomplete codes, so another loop after this one fills -- in the rest of the decoding tables with invalid code markers. -- */ -- -- /* set up for code type */ -- switch (type) { -- case CODES: -- base = extra = work; /* dummy value--not used */ -- end = 19; -- break; -- case LENS: -- base = lbase; -- base -= 257; -- extra = lext; -- extra -= 257; -- end = 256; -- break; -- default: /* DISTS */ -- base = dbase; -- extra = dext; -- end = -1; -- } -- -- /* initialize state for loop */ -- huff = 0; /* starting code */ -- sym = 0; /* starting code symbol */ -- len = min; /* starting code length */ -- next = *table; /* current table to fill in */ -- curr = root; /* current table index bits */ -- drop = 0; /* current bits to drop from code for index */ -- low = (unsigned)(-1); /* trigger new sub-table when len > root */ -- used = 1U << root; /* use root table entries */ -- mask = used - 1; /* mask for comparing low */ -- -- /* check available table space */ -- if (type == LENS && used >= ENOUGH - MAXD) -- return 1; -- -- /* process all codes and make table entries */ -- for (;;) { -- /* create table entry */ -- This.bits = (unsigned char)(len - drop); -- if ((int)(work[sym]) < end) { -- This.op = (unsigned char)0; -- This.val = work[sym]; -- } -- else if ((int)(work[sym]) > end) { -- This.op = (unsigned char)(extra[work[sym]]); -- This.val = base[work[sym]]; -- } -- else { -- This.op = (unsigned char)(32 + 64); /* end of block */ -- This.val = 0; -- } -- -- /* replicate for those indices with low len bits equal to huff */ -- incr = 1U << (len - drop); -- fill = 1U << curr; -- min = fill; /* save offset to next table */ -- do { -- fill -= incr; -- next[(huff >> drop) + fill] = This; -- } while (fill != 0); -- -- /* backwards increment the len-bit code huff */ -- incr = 1U << (len - 1); -- while (huff & incr) -- incr >>= 1; -- if (incr != 0) { -- huff &= incr - 1; -- huff += incr; -- } -- else -- huff = 0; -- -- /* go to next symbol, update count, len */ -- sym++; -- if (--(count[len]) == 0) { -- if (len == max) break; -- len = lens[work[sym]]; -- } -- -- /* create new sub-table if needed */ -- if (len > root && (huff & mask) != low) { -- /* if first time, transition to sub-tables */ -- if (drop == 0) -- drop = root; -- -- /* increment past last table */ -- next += min; /* here min is 1 << curr */ -- -- /* determine length of next table */ -- curr = len - drop; -- left = (int)(1 << curr); -- while (curr + drop < max) { -- left -= count[curr + drop]; -- if (left <= 0) break; -- curr++; -- left <<= 1; -- } -- -- /* check for enough space */ -- used += 1U << curr; -- if (type == LENS && used >= ENOUGH - MAXD) -- return 1; -- -- /* point entry in root table to sub-table */ -- low = huff & mask; -- (*table)[low].op = (unsigned char)curr; -- (*table)[low].bits = (unsigned char)root; -- (*table)[low].val = (unsigned short)(next - *table); -- } -- } -- -- /* -- Fill in rest of table for incomplete codes. This loop is similar to the -- loop above in incrementing huff for table indices. It is assumed that -- len is equal to curr + drop, so there is no loop needed to increment -- through high index bits. When the current sub-table is filled, the loop -- drops back to the root table to fill in any remaining entries there. -- */ -- This.op = (unsigned char)64; /* invalid code marker */ -- This.bits = (unsigned char)(len - drop); -- This.val = (unsigned short)0; -- while (huff != 0) { -- /* when done with sub-table, drop back to root table */ -- if (drop != 0 && (huff & mask) != low) { -- drop = 0; -- len = root; -- next = *table; -- This.bits = (unsigned char)len; -- } -- -- /* put invalid code marker in table */ -- next[huff >> drop] = This; -- -- /* backwards increment the len-bit code huff */ -- incr = 1U << (len - 1); -- while (huff & incr) -- incr >>= 1; -- if (incr != 0) { -- huff &= incr - 1; -- huff += incr; -- } -- else -- huff = 0; -- } -- -- /* set return parameters */ -- *table += used; -- *bits = root; -- return 0; --} -diff -ruN seqinr.orig/src/inftrees.h seqinr/src/inftrees.h ---- seqinr.orig/src/inftrees.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/inftrees.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,55 +0,0 @@ --/* inftrees.h -- header to use inftrees.c -- * Copyright (C) 1995-2005 Mark Adler -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* Structure for decoding tables. Each entry provides either the -- information needed to do the operation requested by the code that -- indexed that table entry, or it provides a pointer to another -- table that indexes more bits of the code. op indicates whether -- the entry is a pointer to another table, a literal, a length or -- distance, an end-of-block, or an invalid code. For a table -- pointer, the low four bits of op is the number of index bits of -- that table. For a length or distance, the low four bits of op -- is the number of extra bits to get after the code. bits is -- the number of bits in this code or part of the code to drop off -- of the bit buffer. val is the actual byte to output in the case -- of a literal, the base length or distance, or the offset from -- the current table to the next table. Each entry is four bytes. */ --typedef struct { -- unsigned char op; /* operation, extra bits, table bits */ -- unsigned char bits; /* bits in this part of the code */ -- unsigned short val; /* offset in table or code value */ --} code; -- --/* op values as set by inflate_table(): -- 00000000 - literal -- 0000tttt - table link, tttt != 0 is the number of table index bits -- 0001eeee - length or distance, eeee is the number of extra bits -- 01100000 - end of block -- 01000000 - invalid code -- */ -- --/* Maximum size of dynamic tree. The maximum found in a long but non- -- exhaustive search was 1444 code structures (852 for length/literals -- and 592 for distances, the latter actually the result of an -- exhaustive search). The true maximum is not known, but the value -- below is more than safe. */ --#define ENOUGH 2048 --#define MAXD 592 -- --/* Type of code to build for inftable() */ --typedef enum { -- CODES, -- LENS, -- DISTS --} codetype; -- --extern int inflate_table OF((codetype type, unsigned short FAR *lens, -- unsigned codes, code FAR * FAR *table, -- unsigned FAR *bits, unsigned short FAR *work)); -diff -ruN seqinr.orig/src/Makevars seqinr/src/Makevars ---- seqinr.orig/src/Makevars 2007-04-19 14:23:37.000000000 +0200 -+++ seqinr/src/Makevars 2009-05-17 21:38:04.000000000 +0200 -@@ -1 +1,2 @@ - PKG_CFLAGS = -DUSE_TYPE_CHECKING_STRICT -+PKG_LIBS=-lz -diff -ruN seqinr.orig/src/trees.c seqinr/src/trees.c ---- seqinr.orig/src/trees.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/trees.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1249 +0,0 @@ --/* trees.c -- output deflated data using Huffman coding -- * Copyright (C) 1995-2005 Jean-loup Gailly -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* -- * ALGORITHM -- * -- * The "deflation" process uses several Huffman trees. The more -- * common source values are represented by shorter bit sequences. -- * -- * Each code tree is stored in a compressed form which is itself -- * a Huffman encoding of the lengths of all the code strings (in -- * ascending order by source values). The actual code strings are -- * reconstructed from the lengths in the inflate process, as described -- * in the deflate specification. -- * -- * REFERENCES -- * -- * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". -- * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc -- * -- * Storer, James A. -- * Data Compression: Methods and Theory, pp. 49-50. -- * Computer Science Press, 1988. ISBN 0-7167-8156-5. -- * -- * Sedgewick, R. -- * Algorithms, p290. -- * Addison-Wesley, 1983. ISBN 0-201-06672-6. -- */ -- --/* @(#) $Id: trees.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ -- --/* #define GEN_TREES_H */ -- --#include "deflate.h" -- --#ifdef DEBUG --# include --#endif -- --/* =========================================================================== -- * Constants -- */ -- --#define MAX_BL_BITS 7 --/* Bit length codes must not exceed MAX_BL_BITS bits */ -- --#define END_BLOCK 256 --/* end of block literal code */ -- --#define REP_3_6 16 --/* repeat previous bit length 3-6 times (2 bits of repeat count) */ -- --#define REPZ_3_10 17 --/* repeat a zero length 3-10 times (3 bits of repeat count) */ -- --#define REPZ_11_138 18 --/* repeat a zero length 11-138 times (7 bits of repeat count) */ -- --local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ -- = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; -- --local const int extra_dbits[D_CODES] /* extra bits for each distance code */ -- = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; -- --local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ -- = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; -- --local const uch bl_order[BL_CODES] -- = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; --/* The lengths of the bit length codes are sent in order of decreasing -- * probability, to avoid transmitting the lengths for unused bit length codes. -- */ -- --#define Buf_size (8 * 2*sizeof(char)) --/* Number of bits used within bi_buf. (bi_buf might be implemented on -- * more than 16 bits on some systems.) -- */ -- --/* =========================================================================== -- * Local data. These are initialized only once. -- */ -- --#define DIST_CODE_LEN 512 /* see definition of array dist_code below */ -- --#if defined(GEN_TREES_H) || !defined(STDC) --/* non ANSI compilers may not accept trees.h */ -- --local ct_data static_ltree[L_CODES+2]; --/* The static literal tree. Since the bit lengths are imposed, there is no -- * need for the L_CODES extra codes used during heap construction. However -- * The codes 286 and 287 are needed to build a canonical tree (see _tr_init -- * below). -- */ -- --local ct_data static_dtree[D_CODES]; --/* The static distance tree. (Actually a trivial tree since all codes use -- * 5 bits.) -- */ -- --uch _dist_code[DIST_CODE_LEN]; --/* Distance codes. The first 256 values correspond to the distances -- * 3 .. 258, the last 256 values correspond to the top 8 bits of -- * the 15 bit distances. -- */ -- --uch _length_code[MAX_MATCH-MIN_MATCH+1]; --/* length code for each normalized match length (0 == MIN_MATCH) */ -- --local int base_length[LENGTH_CODES]; --/* First normalized length for each code (0 = MIN_MATCH) */ -- --local int base_dist[D_CODES]; --/* First normalized distance for each code (0 = distance of 1) */ -- --#else --# include "trees.h" --#endif /* GEN_TREES_H */ -- --struct static_tree_desc_s { -- const ct_data *static_tree; /* static tree or NULL */ -- const intf *extra_bits; /* extra bits for each code or NULL */ -- int extra_base; /* base index for extra_bits */ -- int elems; /* max number of elements in the tree */ -- int max_length; /* max bit length for the codes */ --}; -- --local static_tree_desc static_l_desc = --{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; -- --local static_tree_desc static_d_desc = --{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; -- --local static_tree_desc static_bl_desc = --{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; -- --/* =========================================================================== -- * Local (static) routines in this file. -- */ -- --local void tr_static_init OF((void)); --local void init_block OF((deflate_state *s)); --local void pqdownheap OF((deflate_state *s, ct_data *tree, int k)); --local void gen_bitlen OF((deflate_state *s, tree_desc *desc)); --local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count)); --local void build_tree OF((deflate_state *s, tree_desc *desc)); --local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code)); --local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); --local int build_bl_tree OF((deflate_state *s)); --local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, -- int blcodes)); --local void compress_block OF((deflate_state *s, ct_data *ltree, -- ct_data *dtree)); --local void set_data_type OF((deflate_state *s)); --local unsigned bi_reverse OF((unsigned value, int length)); --local void bi_windup OF((deflate_state *s)); --local void bi_flush OF((deflate_state *s)); --local void copy_block OF((deflate_state *s, charf *buf, unsigned len, -- int header)); -- --#ifdef GEN_TREES_H --local void gen_trees_header OF((void)); --#endif -- --#ifndef DEBUG --# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) -- /* Send a code of the given tree. c and tree must not have side effects */ -- --#else /* DEBUG */ --# define send_code(s, c, tree) \ -- { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ -- send_bits(s, tree[c].Code, tree[c].Len); } --#endif -- --/* =========================================================================== -- * Output a short LSB first on the stream. -- * IN assertion: there is enough room in pendingBuf. -- */ --#define put_short(s, w) { \ -- put_byte(s, (uch)((w) & 0xff)); \ -- put_byte(s, (uch)((ush)(w) >> 8)); \ --} -- --/* =========================================================================== -- * Send a value on a given number of bits. -- * IN assertion: length <= 16 and value fits in length bits. -- */ --#ifdef DEBUG --local void send_bits OF((deflate_state *s, int value, int length)); -- --local void send_bits(s, value, length) -- deflate_state *s; -- int value; /* value to send */ -- int length; /* number of bits */ --{ -- Tracevv((stderr," l %2d v %4x ", length, value)); -- Assert(length > 0 && length <= 15, "invalid length"); -- s->bits_sent += (ulg)length; -- -- /* If not enough room in bi_buf, use (valid) bits from bi_buf and -- * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) -- * unused bits in value. -- */ -- if (s->bi_valid > (int)Buf_size - length) { -- s->bi_buf |= (value << s->bi_valid); -- put_short(s, s->bi_buf); -- s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); -- s->bi_valid += length - Buf_size; -- } else { -- s->bi_buf |= value << s->bi_valid; -- s->bi_valid += length; -- } --} --#else /* !DEBUG */ -- --#define send_bits(s, value, length) \ --{ int len = length;\ -- if (s->bi_valid > (int)Buf_size - len) {\ -- int val = value;\ -- s->bi_buf |= (val << s->bi_valid);\ -- put_short(s, s->bi_buf);\ -- s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ -- s->bi_valid += len - Buf_size;\ -- } else {\ -- s->bi_buf |= (value) << s->bi_valid;\ -- s->bi_valid += len;\ -- }\ --} --#endif /* DEBUG */ -- -- --/* the arguments must not have side effects */ -- --/* =========================================================================== -- * Initialize the various 'constant' tables. -- */ --local void tr_static_init() --{ --#if defined(GEN_TREES_H) || !defined(STDC) -- static int static_init_done = 0; -- int n; /* iterates over tree elements */ -- int bits; /* bit counter */ -- int length; /* length value */ -- int code; /* code value */ -- int dist; /* distance index */ -- ush bl_count[MAX_BITS+1]; -- /* number of codes at each bit length for an optimal tree */ -- -- if (static_init_done) return; -- -- /* For some embedded targets, global variables are not initialized: */ -- static_l_desc.static_tree = static_ltree; -- static_l_desc.extra_bits = extra_lbits; -- static_d_desc.static_tree = static_dtree; -- static_d_desc.extra_bits = extra_dbits; -- static_bl_desc.extra_bits = extra_blbits; -- -- /* Initialize the mapping length (0..255) -> length code (0..28) */ -- length = 0; -- for (code = 0; code < LENGTH_CODES-1; code++) { -- base_length[code] = length; -- for (n = 0; n < (1< dist code (0..29) */ -- dist = 0; -- for (code = 0 ; code < 16; code++) { -- base_dist[code] = dist; -- for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ -- for ( ; code < D_CODES; code++) { -- base_dist[code] = dist << 7; -- for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { -- _dist_code[256 + dist++] = (uch)code; -- } -- } -- Assert (dist == 256, "tr_static_init: 256+dist != 512"); -- -- /* Construct the codes of the static literal tree */ -- for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; -- n = 0; -- while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; -- while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; -- while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; -- while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; -- /* Codes 286 and 287 do not exist, but we must include them in the -- * tree construction to get a canonical Huffman tree (longest code -- * all ones) -- */ -- gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); -- -- /* The static distance tree is trivial: */ -- for (n = 0; n < D_CODES; n++) { -- static_dtree[n].Len = 5; -- static_dtree[n].Code = bi_reverse((unsigned)n, 5); -- } -- static_init_done = 1; -- --# ifdef GEN_TREES_H -- gen_trees_header(); --# endif --#endif /* defined(GEN_TREES_H) || !defined(STDC) */ --} -- --/* =========================================================================== -- * Genererate the file trees.h describing the static trees. -- */ --#ifdef GEN_TREES_H --# ifndef DEBUG --# include --# endif -- --# define SEPARATOR(i, last, width) \ -- ((i) == (last)? "\n};\n\n" : \ -- ((i) % (width) == (width)-1 ? ",\n" : ", ")) -- --void gen_trees_header() --{ -- FILE *header = fopen("trees.h", "w"); -- int i; -- -- Assert (header != NULL, "Can't open trees.h"); -- fprintf(header, -- "/* header created automatically with -DGEN_TREES_H */\n\n"); -- -- fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); -- for (i = 0; i < L_CODES+2; i++) { -- fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, -- static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); -- } -- -- fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); -- for (i = 0; i < D_CODES; i++) { -- fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, -- static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); -- } -- -- fprintf(header, "const uch _dist_code[DIST_CODE_LEN] = {\n"); -- for (i = 0; i < DIST_CODE_LEN; i++) { -- fprintf(header, "%2u%s", _dist_code[i], -- SEPARATOR(i, DIST_CODE_LEN-1, 20)); -- } -- -- fprintf(header, "const uch _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); -- for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { -- fprintf(header, "%2u%s", _length_code[i], -- SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); -- } -- -- fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); -- for (i = 0; i < LENGTH_CODES; i++) { -- fprintf(header, "%1u%s", base_length[i], -- SEPARATOR(i, LENGTH_CODES-1, 20)); -- } -- -- fprintf(header, "local const int base_dist[D_CODES] = {\n"); -- for (i = 0; i < D_CODES; i++) { -- fprintf(header, "%5u%s", base_dist[i], -- SEPARATOR(i, D_CODES-1, 10)); -- } -- -- fclose(header); --} --#endif /* GEN_TREES_H */ -- --/* =========================================================================== -- * Initialize the tree data structures for a new zlib stream. -- */ --void _tr_init(deflate_state *s) --/* -- deflate_state *s; --*/ --{ -- tr_static_init(); -- -- s->l_desc.dyn_tree = s->dyn_ltree; -- s->l_desc.stat_desc = &static_l_desc; -- -- s->d_desc.dyn_tree = s->dyn_dtree; -- s->d_desc.stat_desc = &static_d_desc; -- -- s->bl_desc.dyn_tree = s->bl_tree; -- s->bl_desc.stat_desc = &static_bl_desc; -- -- s->bi_buf = 0; -- s->bi_valid = 0; -- s->last_eob_len = 8; /* enough lookahead for inflate */ --#ifdef DEBUG -- s->compressed_len = 0L; -- s->bits_sent = 0L; --#endif -- -- /* Initialize the first block of the first file: */ -- init_block(s); --} -- --/* =========================================================================== -- * Initialize a new block. -- */ --local void init_block(deflate_state *s) --/* deflate_state *s;*/ --{ -- int n; /* iterates over tree elements */ -- -- /* Initialize the trees. */ -- for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; -- for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; -- for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; -- -- s->dyn_ltree[END_BLOCK].Freq = 1; -- s->opt_len = s->static_len = 0L; -- s->last_lit = s->matches = 0; --} -- --#define SMALLEST 1 --/* Index within the heap array of least frequent node in the Huffman tree */ -- -- --/* =========================================================================== -- * Remove the smallest element from the heap and recreate the heap with -- * one less element. Updates heap and heap_len. -- */ --#define pqremove(s, tree, top) \ --{\ -- top = s->heap[SMALLEST]; \ -- s->heap[SMALLEST] = s->heap[s->heap_len--]; \ -- pqdownheap(s, tree, SMALLEST); \ --} -- --/* =========================================================================== -- * Compares to subtrees, using the tree depth as tie breaker when -- * the subtrees have equal frequency. This minimizes the worst case length. -- */ --#define smaller(tree, n, m, depth) \ -- (tree[n].Freq < tree[m].Freq || \ -- (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) -- --/* =========================================================================== -- * Restore the heap property by moving down the tree starting at node k, -- * exchanging a node with the smallest of its two sons if necessary, stopping -- * when the heap property is re-established (each father smaller than its -- * two sons). -- */ --local void pqdownheap(deflate_state *s, ct_data *tree, int k) --#if 0 -- deflate_state *s; -- ct_data *tree; /* the tree to restore */ -- int k; /* node to move down */ --#endif --{ -- int v = s->heap[k]; -- int j = k << 1; /* left son of k */ -- while (j <= s->heap_len) { -- /* Set j to the smallest of the two sons: */ -- if (j < s->heap_len && -- smaller(tree, s->heap[j+1], s->heap[j], s->depth)) { -- j++; -- } -- /* Exit if v is smaller than both sons */ -- if (smaller(tree, v, s->heap[j], s->depth)) break; -- -- /* Exchange v with the smallest son */ -- s->heap[k] = s->heap[j]; k = j; -- -- /* And continue down the tree, setting j to the left son of k */ -- j <<= 1; -- } -- s->heap[k] = v; --} -- --/* =========================================================================== -- * Compute the optimal bit lengths for a tree and update the total bit length -- * for the current block. -- * IN assertion: the fields freq and dad are set, heap[heap_max] and -- * above are the tree nodes sorted by increasing frequency. -- * OUT assertions: the field len is set to the optimal bit length, the -- * array bl_count contains the frequencies for each bit length. -- * The length opt_len is updated; static_len is also updated if stree is -- * not null. -- */ --local void gen_bitlen(deflate_state *s, tree_desc *desc) --#if 0 -- deflate_state *s; -- tree_desc *desc; /* the tree descriptor */ --#endif --{ -- ct_data *tree = desc->dyn_tree; -- int max_code = desc->max_code; -- const ct_data *stree = desc->stat_desc->static_tree; -- const intf *extra = desc->stat_desc->extra_bits; -- int base = desc->stat_desc->extra_base; -- int max_length = desc->stat_desc->max_length; -- int h; /* heap index */ -- int n, m; /* iterate over the tree elements */ -- int bits; /* bit length */ -- int xbits; /* extra bits */ -- ush f; /* frequency */ -- int overflow = 0; /* number of elements with bit length too large */ -- -- for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; -- -- /* In a first pass, compute the optimal bit lengths (which may -- * overflow in the case of the bit length tree). -- */ -- tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ -- -- for (h = s->heap_max+1; h < HEAP_SIZE; h++) { -- n = s->heap[h]; -- bits = tree[tree[n].Dad].Len + 1; -- if (bits > max_length) bits = max_length, overflow++; -- tree[n].Len = (ush)bits; -- /* We overwrite tree[n].Dad which is no longer needed */ -- -- if (n > max_code) continue; /* not a leaf node */ -- -- s->bl_count[bits]++; -- xbits = 0; -- if (n >= base) xbits = extra[n-base]; -- f = tree[n].Freq; -- s->opt_len += (ulg)f * (bits + xbits); -- if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits); -- } -- if (overflow == 0) return; -- -- Trace((stderr,"\nbit length overflow\n")); -- /* This happens for example on obj2 and pic of the Calgary corpus */ -- -- /* Find the first bit length which could increase: */ -- do { -- bits = max_length-1; -- while (s->bl_count[bits] == 0) bits--; -- s->bl_count[bits]--; /* move one leaf down the tree */ -- s->bl_count[bits+1] += 2; /* move one overflow item as its brother */ -- s->bl_count[max_length]--; -- /* The brother of the overflow item also moves one step up, -- * but this does not affect bl_count[max_length] -- */ -- overflow -= 2; -- } while (overflow > 0); -- -- /* Now recompute all bit lengths, scanning in increasing frequency. -- * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all -- * lengths instead of fixing only the wrong ones. This idea is taken -- * from 'ar' written by Haruhiko Okumura.) -- */ -- for (bits = max_length; bits != 0; bits--) { -- n = s->bl_count[bits]; -- while (n != 0) { -- m = s->heap[--h]; -- if (m > max_code) continue; -- if ((unsigned) tree[m].Len != (unsigned) bits) { -- Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); -- s->opt_len += ((long)bits - (long)tree[m].Len) -- *(long)tree[m].Freq; -- tree[m].Len = (ush)bits; -- } -- n--; -- } -- } --} -- --/* =========================================================================== -- * Generate the codes for a given tree and bit counts (which need not be -- * optimal). -- * IN assertion: the array bl_count contains the bit length statistics for -- * the given tree and the field len is set for all tree elements. -- * OUT assertion: the field code is set for all tree elements of non -- * zero code length. -- */ --local void gen_codes (ct_data *tree, int max_code, ushf *bl_count) --#if 0 -- ct_data *tree; /* the tree to decorate */ -- int max_code; /* largest code with non zero frequency */ -- ushf *bl_count; /* number of codes at each bit length */ --#endif --{ -- ush next_code[MAX_BITS+1]; /* next code value for each bit length */ -- ush code = 0; /* running code value */ -- int bits; /* bit index */ -- int n; /* code index */ -- -- /* The distribution counts are first used to generate the code values -- * without bit reversal. -- */ -- for (bits = 1; bits <= MAX_BITS; bits++) { -- next_code[bits] = code = (code + bl_count[bits-1]) << 1; -- } -- /* Check that the bit counts in bl_count are consistent. The last code -- * must be all ones. -- */ -- Assert (code + bl_count[MAX_BITS]-1 == (1<dyn_tree; -- const ct_data *stree = desc->stat_desc->static_tree; -- int elems = desc->stat_desc->elems; -- int n, m; /* iterate over heap elements */ -- int max_code = -1; /* largest code with non zero frequency */ -- int node; /* new node being created */ -- -- /* Construct the initial heap, with least frequent element in -- * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. -- * heap[0] is not used. -- */ -- s->heap_len = 0, s->heap_max = HEAP_SIZE; -- -- for (n = 0; n < elems; n++) { -- if (tree[n].Freq != 0) { -- s->heap[++(s->heap_len)] = max_code = n; -- s->depth[n] = 0; -- } else { -- tree[n].Len = 0; -- } -- } -- -- /* The pkzip format requires that at least one distance code exists, -- * and that at least one bit should be sent even if there is only one -- * possible code. So to avoid special checks later on we force at least -- * two codes of non zero frequency. -- */ -- while (s->heap_len < 2) { -- node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); -- tree[node].Freq = 1; -- s->depth[node] = 0; -- s->opt_len--; if (stree) s->static_len -= stree[node].Len; -- /* node is 0 or 1 so it does not have extra bits */ -- } -- desc->max_code = max_code; -- -- /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, -- * establish sub-heaps of increasing lengths: -- */ -- for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); -- -- /* Construct the Huffman tree by repeatedly combining the least two -- * frequent nodes. -- */ -- node = elems; /* next internal node of the tree */ -- do { -- pqremove(s, tree, n); /* n = node of least frequency */ -- m = s->heap[SMALLEST]; /* m = node of next least frequency */ -- -- s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ -- s->heap[--(s->heap_max)] = m; -- -- /* Create a new node father of n and m */ -- tree[node].Freq = tree[n].Freq + tree[m].Freq; -- s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? -- s->depth[n] : s->depth[m]) + 1); -- tree[n].Dad = tree[m].Dad = (ush)node; --#ifdef DUMP_BL_TREE -- if (tree == s->bl_tree) { -- fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", -- node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); -- } --#endif -- /* and insert the new node in the heap */ -- s->heap[SMALLEST] = node++; -- pqdownheap(s, tree, SMALLEST); -- -- } while (s->heap_len >= 2); -- -- s->heap[--(s->heap_max)] = s->heap[SMALLEST]; -- -- /* At this point, the fields freq and dad are set. We can now -- * generate the bit lengths. -- */ -- gen_bitlen(s, (tree_desc *)desc); -- -- /* The field len is now set, we can generate the bit codes */ -- gen_codes ((ct_data *)tree, max_code, s->bl_count); --} -- --/* =========================================================================== -- * Scan a literal or distance tree to determine the frequencies of the codes -- * in the bit length tree. -- */ --local void scan_tree (deflate_state *s, ct_data *tree, int max_code) --#if 0 -- deflate_state *s; -- ct_data *tree; /* the tree to be scanned */ -- int max_code; /* and its largest code of non zero frequency */ --#endif --{ -- int n; /* iterates over all tree elements */ -- int prevlen = -1; /* last emitted length */ -- int curlen; /* length of current code */ -- int nextlen = tree[0].Len; /* length of next code */ -- int count = 0; /* repeat count of the current code */ -- int max_count = 7; /* max repeat count */ -- int min_count = 4; /* min repeat count */ -- -- if (nextlen == 0) max_count = 138, min_count = 3; -- tree[max_code+1].Len = (ush)0xffff; /* guard */ -- -- for (n = 0; n <= max_code; n++) { -- curlen = nextlen; nextlen = tree[n+1].Len; -- if (++count < max_count && curlen == nextlen) { -- continue; -- } else if (count < min_count) { -- s->bl_tree[curlen].Freq += count; -- } else if (curlen != 0) { -- if (curlen != prevlen) s->bl_tree[curlen].Freq++; -- s->bl_tree[REP_3_6].Freq++; -- } else if (count <= 10) { -- s->bl_tree[REPZ_3_10].Freq++; -- } else { -- s->bl_tree[REPZ_11_138].Freq++; -- } -- count = 0; prevlen = curlen; -- if (nextlen == 0) { -- max_count = 138, min_count = 3; -- } else if (curlen == nextlen) { -- max_count = 6, min_count = 3; -- } else { -- max_count = 7, min_count = 4; -- } -- } --} -- --/* =========================================================================== -- * Send a literal or distance tree in compressed form, using the codes in -- * bl_tree. -- */ --local void send_tree (deflate_state *s, ct_data *tree, int max_code) --#if 0 -- deflate_state *s; -- ct_data *tree; /* the tree to be scanned */ -- int max_code; /* and its largest code of non zero frequency */ --#endif --{ -- int n; /* iterates over all tree elements */ -- int prevlen = -1; /* last emitted length */ -- int curlen; /* length of current code */ -- int nextlen = tree[0].Len; /* length of next code */ -- int count = 0; /* repeat count of the current code */ -- int max_count = 7; /* max repeat count */ -- int min_count = 4; /* min repeat count */ -- -- /* tree[max_code+1].Len = -1; */ /* guard already set */ -- if (nextlen == 0) max_count = 138, min_count = 3; -- -- for (n = 0; n <= max_code; n++) { -- curlen = nextlen; nextlen = tree[n+1].Len; -- if (++count < max_count && curlen == nextlen) { -- continue; -- } else if (count < min_count) { -- do { send_code(s, curlen, s->bl_tree); } while (--count != 0); -- -- } else if (curlen != 0) { -- if (curlen != prevlen) { -- send_code(s, curlen, s->bl_tree); count--; -- } -- Assert(count >= 3 && count <= 6, " 3_6?"); -- send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2); -- -- } else if (count <= 10) { -- send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3); -- -- } else { -- send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7); -- } -- count = 0; prevlen = curlen; -- if (nextlen == 0) { -- max_count = 138, min_count = 3; -- } else if (curlen == nextlen) { -- max_count = 6, min_count = 3; -- } else { -- max_count = 7, min_count = 4; -- } -- } --} -- --/* =========================================================================== -- * Construct the Huffman tree for the bit lengths and return the index in -- * bl_order of the last bit length code to send. -- */ --local int build_bl_tree(deflate_state *s) --#if 0 -- deflate_state *s; --#endif --{ -- int max_blindex; /* index of last bit length code of non zero freq */ -- -- /* Determine the bit length frequencies for literal and distance trees */ -- scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); -- scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); -- -- /* Build the bit length tree: */ -- build_tree(s, (tree_desc *)(&(s->bl_desc))); -- /* opt_len now includes the length of the tree representations, except -- * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. -- */ -- -- /* Determine the number of bit length codes to send. The pkzip format -- * requires that at least 4 bit length codes be sent. (appnote.txt says -- * 3 but the actual value used is 4.) -- */ -- for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { -- if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; -- } -- /* Update opt_len to include the bit length tree and counts */ -- s->opt_len += 3*(max_blindex+1) + 5+5+4; -- Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", -- s->opt_len, s->static_len)); -- -- return max_blindex; --} -- --/* =========================================================================== -- * Send the header for a block using dynamic Huffman trees: the counts, the -- * lengths of the bit length codes, the literal tree and the distance tree. -- * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. -- */ --local void send_all_trees(deflate_state *s, int lcodes, int dcodes, int blcodes) --#if 0 -- deflate_state *s; -- int lcodes, dcodes, blcodes; /* number of codes for each tree */ --#endif --{ -- int rank; /* index in bl_order */ -- -- Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); -- Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, -- "too many codes"); -- Tracev((stderr, "\nbl counts: ")); -- send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */ -- send_bits(s, dcodes-1, 5); -- send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */ -- for (rank = 0; rank < blcodes; rank++) { -- Tracev((stderr, "\nbl code %2d ", bl_order[rank])); -- send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); -- } -- Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); -- -- send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */ -- Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); -- -- send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */ -- Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); --} -- --/* =========================================================================== -- * Send a stored block -- */ --void _tr_stored_block(deflate_state *s, charf *buf, ulg stored_len, int eof) --#if 0 -- deflate_state *s; -- charf *buf; /* input block */ -- ulg stored_len; /* length of input block */ -- int eof; /* true if this is the last block for a file */ --#endif --{ -- send_bits(s, (STORED_BLOCK<<1)+eof, 3); /* send block type */ --#ifdef DEBUG -- s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; -- s->compressed_len += (stored_len + 4) << 3; --#endif -- copy_block(s, buf, (unsigned)stored_len, 1); /* with header */ --} -- --/* =========================================================================== -- * Send one empty static block to give enough lookahead for inflate. -- * This takes 10 bits, of which 7 may remain in the bit buffer. -- * The current inflate code requires 9 bits of lookahead. If the -- * last two codes for the previous block (real code plus EOB) were coded -- * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode -- * the last real code. In this case we send two empty static blocks instead -- * of one. (There are no problems if the previous block is stored or fixed.) -- * To simplify the code, we assume the worst case of last real code encoded -- * on one bit only. -- */ --void _tr_align(deflate_state *s) --/* deflate_state *s; */ --{ -- send_bits(s, STATIC_TREES<<1, 3); -- send_code(s, END_BLOCK, static_ltree); --#ifdef DEBUG -- s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ --#endif -- bi_flush(s); -- /* Of the 10 bits for the empty block, we have already sent -- * (10 - bi_valid) bits. The lookahead for the last real code (before -- * the EOB of the previous block) was thus at least one plus the length -- * of the EOB plus what we have just sent of the empty static block. -- */ -- if (1 + s->last_eob_len + 10 - s->bi_valid < 9) { -- send_bits(s, STATIC_TREES<<1, 3); -- send_code(s, END_BLOCK, static_ltree); --#ifdef DEBUG -- s->compressed_len += 10L; --#endif -- bi_flush(s); -- } -- s->last_eob_len = 7; --} -- --/* =========================================================================== -- * Determine the best encoding for the current block: dynamic trees, static -- * trees or store, and output the encoded block to the zip file. -- */ --void _tr_flush_block(deflate_state *s, charf *buf, ulg stored_len, int eof) --#if 0 -- deflate_state *s; -- charf *buf; /* input block, or NULL if too old */ -- ulg stored_len; /* length of input block */ -- int eof; /* true if this is the last block for a file */ --#endif --{ -- ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ -- int max_blindex = 0; /* index of last bit length code of non zero freq */ -- -- /* Build the Huffman trees unless a stored block is forced */ -- if (s->level > 0) { -- -- /* Check if the file is binary or text */ -- if (stored_len > 0 && s->strm->data_type == Z_UNKNOWN) -- set_data_type(s); -- -- /* Construct the literal and distance trees */ -- build_tree(s, (tree_desc *)(&(s->l_desc))); -- Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, -- s->static_len)); -- -- build_tree(s, (tree_desc *)(&(s->d_desc))); -- Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, -- s->static_len)); -- /* At this point, opt_len and static_len are the total bit lengths of -- * the compressed block data, excluding the tree representations. -- */ -- -- /* Build the bit length tree for the above two trees, and get the index -- * in bl_order of the last bit length code to send. -- */ -- max_blindex = build_bl_tree(s); -- -- /* Determine the best encoding. Compute the block lengths in bytes. */ -- opt_lenb = (s->opt_len+3+7)>>3; -- static_lenb = (s->static_len+3+7)>>3; -- -- Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", -- opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, -- s->last_lit)); -- -- if (static_lenb <= opt_lenb) opt_lenb = static_lenb; -- -- } else { -- Assert(buf != (char*)0, "lost buf"); -- opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ -- } -- --#ifdef FORCE_STORED -- if (buf != (char*)0) { /* force stored block */ --#else -- if (stored_len+4 <= opt_lenb && buf != (char*)0) { -- /* 4: two words for the lengths */ --#endif -- /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. -- * Otherwise we can't have processed more than WSIZE input bytes since -- * the last block flush, because compression would have been -- * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to -- * transform a block into a stored block. -- */ -- _tr_stored_block(s, buf, stored_len, eof); -- --#ifdef FORCE_STATIC -- } else if (static_lenb >= 0) { /* force static trees */ --#else -- } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { --#endif -- send_bits(s, (STATIC_TREES<<1)+eof, 3); -- compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); --#ifdef DEBUG -- s->compressed_len += 3 + s->static_len; --#endif -- } else { -- send_bits(s, (DYN_TREES<<1)+eof, 3); -- send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, -- max_blindex+1); -- compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); --#ifdef DEBUG -- s->compressed_len += 3 + s->opt_len; --#endif -- } -- Assert (s->compressed_len == s->bits_sent, "bad compressed size"); -- /* The above check is made mod 2^32, for files larger than 512 MB -- * and uLong implemented on 32 bits. -- */ -- init_block(s); -- -- if (eof) { -- bi_windup(s); --#ifdef DEBUG -- s->compressed_len += 7; /* align on byte boundary */ --#endif -- } -- Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3, -- s->compressed_len-7*eof)); --} -- --/* =========================================================================== -- * Save the match info and tally the frequency counts. Return true if -- * the current block must be flushed. -- */ --int _tr_tally (deflate_state *s, unsigned dist, unsigned lc) --#if 0 -- deflate_state *s; -- unsigned dist; /* distance of matched string */ -- unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ --#endif --{ -- s->d_buf[s->last_lit] = (ush)dist; -- s->l_buf[s->last_lit++] = (uch)lc; -- if (dist == 0) { -- /* lc is the unmatched char */ -- s->dyn_ltree[lc].Freq++; -- } else { -- s->matches++; -- /* Here, lc is the match length - MIN_MATCH */ -- dist--; /* dist = match distance - 1 */ -- Assert((ush)dist < (ush)MAX_DIST(s) && -- (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && -- (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); -- -- s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++; -- s->dyn_dtree[d_code(dist)].Freq++; -- } -- --#ifdef TRUNCATE_BLOCK -- /* Try to guess if it is profitable to stop the current block here */ -- if ((s->last_lit & 0x1fff) == 0 && s->level > 2) { -- /* Compute an upper bound for the compressed length */ -- ulg out_length = (ulg)s->last_lit*8L; -- ulg in_length = (ulg)((long)s->strstart - s->block_start); -- int dcode; -- for (dcode = 0; dcode < D_CODES; dcode++) { -- out_length += (ulg)s->dyn_dtree[dcode].Freq * -- (5L+extra_dbits[dcode]); -- } -- out_length >>= 3; -- Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ", -- s->last_lit, in_length, out_length, -- 100L - out_length*100L/in_length)); -- if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1; -- } --#endif -- return (s->last_lit == s->lit_bufsize-1); -- /* We avoid equality with lit_bufsize because of wraparound at 64K -- * on 16 bit machines and because stored blocks are restricted to -- * 64K-1 bytes. -- */ --} -- --/* =========================================================================== -- * Send the block data compressed using the given Huffman trees -- */ --local void compress_block(deflate_state *s, ct_data *ltree, ct_data *dtree) --#if 0 -- deflate_state *s; -- ct_data *ltree; /* literal tree */ -- ct_data *dtree; /* distance tree */ --#endif --{ -- unsigned dist; /* distance of matched string */ -- int lc; /* match length or unmatched char (if dist == 0) */ -- unsigned lx = 0; /* running index in l_buf */ -- unsigned code; /* the code to send */ -- int extra; /* number of extra bits to send */ -- -- if (s->last_lit != 0) do { -- dist = s->d_buf[lx]; -- lc = s->l_buf[lx++]; -- if (dist == 0) { -- send_code(s, lc, ltree); /* send a literal byte */ -- Tracecv(isgraph(lc), (stderr," '%c' ", lc)); -- } else { -- /* Here, lc is the match length - MIN_MATCH */ -- code = _length_code[lc]; -- send_code(s, code+LITERALS+1, ltree); /* send the length code */ -- extra = extra_lbits[code]; -- if (extra != 0) { -- lc -= base_length[code]; -- send_bits(s, lc, extra); /* send the extra length bits */ -- } -- dist--; /* dist is now the match distance - 1 */ -- code = d_code(dist); -- Assert (code < D_CODES, "bad d_code"); -- -- send_code(s, code, dtree); /* send the distance code */ -- extra = extra_dbits[code]; -- if (extra != 0) { -- dist -= base_dist[code]; -- send_bits(s, dist, extra); /* send the extra distance bits */ -- } -- } /* literal or match pair ? */ -- -- /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */ -- Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx, -- "pendingBuf overflow"); -- -- } while (lx < s->last_lit); -- -- send_code(s, END_BLOCK, ltree); -- s->last_eob_len = ltree[END_BLOCK].Len; --} -- --/* =========================================================================== -- * Set the data type to BINARY or TEXT, using a crude approximation: -- * set it to Z_TEXT if all symbols are either printable characters (33 to 255) -- * or white spaces (9 to 13, or 32); or set it to Z_BINARY otherwise. -- * IN assertion: the fields Freq of dyn_ltree are set. -- */ --local void set_data_type(deflate_state *s) --/* deflate_state *s; */ --{ -- int n; -- -- for (n = 0; n < 9; n++) -- if (s->dyn_ltree[n].Freq != 0) -- break; -- if (n == 9) -- for (n = 14; n < 32; n++) -- if (s->dyn_ltree[n].Freq != 0) -- break; -- s->strm->data_type = (n == 32) ? Z_TEXT : Z_BINARY; --} -- --/* =========================================================================== -- * Reverse the first len bits of a code, using straightforward code (a faster -- * method would use a table) -- * IN assertion: 1 <= len <= 15 -- */ --local unsigned bi_reverse(unsigned code, int len) --#if 0 -- unsigned code; /* the value to invert */ -- int len; /* its bit length */ --#endif --{ -- register unsigned res = 0; -- do { -- res |= code & 1; -- code >>= 1, res <<= 1; -- } while (--len > 0); -- return res >> 1; --} -- --/* =========================================================================== -- * Flush the bit buffer, keeping at most 7 bits in it. -- */ --local void bi_flush(deflate_state *s) --/* deflate_state *s; */ --{ -- if (s->bi_valid == 16) { -- put_short(s, s->bi_buf); -- s->bi_buf = 0; -- s->bi_valid = 0; -- } else if (s->bi_valid >= 8) { -- put_byte(s, (Byte)s->bi_buf); -- s->bi_buf >>= 8; -- s->bi_valid -= 8; -- } --} -- --/* =========================================================================== -- * Flush the bit buffer and align the output on a byte boundary -- */ --local void bi_windup(deflate_state *s) --/* deflate_state *s; */ --{ -- if (s->bi_valid > 8) { -- put_short(s, s->bi_buf); -- } else if (s->bi_valid > 0) { -- put_byte(s, (Byte)s->bi_buf); -- } -- s->bi_buf = 0; -- s->bi_valid = 0; --#ifdef DEBUG -- s->bits_sent = (s->bits_sent+7) & ~7; --#endif --} -- --/* =========================================================================== -- * Copy a stored block, storing first the length and its -- * one's complement if requested. -- */ --local void copy_block(deflate_state *s, charf *buf, unsigned len, int header) --#if 0 -- deflate_state *s; -- charf *buf; /* the input data */ -- unsigned len; /* its length */ -- int header; /* true if block header must be written */ --#endif --{ -- bi_windup(s); /* align on byte boundary */ -- s->last_eob_len = 8; /* enough lookahead for inflate */ -- -- if (header) { -- put_short(s, (ush)len); -- put_short(s, (ush)~len); --#ifdef DEBUG -- s->bits_sent += 2*16; --#endif -- } --#ifdef DEBUG -- s->bits_sent += (ulg)len<<3; --#endif -- while (len--) { -- put_byte(s, *buf++); -- } --} -diff -ruN seqinr.orig/src/trees.h seqinr/src/trees.h ---- seqinr.orig/src/trees.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/trees.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,128 +0,0 @@ --/* header created automatically with -DGEN_TREES_H */ -- --local const ct_data static_ltree[L_CODES+2] = { --{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, --{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, --{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, --{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, --{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, --{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, --{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, --{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, --{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, --{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, --{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, --{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, --{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, --{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, --{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, --{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, --{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, --{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, --{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, --{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, --{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, --{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, --{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, --{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, --{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, --{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, --{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, --{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, --{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, --{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, --{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, --{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, --{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, --{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, --{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, --{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, --{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, --{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, --{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, --{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, --{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, --{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, --{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, --{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, --{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, --{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, --{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, --{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, --{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, --{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, --{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, --{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, --{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, --{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, --{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, --{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, --{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, --{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} --}; -- --local const ct_data static_dtree[D_CODES] = { --{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, --{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, --{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, --{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, --{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, --{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} --}; -- --const uch _dist_code[DIST_CODE_LEN] = { -- 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, -- 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, --10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, --11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, --12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, --13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, --13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, --14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, --15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, --18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, --23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, --28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, --29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 --}; -- --const uch _length_code[MAX_MATCH-MIN_MATCH+1]= { -- 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, --13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, --17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, --19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, --21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, --22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, --23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, --25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, --25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, --26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, --27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 --}; -- --local const int base_length[LENGTH_CODES] = { --0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, --64, 80, 96, 112, 128, 160, 192, 224, 0 --}; -- --local const int base_dist[D_CODES] = { -- 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, -- 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, -- 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 --}; -- -diff -ruN seqinr.orig/src/uncompr.c seqinr/src/uncompr.c ---- seqinr.orig/src/uncompr.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/uncompr.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,63 +0,0 @@ --/* uncompr.c -- decompress a memory buffer -- * Copyright (C) 1995-2003 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id: uncompr.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --/* =========================================================================== -- Decompresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be large enough to hold the -- entire uncompressed data. (The size of the uncompressed data must have -- been saved previously by the compressor and transmitted to the decompressor -- by some mechanism outside the scope of this compression library.) -- Upon exit, destLen is the actual size of the compressed buffer. -- This function can be used to decompress a whole file at once if the -- input file is mmap'ed. -- -- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer, or Z_DATA_ERROR if the input data was corrupted. --*/ --int ZEXPORT uncompress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) --/* -- Bytef *dest; -- uLongf *destLen; -- const Bytef *source; -- uLong sourceLen; --*/ --{ -- z_stream stream; -- int err; -- -- stream.next_in = (Bytef*)source; -- stream.avail_in = (uInt)sourceLen; -- /* Check for source > 64K on 16-bit machine: */ -- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; -- -- stream.next_out = dest; -- stream.avail_out = (uInt)*destLen; -- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; -- -- stream.zalloc = (alloc_func)0; -- stream.zfree = (free_func)0; -- -- err = inflateInit(&stream); -- if (err != Z_OK) return err; -- -- err = inflate(&stream, Z_FINISH); -- if (err != Z_STREAM_END) { -- inflateEnd(&stream); -- if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) -- return Z_DATA_ERROR; -- return err; -- } -- *destLen = stream.total_out; -- -- err = inflateEnd(&stream); -- return err; --} -diff -ruN seqinr.orig/src/zconf.h seqinr/src/zconf.h ---- seqinr.orig/src/zconf.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/zconf.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,335 +0,0 @@ --/* zconf.h -- configuration of the zlib compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id: zconf.h,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ -- --#ifndef ZCONF_H --#define ZCONF_H -- --#ifdef HAVE_CONFIG_H --#include --#endif --/* -- * If you *really* need a unique prefix for all types and library functions, -- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. -- */ --#ifdef Z_PREFIX --# define deflateInit_ z_deflateInit_ --# define deflate z_deflate --# define deflateEnd z_deflateEnd --# define inflateInit_ z_inflateInit_ --# define inflate z_inflate --# define inflateEnd z_inflateEnd --# define deflateInit2_ z_deflateInit2_ --# define deflateSetDictionary z_deflateSetDictionary --# define deflateCopy z_deflateCopy --# define deflateReset z_deflateReset --# define deflateParams z_deflateParams --# define deflateBound z_deflateBound --# define deflatePrime z_deflatePrime --# define inflateInit2_ z_inflateInit2_ --# define inflateSetDictionary z_inflateSetDictionary --# define inflateSync z_inflateSync --# define inflateSyncPoint z_inflateSyncPoint --# define inflateCopy z_inflateCopy --# define inflateReset z_inflateReset --# define inflateBack z_inflateBack --# define inflateBackEnd z_inflateBackEnd --# define compress z_compress --# define compress2 z_compress2 --# define compressBound z_compressBound --# define uncompress z_uncompress --# define adler32 z_adler32 --# define crc32 z_crc32 --# define get_crc_table z_get_crc_table --# define zError z_zError -- --# define alloc_func z_alloc_func --# define free_func z_free_func --# define in_func z_in_func --# define out_func z_out_func --# define Byte z_Byte --# define uInt z_uInt --# define uLong z_uLong --# define Bytef z_Bytef --# define charf z_charf --# define intf z_intf --# define uIntf z_uIntf --# define uLongf z_uLongf --# define voidpf z_voidpf --# define voidp z_voidp --#endif -- --#if defined(__MSDOS__) && !defined(MSDOS) --# define MSDOS --#endif --#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) --# define OS2 --#endif --#if defined(_WINDOWS) && !defined(WINDOWS) --# define WINDOWS --#endif --#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) --# ifndef WIN32 --# define WIN32 --# endif --#endif --#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) --# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) --# ifndef SYS16BIT --# define SYS16BIT --# endif --# endif --#endif -- --/* -- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more -- * than 64k bytes at a time (needed on systems with 16-bit int). -- */ --#ifdef SYS16BIT --# define MAXSEG_64K --#endif --#ifdef MSDOS --# define UNALIGNED_OK --#endif -- --#ifdef __STDC_VERSION__ --# ifndef STDC --# define STDC --# endif --# if __STDC_VERSION__ >= 199901L --# ifndef STDC99 --# define STDC99 --# endif --# endif --#endif --#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) --# define STDC --#endif --#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) --# define STDC --#endif --#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) --# define STDC --#endif --#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) --# define STDC --#endif -- --#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ --# define STDC --#endif -- --#ifndef STDC --# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ --# define const /* note: need a more gentle solution here */ --# endif --#endif -- --/* Some Mac compilers merge all .h files incorrectly: */ --#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) --# define NO_DUMMY_DECL --#endif -- --/* Maximum value for memLevel in deflateInit2 */ --#ifndef MAX_MEM_LEVEL --# ifdef MAXSEG_64K --# define MAX_MEM_LEVEL 8 --# else --# define MAX_MEM_LEVEL 9 --# endif --#endif -- --/* Maximum value for windowBits in deflateInit2 and inflateInit2. -- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files -- * created by gzip. (Files created by minigzip can still be extracted by -- * gzip.) -- */ --#ifndef MAX_WBITS --# define MAX_WBITS 15 /* 32K LZ77 window */ --#endif -- --/* The memory requirements for deflate are (in bytes): -- (1 << (windowBits+2)) + (1 << (memLevel+9)) -- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) -- plus a few kilobytes for small objects. For example, if you want to reduce -- the default memory requirements from 256K to 128K, compile with -- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" -- Of course this will generally degrade compression (there's no free lunch). -- -- The memory requirements for inflate are (in bytes) 1 << windowBits -- that is, 32K for windowBits=15 (default value) plus a few kilobytes -- for small objects. --*/ -- -- /* Type declarations */ -- --#ifndef OF /* function prototypes */ --# ifdef STDC --# define OF(args) args --# else --# define OF(args) () --# endif --#endif -- --/* The following definitions for FAR are needed only for MSDOS mixed -- * model programming (small or medium model with some far allocations). -- * This was tested only with MSC; for other MSDOS compilers you may have -- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, -- * just define FAR to be empty. -- */ --#ifdef SYS16BIT --# if defined(M_I86SM) || defined(M_I86MM) -- /* MSC small or medium model */ --# define SMALL_MEDIUM --# ifdef _MSC_VER --# define FAR _far --# else --# define FAR far --# endif --# endif --# if (defined(__SMALL__) || defined(__MEDIUM__)) -- /* Turbo C small or medium model */ --# define SMALL_MEDIUM --# ifdef __BORLANDC__ --# define FAR _far --# else --# define FAR far --# endif --# endif --#endif -- --#if defined(WINDOWS) || defined(WIN32) -- /* If building or using zlib as a DLL, define ZLIB_DLL. -- * This is not mandatory, but it offers a little performance increase. -- */ --# ifdef ZLIB_DLL --# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) --# ifdef ZLIB_INTERNAL --# define ZEXTERN extern __declspec(dllexport) --# else --# define ZEXTERN extern __declspec(dllimport) --# endif --# endif --# endif /* ZLIB_DLL */ -- /* If building or using zlib with the WINAPI/WINAPIV calling convention, -- * define ZLIB_WINAPI. -- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. -- */ --# ifdef ZLIB_WINAPI --# ifdef FAR --# undef FAR --# endif --# include -- /* No need for _export, use ZLIB.DEF instead. */ -- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ --# define ZEXPORT WINAPI --# ifdef WIN32 --# define ZEXPORTVA WINAPIV --# else --# define ZEXPORTVA FAR CDECL --# endif --# endif --#endif -- --#if defined (__BEOS__) --# ifdef ZLIB_DLL --# ifdef ZLIB_INTERNAL --# define ZEXPORT __declspec(dllexport) --# define ZEXPORTVA __declspec(dllexport) --# else --# define ZEXPORT __declspec(dllimport) --# define ZEXPORTVA __declspec(dllimport) --# endif --# endif --#endif -- --#ifndef ZEXTERN --# define ZEXTERN extern --#endif --#ifndef ZEXPORT --# define ZEXPORT --#endif --#ifndef ZEXPORTVA --# define ZEXPORTVA --#endif -- --#ifndef FAR --# define FAR --#endif -- --#if !defined(__MACTYPES__) --typedef unsigned char Byte; /* 8 bits */ --#endif --typedef unsigned int uInt; /* 16 bits or more */ --typedef unsigned long uLong; /* 32 bits or more */ -- --#ifdef SMALL_MEDIUM -- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ --# define Bytef Byte FAR --#else -- typedef Byte FAR Bytef; --#endif --typedef char FAR charf; --typedef int FAR intf; --typedef uInt FAR uIntf; --typedef uLong FAR uLongf; -- --#ifdef STDC -- typedef void const *voidpc; -- typedef void FAR *voidpf; -- typedef void *voidp; --#else -- typedef Byte const *voidpc; -- typedef Byte FAR *voidpf; -- typedef Byte *voidp; --#endif -- --#ifdef HAVE_UNISTD_H /* HAVE_UNISTD_H -- this line is updated by ./configure */ --# include /* for off_t */ --# include /* for SEEK_* and off_t */ --# ifdef VMS --# include /* for off_t */ --# endif --# define z_off_t off_t --#endif --#ifndef SEEK_SET --# define SEEK_SET 0 /* Seek from beginning of file. */ --# define SEEK_CUR 1 /* Seek from current position. */ --# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ --#endif --#ifndef z_off_t --# define z_off_t long --#endif -- --#if defined(__OS400__) --# define NO_vsnprintf --#endif -- --#if defined(__MVS__) --# define NO_vsnprintf --# ifdef FAR --# undef FAR --# endif --#endif -- --/* MVS linker does not support external names larger than 8 bytes */ --#if defined(__MVS__) --# pragma map(deflateInit_,"DEIN") --# pragma map(deflateInit2_,"DEIN2") --# pragma map(deflateEnd,"DEEND") --# pragma map(deflateBound,"DEBND") --# pragma map(inflateInit_,"ININ") --# pragma map(inflateInit2_,"ININ2") --# pragma map(inflateEnd,"INEND") --# pragma map(inflateSync,"INSY") --# pragma map(inflateSetDictionary,"INSEDI") --# pragma map(compressBound,"CMBND") --# pragma map(inflate_table,"INTABL") --# pragma map(inflate_fast,"INFA") --# pragma map(inflate_copyright,"INCOPY") --#endif -- --#endif /* ZCONF_H */ -diff -ruN seqinr.orig/src/zlib.h seqinr/src/zlib.h ---- seqinr.orig/src/zlib.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/zlib.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,1357 +0,0 @@ --/* zlib.h -- interface of the 'zlib' general purpose compression library -- version 1.2.3, July 18th, 2005 -- -- Copyright (C) 1995-2005 Jean-loup Gailly and Mark Adler -- -- This software is provided 'as-is', without any express or implied -- warranty. In no event will the authors be held liable for any damages -- arising from the use of this software. -- -- Permission is granted to anyone to use this software for any purpose, -- including commercial applications, and to alter it and redistribute it -- freely, subject to the following restrictions: -- -- 1. The origin of this software must not be misrepresented; you must not -- claim that you wrote the original software. If you use this software -- in a product, an acknowledgment in the product documentation would be -- appreciated but is not required. -- 2. Altered source versions must be plainly marked as such, and must not be -- misrepresented as being the original software. -- 3. This notice may not be removed or altered from any source distribution. -- -- Jean-loup Gailly Mark Adler -- jloup@gzip.org madler@alumni.caltech.edu -- -- -- The data format used by the zlib library is described by RFCs (Request for -- Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt -- (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). --*/ -- --#ifndef ZLIB_H --#define ZLIB_H -- --#include "zconf.h" -- --#ifdef __cplusplus --extern "C" { --#endif -- --#define ZLIB_VERSION "1.2.3" --#define ZLIB_VERNUM 0x1230 -- --/* -- The 'zlib' compression library provides in-memory compression and -- decompression functions, including integrity checks of the uncompressed -- data. This version of the library supports only one compression method -- (deflation) but other algorithms will be added later and will have the same -- stream interface. -- -- Compression can be done in a single step if the buffers are large -- enough (for example if an input file is mmap'ed), or can be done by -- repeated calls of the compression function. In the latter case, the -- application must provide more input and/or consume the output -- (providing more output space) before each call. -- -- The compressed data format used by default by the in-memory functions is -- the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped -- around a deflate stream, which is itself documented in RFC 1951. -- -- The library also supports reading and writing files in gzip (.gz) format -- with an interface similar to that of stdio using the functions that start -- with "gz". The gzip format is different from the zlib format. gzip is a -- gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. -- -- This library can optionally read and write gzip streams in memory as well. -- -- The zlib format was designed to be compact and fast for use in memory -- and on communications channels. The gzip format was designed for single- -- file compression on file systems, has a larger header than zlib to maintain -- directory information, and uses a different, slower check method than zlib. -- -- The library does not install any signal handler. The decoder checks -- the consistency of the compressed data, so the library should never -- crash even in case of corrupted input. --*/ -- --typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); --typedef void (*free_func) OF((voidpf opaque, voidpf address)); -- --struct internal_state; -- --typedef struct z_stream_s { -- Bytef *next_in; /* next input byte */ -- uInt avail_in; /* number of bytes available at next_in */ -- uLong total_in; /* total nb of input bytes read so far */ -- -- Bytef *next_out; /* next output byte should be put there */ -- uInt avail_out; /* remaining free space at next_out */ -- uLong total_out; /* total nb of bytes output so far */ -- -- char *msg; /* last error message, NULL if no error */ -- struct internal_state FAR *state; /* not visible by applications */ -- -- alloc_func zalloc; /* used to allocate the internal state */ -- free_func zfree; /* used to free the internal state */ -- voidpf opaque; /* private data object passed to zalloc and zfree */ -- -- int data_type; /* best guess about the data type: binary or text */ -- uLong adler; /* adler32 value of the uncompressed data */ -- uLong reserved; /* reserved for future use */ --} z_stream; -- --typedef z_stream FAR *z_streamp; -- --/* -- gzip header information passed to and from zlib routines. See RFC 1952 -- for more details on the meanings of these fields. --*/ --typedef struct gz_header_s { -- int text; /* true if compressed data believed to be text */ -- uLong time; /* modification time */ -- int xflags; /* extra flags (not used when writing a gzip file) */ -- int os; /* operating system */ -- Bytef *extra; /* pointer to extra field or Z_NULL if none */ -- uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ -- uInt extra_max; /* space at extra (only when reading header) */ -- Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ -- uInt name_max; /* space at name (only when reading header) */ -- Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ -- uInt comm_max; /* space at comment (only when reading header) */ -- int hcrc; /* true if there was or will be a header crc */ -- int done; /* true when done reading gzip header (not used -- when writing a gzip file) */ --} gz_header; -- --typedef gz_header FAR *gz_headerp; -- --/* -- 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 -- has dropped to zero. The application must initialize zalloc, zfree and -- opaque before calling the init function. All other fields are set by the -- compression library and must not be updated by the application. -- -- The opaque value provided by the application will be passed as the first -- parameter for calls of zalloc and zfree. This can be useful for custom -- memory management. The compression library attaches no meaning to the -- opaque value. -- -- zalloc must return Z_NULL if there is not enough memory for the object. -- If zlib is used in a multi-threaded application, zalloc and zfree must be -- thread safe. -- -- On 16-bit systems, the functions zalloc and zfree must be able to allocate -- exactly 65536 bytes, but will not be required to allocate more than this -- if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, -- pointers returned by zalloc for objects of exactly 65536 bytes *must* -- have their offset normalized to zero. The default allocation function -- provided by this library ensures this (see zutil.c). To reduce memory -- requirements and avoid any allocation of 64K objects, at the expense of -- compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). -- -- The fields total_in and total_out can be used for statistics or -- progress reports. After compression, total_in holds the total size of -- the uncompressed data and may be saved for use in the decompressor -- (particularly if the decompressor wants to decompress everything in -- a single step). --*/ -- -- /* constants */ -- --#define Z_NO_FLUSH 0 --#define Z_PARTIAL_FLUSH 1 /* will be removed, use Z_SYNC_FLUSH instead */ --#define Z_SYNC_FLUSH 2 --#define Z_FULL_FLUSH 3 --#define Z_FINISH 4 --#define Z_BLOCK 5 --/* Allowed flush values; see deflate() and inflate() below for details */ -- --#define Z_OK 0 --#define Z_STREAM_END 1 --#define Z_NEED_DICT 2 --#define Z_ERRNO (-1) --#define Z_STREAM_ERROR (-2) --#define Z_DATA_ERROR (-3) --#define Z_MEM_ERROR (-4) --#define Z_BUF_ERROR (-5) --#define Z_VERSION_ERROR (-6) --/* Return codes for the compression/decompression functions. Negative -- * values are errors, positive values are used for special but normal events. -- */ -- --#define Z_NO_COMPRESSION 0 --#define Z_BEST_SPEED 1 --#define Z_BEST_COMPRESSION 9 --#define Z_DEFAULT_COMPRESSION (-1) --/* compression levels */ -- --#define Z_FILTERED 1 --#define Z_HUFFMAN_ONLY 2 --#define Z_RLE 3 --#define Z_FIXED 4 --#define Z_DEFAULT_STRATEGY 0 --/* compression strategy; see deflateInit2() below for details */ -- --#define Z_BINARY 0 --#define Z_TEXT 1 --#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ --#define Z_UNKNOWN 2 --/* Possible values of the data_type field (though see inflate()) */ -- --#define Z_DEFLATED 8 --/* The deflate compression method (the only one supported in this version) */ -- --#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ -- --#define zlib_version zlibVersion() --/* for compatibility with versions < 1.0.2 */ -- -- /* basic functions */ -- --ZEXTERN const char * ZEXPORT zlibVersion OF((void)); --/* The application can compare zlibVersion and ZLIB_VERSION for consistency. -- If the first character differs, the library code actually used is -- not compatible with the zlib.h header file used by the application. -- This check is automatically made by deflateInit and inflateInit. -- */ -- --/* --ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); -- -- Initializes the internal stream state for compression. The fields -- zalloc, zfree and opaque must be initialized before by the caller. -- If zalloc and zfree are set to Z_NULL, deflateInit updates them to -- use default allocation functions. -- -- The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: -- 1 gives best speed, 9 gives best compression, 0 gives no compression at -- all (the input data is simply copied a block at a time). -- Z_DEFAULT_COMPRESSION requests a default compromise between speed and -- compression (currently equivalent to level 6). -- -- deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if level is not a valid compression level, -- Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible -- with the version assumed by the caller (ZLIB_VERSION). -- msg is set to null if there is no error message. deflateInit does not -- perform any compression: this will be done by deflate(). --*/ -- -- --ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); --/* -- deflate compresses as much data as possible, and stops when the input -- buffer becomes empty or the output buffer becomes full. It may introduce some -- output latency (reading input without producing any output) except when -- forced to flush. -- -- The detailed semantics are as follows. deflate performs one or both of the -- following actions: -- -- - Compress more input starting at next_in and update next_in and avail_in -- accordingly. If not all input can be processed (because there is not -- enough room in the output buffer), next_in and avail_in are updated and -- processing will resume at this point for the next call of deflate(). -- -- - Provide more output starting at next_out and update next_out and avail_out -- accordingly. This action is forced if the parameter flush is non zero. -- Forcing flush frequently degrades the compression ratio, so this parameter -- should be set only when necessary (in interactive applications). -- Some output may be provided even if flush is not set. -- -- Before the call of deflate(), the application should ensure that at least -- one of the actions is possible, by providing more input and/or consuming -- more output, and updating avail_in or avail_out accordingly; avail_out -- should never be zero before the call. The application can consume the -- compressed output when it wants, for example when the output buffer is full -- (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK -- and with zero avail_out, it must be called again after making room in the -- output buffer because there might be more output pending. -- -- Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to -- decide how much data to accumualte before producing output, in order to -- maximize compression. -- -- If the parameter flush is set to Z_SYNC_FLUSH, all pending output is -- flushed to the output buffer and the output is aligned on a byte boundary, so -- that the decompressor can get all input data available so far. (In particular -- avail_in is zero after the call if enough output space has been provided -- before the call.) Flushing may degrade compression for some compression -- algorithms and so it should be used only when necessary. -- -- If flush is set to Z_FULL_FLUSH, all output is flushed as with -- Z_SYNC_FLUSH, and the compression state is reset so that decompression can -- restart from this point if previous compressed data has been damaged or if -- random access is desired. Using Z_FULL_FLUSH too often can seriously degrade -- compression. -- -- If deflate returns with avail_out == 0, this function must be called again -- with the same value of the flush parameter and more output space (updated -- avail_out), until the flush is complete (deflate returns with non-zero -- avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that -- avail_out is greater than six to avoid repeated flush markers due to -- avail_out == 0 on return. -- -- If the parameter flush is set to Z_FINISH, pending input is processed, -- pending output is flushed and deflate returns with Z_STREAM_END if there -- was enough output space; if deflate returns with Z_OK, this function must be -- called again with Z_FINISH and more output space (updated avail_out) but no -- more input data, until it returns with Z_STREAM_END or an error. After -- deflate has returned Z_STREAM_END, the only possible operations on the -- stream are deflateReset or deflateEnd. -- -- Z_FINISH can be used immediately after deflateInit if all the compression -- is to be done in a single step. In this case, avail_out must be at least -- the value returned by deflateBound (see below). If deflate does not return -- Z_STREAM_END, then it must be called again as described above. -- -- deflate() sets strm->adler to the adler32 checksum of all input read -- so far (that is, total_in bytes). -- -- deflate() may update strm->data_type if it can make a good guess about -- the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered -- binary. This field is only for information purposes and does not affect -- the compression algorithm in any manner. -- -- deflate() returns Z_OK if some progress has been made (more input -- processed or more output produced), Z_STREAM_END if all input has been -- consumed and all output has been produced (only when flush is set to -- Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example -- if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible -- (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not -- fatal, and deflate() can be called again with more input and more output -- space to continue compressing. --*/ -- -- --ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); --/* -- All dynamically allocated data structures for this stream are freed. -- This function discards any unprocessed input and does not flush any -- pending output. -- -- deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the -- stream state was inconsistent, Z_DATA_ERROR if the stream was freed -- prematurely (some input or output was discarded). In the error case, -- msg may be set but then points to a static string (which must not be -- deallocated). --*/ -- -- --/* --ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); -- -- Initializes the internal stream state for decompression. The fields -- next_in, avail_in, zalloc, zfree and opaque must be initialized before by -- the caller. If next_in is not Z_NULL and avail_in is large enough (the exact -- value depends on the compression method), inflateInit determines the -- compression method from the zlib header and allocates all data structures -- accordingly; otherwise the allocation will be deferred to the first call of -- inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to -- use default allocation functions. -- -- inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_VERSION_ERROR if the zlib library version is incompatible with the -- version assumed by the caller. msg is set to null if there is no error -- message. inflateInit does not perform any decompression apart from reading -- the zlib header if present: this will be done by inflate(). (So next_in and -- avail_in may be modified, but next_out and avail_out are unchanged.) --*/ -- -- --ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); --/* -- inflate decompresses as much data as possible, and stops when the input -- buffer becomes empty or the output buffer becomes full. It may introduce -- some output latency (reading input without producing any output) except when -- forced to flush. -- -- The detailed semantics are as follows. inflate performs one or both of the -- following actions: -- -- - Decompress more input starting at next_in and update next_in and avail_in -- accordingly. If not all input can be processed (because there is not -- enough room in the output buffer), next_in is updated and processing -- will resume at this point for the next call of inflate(). -- -- - Provide more output starting at next_out and update next_out and avail_out -- accordingly. inflate() provides as much output as possible, until there -- is no more input data or no more space in the output buffer (see below -- about the flush parameter). -- -- Before the call of inflate(), the application should ensure that at least -- one of the actions is possible, by providing more input and/or consuming -- more output, and updating the next_* and avail_* values accordingly. -- The application can consume the uncompressed output when it wants, for -- example when the output buffer is full (avail_out == 0), or after each -- call of inflate(). If inflate returns Z_OK and with zero avail_out, it -- must be called again after making room in the output buffer because there -- might be more output pending. -- -- The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, -- Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much -- output as possible to the output buffer. Z_BLOCK requests that inflate() stop -- if and when it gets to the next deflate block boundary. When decoding the -- zlib or gzip format, this will cause inflate() to return immediately after -- the header and before the first block. When doing a raw inflate, inflate() -- will go ahead and process the first block, and will return when it gets to -- the end of that block, or when it runs out of data. -- -- The Z_BLOCK option assists in appending to or combining deflate streams. -- Also to assist in this, on return inflate() will set strm->data_type to the -- number of unused bits in the last byte taken from strm->next_in, plus 64 -- if inflate() is currently decoding the last block in the deflate stream, -- plus 128 if inflate() returned immediately after decoding an end-of-block -- code or decoding the complete header up to just before the first byte of the -- deflate stream. The end-of-block will not be indicated until all of the -- uncompressed data from that block has been written to strm->next_out. The -- number of unused bits may in general be greater than seven, except when -- bit 7 of data_type is set, in which case the number of unused bits will be -- less than eight. -- -- inflate() should normally be called until it returns Z_STREAM_END or an -- error. However if all decompression is to be performed in a single step -- (a single call of inflate), the parameter flush should be set to -- Z_FINISH. In this case all pending input is processed and all pending -- output is flushed; avail_out must be large enough to hold all the -- uncompressed data. (The size of the uncompressed data may have been saved -- by the compressor for this purpose.) The next operation on this stream must -- be inflateEnd to deallocate the decompression state. The use of Z_FINISH -- is never required, but can be used to inform inflate that a faster approach -- may be used for the single inflate() call. -- -- In this implementation, inflate() always flushes as much output as -- possible to the output buffer, and always uses the faster approach on the -- first call. So the only effect of the flush parameter in this implementation -- is on the return value of inflate(), as noted below, or when it returns early -- because Z_BLOCK is used. -- -- If a preset dictionary is needed after this call (see inflateSetDictionary -- below), inflate sets strm->adler to the adler32 checksum of the 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() checks that its computed adler32 -- checksum is equal to that saved by the compressor and returns Z_STREAM_END -- only if the checksum is correct. -- -- inflate() will decompress and check either zlib-wrapped or gzip-wrapped -- deflate data. The header type is detected automatically. Any information -- contained in the gzip header is not retained, so applications that need that -- information should instead use raw inflate, see inflateInit2() below, or -- inflateBack() and perform their own processing of the gzip header and -- trailer. -- -- inflate() returns Z_OK if some progress has been made (more input processed -- or more output produced), Z_STREAM_END if the end of the compressed data has -- been reached and all uncompressed output has been produced, Z_NEED_DICT if a -- preset dictionary is needed at this point, Z_DATA_ERROR if the input data was -- corrupted (input stream not conforming to the zlib format or incorrect check -- value), Z_STREAM_ERROR if the stream structure was inconsistent (for example -- if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, -- Z_BUF_ERROR if no progress is possible or if there was not enough room in the -- output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and -- inflate() can be called again with more input and more output space to -- continue decompressing. If Z_DATA_ERROR is returned, the application may then -- call inflateSync() to look for a good compression block if a partial recovery -- of the data is desired. --*/ -- -- --ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); --/* -- All dynamically allocated data structures for this stream are freed. -- This function discards any unprocessed input and does not flush any -- pending output. -- -- inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state -- was inconsistent. In the error case, msg may be set but then points to a -- static string (which must not be deallocated). --*/ -- -- /* Advanced functions */ -- --/* -- The following functions are needed only in some special applications. --*/ -- --/* --ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, -- int level, -- int method, -- int windowBits, -- int memLevel, -- int strategy)); -- -- This is another version of deflateInit with more compression options. The -- fields next_in, zalloc, zfree and opaque must be initialized before by -- the caller. -- -- The method parameter is the compression method. It must be Z_DEFLATED in -- this version of the library. -- -- The windowBits parameter is the base two logarithm of the window size -- (the size of the history buffer). It should be in the range 8..15 for this -- version of the library. Larger values of this parameter result in better -- compression at the expense of memory usage. The default value is 15 if -- deflateInit is used instead. -- -- windowBits can also be -8..-15 for raw deflate. In this case, -windowBits -- determines the window size. deflate() will then generate raw deflate data -- with no zlib header or trailer, and will not compute an adler32 check value. -- -- windowBits can also be greater than 15 for optional gzip encoding. Add -- 16 to windowBits to write a simple gzip header and trailer around the -- compressed data instead of a zlib wrapper. The gzip header will have no -- file name, no extra data, no comment, no modification time (set to zero), -- no header crc, and the operating system will be set to 255 (unknown). If a -- gzip stream is being written, strm->adler is a crc32 instead of an adler32. -- -- The memLevel parameter specifies how much memory should be allocated -- for the internal compression state. memLevel=1 uses minimum memory but -- is slow and reduces compression ratio; memLevel=9 uses maximum memory -- for optimal speed. The default value is 8. See zconf.h for total memory -- usage as a function of windowBits and memLevel. -- -- The strategy parameter is used to tune the compression algorithm. Use the -- value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a -- filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no -- string match), or Z_RLE to limit match distances to one (run-length -- encoding). Filtered data consists mostly of small values with a somewhat -- random distribution. In this case, the compression algorithm is tuned to -- compress them better. The effect of Z_FILTERED is to force more Huffman -- coding and less string matching; it is somewhat intermediate between -- Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as -- Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy -- parameter only affects the compression ratio but not the correctness of the -- compressed output even if it is not set appropriately. Z_FIXED prevents the -- use of dynamic Huffman codes, allowing for a simpler decoder for special -- applications. -- -- deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid -- method). msg is set to null if there is no error message. deflateInit2 does -- not perform any compression: this will be done by deflate(). --*/ -- --ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, -- const Bytef *dictionary, -- uInt dictLength)); --/* -- Initializes the compression dictionary from the given byte sequence -- without producing any compressed output. This function must be called -- immediately after deflateInit, deflateInit2 or deflateReset, before any -- call of deflate. The compressor and decompressor must use exactly the same -- dictionary (see inflateSetDictionary). -- -- The dictionary should consist of strings (byte sequences) that are likely -- to be encountered later in the data to be compressed, with the most commonly -- used strings preferably put towards the end of the dictionary. Using a -- dictionary is most useful when the data to be compressed is short and can be -- predicted with good accuracy; the data can then be compressed better than -- with the default empty dictionary. -- -- Depending on the size of the compression data structures selected by -- deflateInit or deflateInit2, a part of the dictionary may in effect be -- discarded, for example if the dictionary is larger than the window size in -- deflate or deflate2. Thus the strings most likely to be useful should be -- put at the end of the dictionary, not at the front. In addition, the -- current implementation of deflate will use at most the window size minus -- 262 bytes of the provided dictionary. -- -- Upon return of this function, strm->adler is set to the adler32 value -- of the dictionary; the decompressor may later use this value to determine -- which dictionary has been used by the compressor. (The adler32 value -- applies to the whole dictionary even if only a subset of the dictionary is -- actually used by the compressor.) If a raw deflate was requested, then the -- adler32 value is not computed and strm->adler is not set. -- -- deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a -- parameter is invalid (such as NULL dictionary) or the stream state is -- inconsistent (for example if deflate has already been called for this stream -- or if the compression method is bsort). deflateSetDictionary does not -- perform any compression: this will be done by deflate(). --*/ -- --ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, -- z_streamp source)); --/* -- Sets the destination stream as a complete copy of the source stream. -- -- This function can be useful when several compression strategies will be -- tried, for example when there are several ways of pre-processing the input -- data with a filter. The streams that will be discarded should then be freed -- by calling deflateEnd. Note that deflateCopy duplicates the internal -- compression state which can be quite large, so this strategy is slow and -- can consume lots of memory. -- -- deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent -- (such as zalloc being NULL). msg is left unchanged in both source and -- destination. --*/ -- --ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); --/* -- This function is equivalent to deflateEnd followed by deflateInit, -- but does not free and reallocate all the internal compression state. -- The stream will keep the same compression level and any other attributes -- that may have been set by deflateInit2. -- -- deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent (such as zalloc or state being NULL). --*/ -- --ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, -- int level, -- int strategy)); --/* -- Dynamically update the compression level and compression strategy. The -- interpretation of level and strategy is as in deflateInit2. This can be -- used to switch between compression and straight copy of the input data, or -- to switch to a different kind of input data requiring a different -- strategy. If the compression level is changed, the input available so far -- is compressed with the old level (and may be flushed); the new level will -- take effect only at the next call of deflate(). -- -- Before the call of deflateParams, the stream state must be set as for -- a call of deflate(), since the currently available input may have to -- be compressed and flushed. In particular, strm->avail_out must be non-zero. -- -- deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source -- stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR -- if strm->avail_out was zero. --*/ -- --ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, -- int good_length, -- int max_lazy, -- int nice_length, -- int max_chain)); --/* -- Fine tune deflate's internal compression parameters. This should only be -- used by someone who understands the algorithm used by zlib's deflate for -- searching for the best matching string, and even then only by the most -- fanatic optimizer trying to squeeze out the last compressed bit for their -- specific input data. Read the deflate.c source code for the meaning of the -- max_lazy, good_length, nice_length, and max_chain parameters. -- -- deflateTune() can be called after deflateInit() or deflateInit2(), and -- returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. -- */ -- --ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, -- uLong sourceLen)); --/* -- deflateBound() returns an upper bound on the compressed size after -- deflation of sourceLen bytes. It must be called after deflateInit() -- or deflateInit2(). This would be used to allocate an output buffer -- for deflation in a single pass, and so would be called before deflate(). --*/ -- --ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, -- int bits, -- int value)); --/* -- deflatePrime() inserts bits in the deflate output stream. The intent -- is that this function is used to start off the deflate output with the -- bits leftover from a previous deflate stream when appending to it. As such, -- this function can only be used for raw deflate, and must be used before the -- first deflate() call after a deflateInit2() or deflateReset(). bits must be -- less than or equal to 16, and that many of the least significant bits of -- value will be inserted in the output. -- -- deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, -- gz_headerp head)); --/* -- deflateSetHeader() provides gzip header information for when a gzip -- stream is requested by deflateInit2(). deflateSetHeader() may be called -- after deflateInit2() or deflateReset() and before the first call of -- deflate(). The text, time, os, extra field, name, and comment information -- in the provided gz_header structure are written to the gzip header (xflag is -- ignored -- the extra flags are set according to the compression level). The -- caller must assure that, if not Z_NULL, name and comment are terminated with -- a zero byte, and that if extra is not Z_NULL, that extra_len bytes are -- available there. If hcrc is true, a gzip header crc is included. Note that -- the current versions of the command-line version of gzip (up through version -- 1.3.x) do not support header crc's, and will report that it is a "multi-part -- gzip file" and give up. -- -- If deflateSetHeader is not used, the default gzip header has text false, -- the time set to zero, and os set to 255, with no extra, name, or comment -- fields. The gzip header is returned to the default state by deflateReset(). -- -- deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --/* --ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, -- int windowBits)); -- -- This is another version of inflateInit with an extra parameter. The -- fields next_in, avail_in, zalloc, zfree and opaque must be initialized -- before by the caller. -- -- The windowBits parameter is the base two logarithm of the maximum window -- size (the size of the history buffer). It should be in the range 8..15 for -- this version of the library. The default value is 15 if inflateInit is used -- instead. windowBits must be greater than or equal to the windowBits value -- provided to deflateInit2() while compressing, or it must be equal to 15 if -- deflateInit2() was not used. If a compressed stream with a larger window -- size is given as input, inflate() will return with the error code -- Z_DATA_ERROR instead of trying to allocate a larger window. -- -- windowBits can also be -8..-15 for raw inflate. In this case, -windowBits -- determines the window size. inflate() will then process raw deflate data, -- not looking for a zlib or gzip header, not generating a check value, and not -- looking for any check values for comparison at the end of the stream. This -- is for use with other formats that use the deflate compressed data format -- such as zip. Those formats provide their own check values. If a custom -- format is developed using the raw deflate format for compressed data, it is -- recommended that a check value such as an adler32 or a crc32 be applied to -- the uncompressed data as is done in the zlib, gzip, and zip formats. For -- most applications, the zlib format should be used as is. Note that comments -- above on the use in deflateInit2() applies to the magnitude of windowBits. -- -- windowBits can also be greater than 15 for optional gzip decoding. Add -- 32 to windowBits to enable zlib and gzip decoding with automatic header -- detection, or add 16 to decode only the gzip format (the zlib format will -- return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is -- a crc32 instead of an adler32. -- -- inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). msg -- is set to null if there is no error message. inflateInit2 does not perform -- any decompression apart from reading the zlib header if present: this will -- be done by inflate(). (So next_in and avail_in may be modified, but next_out -- and avail_out are unchanged.) --*/ -- --ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, -- const Bytef *dictionary, -- uInt dictLength)); --/* -- Initializes the decompression dictionary from the given uncompressed byte -- sequence. This function must be called immediately after a call of inflate, -- if that call returned Z_NEED_DICT. The dictionary chosen by the compressor -- can be determined from the adler32 value returned by that call of inflate. -- The compressor and decompressor must use exactly the same dictionary (see -- deflateSetDictionary). For raw inflate, this function can be called -- immediately after inflateInit2() or inflateReset() and before any call of -- inflate() to set the dictionary. The application must insure that the -- dictionary that was used for compression is provided. -- -- inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a -- parameter is invalid (such as NULL dictionary) or the stream state is -- inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the -- expected one (incorrect adler32 value). inflateSetDictionary does not -- perform any decompression: this will be done by subsequent calls of -- inflate(). --*/ -- --ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); --/* -- Skips invalid compressed data until a full flush point (see above the -- description of deflate with Z_FULL_FLUSH) can be found, or until all -- available input is skipped. No output is provided. -- -- inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR -- if no more input was provided, Z_DATA_ERROR if no flush point has been found, -- or Z_STREAM_ERROR if the stream structure was inconsistent. In the success -- case, the application may save the current current value of total_in which -- indicates where valid compressed data was found. In the error case, the -- application may repeatedly call inflateSync, providing more input each time, -- until success or end of the input data. --*/ -- --ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, -- z_streamp source)); --/* -- Sets the destination stream as a complete copy of the source stream. -- -- This function can be useful when randomly accessing a large stream. The -- first pass through the stream can periodically record the inflate state, -- allowing restarting inflate at those points when randomly accessing the -- stream. -- -- inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent -- (such as zalloc being NULL). msg is left unchanged in both source and -- destination. --*/ -- --ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); --/* -- This function is equivalent to inflateEnd followed by inflateInit, -- but does not free and reallocate all the internal decompression state. -- The stream will keep attributes that may have been set by inflateInit2. -- -- inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent (such as zalloc or state being NULL). --*/ -- --ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, -- int bits, -- int value)); --/* -- This function inserts bits in the inflate input stream. The intent is -- that this function is used to start inflating at a bit position in the -- middle of a byte. The provided bits will be used before any bytes are used -- from next_in. This function should only be used with raw inflate, and -- should be used before the first inflate() call after inflateInit2() or -- inflateReset(). bits must be less than or equal to 16, and that many of the -- least significant bits of value will be inserted in the input. -- -- inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, -- gz_headerp head)); --/* -- inflateGetHeader() requests that gzip header information be stored in the -- provided gz_header structure. inflateGetHeader() may be called after -- inflateInit2() or inflateReset(), and before the first call of inflate(). -- As inflate() processes the gzip stream, head->done is zero until the header -- is completed, at which time head->done is set to one. If a zlib stream is -- being decoded, then head->done is set to -1 to indicate that there will be -- no gzip header information forthcoming. Note that Z_BLOCK can be used to -- force inflate() to return immediately after header processing is complete -- and before any actual data is decompressed. -- -- The text, time, xflags, and os fields are filled in with the gzip header -- contents. hcrc is set to true if there is a header CRC. (The header CRC -- was valid if done is set to one.) If extra is not Z_NULL, then extra_max -- contains the maximum number of bytes to write to extra. Once done is true, -- extra_len contains the actual extra field length, and extra contains the -- extra field, or that field truncated if extra_max is less than extra_len. -- If name is not Z_NULL, then up to name_max characters are written there, -- terminated with a zero unless the length is greater than name_max. If -- comment is not Z_NULL, then up to comm_max characters are written there, -- terminated with a zero unless the length is greater than comm_max. When -- any of extra, name, or comment are not Z_NULL and the respective field is -- not present in the header, then that field is set to Z_NULL to signal its -- absence. This allows the use of deflateSetHeader() with the returned -- structure to duplicate the header. However if those fields are set to -- allocated memory, then the application will need to save those pointers -- elsewhere so that they can be eventually freed. -- -- If inflateGetHeader is not used, then the header information is simply -- discarded. The header is always checked for validity, including the header -- CRC if present. inflateReset() will reset the process to discard the header -- information. The application would need to call inflateGetHeader() again to -- retrieve the header from the next gzip stream. -- -- inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source -- stream state was inconsistent. --*/ -- --/* --ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, -- unsigned char FAR *window)); -- -- Initialize the internal stream state for decompression using inflateBack() -- calls. The fields zalloc, zfree and opaque in strm must be initialized -- before the call. If zalloc and zfree are Z_NULL, then the default library- -- derived memory allocation routines are used. windowBits is the base two -- logarithm of the window size, in the range 8..15. window is a caller -- supplied buffer of that size. Except for special applications where it is -- assured that deflate was used with small window sizes, windowBits must be 15 -- and a 32K byte window must be supplied to be able to decompress general -- deflate streams. -- -- See inflateBack() for the usage of these routines. -- -- inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of -- the paramaters are invalid, Z_MEM_ERROR if the internal state could not -- be allocated, or Z_VERSION_ERROR if the version of the library does not -- match the version of the header file. --*/ -- --typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); --typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); -- --ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, -- in_func in, void FAR *in_desc, -- out_func out, void FAR *out_desc)); --/* -- inflateBack() does a raw inflate with a single call using a call-back -- interface for input and output. This is more efficient than inflate() for -- file i/o applications in that it avoids copying between the output and the -- sliding window by simply making the window itself the output buffer. This -- function trusts the application to not change the output buffer passed by -- the output function, at least until inflateBack() returns. -- -- inflateBackInit() must be called first to allocate the internal state -- and to initialize the state with the user-provided window buffer. -- inflateBack() may then be used multiple times to inflate a complete, raw -- deflate stream with each call. inflateBackEnd() is then called to free -- the allocated state. -- -- A raw deflate stream is one with no zlib or gzip header or trailer. -- This routine would normally be used in a utility that reads zip or gzip -- files and writes out uncompressed files. The utility would decode the -- header and process the trailer on its own, hence this routine expects -- only the raw deflate stream to decompress. This is different from the -- normal behavior of inflate(), which expects either a zlib or gzip header and -- trailer around the deflate stream. -- -- inflateBack() uses two subroutines supplied by the caller that are then -- called by inflateBack() for input and output. inflateBack() calls those -- routines until it reads a complete deflate stream and writes out all of the -- uncompressed data, or until it encounters an error. The function's -- parameters and return types are defined above in the in_func and out_func -- typedefs. inflateBack() will call in(in_desc, &buf) which should return the -- number of bytes of provided input, and a pointer to that input in buf. If -- there is no input available, in() must return zero--buf is ignored in that -- case--and inflateBack() will return a buffer error. inflateBack() will call -- out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() -- should return zero on success, or non-zero on failure. If out() returns -- non-zero, inflateBack() will return with an error. Neither in() nor out() -- are permitted to change the contents of the window provided to -- inflateBackInit(), which is also the buffer that out() uses to write from. -- The length written by out() will be at most the window size. Any non-zero -- amount of input may be provided by in(). -- -- For convenience, inflateBack() can be provided input on the first call by -- setting strm->next_in and strm->avail_in. If that input is exhausted, then -- in() will be called. Therefore strm->next_in must be initialized before -- calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called -- immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in -- must also be initialized, and then if strm->avail_in is not zero, input will -- initially be taken from strm->next_in[0 .. strm->avail_in - 1]. -- -- The in_desc and out_desc parameters of inflateBack() is passed as the -- first parameter of in() and out() respectively when they are called. These -- descriptors can be optionally used to pass any information that the caller- -- supplied in() and out() functions need to do their job. -- -- On return, inflateBack() will set strm->next_in and strm->avail_in to -- pass back any unused input that was provided by the last in() call. The -- return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR -- if in() or out() returned an error, Z_DATA_ERROR if there was a format -- error in the deflate stream (in which case strm->msg is set to indicate the -- nature of the error), or Z_STREAM_ERROR if the stream was not properly -- initialized. In the case of Z_BUF_ERROR, an input or output error can be -- distinguished using strm->next_in which will be Z_NULL only if in() returned -- an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to -- out() returning non-zero. (in() will always be called before out(), so -- strm->next_in is assured to be defined if out() returns non-zero.) Note -- that inflateBack() cannot return Z_OK. --*/ -- --ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); --/* -- All memory allocated by inflateBackInit() is freed. -- -- inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream -- state was inconsistent. --*/ -- --ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); --/* Return flags indicating compile-time options. -- -- Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: -- 1.0: size of uInt -- 3.2: size of uLong -- 5.4: size of voidpf (pointer) -- 7.6: size of z_off_t -- -- Compiler, assembler, and debug options: -- 8: DEBUG -- 9: ASMV or ASMINF -- use ASM code -- 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention -- 11: 0 (reserved) -- -- One-time table building (smaller code, but not thread-safe if true): -- 12: BUILDFIXED -- build static block decoding tables when needed -- 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed -- 14,15: 0 (reserved) -- -- Library content (indicates missing functionality): -- 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking -- deflate code when not needed) -- 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect -- and decode gzip streams (to avoid linking crc code) -- 18-19: 0 (reserved) -- -- Operation variations (changes in library functionality): -- 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate -- 21: FASTEST -- deflate algorithm with only one, lowest compression level -- 22,23: 0 (reserved) -- -- The sprintf variant used by gzprintf (zero is best): -- 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format -- 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! -- 26: 0 = returns value, 1 = void -- 1 means inferred string length returned -- -- Remainder: -- 27-31: 0 (reserved) -- */ -- -- -- /* utility functions */ -- --/* -- The following utility functions are implemented on top of the -- basic stream-oriented functions. To simplify the interface, some -- default options are assumed (compression level and memory usage, -- standard memory allocation functions). The source code of these -- utility functions can easily be modified if you need special options. --*/ -- --ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen)); --/* -- Compresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be at least the value returned -- by compressBound(sourceLen). Upon exit, destLen is the actual size of the -- compressed buffer. -- This function can be used to compress a whole file at once if the -- input file is mmap'ed. -- compress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer. --*/ -- --ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen, -- int level)); --/* -- Compresses the source buffer into the destination buffer. The level -- parameter has the same meaning as in deflateInit. sourceLen is the byte -- length of the source buffer. Upon entry, destLen is the total size of the -- destination buffer, which must be at least the value returned by -- compressBound(sourceLen). Upon exit, destLen is the actual size of the -- compressed buffer. -- -- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough -- memory, Z_BUF_ERROR if there was not enough room in the output buffer, -- Z_STREAM_ERROR if the level parameter is invalid. --*/ -- --ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); --/* -- compressBound() returns an upper bound on the compressed size after -- compress() or compress2() on sourceLen bytes. It would be used before -- a compress() or compress2() call to allocate the destination buffer. --*/ -- --ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, -- const Bytef *source, uLong sourceLen)); --/* -- Decompresses the source buffer into the destination buffer. sourceLen is -- the byte length of the source buffer. Upon entry, destLen is the total -- size of the destination buffer, which must be large enough to hold the -- entire uncompressed data. (The size of the uncompressed data must have -- been saved previously by the compressor and transmitted to the decompressor -- by some mechanism outside the scope of this compression library.) -- Upon exit, destLen is the actual size of the compressed buffer. -- This function can be used to decompress a whole file at once if the -- input file is mmap'ed. -- -- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not -- enough memory, Z_BUF_ERROR if there was not enough room in the output -- buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. --*/ -- -- --typedef voidp gzFile; -- --ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); --/* -- Opens a gzip (.gz) file for reading or writing. The mode parameter -- is as in fopen ("rb" or "wb") but can also include a compression level -- ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for -- Huffman only compression as in "wb1h", or 'R' for run-length encoding -- as in "wb1R". (See the description of deflateInit2 for more information -- about the strategy parameter.) -- -- gzopen can be used to read a file which is not in gzip format; in this -- case gzread will directly read from the file without decompression. -- -- gzopen returns NULL if the file could not be opened or if there was -- insufficient memory to allocate the (de)compression state; errno -- can be checked to distinguish the two cases (if errno is zero, the -- zlib error is Z_MEM_ERROR). */ -- --ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); --/* -- gzdopen() associates a gzFile with the file descriptor fd. File -- descriptors are obtained from calls like open, dup, creat, pipe or -- fileno (in the file has been previously opened with fopen). -- The mode parameter is as in gzopen. -- The next call of gzclose on the returned gzFile will also close the -- file descriptor fd, just like fclose(fdopen(fd), mode) closes the file -- descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). -- gzdopen returns NULL if there was insufficient memory to allocate -- the (de)compression state. --*/ -- --ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); --/* -- Dynamically update the compression level or strategy. See the description -- of deflateInit2 for the meaning of these parameters. -- gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not -- opened for writing. --*/ -- --ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); --/* -- Reads the given number of uncompressed bytes from the compressed file. -- If the input file was not in gzip format, gzread copies the given number -- of bytes into the buffer. -- gzread returns the number of uncompressed bytes actually read (0 for -- end of file, -1 for error). */ -- --ZEXTERN int ZEXPORT gzwrite OF((gzFile file, -- voidpc buf, unsigned len)); --/* -- Writes the given number of uncompressed bytes into the compressed file. -- gzwrite returns the number of uncompressed bytes actually written -- (0 in case of error). --*/ -- --ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); --/* -- Converts, formats, and writes the args to the compressed file under -- control of the format string, as in fprintf. gzprintf returns the number of -- uncompressed bytes actually written (0 in case of error). The number of -- uncompressed bytes written is limited to 4095. The caller should assure that -- this limit is not exceeded. If it is exceeded, then gzprintf() will return -- return an error (0) with nothing written. In this case, there may also be a -- buffer overflow with unpredictable consequences, which is possible only if -- zlib was compiled with the insecure functions sprintf() or vsprintf() -- because the secure snprintf() or vsnprintf() functions were not available. --*/ -- --ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); --/* -- Writes the given null-terminated string to the compressed file, excluding -- the terminating null character. -- gzputs returns the number of characters written, or -1 in case of error. --*/ -- --ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); --/* -- Reads bytes from the compressed file until len-1 characters are read, or -- a newline character is read and transferred to buf, or an end-of-file -- condition is encountered. The string is then terminated with a null -- character. -- gzgets returns buf, or Z_NULL in case of error. --*/ -- --ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); --/* -- Writes c, converted to an unsigned char, into the compressed file. -- gzputc returns the value that was written, or -1 in case of error. --*/ -- --ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); --/* -- Reads one byte from the compressed file. gzgetc returns this byte -- or -1 in case of end of file or error. --*/ -- --ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); --/* -- Push one character back onto the stream to be read again later. -- Only one character of push-back is allowed. gzungetc() returns the -- character pushed, or -1 on failure. gzungetc() will fail if a -- character has been pushed but not read yet, or if c is -1. The pushed -- character will be discarded if the stream is repositioned with gzseek() -- or gzrewind(). --*/ -- --ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); --/* -- Flushes all pending output into the compressed file. The parameter -- flush is as in the deflate() function. The return value is the zlib -- error number (see function gzerror below). gzflush returns Z_OK if -- the flush parameter is Z_FINISH and all output could be flushed. -- gzflush should be called only when strictly necessary because it can -- degrade compression. --*/ -- --ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, -- z_off_t offset, int whence)); --/* -- Sets the starting position for the next gzread or gzwrite on the -- given compressed file. The offset represents a number of bytes in the -- uncompressed data stream. The whence parameter is defined as in lseek(2); -- the value SEEK_END is not supported. -- If the file is opened for reading, this function is emulated but can be -- extremely slow. If the file is opened for writing, only forward seeks are -- supported; gzseek then compresses a sequence of zeroes up to the new -- starting position. -- -- gzseek returns the resulting offset location as measured in bytes from -- the beginning of the uncompressed stream, or -1 in case of error, in -- particular if the file is opened for writing and the new starting position -- would be before the current position. --*/ -- --ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); --/* -- Rewinds the given file. This function is supported only for reading. -- -- gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) --*/ -- --ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); --/* -- Returns the starting position for the next gzread or gzwrite on the -- given compressed file. This position represents a number of bytes in the -- uncompressed data stream. -- -- gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) --*/ -- --ZEXTERN int ZEXPORT gzeof OF((gzFile file)); --/* -- Returns 1 when EOF has previously been detected reading the given -- input stream, otherwise zero. --*/ -- --ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); --/* -- Returns 1 if file is being read directly without decompression, otherwise -- zero. --*/ -- --ZEXTERN int ZEXPORT gzclose OF((gzFile file)); --/* -- Flushes all pending output if necessary, closes the compressed file -- and deallocates all the (de)compression state. The return value is the zlib -- error number (see function gzerror below). --*/ -- --ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); --/* -- Returns the error message for the last error which occurred on the -- given compressed file. errnum is set to zlib error number. If an -- error occurred in the file system and not in the compression library, -- errnum is set to Z_ERRNO and the application may consult errno -- to get the exact error code. --*/ -- --ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); --/* -- Clears the error and end-of-file flags for file. This is analogous to the -- clearerr() function in stdio. This is useful for continuing to read a gzip -- file that is being written concurrently. --*/ -- -- /* checksum functions */ -- --/* -- These functions are not related to compression but are exported -- anyway because they might be useful in applications using the -- compression library. --*/ -- --ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); --/* -- Update a running Adler-32 checksum with the bytes buf[0..len-1] and -- return the updated checksum. If buf is NULL, this function returns -- the required initial value for the checksum. -- An Adler-32 checksum is almost as reliable as a CRC32 but can be computed -- much faster. Usage example: -- -- uLong adler = adler32(0L, Z_NULL, 0); -- -- while (read_buffer(buffer, length) != EOF) { -- adler = adler32(adler, buffer, length); -- } -- if (adler != original_adler) error(); --*/ -- --ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, -- z_off_t len2)); --/* -- Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 -- and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for -- each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of -- seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. --*/ -- --ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); --/* -- Update a running CRC-32 with the bytes buf[0..len-1] and return the -- updated CRC-32. If buf is NULL, this function returns the required initial -- value for the 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: -- -- uLong crc = crc32(0L, Z_NULL, 0); -- -- while (read_buffer(buffer, length) != EOF) { -- crc = crc32(crc, buffer, length); -- } -- if (crc != original_crc) error(); --*/ -- --ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); -- --/* -- Combine two CRC-32 check values into one. For two sequences of bytes, -- seq1 and seq2 with lengths len1 and len2, CRC-32 check values were -- calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 -- check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and -- len2. --*/ -- -- -- /* various hacks, don't look :) */ -- --/* deflateInit and inflateInit are macros to allow checking the zlib version -- * and the compiler's view of z_stream: -- */ --ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, -- int windowBits, int memLevel, -- int strategy, const char *version, -- int stream_size)); --ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, -- const char *version, int stream_size)); --ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, -- unsigned char FAR *window, -- const char *version, -- int stream_size)); --#define deflateInit(strm, level) \ -- deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) --#define inflateInit(strm) \ -- inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) --#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ -- deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ -- (strategy), ZLIB_VERSION, sizeof(z_stream)) --#define inflateInit2(strm, windowBits) \ -- inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) --#define inflateBackInit(strm, windowBits, window) \ -- inflateBackInit_((strm), (windowBits), (window), \ -- ZLIB_VERSION, sizeof(z_stream)) -- -- --#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) -- struct internal_state {int dummy;}; /* hack for buggy compilers */ --#endif -- --ZEXTERN const char * ZEXPORT zError OF((int)); --ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); --ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); -- --#ifdef __cplusplus --} --#endif -- --#endif /* ZLIB_H */ -diff -ruN seqinr.orig/src/zsockr.c seqinr/src/zsockr.c ---- seqinr.orig/src/zsockr.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/zsockr.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,169 +0,0 @@ --/* functions to handle zlib-compressed data read from socket --*/ --#ifndef WIN32 --#ifdef _WIN32 --#define WIN32 1 --#endif --#endif --#ifndef WIN32 --#include "zlib.h" --#include --#include --#include --#include --#ifdef WIN32 --#include --#else --#include --#endif -- -- --/* included functions */ --void *prepare_sock_gz_r(int sockr); --int z_getc_R(void *v); --char *z_gets(void *v, char *line, size_t len); --char *z_read_sock(void *v); --int close_sock_gz_r(void *v); -- -- -- --#define ZBSIZE 100000 --typedef struct { -- z_stream stream; -- char z_buffer[ZBSIZE]; /* compressed input buffer */ -- char text_buffer[4 * ZBSIZE]; /* decompressed buffer */ -- char *pos, *endbuf; --#ifdef WIN32 -- SOCKET fd; --#else -- int fd; --#endif -- } sock_gz_r; -- -- -- --void *prepare_sock_gz_r(int sockr) --{ --int err; --sock_gz_r *big; --static sock_gz_r s_big; -- --big = &s_big; --if(big == NULL) return NULL; --big->stream.next_in = Z_NULL; --big->stream.avail_in = 0; --big->stream.avail_out = 0; --big->stream.zalloc = Z_NULL; --big->stream.zfree = Z_NULL; --big->stream.opaque = NULL; --big->pos = big->text_buffer; --big->endbuf = big->pos; --#ifdef WIN32 --big->fd = (SOCKET)sockr; --#else --big->fd = sockr; --#endif --err = inflateInit(&big->stream); --return err == Z_OK ? (void *)big : NULL; --} -- -- --int z_getc_R(void *v) --{ --int q, lu; --sock_gz_r *big = (sock_gz_r *)v; --z_streamp zs; --#ifndef WIN32 --int err; --fd_set readfds; --#endif -- --if(big->pos < big->endbuf) { -- return *(big->pos++); -- } --zs = &(big->stream); --zs->next_out = (Bytef *)big->text_buffer; --zs->avail_out = sizeof(big->text_buffer); --big->pos = (char *)zs->next_out; --do { -- if(zs->avail_in == 0) { --#ifdef WIN32 -- do -- lu = recv( big->fd , big->z_buffer, ZBSIZE, 0 ); -- while (lu <=0); --#else -- FD_ZERO(&readfds); -- FD_SET(big->fd, &readfds); -- err = select(big->fd + 1, &readfds, NULL, NULL, NULL); -- if(err > 0 ) { -- lu = read( big->fd , big->z_buffer, ZBSIZE ); -- } -- else lu = -1; --#endif -- if(lu == -1) return EOF; -- zs->next_in = (Bytef *)big->z_buffer; -- zs->avail_in = lu; -- } -- q = inflate(zs, Z_NO_FLUSH); -- if(q == Z_STREAM_END) break; -- if(q != Z_OK) { -- break; -- } -- } --while ( (char *)zs->next_out == big->pos); --big->endbuf = (char *)zs->next_out; --if(big->pos < big->endbuf) return *(big->pos++); --else -- return EOF; --} -- -- --char *z_gets(void *v, char *line, size_t len) --{ --int c; --char *p; -- --p = line; --while(len > 1) { -- c = z_getc_R( v ); -- if(c == EOF) { -- if(p == line) return NULL; -- break; -- } -- *(p++) = c; -- if(c == '\n') break; -- len--; -- } --*p = 0; --return line; --} -- -- --char *z_read_sock(void *v) --{ --static char line[500]; --char *p; --int l; -- --p = z_gets(v, line, sizeof(line)); --if(p == NULL) return NULL; --l = strlen(line); --if(l > 0 && line[l-1] == '\n') line[l-1] = 0; --return line; --} -- -- --int close_sock_gz_r(void *v) --{ --sock_gz_r *big = (sock_gz_r *)v; --int val; -- --val = inflateEnd(&(big->stream)); --return val; --} --#else --void *prepare_sock_gz_r(int sockr) { --return 0; --} --#endif -- -diff -ruN seqinr.orig/src/zutil.c seqinr/src/zutil.c ---- seqinr.orig/src/zutil.c 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/zutil.c 1970-01-01 01:00:00.000000000 +0100 -@@ -1,322 +0,0 @@ --/* zutil.c -- target dependent utility functions for the compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* @(#) $Id: zutil.c,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ -- --#include "zutil.h" -- --#ifndef NO_DUMMY_DECL --struct internal_state {int dummy;}; /* for buggy compilers */ --#endif -- --const char * const z_errmsg[10] = { --"need dictionary", /* Z_NEED_DICT 2 */ --"stream end", /* Z_STREAM_END 1 */ --"", /* Z_OK 0 */ --"file error", /* Z_ERRNO (-1) */ --"stream error", /* Z_STREAM_ERROR (-2) */ --"data error", /* Z_DATA_ERROR (-3) */ --"insufficient memory", /* Z_MEM_ERROR (-4) */ --"buffer error", /* Z_BUF_ERROR (-5) */ --"incompatible version",/* Z_VERSION_ERROR (-6) */ --""}; -- -- --const char * ZEXPORT zlibVersion() --{ -- return ZLIB_VERSION; --} -- --uLong ZEXPORT zlibCompileFlags() --{ -- uLong flags; -- -- flags = 0; -- switch (sizeof(uInt)) { -- case 2: break; -- case 4: flags += 1; break; -- case 8: flags += 2; break; -- default: flags += 3; -- } -- switch (sizeof(uLong)) { -- case 2: break; -- case 4: flags += 1 << 2; break; -- case 8: flags += 2 << 2; break; -- default: flags += 3 << 2; -- } -- switch (sizeof(voidpf)) { -- case 2: break; -- case 4: flags += 1 << 4; break; -- case 8: flags += 2 << 4; break; -- default: flags += 3 << 4; -- } -- switch (sizeof(z_off_t)) { -- case 2: break; -- case 4: flags += 1 << 6; break; -- case 8: flags += 2 << 6; break; -- default: flags += 3 << 6; -- } --#ifdef DEBUG -- flags += 1 << 8; --#endif --#if defined(ASMV) || defined(ASMINF) -- flags += 1 << 9; --#endif --#ifdef ZLIB_WINAPI -- flags += 1 << 10; --#endif --#ifdef BUILDFIXED -- flags += 1 << 12; --#endif --#ifdef DYNAMIC_CRC_TABLE -- flags += 1 << 13; --#endif --#ifdef NO_GZCOMPRESS -- flags += 1L << 16; --#endif --#ifdef NO_GZIP -- flags += 1L << 17; --#endif --#ifdef PKZIP_BUG_WORKAROUND -- flags += 1L << 20; --#endif --#ifdef FASTEST -- flags += 1L << 21; --#endif --#ifdef STDC --# ifdef NO_vsnprintf -- flags += 1L << 25; --# ifdef HAS_vsprintf_void -- flags += 1L << 26; --# endif --# else --# ifdef HAS_vsnprintf_void -- flags += 1L << 26; --# endif --# endif --#else -- flags += 1L << 24; --# ifdef NO_snprintf -- flags += 1L << 25; --# ifdef HAS_sprintf_void -- flags += 1L << 26; --# endif --# else --# ifdef HAS_snprintf_void -- flags += 1L << 26; --# endif --# endif --#endif -- return flags; --} -- --#ifdef DEBUG -- --# ifndef verbose --# define verbose 0 --# endif --int z_verbose = verbose; -- --void z_error (m) -- char *m; --{ -- fprintf(stderr, "%s\n", m); -- exit(1); --} --#endif -- --/* exported to allow conversion of error code to string for compress() and -- * uncompress() -- */ --const char * ZEXPORT zError(int err) --/* int err; */ --{ -- return ERR_MSG(err); --} -- --#if defined(_WIN32_WCE) -- /* The Microsoft C Run-Time Library for Windows CE doesn't have -- * errno. We define it as a global variable to simplify porting. -- * Its value is always 0 and should not be used. -- */ -- int errno = 0; --#endif -- --#ifndef HAVE_MEMCPY -- --void zmemcpy(dest, source, len) -- Bytef* dest; -- const Bytef* source; -- uInt len; --{ -- if (len == 0) return; -- do { -- *dest++ = *source++; /* ??? to be unrolled */ -- } while (--len != 0); --} -- --int zmemcmp(s1, s2, len) -- const Bytef* s1; -- const Bytef* s2; -- uInt len; --{ -- uInt j; -- -- for (j = 0; j < len; j++) { -- if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1; -- } -- return 0; --} -- --void zmemzero(dest, len) -- Bytef* dest; -- uInt len; --{ -- if (len == 0) return; -- do { -- *dest++ = 0; /* ??? to be unrolled */ -- } while (--len != 0); --} --#endif -- -- --#ifdef SYS16BIT -- --#ifdef __TURBOC__ --/* Turbo C in 16-bit mode */ -- --# define MY_ZCALLOC -- --/* Turbo C malloc() does not allow dynamic allocation of 64K bytes -- * and farmalloc(64K) returns a pointer with an offset of 8, so we -- * must fix the pointer. Warning: the pointer must be put back to its -- * original form in order to free it, use zcfree(). -- */ -- --#define MAX_PTR 10 --/* 10*64K = 640K */ -- --local int next_ptr = 0; -- --typedef struct ptr_table_s { -- voidpf org_ptr; -- voidpf new_ptr; --} ptr_table; -- --local ptr_table table[MAX_PTR]; --/* This table is used to remember the original form of pointers -- * to large buffers (64K). Such pointers are normalized with a zero offset. -- * Since MSDOS is not a preemptive multitasking OS, this table is not -- * protected from concurrent access. This hack doesn't work anyway on -- * a protected system like OS/2. Use Microsoft C instead. -- */ -- --voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) --{ -- voidpf buf = opaque; /* just to make some compilers happy */ -- ulg bsize = (ulg)items*size; -- -- /* If we allocate less than 65520 bytes, we assume that farmalloc -- * will return a usable pointer which doesn't have to be normalized. -- */ -- if (bsize < 65520L) { -- buf = farmalloc(bsize); -- if (*(ush*)&buf != 0) return buf; -- } else { -- buf = farmalloc(bsize + 16L); -- } -- if (buf == NULL || next_ptr >= MAX_PTR) return NULL; -- table[next_ptr].org_ptr = buf; -- -- /* Normalize the pointer to seg:0 */ -- *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4; -- *(ush*)&buf = 0; -- table[next_ptr++].new_ptr = buf; -- return buf; --} -- --void zcfree (voidpf opaque, voidpf ptr) --{ -- int n; -- if (*(ush*)&ptr != 0) { /* object < 64K */ -- farfree(ptr); -- return; -- } -- /* Find the original pointer */ -- for (n = 0; n < next_ptr; n++) { -- if (ptr != table[n].new_ptr) continue; -- -- farfree(table[n].org_ptr); -- while (++n < next_ptr) { -- table[n-1] = table[n]; -- } -- next_ptr--; -- return; -- } -- ptr = opaque; /* just to make some compilers happy */ -- Assert(0, "zcfree: ptr not found"); --} -- --#endif /* __TURBOC__ */ -- -- --#ifdef M_I86 --/* Microsoft C in 16-bit mode */ -- --# define MY_ZCALLOC -- --#if (!defined(_MSC_VER) || (_MSC_VER <= 600)) --# define _halloc halloc --# define _hfree hfree --#endif -- --voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) --{ -- if (opaque) opaque = 0; /* to make compiler happy */ -- return _halloc((long)items, size); --} -- --void zcfree (voidpf opaque, voidpf ptr) --{ -- if (opaque) opaque = 0; /* to make compiler happy */ -- _hfree(ptr); --} -- --#endif /* M_I86 */ -- --#endif /* SYS16BIT */ -- -- --#ifndef MY_ZCALLOC /* Any system without a special alloc function */ -- --#ifndef STDC --extern voidp malloc OF((uInt size)); --extern voidp calloc OF((uInt items, uInt size)); --extern void free OF((voidpf ptr)); --#endif -- --voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) --/* -- voidpf opaque; -- unsigned items; -- unsigned size; --*/ --{ -- if (opaque) items += size - size; /* make compiler happy */ -- return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) : -- (voidpf)calloc(items, size); --} -- --void zcfree (voidpf opaque, voidpf ptr) --/* -- voidpf opaque; -- voidpf ptr; --*/ --{ -- free(ptr); -- if (opaque) return; /* make compiler happy */ --} -- --#endif /* MY_ZCALLOC */ -diff -ruN seqinr.orig/src/zutil.h seqinr/src/zutil.h ---- seqinr.orig/src/zutil.h 2007-04-19 11:40:19.000000000 +0200 -+++ seqinr/src/zutil.h 1970-01-01 01:00:00.000000000 +0100 -@@ -1,269 +0,0 @@ --/* zutil.h -- internal interface and configuration of the compression library -- * Copyright (C) 1995-2005 Jean-loup Gailly. -- * For conditions of distribution and use, see copyright notice in zlib.h -- */ -- --/* WARNING: this file should *not* be used by applications. It is -- part of the implementation of the compression library and is -- subject to change. Applications should only use zlib.h. -- */ -- --/* @(#) $Id: zutil.h,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ -- --#ifndef ZUTIL_H --#define ZUTIL_H -- --#define ZLIB_INTERNAL --#include "zlib.h" -- --#ifdef STDC --# ifndef _WIN32_WCE --# include --# endif --# include --# include --#endif --#ifdef NO_ERRNO_H --# ifdef _WIN32_WCE -- /* The Microsoft C Run-Time Library for Windows CE doesn't have -- * errno. We define it as a global variable to simplify porting. -- * Its value is always 0 and should not be used. We rename it to -- * avoid conflict with other libraries that use the same workaround. -- */ --# define errno z_errno --# endif -- extern int errno; --#else --# ifndef _WIN32_WCE --# include --# endif --#endif -- --#ifndef local --# define local static --#endif --/* compile with -Dlocal if your debugger can't find static symbols */ -- --typedef unsigned char uch; --typedef uch FAR uchf; --typedef unsigned short ush; --typedef ush FAR ushf; --typedef unsigned long ulg; -- --extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ --/* (size given to avoid silly warnings with Visual C++) */ -- --#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] -- --#define ERR_RETURN(strm,err) \ -- return (strm->msg = (char*)ERR_MSG(err), (err)) --/* To be used only when the state is known to be valid */ -- -- /* common constants */ -- --#ifndef DEF_WBITS --# define DEF_WBITS MAX_WBITS --#endif --/* default windowBits for decompression. MAX_WBITS is for compression only */ -- --#if MAX_MEM_LEVEL >= 8 --# define DEF_MEM_LEVEL 8 --#else --# define DEF_MEM_LEVEL MAX_MEM_LEVEL --#endif --/* default memLevel */ -- --#define STORED_BLOCK 0 --#define STATIC_TREES 1 --#define DYN_TREES 2 --/* The three kinds of block type */ -- --#define MIN_MATCH 3 --#define MAX_MATCH 258 --/* The minimum and maximum match lengths */ -- --#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ -- -- /* target dependencies */ -- --#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) --# define OS_CODE 0x00 --# if defined(__TURBOC__) || defined(__BORLANDC__) --# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) -- /* Allow compilation with ANSI keywords only enabled */ -- void _Cdecl farfree( void *block ); -- void *_Cdecl farmalloc( unsigned long nbytes ); --# else --# include --# endif --# else /* MSC or DJGPP */ --# include --# endif --#endif -- --#ifdef AMIGA --# define OS_CODE 0x01 --#endif -- --#if defined(VAXC) || defined(VMS) --# define OS_CODE 0x02 --# define F_OPEN(name, mode) \ -- fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") --#endif -- --#if defined(ATARI) || defined(atarist) --# define OS_CODE 0x05 --#endif -- --#ifdef OS2 --# define OS_CODE 0x06 --# ifdef M_I86 -- #include --# endif --#endif -- --#if defined(MACOS) || defined(TARGET_OS_MAC) --# define OS_CODE 0x07 --# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os --# include /* for fdopen */ --# else --# ifndef fdopen --# define fdopen(fd,mode) NULL /* No fdopen() */ --# endif --# endif --#endif -- --#ifdef TOPS20 --# define OS_CODE 0x0a --#endif -- --#ifdef WIN32 --# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ --# define OS_CODE 0x0b --# endif --#endif -- --#ifdef __50SERIES /* Prime/PRIMOS */ --# define OS_CODE 0x0f --#endif -- --#if defined(_BEOS_) || defined(RISCOS) --# define fdopen(fd,mode) NULL /* No fdopen() */ --#endif -- --#if (defined(_MSC_VER) && (_MSC_VER > 600)) --# if defined(_WIN32_WCE) --# define fdopen(fd,mode) NULL /* No fdopen() */ --# ifndef _PTRDIFF_T_DEFINED -- typedef int ptrdiff_t; --# define _PTRDIFF_T_DEFINED --# endif --# else --# define fdopen(fd,type) _fdopen(fd,type) --# endif --#endif -- -- /* common defaults */ -- --#ifndef OS_CODE --# define OS_CODE 0x03 /* assume Unix */ --#endif -- --#ifndef F_OPEN --# define F_OPEN(name, mode) fopen((name), (mode)) --#endif -- -- /* functions */ -- --#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) --# ifndef HAVE_VSNPRINTF --# define HAVE_VSNPRINTF --# endif --#endif --#if defined(__CYGWIN__) --# ifndef HAVE_VSNPRINTF --# define HAVE_VSNPRINTF --# endif --#endif --#ifndef HAVE_VSNPRINTF --# ifdef MSDOS -- /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), -- but for now we just assume it doesn't. */ --# define NO_vsnprintf --# endif --# ifdef __TURBOC__ --# define NO_vsnprintf --# endif --# ifdef WIN32 -- /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ --# if !defined(vsnprintf) && !defined(NO_vsnprintf) --# define vsnprintf _vsnprintf --# endif --# endif --# ifdef __SASC --# define NO_vsnprintf --# endif --#endif --#ifdef VMS --# define NO_vsnprintf --#endif -- --#if defined(pyr) --# define NO_MEMCPY --#endif --#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) -- /* Use our own functions for small and medium model with MSC <= 5.0. -- * You may have to use the same strategy for Borland C (untested). -- * The __SC__ check is for Symantec. -- */ --# define NO_MEMCPY --#endif --#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) --# define HAVE_MEMCPY --#endif --#ifdef HAVE_MEMCPY --# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ --# define zmemcpy _fmemcpy --# define zmemcmp _fmemcmp --# define zmemzero(dest, len) _fmemset(dest, 0, len) --# else --# define zmemcpy memcpy --# define zmemcmp memcmp --# define zmemzero(dest, len) memset(dest, 0, len) --# endif --#else -- extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); -- extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); -- extern void zmemzero OF((Bytef* dest, uInt len)); --#endif -- --/* Diagnostic functions */ --#ifdef DEBUG --# include -- extern int z_verbose; -- extern void z_error OF((char *m)); --# define Assert(cond,msg) {if(!(cond)) z_error(msg);} --# define Trace(x) {if (z_verbose>=0) fprintf x ;} --# define Tracev(x) {if (z_verbose>0) fprintf x ;} --# define Tracevv(x) {if (z_verbose>1) fprintf x ;} --# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} --# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} --#else --# define Assert(cond,msg) --# define Trace(x) --# define Tracev(x) --# define Tracevv(x) --# define Tracec(c,x) --# define Tracecv(c,x) --#endif -- -- --voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); --void zcfree OF((voidpf opaque, voidpf ptr)); -- --#define ZALLOC(strm, items, size) \ -- (*((strm)->zalloc))((strm)->opaque, (items), (size)) --#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) --#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} -- --#endif /* ZUTIL_H */ diff --git a/branch/double_build/inst/etc/patches/svSocket/00list b/branch/double_build/inst/etc/patches/svSocket/00list deleted file mode 100644 index b0adfd9..0000000 --- a/branch/double_build/inst/etc/patches/svSocket/00list +++ /dev/null @@ -1 +0,0 @@ -01_SimpleClient.patch diff --git a/branch/double_build/inst/etc/patches/svSocket/01_SimpleClient.patch b/branch/double_build/inst/etc/patches/svSocket/01_SimpleClient.patch deleted file mode 100644 index 786ba3d..0000000 --- a/branch/double_build/inst/etc/patches/svSocket/01_SimpleClient.patch +++ /dev/null @@ -1,17 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_SimpleClient.dpatch by -## -## All lines beginning with `## DP:' are a description of the patch. -## DP: Correct tclsh path - -@DPATCH@ - -diff -ru svSocket.orig/inst/etc/SimpleClient.Tcl svSocket/inst/etc/SimpleClient.Tcl ---- svSocket.orig/inst/etc/SimpleClient.Tcl 2007-12-31 10:42:05.000000000 +0100 -+++ svSocket/inst/etc/SimpleClient.Tcl 2009-05-18 04:23:04.000000000 +0200 -@@ -1,4 +1,4 @@ --#!/usr/local/bin/tclsh8.4 -+#!/usr/bin/tclsh8.4 - # Open a terminal and issue - # $ tclsh SimpleClient.tcl - # when the R socket server is running diff --git a/branch/double_build/inst/etc/sys/debian-amd64/dput.cf b/branch/double_build/inst/etc/sys/debian-amd64/dput.cf deleted file mode 100644 index 4439493..0000000 --- a/branch/double_build/inst/etc/sys/debian-amd64/dput.cf +++ /dev/null @@ -1,7 +0,0 @@ -[local] -method = local -incoming = /etc/cran2deb/archive/debian-amd64/mini-dinstall/incoming -allow_non-us_software = 1 -run_dinstall = 0 -run_lintian = 1 -allow_unsigned_uploads = 1 diff --git a/branch/double_build/inst/etc/sys/debian-amd64/mini-dinstall.conf b/branch/double_build/inst/etc/sys/debian-amd64/mini-dinstall.conf deleted file mode 100644 index 9cb44c2..0000000 --- a/branch/double_build/inst/etc/sys/debian-amd64/mini-dinstall.conf +++ /dev/null @@ -1,13 +0,0 @@ -[DEFAULT] -architectures = all, i386, amd64 -use_dnotify = 1 -verify_sigs = 0 -mail_on_success = 0 -archive_style = simple-subdir -mail_log_level = NONE -archivedir = /etc/cran2deb/archive/debian-amd64 -logfile = /dev/null -incoming_permissions=770 - -[testing] - diff --git a/branch/double_build/inst/etc/sys/debian-amd64/pbuilderrc b/branch/double_build/inst/etc/sys/debian-amd64/pbuilderrc deleted file mode 100644 index 6479499..0000000 --- a/branch/double_build/inst/etc/sys/debian-amd64/pbuilderrc +++ /dev/null @@ -1,12 +0,0 @@ -BASETGZ=/var/cache/pbuilder/base-cran2deb-debian-amd64.tgz -HOOKDIR=/etc/cran2deb/hook -BUILDRESULT=/var/cache/cran2deb/results/debian-amd64 -EXTRAPACKAGES='debhelper r-base-dev cdbs r-base-core lintian xvfb xauth xfonts-base' -REMOVEPACKAGES='lilo libldap-2.4-2 libopencdk10 libsasl2-2' -# don't actually need aptitude, but pbuilder insists... -#REMOVEPACKAGES+='aptitude libcwidget3 libept0 libncursesw5 libsigc++-2.0-0c2a libxapian15' -DISTRIBUTION=testing -OTHERMIRROR='deb http://localhost/cran2deb/debian-amd64 testing/$(ARCH)/ | deb http://localhost/cran2deb/debian-amd64 testing/all/ | deb http://statmath.wu-wien.ac.at/AASC/debian/ testing main' -MIRRORSITE='http://ftp.at.debian.org/debian/' -APTCACHE='' -PBUILDERSATISFYDEPENDSCMD='/usr/lib/pbuilder/pbuilder-satisfydepends-classic' diff --git a/branch/double_build/inst/etc/sys/debian-i386/dput.cf b/branch/double_build/inst/etc/sys/debian-i386/dput.cf deleted file mode 100644 index 722ece3..0000000 --- a/branch/double_build/inst/etc/sys/debian-i386/dput.cf +++ /dev/null @@ -1,7 +0,0 @@ -[local] -method = local -incoming = /etc/cran2deb/archive/debian-i386/mini-dinstall/incoming -allow_non-us_software = 1 -run_dinstall = 0 -run_lintian = 1 -allow_unsigned_uploads = 1 diff --git a/branch/double_build/inst/etc/sys/debian-i386/mini-dinstall.conf b/branch/double_build/inst/etc/sys/debian-i386/mini-dinstall.conf deleted file mode 100644 index 45bab22..0000000 --- a/branch/double_build/inst/etc/sys/debian-i386/mini-dinstall.conf +++ /dev/null @@ -1,13 +0,0 @@ -[DEFAULT] -architectures = all, i386 -use_dnotify = 1 -verify_sigs = 0 -mail_on_success = 0 -archive_style = simple-subdir -mail_log_level = NONE -archivedir = /etc/cran2deb/archive/debian-i386 -logfile = /dev/null -incoming_permissions=770 - -[testing] - diff --git a/branch/double_build/inst/etc/sys/debian-i386/pbuilderrc b/branch/double_build/inst/etc/sys/debian-i386/pbuilderrc deleted file mode 100644 index e3b5f5e..0000000 --- a/branch/double_build/inst/etc/sys/debian-i386/pbuilderrc +++ /dev/null @@ -1,13 +0,0 @@ -BASETGZ=/var/cache/pbuilder/base-cran2deb-debian-i386.tgz -HOOKDIR=/etc/cran2deb/hook -BUILDRESULT=/var/cache/cran2deb/results/debian-i386 -EXTRAPACKAGES='debhelper r-base-dev cdbs r-base-core lintian xvfb xauth xfonts-base' -REMOVEPACKAGES='lilo libldap-2.4-2 libopencdk10 libsasl2-2' -# don't actually need aptitude, but pbuilder insists... -#REMOVEPACKAGES+='aptitude libcwidget3 libept0 libncursesw5 libsigc++-2.0-0c2a libxapian15' -DISTRIBUTION=testing -OTHERMIRROR='deb http://localhost/cran2deb/debian-i386 testing/$(ARCH)/ | deb http://localhost/cran2deb/debian-i386 testing/all/ | deb http://statmath.wu-wien.ac.at/AASC/debian/ testing main' -MIRRORSITE='http://ftp.at.debian.org/debian/' -APTCACHE='' -PBUILDERSATISFYDEPENDSCMD='/usr/lib/pbuilder/pbuilder-satisfydepends-classic' -DEBOOTSTRAPOPTS='--arch=i386' diff --git a/branch/split_build/DESCRIPTION b/branch/split_build/DESCRIPTION new file mode 100644 index 0000000..b5129db --- /dev/null +++ b/branch/split_build/DESCRIPTION @@ -0,0 +1,11 @@ +Package: cran2deb +Version: 0.0 +Date: 2008-07-14 +Title: Convert CRAN packages into Debian packages +Author: Charles Blundell , with assistance from Dirk Eddelbuettel <> +Maintainer: Charles Blundell +Depends: ctv, utils, RSQLite, DBI, digest, hwriter +SystemRequirements: littler, rc, pbuilder, debian toolchain, web server, mini-dinstall, curl +Description: Convert CRAN packages into Debian packages, mostly unassisted, easily + subverting the R package system. +License: GPL-3 diff --git a/branch/split_build/R/build.R b/branch/split_build/R/build.R new file mode 100644 index 0000000..60a3aac --- /dev/null +++ b/branch/split_build/R/build.R @@ -0,0 +1,133 @@ + +build <- function(name,extra_deps,force=F,do_cleanup=T) { + # can't, and hence don't need to, build base packages + if (name %in% base_pkgs) { + return(T) + } + log_clear() + dir <- setup() + + # obtain the Debian version-to-be + version <- try(new_build_version(name)) + if (inherits(version,'try-error')) { + error('failed to build',name) + return(NULL) + } + + result <- try((function() { + if (!force && !needs_build(name,version)) { + notice('skipping build of',name) + return(NULL) + } + + if (name %in% db_blacklist_packages()) { + #fail('package',name,'is blacklisted. consult database for reason.') + notice('package',name,'is blacklisted. consult database for reason.') + return(NULL) + } + + pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps) + if (pkg$debversion != version) { + fail('expected Debian version',version,'not equal to actual version',pkg$debversion) + } + + notice('R dependencies:',paste(pkg$depends$r,collapse=', ')) + try_upload <- function(pkg, arch) { + ret = log_system('umask 002; reprepro -b ',reprepro_dir,' include testing', changesfile(pkg$srcname,pkg$debversion, arch)) + if (ret != 0) { + fail('upload failed!') + } + } + if (pkg$archdep) { + build_debian(pkg, indep_arch) + try_upload(pkg, indep_arch) + } else { + for (arch in archs) { + build_debian(pkg, arch) + try_upload(pkg, arch) + } + } + + return(pkg$debversion) + })()) + if (do_cleanup) { + cleanup(dir) + } else { + notice('output is in',dir,'. you must clean this up yourself.') + } + if (is.null(result)) { + # nothing was done so escape asap. + return(result) + } + + # otherwise record progress + failed = inherits(result,'try-error') + if (failed) { + error('failure of',name,'means these packages will fail:' + ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', ')) + } + db_record_build(name, version, log_retrieve(), !failed) + return(!failed) +} + +needs_build <- function(name,version) { + # see if the last build was successful + build <- db_latest_build(name) + if (!is.null(build) && build$success) { + # then something must have changed for us to attempt this + # build + if (build$r_version == version_upstream(version) && + build$deb_epoch == version_epoch(version) && + build$db_version == db_get_version()) { + return(F) + } + } else { + # always rebuild on failure or no record + notice('rebuilding',name,': no build record or previous build failed') + return(T) + } + # see if it has already been built *and* successfully uploaded + srcname <- pkgname_as_debian(name,binary=F) + debname <- pkgname_as_debian(name,binary=T) + all=TRUE + for (arch in archs) { + all = all && file.exists(changesfile(srcname, version, arch)) + } + if (all || file.exists(changesfile(srcname, version,indep_arch))) { + notice('already built',srcname,'version',version) + return(F) + } + + if (build$r_version != version_upstream(version)) { + notice('rebuilding',name,': new upstream version',build$r_version,'(old) vs',version_upstream(version),'(new)') + } + if (build$deb_epoch != version_epoch(version)) { + notice('rebuilding',name,': new cran2deb epoch',build$deb_epoch,'(old) vs',version_epoch(version),'(new)') + } + if (build$db_version != db_get_version()) { + notice('rebuilding',name,': new db version',build$db_version,'(old) vs',db_get_version(),'(new)') + } + rm(debname,srcname) + return(T) +} + +build_debian <- function(pkg,arch) { + wd <- getwd() + setwd(pkg$path) + notice('building Debian package' + ,pkg$debname + ,paste('(',pkg$debversion,')',sep='') + ,'for',arch,'...') + + cmd = paste('pdebuild --configfile',shQuote(get_pbuilder_config(arch))) + if (version_revision(pkg$debversion) > 2) { + cmd = paste(cmd,'--debbuildopts','-sd') + notice('build should exclude original source') + } + ret = log_system(cmd) + setwd(wd) + if (ret != 0) { + fail('Failed to build package.') + } +} + diff --git a/branch/split_build/R/db.R b/branch/split_build/R/db.R new file mode 100644 index 0000000..a906b04 --- /dev/null +++ b/branch/split_build/R/db.R @@ -0,0 +1,493 @@ + +db_start <- function() { + drv <- dbDriver('SQLite') + con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db')) + if (!dbExistsTable(con,'sysreq_override')) { + dbGetQuery(con,paste('CREATE TABLE sysreq_override (' + ,' depend_alias TEXT NOT NULL' + ,',r_pattern TEXT PRIMARY KEY NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'debian_dependency')) { + dbGetQuery(con,paste('CREATE TABLE debian_dependency (' + ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',system TEXT NOT NULL' + ,',alias TEXT NOT NULL' + ,',build INTEGER NOT NULL' + ,',debian_pkg TEXT NOT NULL' + ,',UNIQUE (alias,build,debian_pkg)' + ,')')) + } + if (!dbExistsTable(con,'forced_depends')) { + dbGetQuery(con,paste('CREATE TABLE forced_depends (' + ,' r_name TEXT NOT NULL' + ,',depend_alias TEXT NOT NULL' + ,',PRIMARY KEY (r_name,depend_alias)' + ,')')) + } + if (!dbExistsTable(con,'license_override')) { + dbGetQuery(con,paste('CREATE TABLE license_override (' + ,' name TEXT PRIMARY KEY NOT NULL' + ,',accept INT NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'license_hashes')) { + dbGetQuery(con,paste('CREATE TABLE license_hashes (' + ,' name TEXT NOT NULL' + ,',sha1 TEXT PRIMARY KEY NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'database_versions')) { + dbGetQuery(con,paste('CREATE TABLE database_versions (' + ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',version_date INTEGER NOT NULL' + ,',base_epoch INTEGER NOT NULL' + ,')')) + db_add_version(con,1,0) + } + if (!dbExistsTable(con,'packages')) { + dbGetQuery(con,paste('CREATE TABLE packages (' + ,' package TEXT PRIMARY KEY NOT NULL' + ,',latest_r_version TEXT' + ,')')) + } + if (!dbExistsTable(con,'builds')) { + dbGetQuery(con,paste('CREATE TABLE builds (' + ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',system TEXT NOT NULL' + ,',package TEXT NOT NULL' + ,',r_version TEXT NOT NULL' + ,',deb_epoch INTEGER NOT NULL' + ,',deb_revision INTEGER NOT NULL' + ,',db_version INTEGER NOT NULL' + ,',date_stamp TEXT NOT NULL' + ,',time_stamp TEXT NOT NULL' + ,',scm_revision TEXT NOT NULL' + ,',success INTEGER NOT NULL' + ,',log TEXT' + ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)' + ,')')) + } + if (!dbExistsTable(con,'blacklist_packages')) { + dbGetQuery(con,paste('CREATE TABLE blacklist_packages (' + ,' package TEXT PRIMARY KEY NOT NULL ' + ,',system TEXT NOT NULL' + ,',nonfree INTEGER NOT NULL DEFAULT 0' + ,',obsolete INTEGER NOT NULL DEFAULT 0' + ,',broken_dependency INTEGER NOT NULL DEFAULT 0' + ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0' + ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0' + ,',other INTEGER NOT NULL DEFAULT 0' + ,',explanation TEXT NOT NULL ' + ,')')) + } + return(con) +} + +db_stop <- function(con,bump=F) { + if (bump) { + db_bump(con) + } + dbDisconnect(con) +} + +db_quote <- function(text) { + return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep='')) +} + +db_now <- function() { + return(as.integer(gsub('-','',Sys.Date()))) +} + +db_cur_version <- function(con) { + return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]])) +} + +db_base_epoch <- function(con) { + return(as.integer(dbGetQuery(con, + paste('SELECT max(base_epoch) FROM database_versions' + ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]])) +} + +db_get_base_epoch <- function() { + con <- db_start() + v <- db_base_epoch(con) + db_stop(con) + return(v) +} + +db_get_version <- function() { + con <- db_start() + v <- db_cur_version(con) + db_stop(con) + return(v) +} + +db_add_version <- function(con, version, epoch) { + dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)' + ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')')) +} + +db_bump <- function(con) { + db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)) +} + +db_bump_epoch <- function(con) { + db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1) +} + +db_sysreq_override <- function(sysreq_text) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE' + ,db_quote(tolower(sysreq_text)),'LIKE r_pattern')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(results$depend_alias) +} + +db_add_sysreq_override <- function(pattern,depend_alias) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO sysreq_override' + ,'(depend_alias, r_pattern) VALUES (' + ,' ',db_quote(tolower(depend_alias)) + ,',',db_quote(tolower(pattern)) + ,')')) + db_stop(con) +} + +db_sysreq_overrides <- function() { + con <- db_start() + overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override')) + db_stop(con) + return(overrides) +} + +db_get_depends <- function(depend_alias,build=F) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE' + ,db_quote(tolower(depend_alias)),'= alias' + ,'AND',as.integer(build),'= build', + ,'AND',db_quote(which_system),'= system')) + db_stop(con) + return(results$debian_pkg) +} + +db_add_depends <- function(depend_alias,debian_pkg,build=F) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO debian_dependency' + ,'(system, alias, build, debian_pkg) VALUES (' + ,' ',db_quote(which_system) + ,' ',db_quote(tolower(depend_alias)) + ,',',as.integer(build) + ,',',db_quote(tolower(debian_pkg)) + ,')')) + db_stop(con) +} + +db_depends <- function() { + con <- db_start() + depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency WHERE system = ',db_quote(which_system))) + db_stop(con) + return(depends) +} + +db_get_forced_depends <- function(r_name) { + con <- db_start() + forced_depends <- dbGetQuery(con, + paste('SELECT depend_alias FROM forced_depends WHERE' + ,db_quote(r_name),'= r_name')) + db_stop(con) + return(forced_depends$depend_alias) +} + +db_add_forced_depends <- function(r_name, depend_alias) { + if (!length(db_get_depends(depend_alias,build=F)) && + !length(db_get_depends(depend_alias,build=T))) { + fail('Debian dependency alias',depend_alias,'is not know,' + ,'yet trying to force a dependency on it?') + } + con <- db_start() + dbGetQuery(con, + paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)' + ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')')) + db_stop(con) +} + +db_forced_depends <- function() { + con <- db_start() + depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends')) + db_stop(con) + return(depends) +} + +db_license_override_name <- function(name) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT accept FROM license_override WHERE' + ,db_quote(tolower(name)),'= name')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(as.logical(results$accept)) +} + +db_add_license_override <- function(name,accept) { + notice('adding',name,'accept?',accept) + if (accept != TRUE && accept != FALSE) { + fail('accept must be TRUE or FALSE') + } + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO license_override' + ,'(name, accept) VALUES (' + ,' ',db_quote(tolower(name)) + ,',',as.integer(accept) + ,')')) + db_stop(con) +} + +db_license_override_hash <- function(license_sha1) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT accept FROM license_override' + ,'INNER JOIN license_hashes' + ,'ON license_hashes.name = license_override.name WHERE' + ,db_quote(tolower(license_sha1)),'= license_hashes.sha1')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(as.logical(results$accept)) +} + +db_license_overrides <- function() { + con <- db_start() + overrides <- dbGetQuery(con,paste('SELECT * FROM license_override')) + hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes')) + db_stop(con) + return(list(overrides=overrides,hashes=hashes)) +} + +db_add_license_hash <- function(name,license_sha1) { + if (is.null(db_license_override_name(name))) { + fail('license',name,'is not know, yet trying to add a hash for it?') + } + notice('adding hash',license_sha1,'for',name) + con <- db_start() + dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO license_hashes' + ,'(name, sha1) VALUES (' + ,' ',db_quote(tolower(name)) + ,',',db_quote(tolower(license_sha1)) + ,')')) + db_stop(con) +} + + +db_update_package_versions <- function() { + # seems like the quickest way of doing this: + con <- db_start() + dbGetQuery(con, 'DROP TABLE packages') + db_stop(con) + # db_start re-makes all tables + con <- db_start() + for (package in available[,'Package']) { + dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)' + ,'VALUES (',db_quote(package) + ,',',db_quote(available[package,'Version']),')')) + } + dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)') + db_stop(con) +} + +db_date_format <- '%Y-%m-%d' +db_time_format <- '%H:%M:%OS' + +db_record_build <- function(package, deb_version, log, success=F) { + # if the log is more than 1kB, only keep the last 1kB. + # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors. + # if the log is not pruned then we get the following error: + # + # Error in gsub("(['\"])", "\\1\\1", text) : + # Calloc could not allocate (-197080581 of 1) memory + # Error in dbGetQuery(con, paste("INSERT OR REPLACE INTO builds", "(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)", : + # error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery' + + log <- paste(log,collapse='\n') + end <- nchar(log) + max_log_len <- 10240 + if (end > max_log_len) { + log <- db_quote(substr(log,end-max_log_len,end)) + } else { + log <- db_quote(log) + } + con <- db_start() + o <- options(digits.secs = 6) + sqlcmd <- paste('INSERT OR REPLACE INTO builds' + ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)' + ,'VALUES' + ,'(',db_quote(package) + ,',',db_quote(which_system) + ,',',db_quote(version_upstream(deb_version)) + ,',',db_quote(version_epoch(deb_version)) + ,',',db_quote(version_revision(deb_version)) + ,',',db_cur_version(con) + ,',',as.integer(success) + ,',',db_quote(format(Sys.time(), db_date_format)) + ,',',db_quote(format(Sys.time(), db_time_format)) + ,',',db_quote(scm_revision) + ,',',log + ,')') + ##print(sqlcmd) + try(dbGetQuery(con,sqlcmd)) + options(o) + db_stop(con) +} + +db_builds <- function(pkgname) { + # returns all successful builds + con <- db_start() + build <- dbGetQuery(con, paste('SELECT * FROM builds' + ,'WHERE success = 1' + ,'AND system =',db_quote(which_system) + ,'AND package =',db_quote(pkgname))) + db_stop(con) + if (length(build) == 0) { + return(NULL) + } + return(db_cleanup_builds(build)) +} + +db_cleanup_builds <- function(build) { + build$success <- as.logical(build$success) + #o <-options(digits.secs = 6) + dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])), + paste(db_date_format, db_time_format))) + build$time_stamp <- NULL + build$date_stamp <- NULL + newdf <- data.frame(build, date_stamp=dt) + #print(newdf[, -grep("log", colnames(newdf))]) + #options(o) + #print(newdf[, -grep("log", colnames(newdf))]) + return(newdf) +} + +db_latest_build <- function(pkgname) { + con <- db_start() + build <- dbGetQuery(con, paste('SELECT * FROM builds' + ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'WHERE system =',db_quote(which_system) + , 'GROUP BY package) AS last' + ,'WHERE id = max_id' + ,'AND builds.package =',db_quote(pkgname))) + db_stop(con) + if (length(build) == 0) { + return(NULL) + } + return(db_cleanup_builds(build)) +} + +db_latest_build_version <- function(pkgname) { + build <- db_latest_build(pkgname) + if (is.null(build)) { + return(NULL) + } + return(version_new(build$r_version, build$deb_revision, build$deb_epoch)) +} + +db_latest_build_status <- function(pkgname) { + build <- db_latest_build(pkgname) + if (is.null(build)) { + return(NULL) + } + return(list(build$success,build$log)) +} + +db_outdated_packages <- function() { + con <- db_start() + packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages' + ,'LEFT OUTER JOIN (' + # extract the latest attempt at building each package + , 'SELECT * FROM builds' + , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'WHERE system =',db_quote(which_system) + , 'GROUP BY package) AS last' + , 'WHERE id = max_id) AS build' + ,'ON build.package = packages.package' + # outdated iff: + # - there is no latest build + ,'WHERE build.package IS NULL' + # - the database has changed since last build + ,'OR build.db_version < (SELECT max(version) FROM database_versions)' + # - the debian epoch has been bumped up + ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions' + , 'WHERE version IN (' + , 'SELECT max(version) FROM database_versions))' + # - the latest build is not of the latest R version + ,'OR build.r_version != packages.latest_r_version' + ))$package + db_stop(con) + return(packages) +} + +db_blacklist_packages <- function() { + con <- db_start() + packages <- dbGetQuery(con,paste('SELECT package from blacklist_packages' + ,' where system=',db_quote(which_system)))$package + db_stop(con) + return(packages) +} + +db_blacklist_reasons <- function () { + con <- db_start() + packages <- dbGetQuery(con,paste('SELECT package,explanation from blacklist_packages' + ,'where system=',db_quote(which_system),' group by explanation')) + db_stop(con) + return(packages) +} + +db_todays_builds <- function() { + today <- db_quote(format(Sys.time(), db_date_format)) + con <- db_start() + builds <- dbGetQuery(con,paste('select id,success,system,package, + r_version as version,deb_epoch as epo, + deb_revision as rev, scm_revision as svnrev, + db_version as db,date_stamp,time_stamp + from builds where date_stamp = ',today)) + db_stop(con) + return(builds) +} + +db_successful_builds <- function() { + con <- db_start() + builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp + from builds natural join (select system,package,max(id) as id + from builds + where package not in + (select package from blacklist_packages + where blacklist_packages.system == builds.system) + group by package,system) + where success = 1') + db_stop(con) + return(builds) +} + +db_failed_builds <- function() { + con <- db_start() + builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp + from builds natural join (select system,package,max(id) as id + from builds + where package not in + (select package from blacklist_packages) + group by package,system) + where success = 0') + db_stop(con) + return(builds) +} diff --git a/branch/split_build/R/debcontrol.R b/branch/split_build/R/debcontrol.R new file mode 100644 index 0000000..a044f89 --- /dev/null +++ b/branch/split_build/R/debcontrol.R @@ -0,0 +1,168 @@ +get_dependencies <- function(pkg,extra_deps) { + # determine dependencies + dependencies <- r_dependencies_of(description=pkg$description) + depends <- list() + # these are used for generating the Depends fields + as_deb <- function(r,build) { + return(pkgname_as_debian(paste(dependencies[r,]$name) + ,version=dependencies[r,]$version + ,repopref=pkg$repo + ,build=build)) + } + depends$bin <- lapply(rownames(dependencies), as_deb, build=F) + depends$build <- lapply(rownames(dependencies), as_deb, build=T) + # add the command line dependencies + depends$bin = c(extra_deps$deb,depends$bin) + depends$build = c(extra_deps$deb,depends$build) + # add the system requirements + if ('SystemRequirements' %in% colnames(pkg$description)) { + sysreq <- sysreqs_as_debian(pkg$description[1,'SystemRequirements']) + depends$bin = c(sysreq$bin,depends$bin) + depends$build = c(sysreq$build,depends$build) + } + + forced <- forced_deps_as_debian(pkg$name) + if (length(forced)) { + notice('forced build dependencies:',paste(forced$build, collapse=', ')) + notice('forced binary dependencies:',paste(forced$bin, collapse=', ')) + depends$bin = c(forced$bin,depends$bin) + depends$build = c(forced$build,depends$build) + } + + # make sure we depend upon R in some way... + if (!length(grep('^r-base',depends$build))) { + depends$build = c(depends$build,pkgname_as_debian('R',version='>= 2.7.0',build=T)) + depends$bin = c(depends$bin, pkgname_as_debian('R',version='>= 2.7.0',build=F)) + } + # also include stuff to allow tcltk to build (suggested by Dirk) + depends$build = c(depends$build,'xvfb','xauth','xfonts-base') + + # make all bin dependencies build dependencies. + depends$build = c(depends$build, depends$bin) + + # remove duplicates + depends <- lapply(depends,unique) + + # append the Debian dependencies + depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs') + if (file.exists(file.path(patch_dir, pkg$name))) { + depends$build <- c(depends$build,'dpatch') + } + if (pkg$archdep) { + depends$bin=c(depends$bin,'${shlibs:Depends}') + } + + # the names of dependent source packages (to find the .changes file to + # upload via dput). these can be found recursively. + depends$r = r_dependency_closure(dependencies) + # append command line dependencies + depends$r = c(extra_deps$r, depends$r) + return(depends) +} + +sysreqs_as_debian <- function(sysreq_text) { + # form of this field is unspecified (ugh) but most people seem to stick + # with this + aliases <- c() + sysreq_text <- gsub('[[:space:]]and[[:space:]]',' , ',tolower(sysreq_text)) + for (sysreq in strsplit(sysreq_text,'[[:space:]]*,[[:space:]]*')[[1]]) { + startreq = sysreq + # constant case + sysreq = tolower(sysreq) + # drop version information/comments for now + sysreq = gsub('[[][^])]*[]]','',sysreq) + sysreq = gsub('\\([^)]*\\)','',sysreq) + sysreq = gsub('[[][^])]*[]]','',sysreq) + sysreq = gsub('version','',sysreq) + sysreq = gsub('from','',sysreq) + sysreq = gsub('[<>=]*[[:space:]]*[[:digit:]]+[[:digit:].+:~-]*','',sysreq) + # byebye URLs + sysreq = gsub('(ht|f)tps?://[[:alnum:]!?*"\'(),%$_@.&+/=-]*','',sysreq) + # squish out space + sysreq = chomp(gsub('[[:space:]]+',' ',sysreq)) + if (nchar(sysreq) == 0) { + notice('part of the SystemRequirement became nothing') + next + } + alias <- db_sysreq_override(sysreq) + if (is.null(alias)) { + error('do not know what to do with SystemRequirement:',sysreq) + error('original SystemRequirement:',startreq) + fail('unmet system requirement') + } + notice('mapped SystemRequirement',startreq,'onto',alias,'via',sysreq) + aliases = c(aliases,alias) + } + return(map_aliases_to_debian(aliases)) +} + +forced_deps_as_debian <- function(r_name) { + aliases <- db_get_forced_depends(r_name) + return(map_aliases_to_debian(aliases)) +} + +map_aliases_to_debian <- function(aliases) { + if (!length(aliases)) { + return(aliases) + } + debs <- list() + debs$bin = unlist(sapply(aliases, db_get_depends)) + debs$build = unlist(sapply(aliases, db_get_depends, build=T)) + debs$bin = debs$bin[debs$bin != 'build-essential'] + debs$build = debs$build[debs$build != 'build-essential'] + return(debs) +} + +generate_control <- function(pkg) { + # construct control file + + control <- data.frame() + control[1,'Source'] <- pkg$srcname + control[1,'Section'] <- 'gnu-r' + control[1,'Priority'] <- 'optional' + control[1,'Maintainer'] <- maintainer + control[1,'Build-Depends'] <- paste(pkg$depends$build, collapse=', ') + control[1,'Standards-Version'] <- '3.8.4' + + control[2,'Package'] <- pkg$debname + control[2,'Architecture'] <- 'all' + if (pkg$archdep) { + control[2,'Architecture'] <- 'any' + } + control[2,'Depends'] <- paste(pkg$depends$bin,collapse=', ') + + # generate the description + descr <- 'GNU R package "' + if ('Title' %in% colnames(pkg$description)) { + descr <- paste(descr,pkg$description[1,'Title'],sep='') + } else { + descr <- paste(descr,pkg$name,sep='') + } + long_descr <- pkg$description[1,'Description'] + + if (length(long_descr) < 1 || long_descr == "") { + # bypass lintian extended-description-is-empty for which we care not. + long_descr <- paste('The author/maintainer of this package' + ,'did not care to enter a longer description.') + } + + # using \n\n.\n\n is not very nice, but is necessary to make sure + # the longer description does not begin on the synopsis line --- R's + # write.dcf does not appear to have a nicer way of doing this. + descr <- paste(descr,'"\n\n', long_descr, sep='') + # add some extra nice info about the original R package + for (r_info in c('Author','Maintainer','URL')) { + if (r_info %in% colnames(pkg$description)) { + descr <- paste(descr,'\n\n',r_info,': ',pkg$description[1,r_info],sep='') + } + } + if (Encoding(descr) == "unknown") + Encoding(descr) <- "latin1" # or should it be UTF-8 + + control[2,'Description'] <- descr + + # Debian policy says 72 char width; indent minimally + write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72) + write.dcf(control,indent=1,width=72) +} + diff --git a/branch/split_build/R/debiannaming.R b/branch/split_build/R/debiannaming.R new file mode 100644 index 0000000..7e07c9e --- /dev/null +++ b/branch/split_build/R/debiannaming.R @@ -0,0 +1,46 @@ +repourl_as_debian <- function(url) { + # map the url to a repository onto its name in debian package naming + if (length(grep('cran',url))) { + return('cran') + } + if (length(grep('bioc',url))) { + return('bioc') + } + fail('unknown repository',url) +} + +pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) { + # generate the debian package name corresponding to the R package name + if (name %in% base_pkgs) { + name = 'R' + } + if (name == 'R') { + # R is special. + if (binary) { + if (build) { + debname='r-base-dev' + } else { + debname='r-base-core' + } + } else { + debname='R' + } + } else { + # XXX: data.frame rownames are unique, so always override repopref for + # now. + debname = tolower(name) + if (binary) { + if (name %in% rownames(available)) { + repopref <- tolower(repourl_as_debian(available[name,'Repository'])) + } else if (is.null(repopref)) { + repopref <- 'unknown' + } + debname = paste('r',repopref,debname,sep='-') + } + } + if (!is.null(version) && length(version) > 1) { + debname = paste(debname,' (',version,')',sep='') + } + return(debname) +} + diff --git a/branch/split_build/R/debianpkg.R b/branch/split_build/R/debianpkg.R new file mode 100644 index 0000000..3b33ca2 --- /dev/null +++ b/branch/split_build/R/debianpkg.R @@ -0,0 +1,136 @@ +append_build_from_pkg <- function(pkg, builds) { + pkg_build <- data.frame(id = -1 # never used + ,package = pkg$name + ,system = which_system + ,r_version = version_upstream(pkg$debversion) + ,deb_epoch = version_epoch(pkg$debversion) + ,deb_revision = version_revision(pkg$debversion) + ,db_version = db_get_version() + ,date_stamp = pkg$date_stamp + ,scm_revision = scm_revision + ,success = 1 # never used + ,log = '' # never used + ) + return(cbind(data.frame(srcname=pkg$srcname), rbind(builds, pkg_build))) +} + +generate_changelog <- function(pkg) { + # TODO: ``Writing R extensions'' mentions that a package may also have + # {NEWS,ChangeLog} files. + builds <- append_build_from_pkg(pkg, db_builds(pkg$name)) + sapply(rev(rownames(builds)), function(b, changelog) generate_changelog_entry(builds[b,], changelog), pkg$debfile('changelog.in')) +} + +generate_changelog_entry <- function(build, changelog) { + # TODO: should say 'New upstream release' when necessary + debversion <- version_new(build$r_version, build$deb_revision, build$deb_epoch) + cat(paste(paste(build$srcname,' (',debversion,') testing; urgency=low',sep='') + ,'' ,paste(' * cran2deb ',build$scm_revision + ,' with DB version ',as.integer(build$db_version),'.',sep='') + ,'',paste(' --',maintainer,'',format(build$date_stamp,'%a, %d %b %Y %H:%M:%S %z')) + ,'','','',sep='\n'),file=changelog, append=TRUE) +} + +generate_rules <- function(pkg) { + cat(paste('#!/usr/bin/make -f' + ,paste('debRreposname :=',pkg$repo) + ,'include /usr/share/R/debian/r-cran.mk' + ,'',sep='\n') + ,file=pkg$debfile('rules')) + if (pkg$name %in% c("Rmpi", "npRmpi", "doMPI")) { + cat("extraInstallFlags=\"--no-test-load\"\n", file=pkg$debfile('rules'), append=TRUE) + } + Sys.chmod(pkg$debfile('rules'),'0700') +} + +generate_copyright <- function(pkg) { + # generate_copyright file; we trust DESCRIPTION + + # if maintainer is missing then try to use author + if (!('Maintainer' %in% colnames(pkg$description))) { + if ('Author' %in% colnames(pkg$description)) { + maintainer = pkg$description[1,'Author'] + } else { + fail('Maintainer and Author not defined in R DESCRIPTION') + } + } else { + maintainer = pkg$description[1,'Maintainer'] + } + # likewise if author is missing then try to use maintainer + if (!('Author' %in% colnames(pkg$description))) { + author = maintainer + } else { + author = pkg$description[1,'Author'] + } + + writeLines(strwrap( + paste('This Debian package of the GNU R package',pkg$name + ,'was generated automatically using cran2deb by' + ,paste(maintainer,'.',sep='') + ,'' + ,'The original GNU R package is Copyright (C) ' + # TODO: copyright start date, true copyright date + ,format(Sys.time(),'%Y') + ,author + ,'and possibly others.' + ,'' + ,'The original GNU R package is maintained by' + ,maintainer,'and was obtained from:' + ,'' + ,pkg$repoURL + ,'' + ,'' + ,'The GNU R package DESCRIPTION offers a' + ,'Copyright licenses under the terms of the license:' + ,pkg$license,'. On a Debian GNU/Linux system, common' + ,'licenses are included in the directory' + ,'/usr/share/common-licenses/.' + ,'' + ,'The DESCRIPTION file for the original GNU R package ' + ,'can be found in ' + ,file.path('/usr/lib/R/site-library' + ,pkg$debname + ,'DESCRIPTION' + ) + ,sep='\n'), width=72), con=pkg$debfile('copyright.in')) +} + +prepare_new_debian <- function(pkg,extra_deps) { + # generate Debian version and name + pkg$debversion = new_build_version(pkg$name) + + # make the debian/ directory + debdir <- file.path(pkg$path,'debian') + pkg$debfile <- function(x) { file.path(debdir,x) } + unlink(debdir,recursive=T) + dir.create(debdir) + + # see if this is an architecture-dependent package. + # heuristic: if /src/ exists in pkg$path, then this is an + # architecture-dependent package. + # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions'' + # says: ``The sources and headers for the compiled code are in src, plus + # optionally file Makevars or Makefile.'' It seems unlikely that + # architecture independent code would end up here. + pkg$archdep = file.exists(file.path(pkg$path,'src')) + pkg$license <- accept_license(pkg) + pkg$depends <- get_dependencies(pkg,extra_deps) + apply_patches(pkg) + generate_lintian(pkg) + generate_changelog(pkg) + generate_rules(pkg) + generate_copyright(pkg) + generate_control(pkg) + ## debdir <- file.path(pkg$path,'debian') + ## system(paste("ls ", debdir, "; ls -l ", debdir, "/patches/*", sep="")) + + # convert text to utf8 (who knows what the original character set is -- + # let's hope iconv DTRT). + for (file in c('control','changelog','copyright')) { + log_system('iconv -o ',shQuote(pkg$debfile(file)) + ,' -t utf8 -c ' + ,shQuote(pkg$debfile(paste(file,'in',sep='.')))) + file.remove(pkg$debfile(paste(file,'in',sep='.'))) + } + return(pkg) +} diff --git a/branch/split_build/R/getrpkg.R b/branch/split_build/R/getrpkg.R new file mode 100644 index 0000000..38d7a59 --- /dev/null +++ b/branch/split_build/R/getrpkg.R @@ -0,0 +1,166 @@ +setup <- function() { + # set up the working directory + tmp <- tempfile('cran2deb') + dir.create(tmp) + return (tmp) +} + +cleanup <- function(dir) { + # remove the working directory + unlink(dir,recursive=T) + invisible() +} + +download_pkg <- function(dir, pkgname) { + # download pkgname into dir, and construct some metadata + + # record some basic information + pkg <- pairlist() + pkg$date_stamp = Sys.time() + pkg$name = pkgname + pkg$repoURL = available[pkgname,'Repository'] + pkg$repo = repourl_as_debian(pkg$repoURL) + if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) { + fail('Cannot convert package name into a Debian name',pkg$name) + } + pkg$srcname = pkgname_as_debian(pkg$name,binary=F) + pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo) + pkg$version <- available[pkgname,'Version'] + + # see if we have already built this release and uploaded it. + debfn <- get_reprepro_orig_tgz(pkg$srcname, pkg$version) + pkg$need_repack = FALSE + if (file.exists(debfn)) { + # if so, use the existing archive. this is good for three reasons: + # 1. it saves downloading the archive again + # 2. the repacking performed below changes the MD5 sum of the archive + # which upsets some Debian archive software. + # 3. why repack more than once? + pkg$archive <- file.path(dir, basename(debfn)) + file.copy(debfn,pkg$archive) + pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-')) + notice('using an existing debianized source tarball:',debfn) + } else { + # see if we have a local mirror in /srv/R + use_local = FALSE + if (pkg$repo == 'cran') { + localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) + use_local = file.exists(localfn) + } else if (pkg$repo == 'bioc') { + localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) + use_local = file.exists(localfn) + } + + fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='') + archive <- file.path(dir, fn) + + if (use_local) { + file.copy(localfn, archive) + } else { + # use this instead of download.packages as it is more resilient to + # dodgy network connections (hello BT 'OpenWorld', bad ISP) + url <- paste(available[pkgname,'Repository'], fn, sep='/') + # don't log the output -- we don't care! + ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url))) + if (ret != 0) { + fail('failed to download',url) + } + # end of download.packages replacement + } + + if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) { + fail('funny looking path',archive) + } + pkg$path = sub("_\\.(zip|tar\\.gz)", "" + ,gsub(.standard_regexps()$valid_package_version, "" + ,archive)) + pkg$archive = archive + # this is not a Debian conformant archive + pkg$need_repack = TRUE + } + return(pkg) +} + +repack_pkg <- function(pkg) { + # re-pack into a Debian-named archive with a Debian-named directory. + notice('repacking into debian source archive.') + debpath = file.path(dirname(pkg$archive) + ,paste(pkg$srcname + ,pkg$version + ,sep='-')) + file.rename(pkg$path, debpath) + pkg$path = debpath + debarchive = file.path(dirname(pkg$archive) + ,paste(pkg$srcname,'_' + ,pkg$version,'.orig.tar.gz' + ,sep='')) + wd <- getwd() + setwd(dirname(pkg$path)) + # remove them pesky +x files + # BUT EXCLUDE configure and cleanup + log_system('find',shQuote(basename(pkg$path)) + ,'-type f -a ' + , '! \\( -name configure -o -name cleanup \\)' + ,'-exec chmod -x {} \\;') + if (file.exists(file.path(basename(pkg$path),'debian'))) { + warn('debian/ directory found in tarball! removing...') + unlink(file.path(basename(pkg$path),'debian'),recursive=TRUE) + } + # tar it all back up + log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))) + setwd(wd) + file.remove(pkg$archive) + pkg$archive = debarchive + pkg$need_repack = FALSE + return(pkg) +} + +prepare_pkg <- function(dir, pkgname) { + # download and extract an R package named pkgname + + # based loosely on library/utils/R/packages2.R::install.packages + + # grab the archive and some metadata + pkg <- download_pkg(dir, pkgname) + + # now extract the archive + if (!length(grep('\\.tar\\.gz',pkg$archive))) { + fail('archive is not tarball') + } + wd <- getwd() + setwd(dir) + ret = log_system('tar','xzf',shQuote(pkg$archive)) + setwd(wd) + if (ret != 0) { + fail('Extraction of archive',pkg$archive,'failed.') + } + + # if necessary, repack the archive into Debian-conformant format + if (pkg$need_repack) { + pkg <- repack_pkg(pkg) + } + if (!file.info(pkg$path)[,'isdir']) { + fail(pkg$path,'is not a directory and should be.') + } + + # extract the DESCRIPTION file, which contains much metadata + pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) + + # ensure consistency of version numbers + if ('Version' %in% names(pkg$description[1,])) { + if (pkg$description[1,'Version'] != available[pkg$name,'Version']) { + # should never happen since available is the basis upon which the + # package is retrieved. + error('available version:',available[pkg$name,'Version']) + error('package version:',pkg$description[1,'Version']) + fail('inconsistency between R package version and cached R version') + } + } + + # note subtly of short circuit operators (no absorption) + if (pkg$description[1,'Package'] != pkg$name) { + fail('package name mismatch') + } + return(pkg) +} + diff --git a/branch/split_build/R/license.R b/branch/split_build/R/license.R new file mode 100644 index 0000000..113b99e --- /dev/null +++ b/branch/split_build/R/license.R @@ -0,0 +1,166 @@ +is_acceptable_license <- function(license) { + # determine if license text is acceptable + + if (length(grep('^file ',license))) { + # skip file licenses + return(FALSE) + } + license <- license_text_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + return(action) + } + license <- license_text_further_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') + return(action) + } + license <- license_text_extreme_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') + return(action) + } + error('Wild license',license,'did not match classic rules; rejecting') + return(F) +} + +license_text_reduce <- function(license) { + # these reduction steps are sound for all conformant R license + # specifications. + + if (Encoding(license) == "unknown") + Encoding(license) <- "latin1" # or should it be UTF-8 ? + + ## compress spaces into a single space + license = gsub('[[:space:]]+',' ',license) + # make all characters lower case + license = tolower(license) + # don't care about versions of licenses + license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' + ,sub('-[0-9.-]+','',license))) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_further_reduce <- function(license) { + # these reduction steps are heuristic and may lead to + # in correct acceptances, if care is not taken. + + # uninteresting urls + license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license) + license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license) + license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license) + # remove all punctuation + license = gsub('[[:punct:]]+','',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + # redundant + license = gsub('the','',license) + license = gsub('see','',license) + license = gsub('standard','',license) + license = gsub('licen[sc]e','',license) + license = gsub('(gnu )?(gpl|general public)','gpl',license) + license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_extreme_reduce <- function(license) { + # remove everything that may or may not be a version specification + license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?','' + ,license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_hash_reduce <- function(text) { + # reduction of license text, suitable for hashing. + return(chomp(tolower(gsub('[[:space:]]+',' ',text)))) +} + +get_license <- function(pkg,license) { + license <- chomp(gsub('[[:space:]]+',' ',license)) + if (length(grep('^file ',license))) { + if (length(grep('^file LICEN[CS]E$',license))) { + file = gsub('file ','',license) + path = file.path(pkg$path, file) + if (file.exists(path)) { + #license <- license_text_reduce(readChar(path,file.info(path)$size)) + con <- file(path, "rb") + content <- paste(readLines(con), collapse="\n") + close(con) + license <- license_text_reduce(content) + } else { + path = file.path(pkg$path, 'inst', file) + if (file.exists(path)) { + #license <- license_text_reduce(readChar(path,file.info(path)$size)) + con <- file(path, "rb") + content <- paste(readLines(con), collapse="\n") + close(con) + license <- license_text_reduce(content) + } else { + error('said to look at a license file but license file is missing') + } + } + } else { + error('invalid license file specification',license) + return(NA) + } + } + return(license) +} + +get_license_hash <- function(pkg,license) { + return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE)) +} + +is_acceptable_hash_license <- function(pkg,license) { + license_sha1 <- get_license_hash(pkg,license) + if (is.null(license_sha1)) { + return(FALSE) + } + action = db_license_override_hash(license_sha1) + if (is.null(action)) { + action = FALSE + } + if (action) { + warn('Wild license',license,'accepted via hash',license_sha1) + } + return(action) +} + + +accept_license <- function(pkg) { + # check the license + if (!('License' %in% names(pkg$description[1,]))) { + fail('package has no License: field in description!') + } + accept=NULL + for (license in strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { + if (is_acceptable_license(license)) { + accept=license + break + } + if (is_acceptable_hash_license(pkg,license)) { + accept=license + break + } + } + if (is.null(accept)) { + fail('No acceptable license:',pkg$description[1,'License']) + } else { + notice('Auto-accepted license',accept) + } + if (accept == 'Unlimited') { + # definition of Unlimited from ``Writing R extensions'' + accept=paste('Unlimited (no restrictions on distribution or' + ,'use other than those imposed by relevant laws)') + } + return(accept) +} diff --git a/branch/split_build/R/lintian.R b/branch/split_build/R/lintian.R new file mode 100644 index 0000000..9aa02fa --- /dev/null +++ b/branch/split_build/R/lintian.R @@ -0,0 +1,14 @@ +generate_lintian <- function(pkg) { + lintian_src = file.path(lintian_dir, pkg$name) + if (!file.exists(lintian_src)) { + notice('no lintian overrides ', lintian_src) + return() + } + + # copy the lintian file + notice('including lintian file', lintian_src) + lintian_tgt <- pkg$debfile(paste(pkg$debname, "lintian-overrides", sep=".")) + file.copy(lintian_src, lintian_tgt) + invisible(NULL) +} + diff --git a/branch/split_build/R/log.R b/branch/split_build/R/log.R new file mode 100644 index 0000000..3d74bae --- /dev/null +++ b/branch/split_build/R/log.R @@ -0,0 +1,66 @@ +log_messages <- list() + +log_clear <- function() { + assign('log_messages',list(),envir=.GlobalEnv) +} + +log_add <- function(text,print=T) { + if (print) { + message(text) + } + assign('log_messages',c(log_messages, text),envir=.GlobalEnv) +} + +log_retrieve <- function() { + return(log_messages) +} + +notice <- function(...) { + log_add(paste('N:',...)) +} + +warn <- function(...) { + log_add(paste('W:',...)) +} + +error <- function(...) { + log_add(paste('E:',...)) +} + +fail <- function(...) { + txt <- paste('E:',...) + log_add(txt) + stop(txt) +} + +log_system <- function(...) { + r <- try((function() { + # pipe() does not appear useful here, since + # we want the return value! + # XXX: doesn't work with ; or | ! + tmp <- tempfile('log_system') + on.exit(unlink(tmp)) + cmd <- paste(...) + # unfortunately this destroys ret + #cmd <- paste(cmd,'2>&1','| tee',tmp) + cmd <- paste(cmd,'>',tmp,'2>&1') + ret <- system(cmd) + f <- file(tmp) + output <- readLines(f) + close(f) + unlink(tmp) + return(list(ret,output)) + })()) + if (inherits(r,'try-error')) { + fail('system failed on:',paste(...)) + } + log_add(paste('C:',...)) + for (line in r[[2]]) { + if (!length(grep('^[WENI]:',line))) { + line = paste('I:',line) + } + log_add(line) #,print=F) + } + return(r[[1]]) +} + diff --git a/branch/split_build/R/patch.R b/branch/split_build/R/patch.R new file mode 100644 index 0000000..b9dc8ce --- /dev/null +++ b/branch/split_build/R/patch.R @@ -0,0 +1,20 @@ +apply_patches <- function(pkg) { + patch_path = file.path(patch_dir, pkg$name) + if (!file.exists(patch_path)) { + notice('no patches in',patch_path) + return() + } + + # make debian/patches for simple-patchsys + deb_patch = pkg$debfile('patches') + if (!dir.create(deb_patch)) { + fail('could not create patches directory', deb_patch) + } + + # now just copy the contents of patch_path into debian/patches + for (patch in list.files(patch_path)) { + notice('including patch', patch) + file.copy(file.path(patch_path, patch), deb_patch) + } +} + diff --git a/branch/split_build/R/rdep.R b/branch/split_build/R/rdep.R new file mode 100644 index 0000000..78c5d79 --- /dev/null +++ b/branch/split_build/R/rdep.R @@ -0,0 +1,117 @@ + + +r_requiring <- function(names) { + # approximately prune first into a smaller availability + candidates <- rownames(available)[sapply(rownames(available) + ,function(name) + length(grep(paste(names,collapse='|') + ,available[name,r_depend_fields])) > 0)] + if (length(candidates) == 0) { + return(c()) + } + # find a logical index into available of every package + # whose dependency field contains at least one element of names. + # (this is not particularly easy to read---sorry---but is much faster than + # the alternatives i could think of) + prereq=c() + dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names + any_dep_matches <- function(name,field=NA) + any(sapply(strsplit(chomp(available[name,field]) + ,'[[:space:]]*,[[:space:]]*') + ,dep_matches)) + + for (field in r_depend_fields) { + matches = sapply(candidates, any_dep_matches, field=field) + if (length(matches) > 0) { + prereq = c(prereq,candidates[matches]) + } + } + return(unique(prereq)) +} + +r_dependencies_of <- function(name=NULL,description=NULL) { + # find the immediate dependencies (children in the dependency graph) of an + # R package + if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) { + return(data.frame()) + } + if (is.null(description) && is.null(name)) { + fail('must specify either a description or a name.') + } + if (is.null(description)) { + if (!(name %in% rownames(available))) { + # unavailable packages don't depend upon anything + return(data.frame()) + } + description <- data.frame() + # keep only the interesting fields + for (field in r_depend_fields) { + if (!(field %in% names(available[name,]))) { + next + } + description[1,field] = available[name,field] + } + } + # extract the dependencies from the description + deps <- data.frame() + for (field in r_depend_fields) { + if (!(field %in% names(description[1,]))) { + next + } + new_deps <- lapply(strsplit(chomp(description[1,field]) + ,'[[:space:]]*,[[:space:]]*')[[1]] + ,r_parse_dep_field) + deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind) + } + return (deps) +} + +r_parse_dep_field <- function(dep) { + if (is.na(dep)) { + return(NA) + } + # remove other comments + dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep) + # squish spaces + dep = chomp(gsub('[[:space:]]+',' ',dep)) + # parse version + pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' + if (!length(grep(pat,dep))) { + fail('R dependency',dep,'does not appear to be well-formed') + } + version = sub(pat,'\\3',dep) + dep = sub(pat,'\\1',dep) + return(list(name=dep,version=version)) +} + +r_dependency_closure <- function(fringe, forward_arcs=T) { + # find the transitive closure of the dependencies/prerequisites of some R + # packages + closure <- list() + if (is.data.frame(fringe)) { + fringe <- as.list(fringe$name) + } + fun = function(x) r_dependencies_of(name=x)$name + if (!forward_arcs) { + fun = r_requiring + } + while(length(fringe) > 0) { + # pop off the top + top <- fringe[[1]] + if (length(fringe) > 1) { + fringe <- fringe[2:length(fringe)] + } else { + fringe <- list() + } + src <- pkgname_as_debian(top,binary=F) + if (src == 'R') { + next + } + newdeps <- fun(top) + closure=c(closure,top) + fringe=c(fringe,newdeps) + } + # build order + return(rev(unique(closure,fromLast=T))) +} + diff --git a/branch/split_build/R/util.R b/branch/split_build/R/util.R new file mode 100644 index 0000000..68401fd --- /dev/null +++ b/branch/split_build/R/util.R @@ -0,0 +1,20 @@ +iterate <- function(xs,z,fun) { + y <- z + for (x in xs) + y <- fun(y,x) + return(y) +} + +chomp <- function(x) { + # remove leading and trailing spaces + return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x))) +} + +err <- function(...) { + error(...) + exit() +} + +exit <- function() { + q(save='no') +} diff --git a/branch/split_build/R/version.R b/branch/split_build/R/version.R new file mode 100644 index 0000000..5795233 --- /dev/null +++ b/branch/split_build/R/version.R @@ -0,0 +1,88 @@ +version_new <- function(rver,debian_revision=1, debian_epoch=db_get_base_epoch()) { + # generate a string representation of the Debian version of an + # R version of a package + pkgver = rver + + # ``Writing R extensions'' says that the version consists of at least two + # non-negative integers, separated by . or - + if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) { + fail('Not a valid R package version',rver) + } + + # Debian policy says that an upstream version should start with a digit and + # may only contain ASCII alphanumerics and '.+-:~' + if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) { + fail('R package version',rver + ,'does not obviously translate into a valid Debian version.') + } + + # if rver contains a : then the Debian version must also have a colon + if (debian_epoch == 0 && length(grep(':',pkgver))) + debian_epoch = 1 + + # if the epoch is non-zero then include it + if (debian_epoch != 0) + pkgver = paste(debian_epoch,':',pkgver,sep='') + + # always add the '-1' Debian release; nothing is lost and rarely will R + # packages be Debian packages without modification. + return(paste(pkgver,'-',version_suffix_step,version_suffix,debian_revision,sep='')) +} + +version_epoch <- function(pkgver) { + # return the Debian epoch of a Debian package version + if (!length(grep(':',pkgver))) + return(0) + return(as.integer(sub('^([0-9]+):.*$','\\1',pkgver))) +} +# version_epoch . version_new(x,y) = id +# version_epoch(version_new(x,y)) = base_epoch + +version_revision <- function(pkgver) { + # return the Debian revision of a Debian package version + return(as.integer(sub(paste('.*-([0-9]+',version_suffix,')?([0-9]+)$',sep=''),'\\2',pkgver))) +} +# version_revision . version_new(x) = id +# version_revision(version_new(x)) = 1 + +version_upstream <- function(pkgver) { + # return the upstream version of a Debian package version + return(sub('-[a-zA-Z0-9+.~]+$','',sub('^[0-9]+:','',pkgver))) +} +# version_upstream . version_new = id + +version_update <- function(rver, prev_pkgver, prev_success) { + # return the next debian package version + prev_rver <- version_upstream(prev_pkgver) + if (prev_rver == rver) { + # increment the Debian revision if the previous build was successful + inc = 0 + if (prev_success) { + inc = 1 + } + return(version_new(rver + ,debian_revision = version_revision(prev_pkgver)+inc + ,debian_epoch = version_epoch(prev_pkgver) + )) + } + # new release + # TODO: implement Debian ordering over version and then autoincrement + # Debian epoch when upstream version does not increment. + return(version_new(rver + ,debian_epoch = version_epoch(prev_pkgver) + )) +} + +new_build_version <- function(pkgname) { + if (!(pkgname %in% rownames(available))) { + fail('tried to discover new version of',pkgname,'but it does not appear to be available') + } + db_ver <- db_latest_build_version(pkgname) + db_succ <- db_latest_build_status(pkgname)[[1]] + latest_r_ver <- available[pkgname,'Version'] + if (!is.null(db_ver)) { + return(version_update(latest_r_ver, db_ver, db_succ)) + } + return(version_new(latest_r_ver)) +} + diff --git a/branch/split_build/R/zzz.R b/branch/split_build/R/zzz.R new file mode 100644 index 0000000..dc2a5e0 --- /dev/null +++ b/branch/split_build/R/zzz.R @@ -0,0 +1,42 @@ +.First.lib <- function(libname, pkgname) { + global <- function(name,value) assign(name,value,envir=.GlobalEnv) + global("which_system", Sys.getenv('CRAN2DEB_SYS','debian')) + if (!length(grep('^[a-z]+$',which_system))) { + stop('Invalid system specification: must be of the form name') + } + global("maintainer", 'cran2deb autobuild ') + global("root", system.file(package='cran2deb')) + global("cache_root", '/var/cache/cran2deb') + global("indep_arch", "all") + global("archs", c("i386", "amd64")) + # get the pbuilder results dir, and config + global("get_pbuilder_config", function(arch) { + sys_arch <- paste(which_system, arch, sep='-') + return(c(file.path('/var/cache/cran2deb/results',sys_arch)) + ,file.path('/etc/cran2deb/sys',sys_arch,'pbuilderrc')) + }) + global("reprepro_dir", file.path('/var/www/repo',which_system)) + global("get_reprepro_orig_tgz", function(srcname, version) { + return file.path(reprepro_dir, 'pool', 'main', substr(srcname, 1, 1), + srcname, paste(srcname,'_',version,'.orig.tar.gz', + sep='')) + }) + global("r_depend_fields", c('Depends','Imports')) # Suggests, Enhances + global("scm_revision", paste("svn:", svnversion())) + global("patch_dir", '/etc/cran2deb/patches') + global("lintian_dir", '/etc/cran2deb/lintian') + global("changesfile", function(srcname,version='*',arch='*') { + return(file.path(pbuilder_results + ,paste(srcname,'_',version,'_' + ,arch,'.changes',sep=''))) + }) + global("version_suffix","cran") + # perhaps db_cur_version() should be used instead? + global("version_suffix_step",1) + + cache <- file.path(cache_root,'cache.rda') + if (file.exists(cache)) { + load(cache,envir=.GlobalEnv) + } + message(paste('I: cran2deb',scm_revision,'building for',which_system,'at',Sys.time())) +} diff --git a/branch/split_build/README b/branch/split_build/README new file mode 120000 index 0000000..a6047ac --- /dev/null +++ b/branch/split_build/README @@ -0,0 +1 @@ +inst/doc/README \ No newline at end of file diff --git a/branch/split_build/configure b/branch/split_build/configure new file mode 100755 index 0000000..fa1a12a --- /dev/null +++ b/branch/split_build/configure @@ -0,0 +1,19 @@ +#!/bin/sh +# +# We are tricking the builds process into executing this so that we can +# extract an svn revision number from the source directory + +# do nothing if we are not in a svn repository +if [ ! -d .svn ]; then + exit +fi + +svnrev=$(svnversion | cut -f1 -d:) + +cat < R/svnversion.R +# Autogenerated by configure. Do not edit. +svnversion <- function() { + return("$svnrev") +} +EOF + diff --git a/branch/split_build/data/populate_depend_aliases b/branch/split_build/data/populate_depend_aliases new file mode 100644 index 0000000..3b1b9cb --- /dev/null +++ b/branch/split_build/data/populate_depend_aliases @@ -0,0 +1,135 @@ +alias_build boost libboost-dev +alias_build boost libboost-graph-dev +alias_build ggobi ggobi +alias_run ggobi ggobi +alias_build glade libglade2-dev +alias_run glade libglade2-0 +alias_build glib libglib2.0-dev +alias_run glib libglib2.0-0 +alias_build glu libglu1-mesa-dev +alias_run glu libglu1-mesa +alias_build gmp libgmp3-dev +alias_run gmp libgmp3c2 +alias_build gsl libgsl0-dev +alias_run gsl libgsl0ldbl +alias_build ignore build-essential +alias_build java openjdk-6-jdk +alias_build java libgcj10-dev +alias_run java openjdk-6-jre +alias_build libatk libatk1.0-dev +alias_run libatk libatk1.0-0 +alias_build libcairo libcairo2-dev +alias_run libcairo libcairo2 +alias_run libcurl libcurl3 +alias_build libcurl libcurl4-openssl-dev +alias_build libdieharder libdieharder-dev +alias_run libdieharder libdieharder2 +alias_build libfontconfig libfontconfig1-dev +alias_run libfontconfig libfontconfig1 +alias_build libfreetype libfreetype6-dev +alias_run libfreetype libfreetype6 +alias_build libgdal libgdal1-dev +alias_run libgdal libgdal1-1.6.0 +alias_build libgd libgd2-noxpm-dev +alias_run libgd libgd2-noxpm +alias_build libgraphviz libgraphviz-dev +alias_run libgraphviz libgraphviz4 +alias_build libgtk libgtk2.0-dev +alias_run libgtk libgtk2.0-0 +alias_build libjpeg libjpeg62-dev +alias_run libjpeg libjpeg62 +alias_build libmagick libmagick9-dev +alias_run libmagick libmagick9 +alias_build libpango libpango1.0-dev +alias_run libpango libpango1.0-0 +alias_build libpng libpng12-dev +alias_run libpng libpng12-0 +alias_build libxml libxml2-dev +alias_run libxml libxml2 +alias_build msttcorefonts ttf-liberation +alias_run msttcorefonts ttf-liberation +alias_run netcdf libnetcdf4 +alias_build opengl libgl1-mesa-dev +alias_run opengl libgl1-mesa-glx +alias_build pari-gp pari-gp +alias_run pari-gp pari-gp +alias_build proj proj +alias_run proj proj +alias_build quantlib libquantlib0-dev +alias_run quantlib libquantlib-0.9.9 +alias_run sqlite libsqlite3-0 +alias_build sqlite libsqlite3-dev +alias_build zlib zlib1g-dev +alias_run zlib zlib1g +alias_build cshell tcsh|csh|c-shell +alias_run cshell tcsh|csh|c-shell +alias_build autotools autotools-dev +alias_build tcl tcl8.5-dev +alias_build tk tk8.5-dev +alias_build odbc unixodbc-dev +alias_build mysql libmysqlclient-dev +alias_build mpi libopenmpi-dev +alias_build pvm pvm-dev +alias_build hdf5 libhdf5-serial-dev +alias_build sprng libsprng2-dev +alias_build netcdf libnetcdf-dev +alias_build libtiff libtiff4-dev +alias_build fftw libfftw3-dev +alias_build fftw-dev fftw-dev +alias_build r-recommended r-recommended +alias_run r-recommended r-recommended +alias_build libxt libxt-dev +alias_run libxt libxt6 +alias_build grass grass-dev +alias_build blacs blacsgf-mpich-dev +alias_build scalapack scalapack-mpich-dev +alias_build mpich libmpich1.0-dev +alias_run libblas libblas3gf +alias_build libblas libblas-dev +alias_run wordnet wordnet-base +alias_build wordnet wordnet-base +alias_build postgresql libpq-dev +alias_build jags jags +alias_run jags jags +alias_build udunits udunits +alias_run udunits udunits +alias_build nlme r-cran-nlme +alias_run nlme r-cran-nlme +alias_build vcd r-cran-vcd +alias_run vcd r-cran-vcd +alias_build vr r-cran-vr +alias_run vr r-cran-vr +alias_build colorspace r-cran-colorspace +alias_run colorspace r-cran-colorspace +alias_run rgrs xclip +alias_run flac flac +alias_build latticist r-cran-vr +alias_run latticist r-cran-vr +alias_build writexls-perl libtext-csv-xs-perl +alias_run writexls-perl libtext-csv-xs-perl +alias_run perl perl +alias_build perl libperl-dev +alias_build tktable libtktable2.9 +alias_run tktable libtktable2.9 +alias_build bwidget bwidget +alias_run bwidget bwidget +alias_build graphviz graphviz +alias_run graphviz graphviz +alias_build libdb libdb-dev +alias_build mpfr libmpfr-dev +alias_run tk-img libtk-img +alias_build tk-img libtk-img-dev +alias_build pkg-config pkg-config +alias_run pkg-config pkg-config +alias_build rgtk2 r-cran-rgtk2 +alias_run rgtk2 r-cran-rgtk2 +alias_build libitpp libitpp-dev +alias_build libxerces-c libxerces-c-dev +alias_build protobuf-compiler protobuf-compiler +alias_build libprotobuf-dev libprotobuf-dev +alias_build libprotoc-dev libprotoc-dev +alias_build postgresql_java libpg-java +alias_run postgresql_java libpg-java +alias_build armadillo libarmadillo-dev +alias_build rpcgen libc-dev-bin +alias_run rpcgen libc-dev-bin diff --git a/branch/split_build/data/populate_forcedep b/branch/split_build/data/populate_forcedep new file mode 100644 index 0000000..52f4551 --- /dev/null +++ b/branch/split_build/data/populate_forcedep @@ -0,0 +1,69 @@ +force java rJava +force autotools rJava +force sqlite RSQLite +force sqlite SQLiteDF +force netcdf ncdf +force cshell dse +force libgtk cairoDevice +force tcl tkrplot +force tk tkrplot +force mysql RMySQL +force mpi Rmpi +force pvm rpvm +force hdf5 hdf5 +force libgtk rggobi +force libxml rggobi +force sprng rsprng +force gmp rsprng +force java JavaGD +force boost RBGL +force netcdf RNetCDF +force libtiff biOps +force fftw-dev rimage +force libxt Cairo +force autotools qp +force boost MBA +force mpich RScaLAPACK +force libblas odesolve +force postgresql RPostgreSQL +force udunits udunits +force nlme primer +force vcd biclust +force vr mboost +force colorspace mboost +force vr party +force colorspace party +force vr latticist +force colorspace latticist +force writexls-perl WriteXLS +force fftw ReadImages +force fftw-dev ReadImages +force vr surveillance +force colorspace surveillance +force vr TIMP +force colorspace TIMP +force VR cmm +force libdb RBerkeley +force vr DoE.base +force colorspace DoE.base +force pkg-config mvgraph +force glade RGtk2 +force rgtk2 rattle +force libitpp psgp +force java farmR +force gsl mvabund +force colorspace nnDiag +force autotools fftw +force protobuf-compiler RProtoBuf +force libprotobuf-dev RProtoBuf +force libprotoc-dev RProtoBuf +force pkg-config RProtoBuf +force colorspace simPopulation +force java RpgSQL +force netcdf ncdf4 +force colorspace vcdExtra +force boost RcppArmadillo +force pkg-config fftw +force boost SV +force gsl magnets +force mpi npRmpi diff --git a/branch/split_build/data/populate_license_hashes b/branch/split_build/data/populate_license_hashes new file mode 100644 index 0000000..32cc69b --- /dev/null +++ b/branch/split_build/data/populate_license_hashes @@ -0,0 +1,156 @@ +accept apache +accept artistic +accept bsd +accept cecill +accept gpl +accept gplqa +accept gpl+qhull +accept lgpl +accept mit +accept mpl +accept unlimited +accept x11 +accept distrib-noncomm +accept gpl+acm +accept unclear +accept nistnls +accept rtiff +accept mvpart +accept mmcm +accept grade +accept agpl +accept scagnostics +accept akima +accept tripack +reject mclust +accept gpl+agpl +accept cpl +accept cc-sa +accept acm +accept camassclass +accept rwt +accept tcltk2 +accept agpl-3 +accept gpl-2-qa +accept ff_license +accept rindex_license +accept eupl +accept statnet +accept degreenet +accept geometry +accept ergm +accept acepack +accept ff +accept mspath +accept ever +accept latentnet +accept sgeostat +hash_sha1 apache 2b8b815229aa8a61e483fb4ba0588b8b6c491890 +hash_sha1 artistic be0627fff2e8aef3d2a14d5d7486babc8a4873ba +hash_sha1 bsd 095d1f504f6fd8add73a4e4964e37f260f332b6a +hash_sha1 gpl 06877624ea5c77efe3b7e39b0f909eda6e25a4ec +hash_sha1 gpl 842745cb706f8f2126506f544492f7a80dbe29b3 +hash_sha1 lgpl c08668a6ace9b36ba46940609040748161b03a37 +hash_sha1 lgpl 9a1929f4700d2407c70b507b3b2aaf6226a9543c +hash_sha1 lgpl e7d563f52bf5295e6dba1d67ac23e9f6a160fab9 +hash_sha1 bsd 691cf5d9d41c00bd9df4f71a769903cd3c1114e5 +hash_sha1 cecill 7b5d0f2dcc332e487cfce45d67694829e2dc551f +hash_sha1 cpl 24f4880707f1a115710b08691a134fbcac8b3187 +hash_sha1 distrib-noncomm fbcd040e3968045f82ec3eae01c0ee4d023aaf0a +hash_sha1 distrib-noncomm 6821f142965fb3093f42d4a3bf188966ef559947 +hash_sha1 distrib-noncomm 430b61f55057719112e0a4fcea37bc05e1951cb8 +hash_sha1 distrib-noncomm eff2ff3591871ede0ee8b4397bdc7ff059edd91e +hash_sha1 distrib-noncomm 56911f201d1c8e0d9a2c7bb8820369c31dd727b3 +hash_sha1 distrib-noncomm 34cd71d41285f582be7c00f0c180eaf3ec6d6840 +hash_sha1 distrib-noncomm 4aa695cbc309ab9fa4d74d28675a0e8e8ec299db +hash_sha1 gpl+acm f53f55135e38afd2993d3990fad973b49cd16bef +hash_sha1 gpl+acm 5ec09fa25a8aabad7d54901e5a4ee9e799b334ef +hash_sha1 gpl dd5ca2e0351075a5985dbc75aea9a579367c3603 +hash_sha1 gpl 2c02993e7c8f22d0b5bb590125c37fa58a24637e +hash_sha1 gpl 37bcb2c23ebffb2a669d606391d4df1c4d794b37 +hash_sha1 gpl 4ac49046f7c453d5d4992dc1695acd447effaebb +hash_sha1 gpl 811325c3b7f5e0b1073a382c4f53c37a47720e47 +hash_sha1 gpl 67f006f04797fc844b71c55b911656ab8144317a +hash_sha1 gpl 31fe0bd96e05d07216701ff457b8adaf6462379b +hash_sha1 gpl f50f1034fc720a1c03875d5bf3b79d102c9d6605 +hash_sha1 gpl+qhull 9b03de793e5641feb756a7b0ce2bfffdeb778ccd +hash_sha1 gpl 34f7b4fc3375c326ea742f053ba75e4e80795cf4 +hash_sha1 gpl e6e02671a920a2a1befa8cebf2d152ef70d0ed20 +hash_sha1 gpl b0909a630db543721dafe4a348ee755f85fbe001 +hash_sha1 gpl 1fabda5fc86f494ae54cf8f8ad85fde49e0548c9 +hash_sha1 lgpl bb3101315829c159125a337b1e11b9ad9e9bad31 +hash_sha1 mclust bc98e96bfbbe8396c57d9decccb8bd6bcea99a04 +hash_sha1 tcltk2 50424add056b71665e3e26b393f460e0908e9da2 +hash_sha1 unclear 3d76287efb04bc6eb366ea0d49ac518d811bd32f +hash_sha1 unclear 8408f5eaded6ad4895fdf161c9cd38231dd072ad +hash_sha1 unclear 1ecc6e16f3390f00709b2516e609366f2efeabb7 +hash_sha1 unclear eee8da9d5d6ac0f21d97b3038c0fc7f86a4891a0 +hash_sha1 unclear 4932e4c94fb80efe20297bd9ace2fda86758874d +hash_sha1 unlimited b4323144ad3c121088025ff951028ae588ba3031 +hash_sha1 gplqa b39206c5297bcea7e6abbc4981f8f15a76aef24f +hash_sha1 gpl 5b7c62c4726d772162e3e4fbf368dfaf65fe5e32 +hash_sha1 gpl ecdf063f8a937c005c4f02450d0ecbdc3376acf6 +hash_sha1 gpl 64ed18b138fcc9389a33f620eaa2f9479f367ff7 +hash_sha1 gpl 931a2aaf2fac897138f90c96a27e5acaf74b4694 +hash_sha1 gpl edde20802066923644c363328903121c05799bb6 +hash_sha1 agpl 86d2ea18c092d87328f06d22d997af59cee10fc4 +hash_sha1 gpl d093976b85026cb225a12908088bb19dd9d480b7 +hash_sha1 gpl 0e9f026efef26009619f9048637eb2a498379c88 +hash_sha1 acepack 6bdcfb412d82fe3ad5b64650d900c2845d08fbc6 +hash_sha1 agpl d3c31418974fd4d69032bc1f5c58e13c1634ca40 +hash_sha1 agpl 6bdfdd431d081dd0bacf493ba3563f3480ab8936 +hash_sha1 nistnls 735b08919865788221c3139506b4f508e6636dfa +hash_sha1 gpl 836f5f94473a04c4b7c48e6cb86c351131201ae9 +hash_sha1 gpl dca3c7c942b9e09fa2dde956b00b1ceaa5b99e02 +hash_sha1 distrib-noncomm 7d15a1e04d01df4fa36abccf1f6702ace54ec15f +hash_sha1 gpl 9e3914cc887ffa697e008b1990607dec00075d9e +hash_sha1 gpl 82a48e8a04d4a53a63cb7d84c57ca3908add375f +hash_sha1 eupl 7642ee2451a0d84de46a7e8236ccfd019e9595b4 +hash_sha1 gpl f76132a54a079daad040663668572cd91a8bfae1 +hash_sha1 scagnostics 5e059a7b25be224c8d9bae55bbdd7cb3675e36b5 +hash_sha1 akima 485316717b03afbd6d20f7810f9123b4445c8660 +hash_sha1 tripack b71ffb1e3a65c83693858fd3c8f1e557f97cc43c +hash_sha1 bsd 105de13a43220f6fc5d7d46d7b592298c4a23f64 +hash_sha1 mclust 9ac21f87563664c2a2ebc6d4413ec61c8ebb84ff +hash_sha1 distrib-noncomm c14cd24b4e49bb78bb5b57472c6253781f6efed3 +hash_sha1 distrib-noncomm a0ba68c1c804fda1edde14e8d42225b8225cb0b7 +hash_sha1 distrib-noncomm e7f48dfecfde56adcf5c9bd57779a0d7d15c4f4b +hash_sha1 gpl+agpl 4c667eba3ef3f3cdd47170fe438b8abc1adcfaff +hash_sha1 cpl 69c37907f7adb8ec4d7189aed8a4dd12294056f2 +hash_sha1 cc-sa c960bb1a7ed5e5f8c24591f77256eb8f5b9ae73b +hash_sha1 acm 1127f761137a717b10892c1b4df07fc14d70f659 +hash_sha1 acm 4cfe0db3b018ae1f7ad70556753dec9c603ada50 +hash_sha1 camassclass 8b455d73a369934c7e84b24e0a16886248285221 +hash_sha1 artistic 07ce494c32b890b381e73b8fa4fdf87a8d946e1e +hash_sha1 gpl 78f806d7e93a3c1ec08836b9d4b689fecb1df19b +hash_sha1 gpl 756981bd0b95c68fd2d1c9123759261aefb51373 +hash_sha1 rwt b6da6c2417cc2cd2be37db408543c2f8c2201034 +hash_sha1 unclear befc3a63448173d57ad7304319ceaf01302ba035 +hash_sha1 tcltk2 e7d59565ab5ec7245fbfea74384798e5f6a9f483 +hash_sha1 tcltk2 7ddf1b18f9624b0a6ded40c70be329cadd074af8 +hash_sha1 gpl 6866382245b1802189e6e8b956196ce4715fc67f +hash_sha1 agpl-3 70ae9c1442b696a7b3ded90579785030ff7bdbb4 +hash_sha1 agpl-3 a596e7f3a3125045173253bddfc8e4b3cba09004 +hash_sha1 rindex_license fa72fc5a881001769d691af7ab529699c08edda0 +hash_sha1 eupl 4418cb312744f1b1a76420cf3ed43dded454e1a2 +hash_sha1 eupl 4b4f67314d4b0cbdcf18e8c765374bfc49c699d1 +hash_sha1 statnet 73d704179dcbe75498f174941036db921e4aab98 +hash_sha1 statnet d6cfab1f34efdeb09ff17948ef37eb82bb151d71 +hash_sha1 degreenet bcfb8b637a823520e18cd00570ab67ac34355e9b +hash_sha1 degreenet c1a8f1e9fda548a222131a42db976a9b841a8b84 +hash_sha1 geometry 4265480ee7ad0ef41f684d20c8204356e12c525c +hash_sha1 geometry c52bef65629df25bcd18e97236f5405e7c408097 +hash_sha1 ergm 2f7fb32f8c752f73fd9f32e92af697c8395ad3ae +hash_sha1 ergm e36db453758cb8173f7cd80561feaea796f767ce +hash_sha1 acepack 698e04a130a50d9e0b990f4bd2569fa54366102a +hash_sha1 acepack 44801e90a3c00a7fe4f5a6bff8c9eaf743d717f4 +hash_sha1 ff 220e79fccd4f8e4874b8c8c481fe7ff9b8e3c850 +hash_sha1 ff 1e0f7f00f430604860afdb5fe911be5db07d5913 +hash_sha1 mspath 58c267c9ae997b5814c5fcaaf6233783f937a2c3 +hash_sha1 mspath 0a4121a7735852e842112b0dd667160f99df39d4 +hash_sha1 ever a3ab3a534d3514d56ae1ea76414e51543af5bef8 +hash_sha1 ever 8b25578cf5d509b042115c54824e8423d95f4061 +hash_sha1 latentnet a67ae6964aa0ede190721cfd17c2509b7799e881 +hash_sha1 latentnet d72813ddddb94f752d9929bdbe622179a623986b +hash_sha1 sgeostat c66e00dc696a8e22dff8f1f180612ac535c0706c +hash_sha1 sgeostat 8c36b0a6a8bf9a031086c85ff41eb7081ba2ae62 diff --git a/branch/split_build/data/populate_licenses b/branch/split_build/data/populate_licenses new file mode 100644 index 0000000..7de0360 --- /dev/null +++ b/branch/split_build/data/populate_licenses @@ -0,0 +1,120 @@ +accept AGPL +accept APACHE +accept ARTISTIC +accept BSD +accept CPL +accept CeCILL +accept EUPL +accept GPL +accept GPL+ACM +accept GPL+QHULL +accept GPLQA +accept LGPL +reject MCLUST +accept MIT +accept MPL +accept NISTnls +accept TCLTK2 +accept UNCLEAR +accept UNLIMITED +accept X11 +accept acepack +accept distrib-noncomm +accept ff +accept grade +accept mmcm +accept mvpart +accept rtiff +accept scagnostics +accept tripack +hash APACHE /usr/share/common-licenses/Apache-2.0 +hash ARTISTIC /usr/share/common-licenses/Artistic +hash BSD /usr/share/common-licenses/BSD +hash GPL /usr/share/common-licenses/GPL-2 +hash GPL /usr/share/common-licenses/GPL-3 +hash LGPL /usr/share/common-licenses/LGPL-2 +hash LGPL /usr/share/common-licenses/LGPL-2.1 +hash LGPL /usr/share/common-licenses/LGPL-3 +pkg AGPL AIS +pkg AGPL BARD +pkg AGPL Zelig +pkg AGPL accuracy +pkg BSD minpack.lm +pkg CPL lmom +pkg CeCILL LLAhclust +pkg EUPL EVER +pkg GPL BayesDA +pkg GPL CDNmoney +pkg GPL HTMLapplets +pkg GPL ICE +pkg GPL ICEinfer +pkg GPL NMMAPSlite +pkg GPL PET +pkg GPL PKtools +pkg GPL RXshrink +pkg GPL Rigroup +pkg GPL TWIX +pkg GPL aplpack +pkg GPL degreenet +pkg GPL ergm +pkg GPL gllm +pkg GPL gmodels +pkg GPL ibdreg +pkg GPL latentnet +pkg GPL moc +pkg GPL network +pkg GPL networksis +pkg GPL partsm +pkg GPL pastecs +pkg GPL pbatR +pkg GPL rake +pkg GPL reldist +pkg GPL snpMatrix +pkg GPL splancs +pkg GPL statnet +pkg GPL timsac +pkg GPL tsfa +pkg GPL uroot +pkg GPL+ACM akima +pkg GPL+ACM tripack +pkg GPL+QHULL geometry +pkg GPLQA regtest +pkg LGPL R.huge +pkg MCLUST mclust +pkg NISTnls NISTnls +pkg TCLTK2 tcltk2 +pkg UNCLEAR adapt +pkg UNCLEAR cat +pkg UNCLEAR cosmo +pkg UNCLEAR mix +pkg UNCLEAR mlmm +pkg UNCLEAR norm +pkg UNCLEAR pan +pkg UNCLEAR titecrm +pkg UNCLEAR tlnise +pkg UNLIMITED boolean +pkg acepack acepack +pkg distrib-noncomm mlbench +pkg ff ff +pkg scagnostics scagnostics +pkg tripack tripack +pkg BSD rtiff +pkg MCLUST mclust02 +pkg distrib-noncomm CoCo +accept GPL+AGPL +pkg GPL+AGPL FAiR +accept CPL +pkg CPL Rcsdp +accept CC-SA +pkg CC-SA SGP +accept ACM +pkg ACM alphahull +pkg ACM asypow +accept caMassClass +pkg caMassClass caMassClass +pkg ARTISTIC matlab +pkg GPL mmcm +pkg GPL mvpart +accept rwt +pkg rwt rwt +pkg UNCLEAR sgeostat diff --git a/branch/split_build/data/populate_sysreq b/branch/split_build/data/populate_sysreq new file mode 100644 index 0000000..6aa3775 --- /dev/null +++ b/branch/split_build/data/populate_sysreq @@ -0,0 +1,107 @@ +sysreq ignore gcc +sysreq ignore gnu make +sysreq ignore % if present +sysreq ignore none +sysreq libcurl curl +sysreq ggobi ggobi +sysreq libatk atk +sysreq libcairo cairo +sysreq libdieharder dieharder% +sysreq libfontconfig fontconfig +sysreq libfreetype freetype +sysreq libfreetype %freetype +sysreq libgd libgd +sysreq libgdal %gdal% +sysreq opengl opengl +sysreq glade %glade +sysreq glib glib +sysreq glu glu library +sysreq gmp gmp +sysreq libgraphviz graphviz +sysreq gsl gnu gsl% +sysreq gsl gnu scientific library +sysreq libgtk gtk% +sysreq libjpeg libjpeg% +sysreq libmagick imagemagick +sysreq libpango pango +sysreq libpng libpng +sysreq quantlib quantlib% +sysreq libxml libxml% +sysreq msttcorefonts msttcorefonts +sysreq pari-gp pari/gp +sysreq proj proj% +sysreq zlib zlib +sysreq java java +sysreq odbc %odbc% +sysreq ignore drivers. see readme. +sysreq ignore r must be compiled with --enable-r-shlib if the server is to be built +sysreq yacas yacas% +sysreq libtiff %libtiff% +sysreq ignore zlibdll +sysreq ignore jpegdll% +sysreq fftw fftw% +sysreq python python +sysreq ghostscript ghostscript +sysreq gsl libgsl +sysreq ignore rgl packages for rendering +sysreq grass grass +sysreq ignore internal files xba.cqv +sysreq ignore xba.regions +sysreq ignore lammpi or mpich +sysreq blas blas +sysreq blacs blacs +sysreq scalapack scalapack +sysreq wordnet wndb-tar.gz% +sysreq boost boost% +sysreq jags jags +sysreq ignore winbugs +sysreq ignore posix-compliant os +sysreq curl curl% +sysreq netcdf netcdf% +sysreq udunits udunits% +sysreq rgrs xclip +sysreq flac flac +sysreq perl perl +sysreq ignore encode +sysreq ignore parse::recdescent +sysreq ignore getopt::long +sysreq ignore file::basename +sysreq ignore spreadsheet::writeexcel +sysreq ignore file::glob +sysreq writexls-perl text::csv_xs +sysreq ignore ant +sysreq ignore linux/64bit +sysreq ignore linux/bit +sysreq tk tcl/tk +sysreq tktable tktable +sysreq tktable tktable% +sysreq ignore optional) +sysreq bwidget bwidget +sysreq ignore drivers. +sysreq graphviz dot graphviz +sysreq ignore berkeleydb +sysreq mpfr %mpfr% +sysreq ignore http://mpfr.org/% +sysreq gmp gmp (gnu multiple precision library +sysreq ignore see readme +sysreq tk-img img +sysreq ignore activetcl +sysreq libitpp libitpp +sysreq libxerces-c libxerces-c +sysreq ignore java runtime +sysreq protobuf protocol buffer compiler (to create c++ header +sysreq ignore Protocol Buffer compiler (% +sysreq ignore source files .proto % +sysreq ignore library (version 2.2.0 or later) +sysreq ignore library +sysreq libpng libpng% +sysreq postgresql postgresql +sysreq postgresql_java postgresql jdbc driver +sysreq ignore gmt +sysreq armadillo armadillo +sysreq java jri +sysreq rpcgen rpcgen +sysreq ignore lapack_atlas +sysreq ignore libgsl0ldbl +sysreq ignore libgslldbl +sysreq ignore libgsldev diff --git a/branch/split_build/data/pull b/branch/split_build/data/pull new file mode 100755 index 0000000..f53e1e8 --- /dev/null +++ b/branch/split_build/data/pull @@ -0,0 +1,6 @@ +#!/bin/sh +cran2deb depend ls aliases >populate_depend_aliases +cran2deb depend ls force >populate_forcedep +cran2deb depend ls sysreq >populate_sysreq +cran2deb license ls >populate_license_hashes +echo NOTE: you need to update populate_licenses manually! diff --git a/branch/split_build/data/quit b/branch/split_build/data/quit new file mode 100644 index 0000000..ff60466 --- /dev/null +++ b/branch/split_build/data/quit @@ -0,0 +1 @@ +quit diff --git a/branch/split_build/exec/autobuild b/branch/split_build/exec/autobuild new file mode 100755 index 0000000..f9dbaf9 --- /dev/null +++ b/branch/split_build/exec/autobuild @@ -0,0 +1,15 @@ +#!/usr/bin/env r +## DOC: cran2deb autobuild +## DOC: automatically builds all out of date packages. +## DOC: +suppressPackageStartupMessages(library(cran2deb)) + +if (exists('argv')) { # check for littler + db_update_package_versions() + outdated <- db_outdated_packages() + build_order <- r_dependency_closure(outdated) + notice('build order',paste(build_order,collapse=', ')) + for (pkg in build_order) { + build(pkg,c()) + } +} diff --git a/branch/split_build/exec/build b/branch/split_build/exec/build new file mode 100755 index 0000000..6feaf5d --- /dev/null +++ b/branch/split_build/exec/build @@ -0,0 +1,48 @@ +#!/usr/bin/env r +## DOC: cran2deb build [-d] [-D extra_dep1,extra_dep2,...] package1 package2 ... +## DOC: builds a particular package. +## DOC: -d leave the staging directory around for debugging. +## DOC: +suppressPackageStartupMessages(library(cran2deb)) + +if (exists('argv')) { # check for littler + argc <- length(argv) + extra_deps = list() + extra_deps$deb = c() + extra_deps$r = c() + do_cleanup = T + opts = c('-D','-R','-d') + # first argument is the root --- this is dealt with elsewhere. + for (i in 2:argc) { + if (!(argv[i] %in% opts)) { + if (argc >= i) { + argv <- argv[i:argc] + } else { + argv <- list() + } + argc = argc - i + 1 + break + } + if (i == argc) { + err('missing argument') + } + if (argv[i] == '-D') { + extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) + } + if (argv[i] == '-R') { + extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]]) + extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname_as_debian)) + } + if (argv[i] == '-d') { #debug + do_cleanup = F + } + } + if (argc == 0) { + err('usage: cran2deb build [-d] [-D extra_dep1,extra_dep2,...] package package ...') + } + build_order <- r_dependency_closure(c(extra_deps$r,argv)) + notice('build order',paste(build_order,collapse=', ')) + for (pkg in build_order) { + build(pkg,extra_deps,force=pkg %in% argv, do_cleanup) + } +} diff --git a/branch/split_build/exec/build_all b/branch/split_build/exec/build_all new file mode 100644 index 0000000..64f125d --- /dev/null +++ b/branch/split_build/exec/build_all @@ -0,0 +1,16 @@ +#!/usr/bin/env r +## DOC: cran2deb build_all +## DOC: build all packages again +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) + +if (exists('argv')) { # check for littler + db_update_package_versions() + pkgs <- dimnames(available)[1] + build_order <- r_dependency_closure(pkgs) + notice('build order',paste(build_order,collapse=', ')) + for (pkg in build_order) { + build(pkg,c(),force=T) + } +} diff --git a/branch/split_build/exec/build_ctv b/branch/split_build/exec/build_ctv new file mode 100755 index 0000000..1e39e04 --- /dev/null +++ b/branch/split_build/exec/build_ctv @@ -0,0 +1,14 @@ +#!/bin/sh +## DOC: cran2deb build_ctv +## DOC: build all CRAN TaskViews. warning and error logs in ./ctv/ +## DOC: + +for ctv in $(cran2deb cran_pkgs query); do + echo task view $ctv... + if [ ! -e "ctv/$ctv" ]; then + cran2deb build_some "$ctv" + mkdir -p "ctv/$ctv" + mv warn fail "ctv/$ctv" + fi +done + diff --git a/branch/split_build/exec/build_some b/branch/split_build/exec/build_some new file mode 100755 index 0000000..da105fd --- /dev/null +++ b/branch/split_build/exec/build_some @@ -0,0 +1,37 @@ +#!/usr/bin/rc +## DOC: cran2deb build_some [taskview1 taskview2 ...] +## DOC: build some packages, logging warnings into ./warn/$package +## DOC: and failures into ./fail/$package. with no arguments a random +## DOC: sample of packages is built. the file ./all_pkgs overrides this +## DOC: behaviour and is expected to be a list of packages to build. +## DOC: + +mkdir -p warn fail +shift +if ([ ! -e all_pkgs ]) { + cran2deb cran_pkgs $* >all_pkgs +} + +for (pkg in `{cat all_pkgs}) { + if (~ $pkg *..* */*) { + echo bad name $pkg >>fail/ERROR + } else if ([ -e warn/$pkg ]) { + echo skipping $pkg... + } else if ([ -e fail/$pkg ]) { + echo skipping failed $pkg... + } else { + echo -n .. package $pkg + fail=0 + cran2deb build $pkg >fail/$pkg >[2=1] || fail=1 + if (~ $fail 0) { + echo success + grep '^[WE]:' fail/$pkg >warn/$pkg +# if (~ `{stat -c '%s' warn/$pkg} 0) { +# rm -f warn/$pkg +# } + rm -f fail/$pkg + } else { + echo FAILED + } + } +} diff --git a/branch/split_build/exec/copy_find b/branch/split_build/exec/copy_find new file mode 100755 index 0000000..eebcec1 --- /dev/null +++ b/branch/split_build/exec/copy_find @@ -0,0 +1,33 @@ +#!/usr/bin/rc +## DOC: cran2deb copy_find path +## DOC: a tool for finding (heuristically) some copyright notices. +## DOC: +kwords='copyright|warranty|redistribution|modification|patent|trademark|licen[cs]e|permission' +nl=`` () {printf '\n'} +ifs=$nl { + files=`{find $1 ! -path '*debian*' -type f} + lines=() + for (file in $files) { + notices=`{grep -H '(C)' $file} + notices=($notices `{grep -HEi $kwords $file}) + lines=($lines `{{for (notice in $notices) echo $notice} | sort -u}) + } + # let's hope no file has a : in it + ifs=() { seen_files=`{{for (line in $lines) echo $line} | cut -d: -f1} } + missing_copyright=() + for (file in $files) { + if (echo -n $seen_files | grep -q '^'^$file^'$') { + } else { + missing_copyright=($missing_copyright $file) + } + } + echo 'Suspect copyright notices:' + for (line in $lines) echo ' '$line + echo 'Files without *suspect* copyright notices:' + for (missing in $missing_copyright) { + echo ' '$missing + echo ' type: '`{file $missing} + echo ' chars: '`{wc -c $missing | awk '{print $1}'} + echo ' lines: '`{wc -l $missing | awk '{print $1}'} + } +} diff --git a/branch/split_build/exec/cran2deb b/branch/split_build/exec/cran2deb new file mode 100755 index 0000000..7efedc7 --- /dev/null +++ b/branch/split_build/exec/cran2deb @@ -0,0 +1,10 @@ +#!/bin/sh +umask 002 +root=$(r -e 'suppressMessages(library(cran2deb));cat(system.file(package="cran2deb"),file=stdout())') +cmd=$1 +shift +if [ ! -x "$root/exec/$cmd" ]; then + echo unknown command $cmd + exit 1 +fi +"$root/exec/$cmd" "$root" $* diff --git a/branch/split_build/exec/cran_pkgs b/branch/split_build/exec/cran_pkgs new file mode 100755 index 0000000..201f968 --- /dev/null +++ b/branch/split_build/exec/cran_pkgs @@ -0,0 +1,28 @@ +#!/usr/bin/env r +## DOC: cran2deb cran_pkgs +## DOC: print a list of 800 packages picked at random +## DOC: cran2deb cran_pkgs query +## DOC: print the names of all CRAN TaskViews +## DOC: cran2deb cran_pkgs taskview1 taskview2 ... +## DOC: print the names of all packages in a particular CRAN TaskView +## DOC: + +library(cran2deb) + +if (length(argv) == 1) { + writeLines(dimnames(available)[[1]]) +} else { + argv = argv[2:length(argv)] + if (argv[1] == 'query') { + for (ctv in ctv.available) { + writeLines(ctv$name) + } + q(save='no') + } + # list of task lists + for (ctv in ctv.available) { + if (ctv$name %in% argv) { + writeLines(ctv$packagelist$name) + } + } +} diff --git a/branch/split_build/exec/db_release b/branch/split_build/exec/db_release new file mode 100755 index 0000000..cc6d59d --- /dev/null +++ b/branch/split_build/exec/db_release @@ -0,0 +1,13 @@ +#!/usr/bin/env r +## DOC: cran2deb db_release +## DOC: make note of a substantial update of the database. causes all packages to be marked for ebuild. +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) + +con <- db_start() +notice('old db version:',db_cur_version(con)) +db_stop(con,TRUE) +con <- db_start() +notice('new db version:',db_cur_version(con)) +db_stop(con) diff --git a/branch/split_build/exec/depclosure b/branch/split_build/exec/depclosure new file mode 100755 index 0000000..4ce117f --- /dev/null +++ b/branch/split_build/exec/depclosure @@ -0,0 +1,6 @@ +#!/usr/bin/r +## DOC: cran2deb depclosure package1 [package2 ...] +## DOC: show the dependency closure for ... +## DOC: +suppressMessages(library(cran2deb)) +print(do.call(rbind, r_dependency_closure(argv,forward_arcs=F))) diff --git a/branch/split_build/exec/depend b/branch/split_build/exec/depend new file mode 100755 index 0000000..2552d8f --- /dev/null +++ b/branch/split_build/exec/depend @@ -0,0 +1,95 @@ +#!/usr/bin/env r +## DOC: cran2deb depend +## DOC: add dependency aliases, system requirements and forced dependencies +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) +suppressPackageStartupMessages(library(digest)) + +exec_cmd <- function(argc, argv) { + usage <- function() + message(paste('usage: alias ' + ,' alias_run ' + ,' alias_build ' + ,' sysreq ' + ,' force ' + ,' ls [aliases|force|sysreq]' + ,' quit' + ,sep='\n')) + + if (argc < 1) { + return() + } + cmd = argv[1] + + if (cmd == 'alias') { + if (argc < 3) { + usage() + return() + } + alias = argv[2] + pkg = argv[3] + db_add_depends(alias, pkg, build=T) + pkg = gsub('-dev$','',pkg) + db_add_depends(alias, pkg, build=F) + } else if (cmd == 'alias_run' || cmd == 'alias_build') { + if (argc < 3) { + usage() + return() + } + db_add_depends(argv[2], argv[3], cmd == 'alias_build') + } else if (cmd == 'sysreq') { + if (argc < 3) { + usage() + return() + } + sysreq = paste(argv[3:argc],collapse=' ') + db_add_sysreq_override(sysreq,argv[2]) + } else if (cmd == 'force') { + if (argc < 3) { + usage() + return() + } + db_add_forced_depends(argv[3],argv[2]) + } else if (cmd == 'ls') { + if (argc < 2 || argv[2] == 'aliases') { + aliases <- db_depends() + for (i in rownames(aliases)) { + type = 'alias_run' + if (as.logical(aliases[i,'build'])) { + type = 'alias_build' + } + cat(paste(type,aliases[i,'alias'],aliases[i,'debian_pkg'],'\n')) + } + } else if (argv[2] == 'sysreq') { + sysreqs <- db_sysreq_overrides() + for (i in rownames(sysreqs)) { + cat(paste('sysreq',sysreqs[i,'depend_alias'],sysreqs[i,'r_pattern'],'\n')) + } + } else if (argv[2] == 'force') { + forced <- db_forced_depends() + for (i in rownames(forced)) { + cat(paste('force',forced[i,'depend_alias'],forced[i,'r_name'],'\n')) + } + } else { + usage() + return() + } + } else if (cmd == 'quit') { + exit() + } else if (cmd == '#') { + } else { + usage() + return() + } +} + +argc <- length(argv) +if (argc > 1) { + exec_cmd(argc-1,argv[c(2:argc)]) +} else { + while(T) { + argv <- strsplit(readline('depend> '),'[[:space:]]+')[[1]] + exec_cmd(length(argv),argv) + } +} diff --git a/branch/split_build/exec/diagnose b/branch/split_build/exec/diagnose new file mode 100755 index 0000000..b696929 --- /dev/null +++ b/branch/split_build/exec/diagnose @@ -0,0 +1,31 @@ +#!/bin/sh +last='natural join (select system,package,max(id) as id from builds where package not in (select package from blacklist_packages) group by package,system)' + +echo blacklist: +#sqlite3 -header -column /var/cache/cran2deb/cran2deb.db "select count(*) as total_blacklist,sum(nonfree) as num_nonfree, sum(obsolete) as num_obsolete, sum(broken_dependency) as num_broke_depend, sum(unsatisfied_dependency) as num_unsat_depend, sum(breaks_cran2deb) as num_break_cran2deb, sum(other) as num_other from blacklist_packages;" +sqlite3 -header -column /var/cache/cran2deb/cran2deb.db "select count(*) as total,sum(nonfree) as nonfree, sum(obsolete) as obsolete, sum(broken_dependency) as broke_depend, sum(unsatisfied_dependency) as unsat_depend, sum(breaks_cran2deb) as break_cran2deb, sum(other) as other from blacklist_packages;" + +echo bad licenses: +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and log like '%No acceptable license:%' group by system;" +echo +echo bad system req: +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and log like '%do not know what to do with SystemRequirement:%' group by system;" +echo +echo 'c/c++ error (maybe):' +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like '%error: %.h: No such file or directory%' or log like '%error: %.hpp: No such file or directory%') group by system;" +echo +echo 'missing r-cran- package:' +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: Couldn't find package r-cran-%\") group by system;" + +echo +echo 'missing r-cran- package: (frequency, missing package)' +cran2deb latest_log $(sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: Couldn't find package r-cran-%\") group by system;" | head -n 1 | cut -d'|' -f3- | tr ',' ' ') 2>/dev/null | grep "^E: Couldn't find package r-cran-" | awk '{print $5}' | sort | uniq -c | sort -rn + +echo +echo 'lintian:' +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like \"%E: r-cran-%\") group by system;" +echo +echo some other dependency failure: +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),group_concat(package) from builds $last where success = 0 and (log like '%Error: package % could not be loaded%' or log like '%ERROR: lazy loading failed for package%' or log like '%is not available%' or log like '%there is no package called%') and not (log like \"%E: Couldn't find package r-cran-%\") group by system;" + + diff --git a/branch/split_build/exec/diagnose_ctv b/branch/split_build/exec/diagnose_ctv new file mode 100755 index 0000000..5e7ef03 --- /dev/null +++ b/branch/split_build/exec/diagnose_ctv @@ -0,0 +1,2 @@ +#!/bin/sh +(for x in ctv/*; do echo;echo;echo "$x: "; cd "$x" && cran2deb diagnose && cd ../..; done) >ctv.results diff --git a/branch/split_build/exec/get_base_pkgs b/branch/split_build/exec/get_base_pkgs new file mode 100755 index 0000000..46de12c --- /dev/null +++ b/branch/split_build/exec/get_base_pkgs @@ -0,0 +1,6 @@ +#!/usr/bin/env r +instPkgs <- installed.packages(lib.loc="/usr/lib/R/library") +instPkgs <- instPkgs[ instPkgs[,"Priority"] == 'base', ] +for (pkg in rownames(instPkgs)) { + message(pkg) +} diff --git a/branch/split_build/exec/help b/branch/split_build/exec/help new file mode 100755 index 0000000..3eeabab --- /dev/null +++ b/branch/split_build/exec/help @@ -0,0 +1,6 @@ +#!/bin/sh +echo usage: cran2deb ' [args ...]' +echo where '' is one of +grep '## [D]OC:' $1/exec/* | sed -e 's/.*[D]OC://' +echo +echo installation root is: $1 diff --git a/branch/split_build/exec/latest_log b/branch/split_build/exec/latest_log new file mode 100644 index 0000000..1aa875a --- /dev/null +++ b/branch/split_build/exec/latest_log @@ -0,0 +1,12 @@ +#!/usr/bin/env r +## DOC: cran2deb latest_log package1 package2 ... +## DOC: show the latest log output for +## DOC: +suppressPackageStartupMessages(library(cran2deb)) + +if (exists('argv')) { + for (pkg in argv) { + cat(db_latest_build(pkg)$log) + cat('\n') + } +} diff --git a/branch/split_build/exec/license b/branch/split_build/exec/license new file mode 100755 index 0000000..a211525 --- /dev/null +++ b/branch/split_build/exec/license @@ -0,0 +1,145 @@ +#!/usr/bin/env r +## DOC: cran2deb license +## DOC: add licenses and change acceptance/rejection of licenses +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) +suppressPackageStartupMessages(library(digest)) + +exec_cmd <- function(argc, argv) { + usage <- function() + message(paste('usage: accept ' + ,' reject ' + ,' hash (|)' + ,' pkg ' + ,' view ' + ,' ls' + ,' quit' + ,sep='\n')) + + if (argc < 1) { + exit() + } + cmd = argv[1] + + if (cmd == 'accept' || cmd == 'reject') { + if (argc != 2) { + usage() + return() + } + action = (cmd == 'accept') + db_add_license_override(argv[2],action) + } else if (cmd == 'hash') { + if (argc != 3) { + usage() + return() + } + license = argv[2] + path = argv[3] + if (is.null(db_license_override_name(license))) { + error('license',license,'is not known; add it first') + return() + } + if (!file.exists(path)) { + error(path,'does not exist') + return() + } + license_sha1 = digest(readChar(path,file.info(path)$size) + ,algo='sha1', serialize=FALSE) + db_add_license_hash(license,license_sha1) + } else if (cmd == 'hash_sha1') { + if (argc != 3) { + usage() + return() + } + license = argv[2] + license_sha1 = argv[3] + if (is.null(db_license_override_name(license))) { + error('license',license,'is not known; add it first') + return() + } + db_add_license_hash(license,license_sha1) + } else if (cmd == 'pkg') { + if (argc != 3) { + usage() + return() + } + license <- argv[2] + pkg_name <- argv[3] + current_action <- db_license_override_name(license) + if (is.null(current_action)) { + notice('license',license,'is not known; add it') + return() + } + action = 'accept' + if (!current_action) { + action = 'reject' + } + notice('in future, will',action,'the package',pkg_name,'under license',license) + tmp <- setup() + success <- try((function() { + pkg <- prepare_pkg(tmp,pkg_name) + if (!('License' %in% names(pkg$description[1,]))) { + error('package',pkg$name,'has no License: field in DESCRIPTION') + return() + } + first_license = (strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] + license_sha1 <- get_license_hash(pkg,first_license) + db_add_license_hash(license,license_sha1) + })()) + cleanup(tmp) + if (inherits(success,'try-error')) { + return() + } + } else if (cmd == 'view') { + if (argc != 2) { + usage() + return() + } + pkg_name <- argv[2] + tmp <- setup() + success <- try((function() { + pkg <- prepare_pkg(tmp,pkg_name) + if (!('License' %in% names(pkg$description[1,]))) { + error('package',pkg$name,'has no License: field in DESCRIPTION') + return() + } + first_license = (strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] + first_license = get_license(pkg,first_license) + cat(strwrap(first_license),file='|less') + })()) + cleanup(tmp) + if (inherits(success,'try-error')) { + return() + } + } else if (cmd == 'ls') { + licenses <- db_license_overrides() + for (i in rownames(licenses$overrides)) { + mode='accept' + if (licenses$overrides[i,'accept']==0) { + mode='reject' + } + cat(paste(mode,licenses$overrides[i,'name'],'\n')) + } + for (i in rownames(licenses$hashes)) { + cat(paste('hash_sha1',licenses$hashes[i,'name'],licenses$hashes[i,'sha1'],'\n')) + } + } else if (cmd == 'help') { + usage() + return() + } else if (cmd == 'quit') { + exit() + } +} + +argc <- length(argv) +if (argc > 1) { + exec_cmd(argc-1,argv[c(2:argc)]) +} else { + while(T) { + argv <- strsplit(readline('license> '),'[[:space:]]+')[[1]] + exec_cmd(length(argv),argv) + } +} diff --git a/branch/split_build/exec/progress b/branch/split_build/exec/progress new file mode 100755 index 0000000..e36f274 --- /dev/null +++ b/branch/split_build/exec/progress @@ -0,0 +1,13 @@ +#!/bin/sh +## DOC: cran2deb progress +## DOC: show summary report of aggregate build progress +## DOC: +last='natural join (select system,package,max(id) as id from builds where package not in (select package from blacklist_packages) group by package,system)' +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,(select count(*) from blacklist_packages),-1 from builds group by system;" +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,count(package),success from builds $last group by success,system" + +echo failures: +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,group_concat(package) from builds $last where success = 0 group by system" + +echo Xvfb failures: +sqlite3 /var/cache/cran2deb/cran2deb.db "select system,group_concat(package) from builds $last where success = 0 and log like '%Xvfb failed to start%' group by system;" diff --git a/branch/split_build/exec/repopulate b/branch/split_build/exec/repopulate new file mode 100755 index 0000000..ab3ea60 --- /dev/null +++ b/branch/split_build/exec/repopulate @@ -0,0 +1,24 @@ +#!/bin/sh +## DOC: cran2deb repopulate +## DOC: repopulate the cran2deb database and configurations from a new cran2deb release +## DOC: + +umask 002 +root=$1 +shift +for x in $(find /etc/cran2deb/ -type f -name '*.in'); do + y=$(echo $x | sed -e 's,.in$,,') + sed -e "s:@ROOT@:$root:g" <"$x" >"$y" +done + +# now do an update to reflect any config changes +"$root/exec/update" "$root" + +(for fn in populate_licenses quit; do + cat "$root/data/$fn" +done) | "$root/exec/license" "$root" + +(for fn in populate_depend_aliases populate_sysreq populate_forcedep quit; do + cat "$root/data/$fn" +done) | "$root/exec/depend" "$root" + diff --git a/branch/split_build/exec/root b/branch/split_build/exec/root new file mode 100755 index 0000000..3133778 --- /dev/null +++ b/branch/split_build/exec/root @@ -0,0 +1,2 @@ +#!/bin/sh +echo $1 diff --git a/branch/split_build/exec/showbuilds b/branch/split_build/exec/showbuilds new file mode 100755 index 0000000..c35e558 --- /dev/null +++ b/branch/split_build/exec/showbuilds @@ -0,0 +1,37 @@ +#!/bin/sh +## DOC: cran2deb showbuilds [date] +## DOC: list build summary for given date +## DOC: default value for date is current day +## DOC: +db=/var/cache/cran2deb/cran2deb.db +date=`date "+%Y-%m-%d"` + +usage_and_exit() +{ + cat <&1 >/dev/null <' + ,shQuote(file.path(root,'exec/get_base_pkgs')) + ,'| grep -v ^W:'))) + +message('updating list of existing Debian packages...') +debian_pkgs <- readLines(pipe('apt-cache rdepends r-base-core | sed -e "/^ r-cran/{s/^[[:space:]]*r/r/;p}" -e d | sort -u')) + +save(debian_pkgs, base_pkgs, available, ctv.available, file=file.path(cache_root,'cache.rda'),eval.promises=T) + +message('synchronising database...') +db_update_package_versions() diff --git a/branch/split_build/exec/web b/branch/split_build/exec/web new file mode 100755 index 0000000..10dbcb4 --- /dev/null +++ b/branch/split_build/exec/web @@ -0,0 +1,39 @@ +#!/usr/bin/env r +## DOC: cran2deb web +## DOC: generate cran2deb status web pages +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) +library(hwriter) + +banned_builds_path='/var/www/banned_packages.html' +todays_builds_path='/var/www/todays_packages.html' +latest_builds_path='/var/www/latest_packages.html' +failed_builds_path='/var/www/failed_packages.html' + +links <- function(p) { + hwrite(c( + hwrite('Packages built today',link='/todays_packages.html') + ,hwrite('Successful packages',link='/latest_packages.html') + ,hwrite('Failed packages',link='/failed_packages.html') + ,hwrite('Banned packages',link='/banned_packages.html') + ),p,center=TRUE,border=0,style='padding: 6px 6px 6px 12px') +} + +page <- function(content,path,title) { + title <- paste('cran2deb:',title) + p <- openPage(path,title=title) + hwrite(title,p,heading=1) + hwrite('Install instructions',p,center=TRUE,link='/') + links(p) + hwrite(content,p,center=TRUE,border=1,table.style='border-collapse: collapse; padding: 0; margin: 0' + ,row.names=FALSE,row.bgcolor='#ffaaaa') + links(p) + closePage(p) +} + +page(db_blacklist_reasons(),banned_builds_path,'Banned packages') +page(db_todays_builds(),todays_builds_path,'Packages built today') +page(db_successful_builds(),latest_builds_path,'Latest successfully built packages') +page(db_failed_builds(),failed_builds_path,'Recent failed packages') + diff --git a/branch/split_build/exec/which_system b/branch/split_build/exec/which_system new file mode 100755 index 0000000..c7b62de --- /dev/null +++ b/branch/split_build/exec/which_system @@ -0,0 +1,7 @@ +#!/usr/bin/env r +## DOC: cran2deb which_system +## DOC: show which system cran2deb will build for next +## DOC: +suppressMessages(library(cran2deb)) + +cat(which_system) diff --git a/branch/split_build/inst/doc/DB_NOTES b/branch/split_build/inst/doc/DB_NOTES new file mode 100644 index 0000000..0960026 --- /dev/null +++ b/branch/split_build/inst/doc/DB_NOTES @@ -0,0 +1,81 @@ +this file documents some of R/db.R -- the DB interface code. + + +table: sysreq_override +fields: depend_alias TEXT, r_pattern TEXT + +SystemRequirements LIKE r_pattern are mapped onto the dependency alias +depend_alias (this is a foreign key in debian_dependency). + +table: debian_dependency +fields: id INTEGER PRIMARY KEY AUTOINCREMENT, + alias TEXT, + build INTEGER NOT NULL, + debian_pkg TEXT NOT NULL, + UNIQUE (alias,build,debian_pkg) + +sets up a dependency alias. each row is a Debian dependency entry, debian_pkg, which +may be added to Depends: (and Build-Depends: if build = 1). + +table: forced_depends +fields: r_name TEXT. + depend_alias TEXT, + PRIMARY KEY (r_name,depend_alias)' + +forces the R package r_name to have the dependencies implied by depend_alias (a foriegn +key in debian_dependency). + +table: license_override +fields: name TEXT PRIMARY KEY, + accept INT NOT NULL + +specifies whether the license, name, is accepted or rejected. + +table: license_hashes +fields: name TEXT + sha1 TEXT PRIMARY KEY + +matches an SHA1 hash of the LICEN[CS]E file or part of the License: field to +a particular license name (a foreign key in license_override). + +table: database_versions +fields: version INTEGER PRIMARY KEY AUTOINCREMENT, + version_date INTEGER, + base_epoch INTEGER + +a version of the database. each time one of the above tables (but not the below +tables) is updated, a new record is added to this table, indicating significant +changes to the database. version_date indicates when this change occurred +(seconds since UNIX epoch) and base_epoch is the Debian version epoch. + +in future, all of the above fields should be versioned and somehow linked to +the packages that used them, so we only rebuild what is necessary. + +table: packages +fields: package TEXT PRIMARY KEY, + latest_r_version TEXT + +a package, and its latest R version. this is a copy of the 'available' +structure in the cran2deb R cache, and it is here as it allows queries on the +'builds' table to be much simpler (and perhaps faster). + +table: builds +fields: id INTEGER PRIMARY KEY AUTOINCREMENT, + package TEXT, + r_version TEXT, + deb_epoch INTEGER, + deb_revision INTEGER, + db_version INTEGER, + date_stamp TEXT, + git_revision TEXT, + success INTEGER, + log TEXT, + UNIQUE(package,r_version,deb_epoch,deb_revision,db_version) + +Each time a 'package' is built, its 'success' is logged, along with the +particular database, cran2deb, R and Debian version information (db_version, +git_revision, r_version, deb_epoch, deb_revision) and the current date +(date_stamp). 'log' contains the output of the build process. + +A new 'deb_revision' is assigned to each successful build. + diff --git a/branch/split_build/inst/doc/DEPENDS b/branch/split_build/inst/doc/DEPENDS new file mode 100644 index 0000000..471f240 --- /dev/null +++ b/branch/split_build/inst/doc/DEPENDS @@ -0,0 +1,33 @@ +A dependency alias (created in populated_depend_aliases) is some name (such as +java) and some associated run and build time dependencies, specified like this: + + alias_build java openjdk-6-jdk + alias_build java libgcj9-dev + alias_run java openjdk-6-jre + +So when cran2deb needs to use the 'java' build dependency, it will add +"openjdk-6-jdk, libgcj9-dev" to the Build-Depends:. alias_run deals with +Depends: only. +Since in Debian you cannot Build-Depend: upon build-essential, there is a +special 'ignore' dependency alias (this can be handy for dropping unnecessary +system requirements) + + alias_build ignore build-essential + +populate_forcedep contains like: + + force java rJava + +which forces the R package rJava to use the dependency alias 'java'. This is +for cases where there is no SystemRequirement. + +Finally, populate_sysreq has lines like: + + sysreq quantlib quantlib% + +This says, whenever a part of a SystemRequirement matches the SQL LIKE pattern +'quantlib%', use the dependency alias. SystemRequirements are converted to +lower case and messed around with; details are in R/debcontrol.R in the +sysreqs_as_debian function. R/debcontrol.R contains pretty much all of the code +for dependencies (the database interface code is in R/db.R). + diff --git a/branch/split_build/inst/doc/INSTALL_NOTES b/branch/split_build/inst/doc/INSTALL_NOTES new file mode 100644 index 0000000..5acec95 --- /dev/null +++ b/branch/split_build/inst/doc/INSTALL_NOTES @@ -0,0 +1,62 @@ +*WARNING* This is not up to date! The major difference is that now we have +*WARNING* system-specific configurations, archives and results, so that several +*WARNING* of the paths have either a 'sys/FOO' part or a 'FOO' part where FOO +*WARNING* is something like debian-amd64, debian-i386.. + + +git clone git://github.com/blundellc/cran2deb.git + +apt-get system requirements from DESCRIPTION +apt-get install cdbs + +# install a web server +apt-get install thttpd + +# add a group for cran2deb people +addgroup cran2deb +usermod -a -G cran2deb cb +usermod -a -G cran2deb edd + +# set up web space +mkdir /var/www/cran2deb +chgrp cran2deb /var/www/cran2deb +chmod 3775 /var/www/cran2deb + +# install prereq R packages +r -e "install.packages(c('ctv','RSQLite','DBI','digest'))" +R CMD INSTALL cran2deb + +# set up cran2deb space, as per README +cp /usr/local/lib/R/site-library/cran2deb/exec/cran2deb /usr/local/bin +root=$(cran2deb root) +mkdir /etc/cran2deb +chgrp cran2deb /etc/cran2deb +chmod 3775 /etc/cran2deb +copy ROOT/etc/* to /etc/cran2deb +ln -s /var/www/cran2deb/ /etc/cran2deb/archive +edit /etc/cran2deb/pbuilder.in: +OTHERMIRROR='deb http://localhost/users/cb/cran2deb/ testing/$(ARCH)/ | deb http://localhost/users/cb/cran2deb/ testing/all/' +MIRRORSITE='http://ftp.debian.org/debian/' +to +OTHERMIRROR='deb http://localhost/cran2deb/ testing/$(ARCH)/ | deb http://localhost/cran2deb/ testing/all/' +MIRRORSITE='http://ftp.at.debian.org/debian/' + +# fix permissions for group usage. +mkdir /var/cache/cran2deb +chgrp cran2deb /var/cache/cran2deb +chmod 3775 /var/cache/cran2deb +chgrp -R cran2deb $root +chmod 3775 $root +chmod -R g+w $root + +(log out then log in to get gid cran2deb) + +# build pbuilder archive, initialise database +cran2deb update + +# check it works +cran2deb build zoo + +# is handy +apt-get install sqlite3 + diff --git a/branch/split_build/inst/doc/PKG b/branch/split_build/inst/doc/PKG new file mode 100644 index 0000000..de0a4b2 --- /dev/null +++ b/branch/split_build/inst/doc/PKG @@ -0,0 +1,23 @@ +One of the key data structures using by cran2deb is commonly called 'pkg'. +It is constructed in R/getrpkg.R by prepare_pkg. prepare_pkg obtains +an R package and converts the source package into something suitable for use +with Debian. + +If a particular upstream version has already been used to create a Debian +package, then the source tarball of that upstream version is expected to be +available locally, and is used for building. In this case no conversion is +performed, so the archive does not change. In future it may be desirable to +obtain the source tarball from some central archive but this is not done at the +moment. + +download_pkg in R/getrpkg.R obtains the tarball (archive) of the R package, either +from the previous Debian build, or from the R archive. The field pkg$need_repack +indicates if the obtained archive must be repacked into a form acceptable +as a Debian source archive. This repacking, if necessary, is performed by +repack_pkg in R/getrpkg.R + + +Most of the creation of pkg is done by R/getrpkg.R. However some more build +specific operations (such as determining the new build version pkg$debversion) +are performed by R/debianpkg.R. + diff --git a/branch/split_build/inst/doc/README b/branch/split_build/inst/doc/README new file mode 100644 index 0000000..a2e51f1 --- /dev/null +++ b/branch/split_build/inst/doc/README @@ -0,0 +1,55 @@ +To install: + +$ cd .. +$ R CMD INSTALL cran2deb + +copy cran2deb/exec/cran2deb into somewhere in your executable path (e.g., +/usr/local/bin, $home/bin) + + + +To configure: + +1. You need a web server serving from say, /var/www/cran2deb/ + +Let ROOT be the value returned by running: cran2deb root +Let SYS be the system you wish to build for (e.g., debian-amd64) + +2. create /etc/cran2deb + a. copy ROOT/etc/* into /etc/cran2deb/ + b. ensure ROOT/etc/sys/SYS is set up + c. /etc/cran2deb/archive should be a symlink pointing to /var/www/cran2deb/ + + $ ln -s /var/www/cran2deb/ /etc/cran2deb/archive + $ mkdir /var/www/cran2deb/SYS + + d. modify OTHERMIRROR of /etc/cran2deb/sys/SYS/pbuilderrc.in to point to your webserver + e. run: cran2deb repopulate + +3. cran2deb needs a persistent cache outside of R's control. therefore, create + /var/cache/cran2deb, writable by whichever user(s) will run cran2deb. +4. add to /etc/rc.local: + # one mini-dinstall daemon for each apt repo + for sys in debian-i386 debian-amd64 + do + mini-dinstall -c /etc/cran2deb/sys/$sys/mini-dinstall.conf + done + and execute. + +5. run: cran2deb update +6. Try building a simple package: cran2deb build zoo + (The result will be in /var/cache/cran2deb/results/SYS) + + +$ cran2deb help +will display a short summary of help for each cran2deb command. + + +Concerning data/: +This contains scripts necessary to recreate the database should you lose the +database. It's a backup that can be versioned by SVN. There is a script called +pull that, when run from the data directory will recreate all the files from +the database EXCEPT for the licenses. The licenses cannot be recreated because +licenses can be based on one-way hashes. This process could certainly be +improved. + diff --git a/branch/split_build/inst/etc/patches/BayesTree.deprecated/00list b/branch/split_build/inst/etc/patches/BayesTree.deprecated/00list new file mode 100644 index 0000000..613a63f --- /dev/null +++ b/branch/split_build/inst/etc/patches/BayesTree.deprecated/00list @@ -0,0 +1 @@ +01_mpart.cpp.patch diff --git a/branch/split_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch b/branch/split_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch new file mode 100644 index 0000000..f46fbe2 --- /dev/null +++ b/branch/split_build/inst/etc/patches/BayesTree.deprecated/01_mpart.cpp.patch @@ -0,0 +1,19 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_mbart.cpp.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Add valarray header + +@DPATCH@ + +diff -ru BayesTree.orig/src/mbart.cpp BayesTree/src/mbart.cpp +--- BayesTree.orig/src/mbart.cpp 2006-10-16 18:25:18.000000000 -0500 ++++ BayesTree/src/mbart.cpp 2009-05-11 19:32:57.000000000 -0500 +@@ -6,6 +6,7 @@ + #include + #include + #include ++#include + + extern "C" { + #include diff --git a/branch/split_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch b/branch/split_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch new file mode 100644 index 0000000..ce81d47 --- /dev/null +++ b/branch/split_build/inst/etc/patches/CGIwithR/00_usr_local_shebang.patch @@ -0,0 +1,26 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 00_use_local_shebang.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: remove /usr/local from #! + +@DPATCH@ + +diff -Naur CGIwithR.orig/inst/examples/dangerous.R CGIwithR/inst/examples/dangerous.R +--- CGIwithR.orig/inst/examples/dangerous.R 2005-11-23 16:07:08.000000000 +0000 ++++ CGIwithR/inst/examples/dangerous.R 2008-09-13 15:11:14.000000000 +0000 +@@ -1,4 +1,4 @@ +-#! /usr/local/bin/R ++#! /usr/bin/R + + ### An example CGI script in R + ### +diff -Naur CGIwithR.orig/inst/examples/trivial.R CGIwithR/inst/examples/trivial.R +--- CGIwithR.orig/inst/examples/trivial.R 2005-11-23 16:07:08.000000000 +0000 ++++ CGIwithR/inst/examples/trivial.R 2008-09-13 15:11:24.000000000 +0000 +@@ -1,4 +1,4 @@ +-#! /usr/local/bin/R ++#! /usr/bin/R + + tag(HTML) + tag(HEAD) diff --git a/branch/split_build/inst/etc/patches/CGIwithR/00list b/branch/split_build/inst/etc/patches/CGIwithR/00list new file mode 100644 index 0000000..f951dda --- /dev/null +++ b/branch/split_build/inst/etc/patches/CGIwithR/00list @@ -0,0 +1 @@ +00_usr_local_shebang.patch diff --git a/branch/split_build/inst/etc/patches/HAPim/00list b/branch/split_build/inst/etc/patches/HAPim/00list new file mode 100644 index 0000000..e562cca --- /dev/null +++ b/branch/split_build/inst/etc/patches/HAPim/00list @@ -0,0 +1,2 @@ +00list +01_DESCRIPTION.patch diff --git a/branch/split_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch b/branch/split_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch new file mode 100644 index 0000000..7d7eae9 --- /dev/null +++ b/branch/split_build/inst/etc/patches/HAPim/01_DESCRIPTION.patch @@ -0,0 +1,17 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_DESCRIPTION.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Add space Package: and name + +@DPATCH@ + +diff -ru HAPim.orig/DESCRIPTION HAPim/DESCRIPTION +--- HAPim.orig/DESCRIPTION 2008-08-25 15:12:59.000000000 +0200 ++++ HAPim/DESCRIPTION 2009-05-12 03:13:29.000000000 +0200 +@@ -1,4 +1,4 @@ +-Package:HAPim ++Package: HAPim + Type: Package + Title:HapIM + Version: 1.2 diff --git a/branch/split_build/inst/etc/patches/MatchIt/00list b/branch/split_build/inst/etc/patches/MatchIt/00list new file mode 100644 index 0000000..2b93818 --- /dev/null +++ b/branch/split_build/inst/etc/patches/MatchIt/00list @@ -0,0 +1,2 @@ +00list +01_makematchH.patch diff --git a/branch/split_build/inst/etc/patches/MatchIt/01_makematchH.patch b/branch/split_build/inst/etc/patches/MatchIt/01_makematchH.patch new file mode 100644 index 0000000..7c41ae6 --- /dev/null +++ b/branch/split_build/inst/etc/patches/MatchIt/01_makematchH.patch @@ -0,0 +1,17 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_makematchH.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Correct tcsh path + +@DPATCH@ + +diff -ru MatchIt.orig/inst/doc/makematchH MatchIt/inst/doc/makematchH +--- MatchIt.orig/inst/doc/makematchH 2005-03-10 14:25:54.000000000 +0100 ++++ MatchIt/inst/doc/makematchH 2009-05-12 03:23:35.000000000 +0200 +@@ -1,4 +1,4 @@ +-#!/bin/tcsh ++#!/usr/bin/tcsh + source ~/.aliases + latex matchit + bibtex matchit diff --git a/branch/split_build/inst/etc/patches/RJaCGH/00list b/branch/split_build/inst/etc/patches/RJaCGH/00list new file mode 100644 index 0000000..428554e --- /dev/null +++ b/branch/split_build/inst/etc/patches/RJaCGH/00list @@ -0,0 +1 @@ +01_remove_zlib.patch diff --git a/branch/split_build/inst/etc/patches/RJaCGH/01_lintian_override.patch b/branch/split_build/inst/etc/patches/RJaCGH/01_lintian_override.patch new file mode 100644 index 0000000..d626c25 --- /dev/null +++ b/branch/split_build/inst/etc/patches/RJaCGH/01_lintian_override.patch @@ -0,0 +1,13 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_lintian_override.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Add a lintian override file + +@DPATCH@ + +diff -ruN RJaCGH.orig/debian/RJaCGH.lintian-overrides RJaCGH/debian/RJaCGH.lintian-overrides +--- RJaCGH.orig/debian/RJaCGH.lintian-overrides 1970-01-01 01:00:00.000000000 +0100 ++++ RJaCGH/debian/RJaCGH.lintian-overrides 2009-05-17 21:09:51.000000000 +0200 +@@ -0,0 +1 @@ ++r-cran-rjacgh: embedded-zlib ./usr/lib/R/site-library/RJaCGH/libs/RJaCGH.so diff --git a/branch/split_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch b/branch/split_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch new file mode 100644 index 0000000..e559d61 --- /dev/null +++ b/branch/split_build/inst/etc/patches/RJaCGH/01_remove_zlib.patch @@ -0,0 +1,11220 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_remove_zlib_src.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Remove zlib + +@DPATCH@ + +diff -ruN RJaCGH.orig/src/adler32.c RJaCGH/src/adler32.c +--- RJaCGH.orig/src/adler32.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/adler32.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,149 +0,0 @@ +-/* adler32.c -- compute the Adler-32 checksum of a data stream +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-#define BASE 65521UL /* largest prime smaller than 65536 */ +-#define NMAX 5552 +-/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */ +- +-#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;} +-#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); +-#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); +-#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); +-#define DO16(buf) DO8(buf,0); DO8(buf,8); +- +-/* use NO_DIVIDE if your processor does not do division in hardware */ +-#ifdef NO_DIVIDE +-# define MOD(a) \ +- do { \ +- if (a >= (BASE << 16)) a -= (BASE << 16); \ +- if (a >= (BASE << 15)) a -= (BASE << 15); \ +- if (a >= (BASE << 14)) a -= (BASE << 14); \ +- if (a >= (BASE << 13)) a -= (BASE << 13); \ +- if (a >= (BASE << 12)) a -= (BASE << 12); \ +- if (a >= (BASE << 11)) a -= (BASE << 11); \ +- if (a >= (BASE << 10)) a -= (BASE << 10); \ +- if (a >= (BASE << 9)) a -= (BASE << 9); \ +- if (a >= (BASE << 8)) a -= (BASE << 8); \ +- if (a >= (BASE << 7)) a -= (BASE << 7); \ +- if (a >= (BASE << 6)) a -= (BASE << 6); \ +- if (a >= (BASE << 5)) a -= (BASE << 5); \ +- if (a >= (BASE << 4)) a -= (BASE << 4); \ +- if (a >= (BASE << 3)) a -= (BASE << 3); \ +- if (a >= (BASE << 2)) a -= (BASE << 2); \ +- if (a >= (BASE << 1)) a -= (BASE << 1); \ +- if (a >= BASE) a -= BASE; \ +- } while (0) +-# define MOD4(a) \ +- do { \ +- if (a >= (BASE << 4)) a -= (BASE << 4); \ +- if (a >= (BASE << 3)) a -= (BASE << 3); \ +- if (a >= (BASE << 2)) a -= (BASE << 2); \ +- if (a >= (BASE << 1)) a -= (BASE << 1); \ +- if (a >= BASE) a -= BASE; \ +- } while (0) +-#else +-# define MOD(a) a %= BASE +-# define MOD4(a) a %= BASE +-#endif +- +-/* ========================================================================= */ +-uLong ZEXPORT adler32(adler, buf, len) +- uLong adler; +- const Bytef *buf; +- uInt len; +-{ +- unsigned long sum2; +- unsigned n; +- +- /* split Adler-32 into component sums */ +- sum2 = (adler >> 16) & 0xffff; +- adler &= 0xffff; +- +- /* in case user likes doing a byte at a time, keep it fast */ +- if (len == 1) { +- adler += buf[0]; +- if (adler >= BASE) +- adler -= BASE; +- sum2 += adler; +- if (sum2 >= BASE) +- sum2 -= BASE; +- return adler | (sum2 << 16); +- } +- +- /* initial Adler-32 value (deferred check for len == 1 speed) */ +- if (buf == Z_NULL) +- return 1L; +- +- /* in case short lengths are provided, keep it somewhat fast */ +- if (len < 16) { +- while (len--) { +- adler += *buf++; +- sum2 += adler; +- } +- if (adler >= BASE) +- adler -= BASE; +- MOD4(sum2); /* only added so many BASE's */ +- return adler | (sum2 << 16); +- } +- +- /* do length NMAX blocks -- requires just one modulo operation */ +- while (len >= NMAX) { +- len -= NMAX; +- n = NMAX / 16; /* NMAX is divisible by 16 */ +- do { +- DO16(buf); /* 16 sums unrolled */ +- buf += 16; +- } while (--n); +- MOD(adler); +- MOD(sum2); +- } +- +- /* do remaining bytes (less than NMAX, still just one modulo) */ +- if (len) { /* avoid modulos if none remaining */ +- while (len >= 16) { +- len -= 16; +- DO16(buf); +- buf += 16; +- } +- while (len--) { +- adler += *buf++; +- sum2 += adler; +- } +- MOD(adler); +- MOD(sum2); +- } +- +- /* return recombined sums */ +- return adler | (sum2 << 16); +-} +- +-/* ========================================================================= */ +-uLong ZEXPORT adler32_combine(adler1, adler2, len2) +- uLong adler1; +- uLong adler2; +- z_off_t len2; +-{ +- unsigned long sum1; +- unsigned long sum2; +- unsigned rem; +- +- /* the derivation of this formula is left as an exercise for the reader */ +- rem = (unsigned)(len2 % BASE); +- sum1 = adler1 & 0xffff; +- sum2 = rem * sum1; +- MOD(sum2); +- sum1 += (adler2 & 0xffff) + BASE - 1; +- sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem; +- if (sum1 > BASE) sum1 -= BASE; +- if (sum1 > BASE) sum1 -= BASE; +- if (sum2 > (BASE << 1)) sum2 -= (BASE << 1); +- if (sum2 > BASE) sum2 -= BASE; +- return sum1 | (sum2 << 16); +-} +diff -ruN RJaCGH.orig/src/compress.c RJaCGH/src/compress.c +--- RJaCGH.orig/src/compress.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/compress.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,79 +0,0 @@ +-/* compress.c -- compress a memory buffer +- * Copyright (C) 1995-2003 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-/* =========================================================================== +- Compresses the source buffer into the destination buffer. The level +- parameter has the same meaning as in deflateInit. sourceLen is the byte +- length of the source buffer. Upon entry, destLen is the total size of the +- destination buffer, which must be at least 0.1% larger than sourceLen plus +- 12 bytes. Upon exit, destLen is the actual size of the compressed buffer. +- +- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_BUF_ERROR if there was not enough room in the output buffer, +- Z_STREAM_ERROR if the level parameter is invalid. +-*/ +-int ZEXPORT compress2 (dest, destLen, source, sourceLen, level) +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +- int level; +-{ +- z_stream stream; +- int err; +- +- stream.next_in = (Bytef*)source; +- stream.avail_in = (uInt)sourceLen; +-#ifdef MAXSEG_64K +- /* Check for source > 64K on 16-bit machine: */ +- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +-#endif +- stream.next_out = dest; +- stream.avail_out = (uInt)*destLen; +- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; +- +- stream.zalloc = (alloc_func)0; +- stream.zfree = (free_func)0; +- stream.opaque = (voidpf)0; +- +- err = deflateInit(&stream, level); +- if (err != Z_OK) return err; +- +- err = deflate(&stream, Z_FINISH); +- if (err != Z_STREAM_END) { +- deflateEnd(&stream); +- return err == Z_OK ? Z_BUF_ERROR : err; +- } +- *destLen = stream.total_out; +- +- err = deflateEnd(&stream); +- return err; +-} +- +-/* =========================================================================== +- */ +-int ZEXPORT compress (dest, destLen, source, sourceLen) +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +-{ +- return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION); +-} +- +-/* =========================================================================== +- If the default memLevel or windowBits for deflateInit() is changed, then +- this function needs to be updated. +- */ +-uLong ZEXPORT compressBound (sourceLen) +- uLong sourceLen; +-{ +- return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + 11; +-} +diff -ruN RJaCGH.orig/src/crc32.c RJaCGH/src/crc32.c +--- RJaCGH.orig/src/crc32.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/crc32.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,423 +0,0 @@ +-/* crc32.c -- compute the CRC-32 of a data stream +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- * +- * Thanks to Rodney Brown for his contribution of faster +- * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing +- * tables for updating the shift register in one step with three exclusive-ors +- * instead of four steps with four exclusive-ors. This results in about a +- * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3. +- */ +- +-/* @(#) $Id$ */ +- +-/* +- Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore +- protection on the static variables used to control the first-use generation +- of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should +- first call get_crc_table() to initialize the tables before allowing more than +- one thread to use crc32(). +- */ +- +-#ifdef MAKECRCH +-# include +-# ifndef DYNAMIC_CRC_TABLE +-# define DYNAMIC_CRC_TABLE +-# endif /* !DYNAMIC_CRC_TABLE */ +-#endif /* MAKECRCH */ +- +-#include "zutil.h" /* for STDC and FAR definitions */ +- +-#define local static +- +-/* Find a four-byte integer type for crc32_little() and crc32_big(). */ +-#ifndef NOBYFOUR +-# ifdef STDC /* need ANSI C limits.h to determine sizes */ +-# include +-# define BYFOUR +-# if (UINT_MAX == 0xffffffffUL) +- typedef unsigned int u4; +-# else +-# if (ULONG_MAX == 0xffffffffUL) +- typedef unsigned long u4; +-# else +-# if (USHRT_MAX == 0xffffffffUL) +- typedef unsigned short u4; +-# else +-# undef BYFOUR /* can't find a four-byte integer type! */ +-# endif +-# endif +-# endif +-# endif /* STDC */ +-#endif /* !NOBYFOUR */ +- +-/* Definitions for doing the crc four data bytes at a time. */ +-#ifdef BYFOUR +-# define REV(w) (((w)>>24)+(((w)>>8)&0xff00)+ \ +- (((w)&0xff00)<<8)+(((w)&0xff)<<24)) +- local unsigned long crc32_little OF((unsigned long, +- const unsigned char FAR *, unsigned)); +- local unsigned long crc32_big OF((unsigned long, +- const unsigned char FAR *, unsigned)); +-# define TBLS 8 +-#else +-# define TBLS 1 +-#endif /* BYFOUR */ +- +-/* Local functions for crc concatenation */ +-local unsigned long gf2_matrix_times OF((unsigned long *mat, +- unsigned long vec)); +-local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat)); +- +-#ifdef DYNAMIC_CRC_TABLE +- +-local volatile int crc_table_empty = 1; +-local unsigned long FAR crc_table[TBLS][256]; +-local void make_crc_table OF((void)); +-#ifdef MAKECRCH +- local void write_table OF((FILE *, const unsigned long FAR *)); +-#endif /* MAKECRCH */ +-/* +- Generate tables 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 first table is simply the CRC of all possible eight bit values. This is +- all the information needed to generate CRCs on data a byte at a time for all +- combinations of CRC register values and incoming bytes. The remaining tables +- allow for word-at-a-time CRC calculation for both big-endian and little- +- endian machines, where a word is four bytes. +-*/ +-local void make_crc_table() +-{ +- unsigned long c; +- int n, k; +- unsigned long poly; /* polynomial exclusive-or pattern */ +- /* terms of polynomial defining this crc (except x^32): */ +- static volatile int first = 1; /* flag to limit concurrent making */ +- static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26}; +- +- /* See if another task is already doing this (not thread-safe, but better +- than nothing -- significantly reduces duration of vulnerability in +- case the advice about DYNAMIC_CRC_TABLE is ignored) */ +- if (first) { +- first = 0; +- +- /* make exclusive-or pattern from polynomial (0xedb88320UL) */ +- poly = 0UL; +- for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++) +- poly |= 1UL << (31 - p[n]); +- +- /* generate a crc for every 8-bit value */ +- for (n = 0; n < 256; n++) { +- c = (unsigned long)n; +- for (k = 0; k < 8; k++) +- c = c & 1 ? poly ^ (c >> 1) : c >> 1; +- crc_table[0][n] = c; +- } +- +-#ifdef BYFOUR +- /* generate crc for each value followed by one, two, and three zeros, +- and then the byte reversal of those as well as the first table */ +- for (n = 0; n < 256; n++) { +- c = crc_table[0][n]; +- crc_table[4][n] = REV(c); +- for (k = 1; k < 4; k++) { +- c = crc_table[0][c & 0xff] ^ (c >> 8); +- crc_table[k][n] = c; +- crc_table[k + 4][n] = REV(c); +- } +- } +-#endif /* BYFOUR */ +- +- crc_table_empty = 0; +- } +- else { /* not first */ +- /* wait for the other guy to finish (not efficient, but rare) */ +- while (crc_table_empty) +- ; +- } +- +-#ifdef MAKECRCH +- /* write out CRC tables to crc32.h */ +- { +- FILE *out; +- +- out = fopen("crc32.h", "w"); +- if (out == NULL) return; +- fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n"); +- fprintf(out, " * Generated automatically by crc32.c\n */\n\n"); +- fprintf(out, "local const unsigned long FAR "); +- fprintf(out, "crc_table[TBLS][256] =\n{\n {\n"); +- write_table(out, crc_table[0]); +-# ifdef BYFOUR +- fprintf(out, "#ifdef BYFOUR\n"); +- for (k = 1; k < 8; k++) { +- fprintf(out, " },\n {\n"); +- write_table(out, crc_table[k]); +- } +- fprintf(out, "#endif\n"); +-# endif /* BYFOUR */ +- fprintf(out, " }\n};\n"); +- fclose(out); +- } +-#endif /* MAKECRCH */ +-} +- +-#ifdef MAKECRCH +-local void write_table(out, table) +- FILE *out; +- const unsigned long FAR *table; +-{ +- int n; +- +- for (n = 0; n < 256; n++) +- fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n], +- n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", ")); +-} +-#endif /* MAKECRCH */ +- +-#else /* !DYNAMIC_CRC_TABLE */ +-/* ======================================================================== +- * Tables of CRC-32s of all single-byte values, made by make_crc_table(). +- */ +-#include "crc32.h" +-#endif /* DYNAMIC_CRC_TABLE */ +- +-/* ========================================================================= +- * This function can be used by asm versions of crc32() +- */ +-const unsigned long FAR * ZEXPORT get_crc_table() +-{ +-#ifdef DYNAMIC_CRC_TABLE +- if (crc_table_empty) +- make_crc_table(); +-#endif /* DYNAMIC_CRC_TABLE */ +- return (const unsigned long FAR *)crc_table; +-} +- +-/* ========================================================================= */ +-#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8) +-#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1 +- +-/* ========================================================================= */ +-unsigned long ZEXPORT crc32(crc, buf, len) +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-{ +- if (buf == Z_NULL) return 0UL; +- +-#ifdef DYNAMIC_CRC_TABLE +- if (crc_table_empty) +- make_crc_table(); +-#endif /* DYNAMIC_CRC_TABLE */ +- +-#ifdef BYFOUR +- if (sizeof(void *) == sizeof(ptrdiff_t)) { +- u4 endian; +- +- endian = 1; +- if (*((unsigned char *)(&endian))) +- return crc32_little(crc, buf, len); +- else +- return crc32_big(crc, buf, len); +- } +-#endif /* BYFOUR */ +- crc = crc ^ 0xffffffffUL; +- while (len >= 8) { +- DO8; +- len -= 8; +- } +- if (len) do { +- DO1; +- } while (--len); +- return crc ^ 0xffffffffUL; +-} +- +-#ifdef BYFOUR +- +-/* ========================================================================= */ +-#define DOLIT4 c ^= *buf4++; \ +- c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \ +- crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24] +-#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4 +- +-/* ========================================================================= */ +-local unsigned long crc32_little(crc, buf, len) +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-{ +- register u4 c; +- register const u4 FAR *buf4; +- +- c = (u4)crc; +- c = ~c; +- while (len && ((ptrdiff_t)buf & 3)) { +- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); +- len--; +- } +- +- buf4 = (const u4 FAR *)(const void FAR *)buf; +- while (len >= 32) { +- DOLIT32; +- len -= 32; +- } +- while (len >= 4) { +- DOLIT4; +- len -= 4; +- } +- buf = (const unsigned char FAR *)buf4; +- +- if (len) do { +- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); +- } while (--len); +- c = ~c; +- return (unsigned long)c; +-} +- +-/* ========================================================================= */ +-#define DOBIG4 c ^= *++buf4; \ +- c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \ +- crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24] +-#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4 +- +-/* ========================================================================= */ +-local unsigned long crc32_big(crc, buf, len) +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-{ +- register u4 c; +- register const u4 FAR *buf4; +- +- c = REV((u4)crc); +- c = ~c; +- while (len && ((ptrdiff_t)buf & 3)) { +- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); +- len--; +- } +- +- buf4 = (const u4 FAR *)(const void FAR *)buf; +- buf4--; +- while (len >= 32) { +- DOBIG32; +- len -= 32; +- } +- while (len >= 4) { +- DOBIG4; +- len -= 4; +- } +- buf4++; +- buf = (const unsigned char FAR *)buf4; +- +- if (len) do { +- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); +- } while (--len); +- c = ~c; +- return (unsigned long)(REV(c)); +-} +- +-#endif /* BYFOUR */ +- +-#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */ +- +-/* ========================================================================= */ +-local unsigned long gf2_matrix_times(mat, vec) +- unsigned long *mat; +- unsigned long vec; +-{ +- unsigned long sum; +- +- sum = 0; +- while (vec) { +- if (vec & 1) +- sum ^= *mat; +- vec >>= 1; +- mat++; +- } +- return sum; +-} +- +-/* ========================================================================= */ +-local void gf2_matrix_square(square, mat) +- unsigned long *square; +- unsigned long *mat; +-{ +- int n; +- +- for (n = 0; n < GF2_DIM; n++) +- square[n] = gf2_matrix_times(mat, mat[n]); +-} +- +-/* ========================================================================= */ +-uLong ZEXPORT crc32_combine(crc1, crc2, len2) +- uLong crc1; +- uLong crc2; +- z_off_t len2; +-{ +- int n; +- unsigned long row; +- unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */ +- unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */ +- +- /* degenerate case */ +- if (len2 == 0) +- return crc1; +- +- /* put operator for one zero bit in odd */ +- odd[0] = 0xedb88320L; /* CRC-32 polynomial */ +- row = 1; +- for (n = 1; n < GF2_DIM; n++) { +- odd[n] = row; +- row <<= 1; +- } +- +- /* put operator for two zero bits in even */ +- gf2_matrix_square(even, odd); +- +- /* put operator for four zero bits in odd */ +- gf2_matrix_square(odd, even); +- +- /* apply len2 zeros to crc1 (first square will put the operator for one +- zero byte, eight zero bits, in even) */ +- do { +- /* apply zeros operator for this bit of len2 */ +- gf2_matrix_square(even, odd); +- if (len2 & 1) +- crc1 = gf2_matrix_times(even, crc1); +- len2 >>= 1; +- +- /* if no more bits set, then done */ +- if (len2 == 0) +- break; +- +- /* another iteration of the loop with odd and even swapped */ +- gf2_matrix_square(odd, even); +- if (len2 & 1) +- crc1 = gf2_matrix_times(odd, crc1); +- len2 >>= 1; +- +- /* if no more bits set, then done */ +- } while (len2 != 0); +- +- /* return combined crc */ +- crc1 ^= crc2; +- return crc1; +-} +diff -ruN RJaCGH.orig/src/crc32.h RJaCGH/src/crc32.h +--- RJaCGH.orig/src/crc32.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/crc32.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,441 +0,0 @@ +-/* crc32.h -- tables for rapid CRC calculation +- * Generated automatically by crc32.c +- */ +- +-local const unsigned long FAR crc_table[TBLS][256] = +-{ +- { +- 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL, +- 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL, +- 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, +- 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL, +- 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL, +- 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL, +- 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, +- 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL, +- 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL, +- 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL, +- 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, +- 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL, +- 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL, +- 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL, +- 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, +- 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL, +- 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL, +- 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL, +- 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, +- 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL, +- 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL, +- 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL, +- 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, +- 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL, +- 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL, +- 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL, +- 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, +- 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL, +- 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL, +- 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL, +- 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, +- 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL, +- 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL, +- 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL, +- 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, +- 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL, +- 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL, +- 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL, +- 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, +- 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL, +- 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL, +- 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL, +- 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, +- 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL, +- 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL, +- 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL, +- 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, +- 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL, +- 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL, +- 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL, +- 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, +- 0x2d02ef8dUL +-#ifdef BYFOUR +- }, +- { +- 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL, +- 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL, +- 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL, +- 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL, +- 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL, +- 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL, +- 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL, +- 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL, +- 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL, +- 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL, +- 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL, +- 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL, +- 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL, +- 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL, +- 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL, +- 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL, +- 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL, +- 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL, +- 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL, +- 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL, +- 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL, +- 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL, +- 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL, +- 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL, +- 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL, +- 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL, +- 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL, +- 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL, +- 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL, +- 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL, +- 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL, +- 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL, +- 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL, +- 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL, +- 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL, +- 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL, +- 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL, +- 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL, +- 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL, +- 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL, +- 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL, +- 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL, +- 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL, +- 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL, +- 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL, +- 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL, +- 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL, +- 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL, +- 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL, +- 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL, +- 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL, +- 0x9324fd72UL +- }, +- { +- 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL, +- 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL, +- 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL, +- 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL, +- 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL, +- 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL, +- 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL, +- 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL, +- 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL, +- 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL, +- 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL, +- 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL, +- 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL, +- 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL, +- 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL, +- 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL, +- 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL, +- 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL, +- 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL, +- 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL, +- 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL, +- 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL, +- 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL, +- 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL, +- 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL, +- 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL, +- 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL, +- 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL, +- 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL, +- 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL, +- 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL, +- 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL, +- 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL, +- 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL, +- 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL, +- 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL, +- 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL, +- 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL, +- 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL, +- 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL, +- 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL, +- 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL, +- 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL, +- 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL, +- 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL, +- 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL, +- 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL, +- 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL, +- 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL, +- 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL, +- 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL, +- 0xbe9834edUL +- }, +- { +- 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL, +- 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL, +- 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL, +- 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL, +- 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL, +- 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL, +- 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL, +- 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL, +- 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL, +- 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL, +- 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL, +- 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL, +- 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL, +- 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL, +- 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL, +- 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL, +- 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL, +- 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL, +- 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL, +- 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL, +- 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL, +- 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL, +- 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL, +- 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL, +- 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL, +- 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL, +- 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL, +- 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL, +- 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL, +- 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL, +- 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL, +- 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL, +- 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL, +- 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL, +- 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL, +- 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL, +- 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL, +- 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL, +- 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL, +- 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL, +- 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL, +- 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL, +- 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL, +- 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL, +- 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL, +- 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL, +- 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL, +- 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL, +- 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL, +- 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL, +- 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL, +- 0xde0506f1UL +- }, +- { +- 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL, +- 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL, +- 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL, +- 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL, +- 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL, +- 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL, +- 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL, +- 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL, +- 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL, +- 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL, +- 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL, +- 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL, +- 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL, +- 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL, +- 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL, +- 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL, +- 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL, +- 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL, +- 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL, +- 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL, +- 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL, +- 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL, +- 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL, +- 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL, +- 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL, +- 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL, +- 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL, +- 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL, +- 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL, +- 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL, +- 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL, +- 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL, +- 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL, +- 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL, +- 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL, +- 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL, +- 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL, +- 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL, +- 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL, +- 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL, +- 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL, +- 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL, +- 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL, +- 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL, +- 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL, +- 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL, +- 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL, +- 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL, +- 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL, +- 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL, +- 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL, +- 0x8def022dUL +- }, +- { +- 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL, +- 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL, +- 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL, +- 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL, +- 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL, +- 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL, +- 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL, +- 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL, +- 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL, +- 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL, +- 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL, +- 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL, +- 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL, +- 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL, +- 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL, +- 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL, +- 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL, +- 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL, +- 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL, +- 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL, +- 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL, +- 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL, +- 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL, +- 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL, +- 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL, +- 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL, +- 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL, +- 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL, +- 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL, +- 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL, +- 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL, +- 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL, +- 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL, +- 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL, +- 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL, +- 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL, +- 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL, +- 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL, +- 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL, +- 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL, +- 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL, +- 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL, +- 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL, +- 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL, +- 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL, +- 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL, +- 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL, +- 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL, +- 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL, +- 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL, +- 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL, +- 0x72fd2493UL +- }, +- { +- 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL, +- 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL, +- 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL, +- 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL, +- 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL, +- 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL, +- 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL, +- 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL, +- 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL, +- 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL, +- 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL, +- 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL, +- 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL, +- 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL, +- 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL, +- 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL, +- 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL, +- 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL, +- 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL, +- 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL, +- 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL, +- 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL, +- 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL, +- 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL, +- 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL, +- 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL, +- 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL, +- 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL, +- 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL, +- 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL, +- 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL, +- 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL, +- 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL, +- 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL, +- 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL, +- 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL, +- 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL, +- 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL, +- 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL, +- 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL, +- 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL, +- 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL, +- 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL, +- 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL, +- 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL, +- 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL, +- 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL, +- 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL, +- 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL, +- 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL, +- 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL, +- 0xed3498beUL +- }, +- { +- 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL, +- 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL, +- 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL, +- 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL, +- 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL, +- 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL, +- 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL, +- 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL, +- 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL, +- 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL, +- 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL, +- 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL, +- 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL, +- 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL, +- 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL, +- 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL, +- 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL, +- 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL, +- 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL, +- 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL, +- 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL, +- 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL, +- 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL, +- 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL, +- 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL, +- 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL, +- 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL, +- 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL, +- 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL, +- 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL, +- 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL, +- 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL, +- 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL, +- 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL, +- 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL, +- 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL, +- 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL, +- 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL, +- 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL, +- 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL, +- 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL, +- 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL, +- 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL, +- 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL, +- 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL, +- 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL, +- 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL, +- 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL, +- 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL, +- 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL, +- 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL, +- 0xf10605deUL +-#endif +- } +-}; +diff -ruN RJaCGH.orig/src/deflate.c RJaCGH/src/deflate.c +--- RJaCGH.orig/src/deflate.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/deflate.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1736 +0,0 @@ +-/* deflate.c -- compress data using the deflation algorithm +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * ALGORITHM +- * +- * The "deflation" process depends on being able to identify portions +- * of the input text which are identical to earlier input (within a +- * sliding window trailing behind the input currently being processed). +- * +- * The most straightforward technique turns out to be the fastest for +- * most input files: try all possible matches and select the longest. +- * The key feature of this algorithm is that insertions into the string +- * dictionary are very simple and thus fast, and deletions are avoided +- * completely. Insertions are performed at each input character, whereas +- * string matches are performed only when the previous match ends. So it +- * is preferable to spend more time in matches to allow very fast string +- * insertions and avoid deletions. The matching algorithm for small +- * strings is inspired from that of Rabin & Karp. A brute force approach +- * is used to find longer strings when a small match has been found. +- * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze +- * (by Leonid Broukhis). +- * A previous version of this file used a more sophisticated algorithm +- * (by Fiala and Greene) which is guaranteed to run in linear amortized +- * time, but has a larger average cost, uses more memory and is patented. +- * However the F&G algorithm may be faster for some highly redundant +- * files if the parameter max_chain_length (described below) is too large. +- * +- * ACKNOWLEDGEMENTS +- * +- * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and +- * I found it in 'freeze' written by Leonid Broukhis. +- * Thanks to many people for bug reports and testing. +- * +- * REFERENCES +- * +- * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". +- * Available in http://www.ietf.org/rfc/rfc1951.txt +- * +- * A description of the Rabin and Karp algorithm is given in the book +- * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. +- * +- * Fiala,E.R., and Greene,D.H. +- * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 +- * +- */ +- +-/* @(#) $Id$ */ +- +-#include "deflate.h" +- +-const char deflate_copyright[] = +- " deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly "; +-/* +- If you use the zlib library in a product, an acknowledgment is welcome +- in the documentation of your product. If for some reason you cannot +- include such an acknowledgment, I would appreciate that you keep this +- copyright string in the executable of your product. +- */ +- +-/* =========================================================================== +- * Function prototypes. +- */ +-typedef enum { +- need_more, /* block not completed, need more input or more output */ +- block_done, /* block flush performed */ +- finish_started, /* finish started, need only more output at next deflate */ +- finish_done /* finish done, accept no more input or output */ +-} block_state; +- +-typedef block_state (*compress_func) OF((deflate_state *s, int flush)); +-/* Compression function. Returns the block state after the call. */ +- +-local void fill_window OF((deflate_state *s)); +-local block_state deflate_stored OF((deflate_state *s, int flush)); +-local block_state deflate_fast OF((deflate_state *s, int flush)); +-#ifndef FASTEST +-local block_state deflate_slow OF((deflate_state *s, int flush)); +-#endif +-local void lm_init OF((deflate_state *s)); +-local void putShortMSB OF((deflate_state *s, uInt b)); +-local void flush_pending OF((z_streamp strm)); +-local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size)); +-#ifndef FASTEST +-#ifdef ASMV +- void match_init OF((void)); /* asm code initialization */ +- uInt longest_match OF((deflate_state *s, IPos cur_match)); +-#else +-local uInt longest_match OF((deflate_state *s, IPos cur_match)); +-#endif +-#endif +-local uInt longest_match_fast OF((deflate_state *s, IPos cur_match)); +- +-#ifdef DEBUG +-local void check_match OF((deflate_state *s, IPos start, IPos match, +- int length)); +-#endif +- +-/* =========================================================================== +- * Local data +- */ +- +-#define NIL 0 +-/* Tail of hash chains */ +- +-#ifndef TOO_FAR +-# define TOO_FAR 4096 +-#endif +-/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ +- +-#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +-/* Minimum amount of lookahead, except at the end of the input file. +- * See deflate.c for comments about the MIN_MATCH+1. +- */ +- +-/* Values for max_lazy_match, good_match and max_chain_length, depending on +- * the desired pack level (0..9). The values given below have been tuned to +- * exclude worst case performance for pathological files. Better values may be +- * found for specific files. +- */ +-typedef struct config_s { +- ush good_length; /* reduce lazy search above this match length */ +- ush max_lazy; /* do not perform lazy search above this match length */ +- ush nice_length; /* quit search above this match length */ +- ush max_chain; +- compress_func func; +-} config; +- +-#ifdef FASTEST +-local const config configuration_table[2] = { +-/* good lazy nice chain */ +-/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +-/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ +-#else +-local const config configuration_table[10] = { +-/* good lazy nice chain */ +-/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +-/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ +-/* 2 */ {4, 5, 16, 8, deflate_fast}, +-/* 3 */ {4, 6, 32, 32, deflate_fast}, +- +-/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ +-/* 5 */ {8, 16, 32, 32, deflate_slow}, +-/* 6 */ {8, 16, 128, 128, deflate_slow}, +-/* 7 */ {8, 32, 128, 256, deflate_slow}, +-/* 8 */ {32, 128, 258, 1024, deflate_slow}, +-/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ +-#endif +- +-/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 +- * For deflate_fast() (levels <= 3) good is ignored and lazy has a different +- * meaning. +- */ +- +-#define EQUAL 0 +-/* result of memcmp for equal strings */ +- +-#ifndef NO_DUMMY_DECL +-struct static_tree_desc_s {int dummy;}; /* for buggy compilers */ +-#endif +- +-/* =========================================================================== +- * Update a hash value with the given input byte +- * IN assertion: all calls to to UPDATE_HASH are made with consecutive +- * input characters, so that a running hash key can be computed from the +- * previous key instead of complete recalculation each time. +- */ +-#define UPDATE_HASH(s,h,c) (h = (((h)<hash_shift) ^ (c)) & s->hash_mask) +- +- +-/* =========================================================================== +- * Insert string str in the dictionary and set match_head to the previous head +- * of the hash chain (the most recent string with same hash key). Return +- * the previous length of the hash chain. +- * If this file is compiled with -DFASTEST, the compression level is forced +- * to 1, and no hash chains are maintained. +- * IN assertion: all calls to to INSERT_STRING are made with consecutive +- * input characters and the first MIN_MATCH bytes of str are valid +- * (except for the last MIN_MATCH-1 bytes of the input file). +- */ +-#ifdef FASTEST +-#define INSERT_STRING(s, str, match_head) \ +- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ +- match_head = s->head[s->ins_h], \ +- s->head[s->ins_h] = (Pos)(str)) +-#else +-#define INSERT_STRING(s, str, match_head) \ +- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ +- match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ +- s->head[s->ins_h] = (Pos)(str)) +-#endif +- +-/* =========================================================================== +- * Initialize the hash table (avoiding 64K overflow for 16 bit systems). +- * prev[] will be initialized on the fly. +- */ +-#define CLEAR_HASH(s) \ +- s->head[s->hash_size-1] = NIL; \ +- zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head)); +- +-/* ========================================================================= */ +-int ZEXPORT deflateInit_(strm, level, version, stream_size) +- z_streamp strm; +- int level; +- const char *version; +- int stream_size; +-{ +- return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, +- Z_DEFAULT_STRATEGY, version, stream_size); +- /* To do: ignore strm->next_in if we use it as window */ +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy, +- version, stream_size) +- z_streamp strm; +- int level; +- int method; +- int windowBits; +- int memLevel; +- int strategy; +- const char *version; +- int stream_size; +-{ +- deflate_state *s; +- int wrap = 1; +- static const char my_version[] = ZLIB_VERSION; +- +- ushf *overlay; +- /* We overlay pending_buf and d_buf+l_buf. This works since the average +- * output size for (length,distance) codes is <= 24 bits. +- */ +- +- if (version == Z_NULL || version[0] != my_version[0] || +- stream_size != sizeof(z_stream)) { +- return Z_VERSION_ERROR; +- } +- if (strm == Z_NULL) return Z_STREAM_ERROR; +- +- strm->msg = Z_NULL; +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- +-#ifdef FASTEST +- if (level != 0) level = 1; +-#else +- if (level == Z_DEFAULT_COMPRESSION) level = 6; +-#endif +- +- if (windowBits < 0) { /* suppress zlib wrapper */ +- wrap = 0; +- windowBits = -windowBits; +- } +-#ifdef GZIP +- else if (windowBits > 15) { +- wrap = 2; /* write gzip wrapper instead */ +- windowBits -= 16; +- } +-#endif +- if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || +- windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || +- strategy < 0 || strategy > Z_FIXED) { +- return Z_STREAM_ERROR; +- } +- if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ +- s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); +- if (s == Z_NULL) return Z_MEM_ERROR; +- strm->state = (struct internal_state FAR *)s; +- s->strm = strm; +- +- s->wrap = wrap; +- s->gzhead = Z_NULL; +- s->w_bits = windowBits; +- s->w_size = 1 << s->w_bits; +- s->w_mask = s->w_size - 1; +- +- s->hash_bits = memLevel + 7; +- s->hash_size = 1 << s->hash_bits; +- s->hash_mask = s->hash_size - 1; +- s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH); +- +- s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); +- s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); +- s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); +- +- s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ +- +- overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2); +- s->pending_buf = (uchf *) overlay; +- s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L); +- +- if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || +- s->pending_buf == Z_NULL) { +- s->status = FINISH_STATE; +- strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); +- deflateEnd (strm); +- return Z_MEM_ERROR; +- } +- s->d_buf = overlay + s->lit_bufsize/sizeof(ush); +- s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize; +- +- s->level = level; +- s->strategy = strategy; +- s->method = (Byte)method; +- +- return deflateReset(strm); +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength) +- z_streamp strm; +- const Bytef *dictionary; +- uInt dictLength; +-{ +- deflate_state *s; +- uInt length = dictLength; +- uInt n; +- IPos hash_head = 0; +- +- if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL || +- strm->state->wrap == 2 || +- (strm->state->wrap == 1 && strm->state->status != INIT_STATE)) +- return Z_STREAM_ERROR; +- +- s = strm->state; +- if (s->wrap) +- strm->adler = adler32(strm->adler, dictionary, dictLength); +- +- if (length < MIN_MATCH) return Z_OK; +- if (length > MAX_DIST(s)) { +- length = MAX_DIST(s); +- dictionary += dictLength - length; /* use the tail of the dictionary */ +- } +- zmemcpy(s->window, dictionary, length); +- s->strstart = length; +- s->block_start = (long)length; +- +- /* Insert all strings in the hash table (except for the last two bytes). +- * s->lookahead stays null, so s->ins_h will be recomputed at the next +- * call of fill_window. +- */ +- s->ins_h = s->window[0]; +- UPDATE_HASH(s, s->ins_h, s->window[1]); +- for (n = 0; n <= length - MIN_MATCH; n++) { +- INSERT_STRING(s, n, hash_head); +- } +- if (hash_head) hash_head = 0; /* to make compiler happy */ +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateReset (strm) +- z_streamp strm; +-{ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL || +- strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) { +- return Z_STREAM_ERROR; +- } +- +- strm->total_in = strm->total_out = 0; +- strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ +- strm->data_type = Z_UNKNOWN; +- +- s = (deflate_state *)strm->state; +- s->pending = 0; +- s->pending_out = s->pending_buf; +- +- if (s->wrap < 0) { +- s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ +- } +- s->status = s->wrap ? INIT_STATE : BUSY_STATE; +- strm->adler = +-#ifdef GZIP +- s->wrap == 2 ? crc32(0L, Z_NULL, 0) : +-#endif +- adler32(0L, Z_NULL, 0); +- s->last_flush = Z_NO_FLUSH; +- +- _tr_init(s); +- lm_init(s); +- +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateSetHeader (strm, head) +- z_streamp strm; +- gz_headerp head; +-{ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- if (strm->state->wrap != 2) return Z_STREAM_ERROR; +- strm->state->gzhead = head; +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflatePrime (strm, bits, value) +- z_streamp strm; +- int bits; +- int value; +-{ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- strm->state->bi_valid = bits; +- strm->state->bi_buf = (ush)(value & ((1 << bits) - 1)); +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateParams(strm, level, strategy) +- z_streamp strm; +- int level; +- int strategy; +-{ +- deflate_state *s; +- compress_func func; +- int err = Z_OK; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- s = strm->state; +- +-#ifdef FASTEST +- if (level != 0) level = 1; +-#else +- if (level == Z_DEFAULT_COMPRESSION) level = 6; +-#endif +- if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { +- return Z_STREAM_ERROR; +- } +- func = configuration_table[s->level].func; +- +- if (func != configuration_table[level].func && strm->total_in != 0) { +- /* Flush the last buffer: */ +- err = deflate(strm, Z_PARTIAL_FLUSH); +- } +- if (s->level != level) { +- s->level = level; +- s->max_lazy_match = configuration_table[level].max_lazy; +- s->good_match = configuration_table[level].good_length; +- s->nice_match = configuration_table[level].nice_length; +- s->max_chain_length = configuration_table[level].max_chain; +- } +- s->strategy = strategy; +- return err; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain) +- z_streamp strm; +- int good_length; +- int max_lazy; +- int nice_length; +- int max_chain; +-{ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- s = strm->state; +- s->good_match = good_length; +- s->max_lazy_match = max_lazy; +- s->nice_match = nice_length; +- s->max_chain_length = max_chain; +- return Z_OK; +-} +- +-/* ========================================================================= +- * For the default windowBits of 15 and memLevel of 8, this function returns +- * a close to exact, as well as small, upper bound on the compressed size. +- * They are coded as constants here for a reason--if the #define's are +- * changed, then this function needs to be changed as well. The return +- * value for 15 and 8 only works for those exact settings. +- * +- * For any setting other than those defaults for windowBits and memLevel, +- * the value returned is a conservative worst case for the maximum expansion +- * resulting from using fixed blocks instead of stored blocks, which deflate +- * can emit on compressed data for some combinations of the parameters. +- * +- * This function could be more sophisticated to provide closer upper bounds +- * for every combination of windowBits and memLevel, as well as wrap. +- * But even the conservative upper bound of about 14% expansion does not +- * seem onerous for output buffer allocation. +- */ +-uLong ZEXPORT deflateBound(strm, sourceLen) +- z_streamp strm; +- uLong sourceLen; +-{ +- deflate_state *s; +- uLong destLen; +- +- /* conservative upper bound */ +- destLen = sourceLen + +- ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 11; +- +- /* if can't get parameters, return conservative bound */ +- if (strm == Z_NULL || strm->state == Z_NULL) +- return destLen; +- +- /* if not default parameters, return conservative bound */ +- s = strm->state; +- if (s->w_bits != 15 || s->hash_bits != 8 + 7) +- return destLen; +- +- /* default settings: return tight bound for that case */ +- return compressBound(sourceLen); +-} +- +-/* ========================================================================= +- * Put a short in the pending buffer. The 16-bit value is put in MSB order. +- * IN assertion: the stream state is correct and there is enough room in +- * pending_buf. +- */ +-local void putShortMSB (s, b) +- deflate_state *s; +- uInt b; +-{ +- put_byte(s, (Byte)(b >> 8)); +- put_byte(s, (Byte)(b & 0xff)); +-} +- +-/* ========================================================================= +- * Flush as much pending output as possible. All deflate() output goes +- * through this function so some applications may wish to modify it +- * to avoid allocating a large strm->next_out buffer and copying into it. +- * (See also read_buf()). +- */ +-local void flush_pending(strm) +- z_streamp strm; +-{ +- unsigned len = strm->state->pending; +- +- if (len > strm->avail_out) len = strm->avail_out; +- if (len == 0) return; +- +- zmemcpy(strm->next_out, strm->state->pending_out, len); +- strm->next_out += len; +- strm->state->pending_out += len; +- strm->total_out += len; +- strm->avail_out -= len; +- strm->state->pending -= len; +- if (strm->state->pending == 0) { +- strm->state->pending_out = strm->state->pending_buf; +- } +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflate (strm, flush) +- z_streamp strm; +- int flush; +-{ +- int old_flush; /* value of flush param for previous deflate call */ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL || +- flush > Z_FINISH || flush < 0) { +- return Z_STREAM_ERROR; +- } +- s = strm->state; +- +- if (strm->next_out == Z_NULL || +- (strm->next_in == Z_NULL && strm->avail_in != 0) || +- (s->status == FINISH_STATE && flush != Z_FINISH)) { +- ERR_RETURN(strm, Z_STREAM_ERROR); +- } +- if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); +- +- s->strm = strm; /* just in case */ +- old_flush = s->last_flush; +- s->last_flush = flush; +- +- /* Write the header */ +- if (s->status == INIT_STATE) { +-#ifdef GZIP +- if (s->wrap == 2) { +- strm->adler = crc32(0L, Z_NULL, 0); +- put_byte(s, 31); +- put_byte(s, 139); +- put_byte(s, 8); +- if (s->gzhead == NULL) { +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, s->level == 9 ? 2 : +- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? +- 4 : 0)); +- put_byte(s, OS_CODE); +- s->status = BUSY_STATE; +- } +- else { +- put_byte(s, (s->gzhead->text ? 1 : 0) + +- (s->gzhead->hcrc ? 2 : 0) + +- (s->gzhead->extra == Z_NULL ? 0 : 4) + +- (s->gzhead->name == Z_NULL ? 0 : 8) + +- (s->gzhead->comment == Z_NULL ? 0 : 16) +- ); +- put_byte(s, (Byte)(s->gzhead->time & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); +- put_byte(s, s->level == 9 ? 2 : +- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? +- 4 : 0)); +- put_byte(s, s->gzhead->os & 0xff); +- if (s->gzhead->extra != NULL) { +- put_byte(s, s->gzhead->extra_len & 0xff); +- put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); +- } +- if (s->gzhead->hcrc) +- strm->adler = crc32(strm->adler, s->pending_buf, +- s->pending); +- s->gzindex = 0; +- s->status = EXTRA_STATE; +- } +- } +- else +-#endif +- { +- uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; +- uInt level_flags; +- +- if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) +- level_flags = 0; +- else if (s->level < 6) +- level_flags = 1; +- else if (s->level == 6) +- level_flags = 2; +- else +- level_flags = 3; +- header |= (level_flags << 6); +- if (s->strstart != 0) header |= PRESET_DICT; +- header += 31 - (header % 31); +- +- s->status = BUSY_STATE; +- putShortMSB(s, header); +- +- /* Save the adler32 of the preset dictionary: */ +- if (s->strstart != 0) { +- putShortMSB(s, (uInt)(strm->adler >> 16)); +- putShortMSB(s, (uInt)(strm->adler & 0xffff)); +- } +- strm->adler = adler32(0L, Z_NULL, 0); +- } +- } +-#ifdef GZIP +- if (s->status == EXTRA_STATE) { +- if (s->gzhead->extra != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- +- while (s->gzindex < (s->gzhead->extra_len & 0xffff)) { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) +- break; +- } +- put_byte(s, s->gzhead->extra[s->gzindex]); +- s->gzindex++; +- } +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (s->gzindex == s->gzhead->extra_len) { +- s->gzindex = 0; +- s->status = NAME_STATE; +- } +- } +- else +- s->status = NAME_STATE; +- } +- if (s->status == NAME_STATE) { +- if (s->gzhead->name != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- int val; +- +- do { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) { +- val = 1; +- break; +- } +- } +- val = s->gzhead->name[s->gzindex++]; +- put_byte(s, val); +- } while (val != 0); +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (val == 0) { +- s->gzindex = 0; +- s->status = COMMENT_STATE; +- } +- } +- else +- s->status = COMMENT_STATE; +- } +- if (s->status == COMMENT_STATE) { +- if (s->gzhead->comment != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- int val; +- +- do { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) { +- val = 1; +- break; +- } +- } +- val = s->gzhead->comment[s->gzindex++]; +- put_byte(s, val); +- } while (val != 0); +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (val == 0) +- s->status = HCRC_STATE; +- } +- else +- s->status = HCRC_STATE; +- } +- if (s->status == HCRC_STATE) { +- if (s->gzhead->hcrc) { +- if (s->pending + 2 > s->pending_buf_size) +- flush_pending(strm); +- if (s->pending + 2 <= s->pending_buf_size) { +- put_byte(s, (Byte)(strm->adler & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); +- strm->adler = crc32(0L, Z_NULL, 0); +- s->status = BUSY_STATE; +- } +- } +- else +- s->status = BUSY_STATE; +- } +-#endif +- +- /* Flush as much pending output as possible */ +- if (s->pending != 0) { +- flush_pending(strm); +- if (strm->avail_out == 0) { +- /* 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: +- */ +- s->last_flush = -1; +- return Z_OK; +- } +- +- /* Make sure there is something to do and avoid duplicate consecutive +- * flushes. For repeated and useless calls with Z_FINISH, we keep +- * returning Z_STREAM_END instead of Z_BUF_ERROR. +- */ +- } else if (strm->avail_in == 0 && flush <= old_flush && +- flush != Z_FINISH) { +- ERR_RETURN(strm, Z_BUF_ERROR); +- } +- +- /* User must not provide more input after the first FINISH: */ +- if (s->status == FINISH_STATE && strm->avail_in != 0) { +- ERR_RETURN(strm, Z_BUF_ERROR); +- } +- +- /* Start a new block or continue the current one. +- */ +- if (strm->avail_in != 0 || s->lookahead != 0 || +- (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { +- block_state bstate; +- +- bstate = (*(configuration_table[s->level].func))(s, flush); +- +- if (bstate == finish_started || bstate == finish_done) { +- s->status = FINISH_STATE; +- } +- if (bstate == need_more || bstate == finish_started) { +- if (strm->avail_out == 0) { +- s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ +- } +- return Z_OK; +- /* 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. +- */ +- } +- if (bstate == block_done) { +- if (flush == Z_PARTIAL_FLUSH) { +- _tr_align(s); +- } else { /* FULL_FLUSH or SYNC_FLUSH */ +- _tr_stored_block(s, (char*)0, 0L, 0); +- /* For a full flush, this empty block will be recognized +- * as a special marker by inflate_sync(). +- */ +- if (flush == Z_FULL_FLUSH) { +- CLEAR_HASH(s); /* forget history */ +- } +- } +- flush_pending(strm); +- if (strm->avail_out == 0) { +- s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ +- return Z_OK; +- } +- } +- } +- Assert(strm->avail_out > 0, "bug2"); +- +- if (flush != Z_FINISH) return Z_OK; +- if (s->wrap <= 0) return Z_STREAM_END; +- +- /* Write the trailer */ +-#ifdef GZIP +- if (s->wrap == 2) { +- put_byte(s, (Byte)(strm->adler & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); +- put_byte(s, (Byte)(strm->total_in & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); +- } +- else +-#endif +- { +- putShortMSB(s, (uInt)(strm->adler >> 16)); +- putShortMSB(s, (uInt)(strm->adler & 0xffff)); +- } +- flush_pending(strm); +- /* If avail_out is zero, the application will call deflate again +- * to flush the rest. +- */ +- if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ +- return s->pending != 0 ? Z_OK : Z_STREAM_END; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateEnd (strm) +- z_streamp strm; +-{ +- int status; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- +- status = strm->state->status; +- if (status != INIT_STATE && +- status != EXTRA_STATE && +- status != NAME_STATE && +- status != COMMENT_STATE && +- status != HCRC_STATE && +- status != BUSY_STATE && +- status != FINISH_STATE) { +- return Z_STREAM_ERROR; +- } +- +- /* Deallocate in reverse order of allocations: */ +- TRY_FREE(strm, strm->state->pending_buf); +- TRY_FREE(strm, strm->state->head); +- TRY_FREE(strm, strm->state->prev); +- TRY_FREE(strm, strm->state->window); +- +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- +- return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; +-} +- +-/* ========================================================================= +- * Copy the source state to the destination state. +- * To simplify the source, this is not supported for 16-bit MSDOS (which +- * doesn't have enough memory anyway to duplicate compression states). +- */ +-int ZEXPORT deflateCopy (dest, source) +- z_streamp dest; +- z_streamp source; +-{ +-#ifdef MAXSEG_64K +- return Z_STREAM_ERROR; +-#else +- deflate_state *ds; +- deflate_state *ss; +- ushf *overlay; +- +- +- if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) { +- return Z_STREAM_ERROR; +- } +- +- ss = source->state; +- +- zmemcpy(dest, source, sizeof(z_stream)); +- +- ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); +- if (ds == Z_NULL) return Z_MEM_ERROR; +- dest->state = (struct internal_state FAR *) ds; +- zmemcpy(ds, ss, sizeof(deflate_state)); +- ds->strm = dest; +- +- ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); +- ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); +- ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); +- overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2); +- ds->pending_buf = (uchf *) overlay; +- +- if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || +- ds->pending_buf == Z_NULL) { +- deflateEnd (dest); +- return Z_MEM_ERROR; +- } +- /* following zmemcpy do not work for 16-bit MSDOS */ +- zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); +- zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos)); +- zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos)); +- zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size); +- +- ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); +- ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush); +- ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize; +- +- ds->l_desc.dyn_tree = ds->dyn_ltree; +- ds->d_desc.dyn_tree = ds->dyn_dtree; +- ds->bl_desc.dyn_tree = ds->bl_tree; +- +- return Z_OK; +-#endif /* MAXSEG_64K */ +-} +- +-/* =========================================================================== +- * Read a new buffer from the current input stream, update the adler32 +- * and total number of bytes read. All deflate() input goes through +- * this function so some applications may wish to modify it to avoid +- * allocating a large strm->next_in buffer and copying from it. +- * (See also flush_pending()). +- */ +-local int read_buf(strm, buf, size) +- z_streamp strm; +- Bytef *buf; +- unsigned size; +-{ +- unsigned len = strm->avail_in; +- +- if (len > size) len = size; +- if (len == 0) return 0; +- +- strm->avail_in -= len; +- +- if (strm->state->wrap == 1) { +- strm->adler = adler32(strm->adler, strm->next_in, len); +- } +-#ifdef GZIP +- else if (strm->state->wrap == 2) { +- strm->adler = crc32(strm->adler, strm->next_in, len); +- } +-#endif +- zmemcpy(buf, strm->next_in, len); +- strm->next_in += len; +- strm->total_in += len; +- +- return (int)len; +-} +- +-/* =========================================================================== +- * Initialize the "longest match" routines for a new zlib stream +- */ +-local void lm_init (s) +- deflate_state *s; +-{ +- s->window_size = (ulg)2L*s->w_size; +- +- CLEAR_HASH(s); +- +- /* Set the default configuration parameters: +- */ +- s->max_lazy_match = configuration_table[s->level].max_lazy; +- s->good_match = configuration_table[s->level].good_length; +- s->nice_match = configuration_table[s->level].nice_length; +- s->max_chain_length = configuration_table[s->level].max_chain; +- +- s->strstart = 0; +- s->block_start = 0L; +- s->lookahead = 0; +- s->match_length = s->prev_length = MIN_MATCH-1; +- s->match_available = 0; +- s->ins_h = 0; +-#ifndef FASTEST +-#ifdef ASMV +- match_init(); /* initialize the asm code */ +-#endif +-#endif +-} +- +-#ifndef FASTEST +-/* =========================================================================== +- * Set match_start to the longest match starting at the given string and +- * return its length. Matches shorter or equal to prev_length are discarded, +- * in which case the result is equal to prev_length and match_start is +- * garbage. +- * IN assertions: cur_match is the head of the hash chain for the current +- * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 +- * OUT assertion: the match length is not greater than s->lookahead. +- */ +-#ifndef ASMV +-/* For 80x86 and 680x0, an optimized version will be provided in match.asm or +- * match.S. The code will be functionally equivalent. +- */ +-local uInt longest_match(s, cur_match) +- deflate_state *s; +- IPos cur_match; /* current match */ +-{ +- unsigned chain_length = s->max_chain_length;/* max hash chain length */ +- register Bytef *scan = s->window + s->strstart; /* current string */ +- register Bytef *match; /* matched string */ +- register int len; /* length of current match */ +- int best_len = s->prev_length; /* best match length so far */ +- int nice_match = s->nice_match; /* stop if match long enough */ +- IPos limit = s->strstart > (IPos)MAX_DIST(s) ? +- s->strstart - (IPos)MAX_DIST(s) : NIL; +- /* Stop when cur_match becomes <= limit. To simplify the code, +- * we prevent matches with the string of window index 0. +- */ +- Posf *prev = s->prev; +- uInt wmask = s->w_mask; +- +-#ifdef UNALIGNED_OK +- /* Compare two bytes at a time. Note: this is not always beneficial. +- * Try with and without -DUNALIGNED_OK to check. +- */ +- register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; +- register ush scan_start = *(ushf*)scan; +- register ush scan_end = *(ushf*)(scan+best_len-1); +-#else +- register Bytef *strend = s->window + s->strstart + MAX_MATCH; +- register Byte scan_end1 = scan[best_len-1]; +- register Byte scan_end = scan[best_len]; +-#endif +- +- /* 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. +- */ +- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); +- +- /* Do not waste too much time if we already have a good match: */ +- if (s->prev_length >= s->good_match) { +- chain_length >>= 2; +- } +- /* Do not look for matches beyond the end of the input. This is necessary +- * to make deflate deterministic. +- */ +- if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; +- +- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); +- +- do { +- Assert(cur_match < s->strstart, "no future"); +- match = s->window + cur_match; +- +- /* Skip to next match if the match length cannot increase +- * or if the match length is less than 2. Note that the checks below +- * for insufficient lookahead only occur occasionally for performance +- * reasons. Therefore uninitialized memory will be accessed, and +- * conditional jumps will be made that depend on those values. +- * However the length of the match is limited to the lookahead, so +- * the output of deflate is not affected by the uninitialized values. +- */ +-#if (defined(UNALIGNED_OK) && MAX_MATCH == 258) +- /* This code assumes sizeof(unsigned short) == 2. Do not use +- * UNALIGNED_OK if your compiler uses a different size. +- */ +- if (*(ushf*)(match+best_len-1) != scan_end || +- *(ushf*)match != scan_start) continue; +- +- /* It is not necessary to compare scan[2] and match[2] since they are +- * always equal when the other bytes match, given that the hash keys +- * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at +- * strstart+3, +5, ... up to strstart+257. We check for insufficient +- * lookahead only every 4th comparison; the 128th check will be made +- * 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 +- * to check more often for insufficient lookahead. +- */ +- Assert(scan[2] == match[2], "scan[2]?"); +- scan++, match++; +- do { +- } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- scan < strend); +- /* The funny "do {}" generates better code on most compilers */ +- +- /* Here, scan <= window+strstart+257 */ +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- if (*scan == *match) scan++; +- +- len = (MAX_MATCH - 1) - (int)(strend-scan); +- scan = strend - (MAX_MATCH-1); +- +-#else /* UNALIGNED_OK */ +- +- if (match[best_len] != scan_end || +- match[best_len-1] != scan_end1 || +- *match != *scan || +- *++match != scan[1]) continue; +- +- /* The check at best_len-1 can be removed because it will be made +- * again later. (This heuristic is not always a win.) +- * It is not necessary to compare scan[2] and match[2] since they +- * are always equal when the other bytes match, given that +- * the hash keys are equal and that HASH_BITS >= 8. +- */ +- scan += 2, match++; +- Assert(*scan == *match, "match[2]?"); +- +- /* We check for insufficient lookahead only every 8th comparison; +- * the 256th check will be made at strstart+258. +- */ +- do { +- } while (*++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- scan < strend); +- +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- +- len = MAX_MATCH - (int)(strend - scan); +- scan = strend - MAX_MATCH; +- +-#endif /* UNALIGNED_OK */ +- +- if (len > best_len) { +- s->match_start = cur_match; +- best_len = len; +- if (len >= nice_match) break; +-#ifdef UNALIGNED_OK +- scan_end = *(ushf*)(scan+best_len-1); +-#else +- scan_end1 = scan[best_len-1]; +- scan_end = scan[best_len]; +-#endif +- } +- } while ((cur_match = prev[cur_match & wmask]) > limit +- && --chain_length != 0); +- +- if ((uInt)best_len <= s->lookahead) return (uInt)best_len; +- return s->lookahead; +-} +-#endif /* ASMV */ +-#endif /* FASTEST */ +- +-/* --------------------------------------------------------------------------- +- * Optimized version for level == 1 or strategy == Z_RLE only +- */ +-local uInt longest_match_fast(s, cur_match) +- deflate_state *s; +- IPos cur_match; /* current match */ +-{ +- register Bytef *scan = s->window + s->strstart; /* current string */ +- register Bytef *match; /* matched string */ +- register int len; /* length of current match */ +- register Bytef *strend = s->window + s->strstart + MAX_MATCH; +- +- /* 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. +- */ +- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); +- +- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); +- +- Assert(cur_match < s->strstart, "no future"); +- +- match = s->window + cur_match; +- +- /* Return failure if the match length is less than 2: +- */ +- if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; +- +- /* The check at best_len-1 can be removed because it will be made +- * again later. (This heuristic is not always a win.) +- * It is not necessary to compare scan[2] and match[2] since they +- * are always equal when the other bytes match, given that +- * the hash keys are equal and that HASH_BITS >= 8. +- */ +- scan += 2, match += 2; +- Assert(*scan == *match, "match[2]?"); +- +- /* We check for insufficient lookahead only every 8th comparison; +- * the 256th check will be made at strstart+258. +- */ +- do { +- } while (*++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- scan < strend); +- +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- +- len = MAX_MATCH - (int)(strend - scan); +- +- if (len < MIN_MATCH) return MIN_MATCH - 1; +- +- s->match_start = cur_match; +- return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; +-} +- +-#ifdef DEBUG +-/* =========================================================================== +- * Check that the match at match_start is indeed a match. +- */ +-local void check_match(s, start, match, length) +- deflate_state *s; +- IPos start, match; +- int length; +-{ +- /* check that the match is indeed a match */ +- if (zmemcmp(s->window + match, +- s->window + start, length) != EQUAL) { +- fprintf(stderr, " start %u, match %u, length %d\n", +- start, match, length); +- do { +- fprintf(stderr, "%c%c", s->window[match++], s->window[start++]); +- } while (--length != 0); +- z_error("invalid match"); +- } +- if (z_verbose > 1) { +- fprintf(stderr,"\\[%d,%d]", start-match, length); +- do { putc(s->window[start++], stderr); } while (--length != 0); +- } +-} +-#else +-# define check_match(s, start, match, length) +-#endif /* DEBUG */ +- +-/* =========================================================================== +- * Fill the window when the lookahead becomes insufficient. +- * Updates strstart and lookahead. +- * +- * IN assertion: lookahead < MIN_LOOKAHEAD +- * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD +- * At least one byte has been read, or avail_in == 0; reads are +- * performed for at least two bytes (required for the zip translate_eol +- * option -- not supported here). +- */ +-local void fill_window(s) +- deflate_state *s; +-{ +- register unsigned n, m; +- register Posf *p; +- unsigned more; /* Amount of free space at the end of the window. */ +- uInt wsize = s->w_size; +- +- do { +- more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); +- +- /* Deal with !@#$% 64K limit: */ +- if (sizeof(int) <= 2) { +- if (more == 0 && s->strstart == 0 && s->lookahead == 0) { +- more = wsize; +- +- } else if (more == (unsigned)(-1)) { +- /* Very unlikely, but possible on 16 bit machine if +- * strstart == 0 && lookahead == 1 (input done a byte at time) +- */ +- more--; +- } +- } +- +- /* If the window is almost full and there is insufficient lookahead, +- * move the upper half to the lower one to make room in the upper half. +- */ +- if (s->strstart >= wsize+MAX_DIST(s)) { +- +- zmemcpy(s->window, s->window+wsize, (unsigned)wsize); +- s->match_start -= wsize; +- s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ +- s->block_start -= (long) wsize; +- +- /* Slide the hash table (could be avoided with 32 bit values +- at the expense of memory usage). We slide even when level == 0 +- to keep the hash table consistent if we switch back to level > 0 +- later. (Using level 0 permanently is not an optimal usage of +- zlib, so we don't care about this pathological case.) +- */ +- /* %%% avoid this when Z_RLE */ +- n = s->hash_size; +- p = &s->head[n]; +- do { +- m = *--p; +- *p = (Pos)(m >= wsize ? m-wsize : NIL); +- } while (--n); +- +- n = wsize; +-#ifndef FASTEST +- p = &s->prev[n]; +- do { +- m = *--p; +- *p = (Pos)(m >= wsize ? m-wsize : NIL); +- /* If n is not on any hash chain, prev[n] is garbage but +- * its value will never be used. +- */ +- } while (--n); +-#endif +- more += wsize; +- } +- if (s->strm->avail_in == 0) return; +- +- /* If there was no sliding: +- * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && +- * more == window_size - lookahead - strstart +- * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) +- * => more >= window_size - 2*WSIZE + 2 +- * In the BIG_MEM or MMAP case (not yet supported), +- * window_size == input_size + MIN_LOOKAHEAD && +- * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. +- * Otherwise, window_size == 2*WSIZE so more >= 2. +- * If there was sliding, more >= WSIZE. So in all cases, more >= 2. +- */ +- Assert(more >= 2, "more < 2"); +- +- n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); +- s->lookahead += n; +- +- /* Initialize the hash value now that we have some input: */ +- if (s->lookahead >= MIN_MATCH) { +- s->ins_h = s->window[s->strstart]; +- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +-#if MIN_MATCH != 3 +- Call UPDATE_HASH() MIN_MATCH-3 more times +-#endif +- } +- /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, +- * but this is not important since only literal bytes will be emitted. +- */ +- +- } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); +-} +- +-/* =========================================================================== +- * Flush the current block, with given end-of-file flag. +- * IN assertion: strstart is set to the end of the current match. +- */ +-#define FLUSH_BLOCK_ONLY(s, eof) { \ +- _tr_flush_block(s, (s->block_start >= 0L ? \ +- (charf *)&s->window[(unsigned)s->block_start] : \ +- (charf *)Z_NULL), \ +- (ulg)((long)s->strstart - s->block_start), \ +- (eof)); \ +- s->block_start = s->strstart; \ +- flush_pending(s->strm); \ +- Tracev((stderr,"[FLUSH]")); \ +-} +- +-/* Same but force premature exit if necessary. */ +-#define FLUSH_BLOCK(s, eof) { \ +- FLUSH_BLOCK_ONLY(s, eof); \ +- if (s->strm->avail_out == 0) return (eof) ? finish_started : need_more; \ +-} +- +-/* =========================================================================== +- * Copy without compression as much as possible from the input stream, return +- * the current block state. +- * This function does not insert new strings in the dictionary since +- * uncompressible data is probably not useful. This function is used +- * only for the level=0 compression option. +- * NOTE: this function should be optimized to avoid extra copying from +- * window to pending_buf. +- */ +-local block_state deflate_stored(s, flush) +- deflate_state *s; +- int flush; +-{ +- /* Stored blocks are limited to 0xffff bytes, pending_buf is limited +- * to pending_buf_size, and each stored block has a 5 byte header: +- */ +- ulg max_block_size = 0xffff; +- ulg max_start; +- +- if (max_block_size > s->pending_buf_size - 5) { +- max_block_size = s->pending_buf_size - 5; +- } +- +- /* Copy as much as possible from input to output: */ +- for (;;) { +- /* Fill the window as much as possible: */ +- if (s->lookahead <= 1) { +- +- Assert(s->strstart < s->w_size+MAX_DIST(s) || +- s->block_start >= (long)s->w_size, "slide too late"); +- +- fill_window(s); +- if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more; +- +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- Assert(s->block_start >= 0L, "block gone"); +- +- s->strstart += s->lookahead; +- s->lookahead = 0; +- +- /* Emit a stored block if pending_buf will be full: */ +- max_start = s->block_start + max_block_size; +- if (s->strstart == 0 || (ulg)s->strstart >= max_start) { +- /* strstart == 0 is possible when wraparound on 16-bit machine */ +- s->lookahead = (uInt)(s->strstart - max_start); +- s->strstart = (uInt)max_start; +- FLUSH_BLOCK(s, 0); +- } +- /* Flush if we may have to slide, otherwise block_start may become +- * negative and the data will be gone: +- */ +- if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) { +- FLUSH_BLOCK(s, 0); +- } +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +- +-/* =========================================================================== +- * Compress as much as possible from the input stream, return the current +- * block state. +- * This function does not perform lazy evaluation of matches and inserts +- * new strings in the dictionary only for unmatched strings or for short +- * matches. It is used only for the fast compression options. +- */ +-local block_state deflate_fast(s, flush) +- deflate_state *s; +- int flush; +-{ +- IPos hash_head = NIL; /* head of the hash chain */ +- int bflush; /* set if current block must be flushed */ +- +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the next match, plus MIN_MATCH bytes to insert the +- * string following the next match. +- */ +- if (s->lookahead < MIN_LOOKAHEAD) { +- fill_window(s); +- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* Insert the string window[strstart .. strstart+2] in the +- * dictionary, and set hash_head to the head of the hash chain: +- */ +- if (s->lookahead >= MIN_MATCH) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- +- /* Find the longest match, discarding those <= prev_length. +- * At this point we have always match_length < MIN_MATCH +- */ +- if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { +- /* To simplify the code, we prevent matches with the string +- * of window index 0 (in particular we have to avoid a match +- * of the string with itself at the start of the input file). +- */ +-#ifdef FASTEST +- if ((s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) || +- (s->strategy == Z_RLE && s->strstart - hash_head == 1)) { +- s->match_length = longest_match_fast (s, hash_head); +- } +-#else +- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { +- s->match_length = longest_match (s, hash_head); +- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { +- s->match_length = longest_match_fast (s, hash_head); +- } +-#endif +- /* longest_match() or longest_match_fast() sets match_start */ +- } +- if (s->match_length >= MIN_MATCH) { +- check_match(s, s->strstart, s->match_start, s->match_length); +- +- _tr_tally_dist(s, s->strstart - s->match_start, +- s->match_length - MIN_MATCH, bflush); +- +- s->lookahead -= s->match_length; +- +- /* Insert new strings in the hash table only if the match length +- * is not too large. This saves time but degrades compression. +- */ +-#ifndef FASTEST +- if (s->match_length <= s->max_insert_length && +- s->lookahead >= MIN_MATCH) { +- s->match_length--; /* string at strstart already in table */ +- do { +- s->strstart++; +- INSERT_STRING(s, s->strstart, hash_head); +- /* strstart never exceeds WSIZE-MAX_MATCH, so there are +- * always MIN_MATCH bytes ahead. +- */ +- } while (--s->match_length != 0); +- s->strstart++; +- } else +-#endif +- { +- s->strstart += s->match_length; +- s->match_length = 0; +- s->ins_h = s->window[s->strstart]; +- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +-#if MIN_MATCH != 3 +- Call UPDATE_HASH() MIN_MATCH-3 more times +-#endif +- /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not +- * matter since it will be recomputed at next deflate call. +- */ +- } +- } else { +- /* No match, output a literal byte */ +- Tracevv((stderr,"%c", s->window[s->strstart])); +- _tr_tally_lit (s, s->window[s->strstart], bflush); +- s->lookahead--; +- s->strstart++; +- } +- if (bflush) FLUSH_BLOCK(s, 0); +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +- +-#ifndef FASTEST +-/* =========================================================================== +- * Same as above, but achieves better compression. We use a lazy +- * evaluation for matches: a match is finally adopted only if there is +- * no better match at the next window position. +- */ +-local block_state deflate_slow(s, flush) +- deflate_state *s; +- int flush; +-{ +- IPos hash_head = NIL; /* head of hash chain */ +- int bflush; /* set if current block must be flushed */ +- +- /* Process the input block. */ +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the next match, plus MIN_MATCH bytes to insert the +- * string following the next match. +- */ +- if (s->lookahead < MIN_LOOKAHEAD) { +- fill_window(s); +- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* Insert the string window[strstart .. strstart+2] in the +- * dictionary, and set hash_head to the head of the hash chain: +- */ +- if (s->lookahead >= MIN_MATCH) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- +- /* Find the longest match, discarding those <= prev_length. +- */ +- s->prev_length = s->match_length, s->prev_match = s->match_start; +- s->match_length = MIN_MATCH-1; +- +- if (hash_head != NIL && s->prev_length < s->max_lazy_match && +- s->strstart - hash_head <= MAX_DIST(s)) { +- /* To simplify the code, we prevent matches with the string +- * of window index 0 (in particular we have to avoid a match +- * of the string with itself at the start of the input file). +- */ +- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { +- s->match_length = longest_match (s, hash_head); +- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { +- s->match_length = longest_match_fast (s, hash_head); +- } +- /* longest_match() or longest_match_fast() sets match_start */ +- +- if (s->match_length <= 5 && (s->strategy == Z_FILTERED +-#if TOO_FAR <= 32767 +- || (s->match_length == MIN_MATCH && +- s->strstart - s->match_start > TOO_FAR) +-#endif +- )) { +- +- /* If prev_match is also MIN_MATCH, match_start is garbage +- * but we will ignore the current match anyway. +- */ +- s->match_length = MIN_MATCH-1; +- } +- } +- /* If there was a match at the previous step and the current +- * match is not better, output the previous match: +- */ +- if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { +- uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; +- /* Do not insert strings in hash table beyond this. */ +- +- check_match(s, s->strstart-1, s->prev_match, s->prev_length); +- +- _tr_tally_dist(s, s->strstart -1 - s->prev_match, +- s->prev_length - MIN_MATCH, bflush); +- +- /* Insert in hash table all strings up to the end of the match. +- * strstart-1 and strstart are already inserted. If there is not +- * enough lookahead, the last two strings are not inserted in +- * the hash table. +- */ +- s->lookahead -= s->prev_length-1; +- s->prev_length -= 2; +- do { +- if (++s->strstart <= max_insert) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- } while (--s->prev_length != 0); +- s->match_available = 0; +- s->match_length = MIN_MATCH-1; +- s->strstart++; +- +- if (bflush) FLUSH_BLOCK(s, 0); +- +- } else if (s->match_available) { +- /* 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. +- */ +- Tracevv((stderr,"%c", s->window[s->strstart-1])); +- _tr_tally_lit(s, s->window[s->strstart-1], bflush); +- if (bflush) { +- FLUSH_BLOCK_ONLY(s, 0); +- } +- s->strstart++; +- s->lookahead--; +- if (s->strm->avail_out == 0) return need_more; +- } else { +- /* There is no previous match to compare with, wait for +- * the next step to decide. +- */ +- s->match_available = 1; +- s->strstart++; +- s->lookahead--; +- } +- } +- Assert (flush != Z_NO_FLUSH, "no flush?"); +- if (s->match_available) { +- Tracevv((stderr,"%c", s->window[s->strstart-1])); +- _tr_tally_lit(s, s->window[s->strstart-1], bflush); +- s->match_available = 0; +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +-#endif /* FASTEST */ +- +-#if 0 +-/* =========================================================================== +- * For Z_RLE, simply look for runs of bytes, generate matches only of distance +- * one. Do not maintain a hash table. (It will be regenerated if this run of +- * deflate switches away from Z_RLE.) +- */ +-local block_state deflate_rle(s, flush) +- deflate_state *s; +- int flush; +-{ +- int bflush; /* set if current block must be flushed */ +- uInt run; /* length of run */ +- uInt max; /* maximum length of run */ +- uInt prev; /* byte at distance one to match */ +- Bytef *scan; /* scan for end of run */ +- +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the longest encodable run. +- */ +- if (s->lookahead < MAX_MATCH) { +- fill_window(s); +- if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* See how many times the previous byte repeats */ +- run = 0; +- if (s->strstart > 0) { /* if there is a previous byte, that is */ +- max = s->lookahead < MAX_MATCH ? s->lookahead : MAX_MATCH; +- scan = s->window + s->strstart - 1; +- prev = *scan++; +- do { +- if (*scan++ != prev) +- break; +- } while (++run < max); +- } +- +- /* Emit match if have run of MIN_MATCH or longer, else emit literal */ +- if (run >= MIN_MATCH) { +- check_match(s, s->strstart, s->strstart - 1, run); +- _tr_tally_dist(s, 1, run - MIN_MATCH, bflush); +- s->lookahead -= run; +- s->strstart += run; +- } else { +- /* No match, output a literal byte */ +- Tracevv((stderr,"%c", s->window[s->strstart])); +- _tr_tally_lit (s, s->window[s->strstart], bflush); +- s->lookahead--; +- s->strstart++; +- } +- if (bflush) FLUSH_BLOCK(s, 0); +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +-#endif +diff -ruN RJaCGH.orig/src/deflate.h RJaCGH/src/deflate.h +--- RJaCGH.orig/src/deflate.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/deflate.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,331 +0,0 @@ +-/* deflate.h -- internal compression state +- * Copyright (C) 1995-2004 Jean-loup Gailly +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* @(#) $Id$ */ +- +-#ifndef DEFLATE_H +-#define DEFLATE_H +- +-#include "zutil.h" +- +-/* define NO_GZIP when compiling if you want to disable gzip header and +- trailer creation by deflate(). NO_GZIP would be used to avoid linking in +- the crc code when it is not needed. For shared libraries, gzip encoding +- should be left enabled. */ +-#ifndef NO_GZIP +-# define GZIP +-#endif +- +-/* =========================================================================== +- * Internal compression state. +- */ +- +-#define LENGTH_CODES 29 +-/* number of length codes, not counting the special END_BLOCK code */ +- +-#define LITERALS 256 +-/* number of literal bytes 0..255 */ +- +-#define L_CODES (LITERALS+1+LENGTH_CODES) +-/* number of Literal or Length codes, including the END_BLOCK code */ +- +-#define D_CODES 30 +-/* number of distance codes */ +- +-#define BL_CODES 19 +-/* number of codes used to transfer the bit lengths */ +- +-#define HEAP_SIZE (2*L_CODES+1) +-/* maximum heap size */ +- +-#define MAX_BITS 15 +-/* All codes must not exceed MAX_BITS bits */ +- +-#define INIT_STATE 42 +-#define EXTRA_STATE 69 +-#define NAME_STATE 73 +-#define COMMENT_STATE 91 +-#define HCRC_STATE 103 +-#define BUSY_STATE 113 +-#define FINISH_STATE 666 +-/* Stream status */ +- +- +-/* Data structure describing a single value and its code string. */ +-typedef struct ct_data_s { +- union { +- ush freq; /* frequency count */ +- ush code; /* bit string */ +- } fc; +- union { +- ush dad; /* father node in Huffman tree */ +- ush len; /* length of bit string */ +- } dl; +-} FAR ct_data; +- +-#define Freq fc.freq +-#define Code fc.code +-#define Dad dl.dad +-#define Len dl.len +- +-typedef struct static_tree_desc_s static_tree_desc; +- +-typedef struct tree_desc_s { +- ct_data *dyn_tree; /* the dynamic tree */ +- int max_code; /* largest code with non zero frequency */ +- static_tree_desc *stat_desc; /* the corresponding static tree */ +-} FAR tree_desc; +- +-typedef ush Pos; +-typedef Pos FAR Posf; +-typedef unsigned IPos; +- +-/* A Pos is an index in the character window. We use short instead of int to +- * save space in the various tables. IPos is used only for parameter passing. +- */ +- +-typedef struct internal_state { +- z_streamp strm; /* pointer back to this zlib stream */ +- int status; /* as the name implies */ +- Bytef *pending_buf; /* output still pending */ +- ulg pending_buf_size; /* size of pending_buf */ +- Bytef *pending_out; /* next pending byte to output to the stream */ +- uInt pending; /* nb of bytes in the pending buffer */ +- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ +- gz_headerp gzhead; /* gzip header information to write */ +- uInt gzindex; /* where in extra, name, or comment */ +- Byte method; /* STORED (for zip only) or DEFLATED */ +- int last_flush; /* value of flush param for previous deflate call */ +- +- /* used by deflate.c: */ +- +- uInt w_size; /* LZ77 window size (32K by default) */ +- uInt w_bits; /* log2(w_size) (8..16) */ +- uInt w_mask; /* w_size - 1 */ +- +- Bytef *window; +- /* Sliding window. Input bytes are read into the second half of the window, +- * and move to the first half later to keep a dictionary of at least wSize +- * bytes. With this organization, matches are limited to a distance of +- * wSize-MAX_MATCH bytes, but this ensures that IO is always +- * performed with a length multiple of the block size. Also, it limits +- * the window size to 64K, which is quite useful on MSDOS. +- * To do: use the user input buffer as sliding window. +- */ +- +- ulg window_size; +- /* Actual size of window: 2*wSize, except when the user input buffer +- * is directly used as sliding window. +- */ +- +- Posf *prev; +- /* Link to older string with same hash index. To limit the size of this +- * array to 64K, this link is maintained only for the last 32K strings. +- * An index in this array is thus a window index modulo 32K. +- */ +- +- Posf *head; /* Heads of the hash chains or NIL. */ +- +- uInt ins_h; /* hash index of string to be inserted */ +- uInt hash_size; /* number of elements in hash table */ +- uInt hash_bits; /* log2(hash_size) */ +- uInt hash_mask; /* hash_size-1 */ +- +- uInt hash_shift; +- /* Number of bits by which ins_h must be shifted at each input +- * step. It must be such that after MIN_MATCH steps, the oldest +- * byte no longer takes part in the hash key, that is: +- * hash_shift * MIN_MATCH >= hash_bits +- */ +- +- long block_start; +- /* Window position at the beginning of the current output block. Gets +- * negative when the window is moved backwards. +- */ +- +- uInt match_length; /* length of best match */ +- IPos prev_match; /* previous match */ +- int match_available; /* set if previous match exists */ +- uInt strstart; /* start of string to insert */ +- uInt match_start; /* start of matching string */ +- uInt lookahead; /* number of valid bytes ahead in window */ +- +- uInt prev_length; +- /* Length of the best match at previous step. Matches not greater than this +- * are discarded. This is used in the lazy match evaluation. +- */ +- +- uInt max_chain_length; +- /* To speed up deflation, hash chains are never searched beyond this +- * length. A higher limit improves compression ratio but degrades the +- * speed. +- */ +- +- uInt max_lazy_match; +- /* Attempt to find a better match only when the current match is strictly +- * smaller than this value. This mechanism is used only for compression +- * levels >= 4. +- */ +-# define max_insert_length max_lazy_match +- /* Insert new strings in the hash table only if the match length is not +- * greater than this length. This saves time but degrades compression. +- * max_insert_length is used only for compression levels <= 3. +- */ +- +- int level; /* compression level (1..9) */ +- int strategy; /* favor or force Huffman coding*/ +- +- uInt good_match; +- /* Use a faster search when the previous match is longer than this */ +- +- int nice_match; /* Stop searching when current match exceeds this */ +- +- /* used by trees.c: */ +- /* Didn't use ct_data typedef below to supress compiler warning */ +- struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */ +- struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */ +- struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */ +- +- struct tree_desc_s l_desc; /* desc. for literal tree */ +- struct tree_desc_s d_desc; /* desc. for distance tree */ +- struct tree_desc_s bl_desc; /* desc. for bit length tree */ +- +- ush bl_count[MAX_BITS+1]; +- /* number of codes at each bit length for an optimal tree */ +- +- int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ +- int heap_len; /* number of elements in the heap */ +- int heap_max; /* element of largest frequency */ +- /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. +- * The same heap array is used to build all trees. +- */ +- +- uch depth[2*L_CODES+1]; +- /* Depth of each subtree used as tie breaker for trees of equal frequency +- */ +- +- uchf *l_buf; /* buffer for literals or lengths */ +- +- uInt lit_bufsize; +- /* Size of match buffer for literals/lengths. There are 4 reasons for +- * limiting lit_bufsize to 64K: +- * - frequencies can be kept in 16 bit counters +- * - if compression is not successful for the first block, all input +- * data is still in the window so we can still emit a stored block even +- * when input comes from standard input. (This can also be done for +- * all blocks if lit_bufsize is not greater than 32K.) +- * - if compression is not successful for a file smaller than 64K, we can +- * even emit a stored file instead of a stored block (saving 5 bytes). +- * This is applicable only for zip (not gzip or zlib). +- * - creating new Huffman trees less frequently may not provide fast +- * adaptation to changes in the input data statistics. (Take for +- * example a binary file with poorly compressible code followed by +- * a highly compressible string table.) Smaller buffer sizes give +- * fast adaptation but have of course the overhead of transmitting +- * trees more frequently. +- * - I can't count above 4 +- */ +- +- uInt last_lit; /* running index in l_buf */ +- +- ushf *d_buf; +- /* Buffer for distances. To simplify the code, d_buf and l_buf have +- * the same number of elements. To use different lengths, an extra flag +- * array would be necessary. +- */ +- +- ulg opt_len; /* bit length of current block with optimal trees */ +- ulg static_len; /* bit length of current block with static trees */ +- uInt matches; /* number of string matches in current block */ +- int last_eob_len; /* bit length of EOB code for last block */ +- +-#ifdef DEBUG +- ulg compressed_len; /* total bit length of compressed file mod 2^32 */ +- ulg bits_sent; /* bit length of compressed data sent mod 2^32 */ +-#endif +- +- ush bi_buf; +- /* Output buffer. bits are inserted starting at the bottom (least +- * significant bits). +- */ +- int bi_valid; +- /* Number of valid bits in bi_buf. All bits above the last valid bit +- * are always zero. +- */ +- +-} FAR deflate_state; +- +-/* Output a byte on the stream. +- * IN assertion: there is enough room in pending_buf. +- */ +-#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);} +- +- +-#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +-/* Minimum amount of lookahead, except at the end of the input file. +- * See deflate.c for comments about the MIN_MATCH+1. +- */ +- +-#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD) +-/* In order to simplify the code, particularly on 16 bit machines, match +- * distances are limited to MAX_DIST instead of WSIZE. +- */ +- +- /* in trees.c */ +-void _tr_init OF((deflate_state *s)); +-int _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc)); +-void _tr_flush_block OF((deflate_state *s, charf *buf, ulg stored_len, +- int eof)); +-void _tr_align OF((deflate_state *s)); +-void _tr_stored_block OF((deflate_state *s, charf *buf, ulg stored_len, +- int eof)); +- +-#define d_code(dist) \ +- ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)]) +-/* Mapping from a distance to a distance code. dist is the distance - 1 and +- * must not have side effects. _dist_code[256] and _dist_code[257] are never +- * used. +- */ +- +-#ifndef DEBUG +-/* Inline versions of _tr_tally for speed: */ +- +-#if defined(GEN_TREES_H) || !defined(STDC) +- extern uch _length_code[]; +- extern uch _dist_code[]; +-#else +- extern const uch _length_code[]; +- extern const uch _dist_code[]; +-#endif +- +-# define _tr_tally_lit(s, c, flush) \ +- { uch cc = (c); \ +- s->d_buf[s->last_lit] = 0; \ +- s->l_buf[s->last_lit++] = cc; \ +- s->dyn_ltree[cc].Freq++; \ +- flush = (s->last_lit == s->lit_bufsize-1); \ +- } +-# define _tr_tally_dist(s, distance, length, flush) \ +- { uch len = (length); \ +- ush dist = (distance); \ +- s->d_buf[s->last_lit] = dist; \ +- s->l_buf[s->last_lit++] = len; \ +- dist--; \ +- s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \ +- s->dyn_dtree[d_code(dist)].Freq++; \ +- flush = (s->last_lit == s->lit_bufsize-1); \ +- } +-#else +-# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c) +-# define _tr_tally_dist(s, distance, length, flush) \ +- flush = _tr_tally(s, distance, length) +-#endif +- +-#endif /* DEFLATE_H */ +diff -ruN RJaCGH.orig/src/gzio.c RJaCGH/src/gzio.c +--- RJaCGH.orig/src/gzio.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/gzio.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1026 +0,0 @@ +-/* gzio.c -- IO on .gz files +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- * +- * Compile this file with -DNO_GZCOMPRESS to avoid the compression code. +- */ +- +-/* @(#) $Id$ */ +- +-#include +- +-#include "zutil.h" +- +-#ifdef NO_DEFLATE /* for compatibility with old definition */ +-# define NO_GZCOMPRESS +-#endif +- +-#ifndef NO_DUMMY_DECL +-struct internal_state {int dummy;}; /* for buggy compilers */ +-#endif +- +-#ifndef Z_BUFSIZE +-# ifdef MAXSEG_64K +-# define Z_BUFSIZE 4096 /* minimize memory usage for 16-bit DOS */ +-# else +-# define Z_BUFSIZE 16384 +-# endif +-#endif +-#ifndef Z_PRINTF_BUFSIZE +-# define Z_PRINTF_BUFSIZE 4096 +-#endif +- +-#ifdef __MVS__ +-# pragma map (fdopen , "\174\174FDOPEN") +- FILE *fdopen(int, const char *); +-#endif +- +-#ifndef STDC +-extern voidp malloc OF((uInt size)); +-extern void free OF((voidpf ptr)); +-#endif +- +-#define ALLOC(size) malloc(size) +-#define TRYFREE(p) {if (p) free(p);} +- +-static int const gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ +- +-/* gzip flag byte */ +-#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +-#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ +-#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +-#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +-#define COMMENT 0x10 /* bit 4 set: file comment present */ +-#define RESERVED 0xE0 /* bits 5..7: reserved */ +- +-typedef struct gz_stream { +- z_stream stream; +- int z_err; /* error code for last stream operation */ +- int z_eof; /* set if end of input file */ +- FILE *file; /* .gz file */ +- Byte *inbuf; /* input buffer */ +- Byte *outbuf; /* output buffer */ +- uLong crc; /* crc32 of uncompressed data */ +- char *msg; /* error message */ +- char *path; /* path name for debugging only */ +- int transparent; /* 1 if input file is not a .gz file */ +- char mode; /* 'w' or 'r' */ +- z_off_t start; /* start of compressed data in file (header skipped) */ +- z_off_t in; /* bytes into deflate or inflate */ +- z_off_t out; /* bytes out of deflate or inflate */ +- int back; /* one character push-back */ +- int last; /* true if push-back is last character */ +-} gz_stream; +- +- +-local gzFile gz_open OF((const char *path, const char *mode, int fd)); +-local int do_flush OF((gzFile file, int flush)); +-local int get_byte OF((gz_stream *s)); +-local void check_header OF((gz_stream *s)); +-local int destroy OF((gz_stream *s)); +-local void putLong OF((FILE *file, uLong x)); +-local uLong getLong OF((gz_stream *s)); +- +-/* =========================================================================== +- Opens a gzip (.gz) file for reading or writing. The mode parameter +- is as in fopen ("rb" or "wb"). The file is given either by file descriptor +- or path name (if fd == -1). +- gz_open returns NULL if the file could not be opened or if there was +- insufficient memory to allocate the (de)compression state; errno +- can be checked to distinguish the two cases (if errno is zero, the +- zlib error is Z_MEM_ERROR). +-*/ +-local gzFile gz_open (path, mode, fd) +- const char *path; +- const char *mode; +- int fd; +-{ +- int err; +- int level = Z_DEFAULT_COMPRESSION; /* compression level */ +- int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */ +- char *p = (char*)mode; +- gz_stream *s; +- char fmode[80]; /* copy of mode, without the compression level */ +- char *m = fmode; +- +- if (!path || !mode) return Z_NULL; +- +- s = (gz_stream *)ALLOC(sizeof(gz_stream)); +- if (!s) return Z_NULL; +- +- s->stream.zalloc = (alloc_func)0; +- s->stream.zfree = (free_func)0; +- s->stream.opaque = (voidpf)0; +- s->stream.next_in = s->inbuf = Z_NULL; +- s->stream.next_out = s->outbuf = Z_NULL; +- s->stream.avail_in = s->stream.avail_out = 0; +- s->file = NULL; +- s->z_err = Z_OK; +- s->z_eof = 0; +- s->in = 0; +- s->out = 0; +- s->back = EOF; +- s->crc = crc32(0L, Z_NULL, 0); +- s->msg = NULL; +- s->transparent = 0; +- +- s->path = (char*)ALLOC(strlen(path)+1); +- if (s->path == NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- strcpy(s->path, path); /* do this early for debugging */ +- +- s->mode = '\0'; +- do { +- if (*p == 'r') s->mode = 'r'; +- if (*p == 'w' || *p == 'a') s->mode = 'w'; +- if (*p >= '0' && *p <= '9') { +- level = *p - '0'; +- } else if (*p == 'f') { +- strategy = Z_FILTERED; +- } else if (*p == 'h') { +- strategy = Z_HUFFMAN_ONLY; +- } else if (*p == 'R') { +- strategy = Z_RLE; +- } else { +- *m++ = *p; /* copy the mode */ +- } +- } while (*p++ && m != fmode + sizeof(fmode)); +- if (s->mode == '\0') return destroy(s), (gzFile)Z_NULL; +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- err = Z_STREAM_ERROR; +-#else +- err = deflateInit2(&(s->stream), level, +- Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, strategy); +- /* windowBits is passed < 0 to suppress zlib header */ +- +- s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); +-#endif +- if (err != Z_OK || s->outbuf == Z_NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- } else { +- s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); +- +- err = inflateInit2(&(s->stream), -MAX_WBITS); +- /* windowBits is passed < 0 to tell that there is no zlib header. +- * Note that in this case inflate *requires* an extra "dummy" byte +- * after the compressed stream in order to complete decompression and +- * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are +- * present after the compressed stream. +- */ +- if (err != Z_OK || s->inbuf == Z_NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- } +- s->stream.avail_out = Z_BUFSIZE; +- +- errno = 0; +- s->file = fd < 0 ? F_OPEN(path, fmode) : (FILE*)fdopen(fd, fmode); +- +- if (s->file == NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- if (s->mode == 'w') { +- /* Write a very simple .gz header: +- */ +- fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], +- Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, OS_CODE); +- s->start = 10L; +- /* We use 10L instead of ftell(s->file) to because ftell causes an +- * fflush on some systems. This version of the library doesn't use +- * start anyway in write mode, so this initialization is not +- * necessary. +- */ +- } else { +- check_header(s); /* skip the .gz header */ +- s->start = ftell(s->file) - s->stream.avail_in; +- } +- +- return (gzFile)s; +-} +- +-/* =========================================================================== +- Opens a gzip (.gz) file for reading or writing. +-*/ +-gzFile ZEXPORT gzopen (path, mode) +- const char *path; +- const char *mode; +-{ +- return gz_open (path, mode, -1); +-} +- +-/* =========================================================================== +- Associate a gzFile with the file descriptor fd. fd is not dup'ed here +- to mimic the behavio(u)r of fdopen. +-*/ +-gzFile ZEXPORT gzdopen (fd, mode) +- int fd; +- const char *mode; +-{ +- char name[46]; /* allow for up to 128-bit integers */ +- +- if (fd < 0) return (gzFile)Z_NULL; +- sprintf(name, "", fd); /* for debugging */ +- +- return gz_open (name, mode, fd); +-} +- +-/* =========================================================================== +- * Update the compression level and strategy +- */ +-int ZEXPORT gzsetparams (file, level, strategy) +- gzFile file; +- int level; +- int strategy; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- /* Make room to allow flushing */ +- if (s->stream.avail_out == 0) { +- +- s->stream.next_out = s->outbuf; +- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { +- s->z_err = Z_ERRNO; +- } +- s->stream.avail_out = Z_BUFSIZE; +- } +- +- return deflateParams (&(s->stream), level, strategy); +-} +- +-/* =========================================================================== +- Read a byte from a gz_stream; update next_in and avail_in. Return EOF +- for end of file. +- IN assertion: the stream s has been sucessfully opened for reading. +-*/ +-local int get_byte(s) +- gz_stream *s; +-{ +- if (s->z_eof) return EOF; +- if (s->stream.avail_in == 0) { +- errno = 0; +- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); +- if (s->stream.avail_in == 0) { +- s->z_eof = 1; +- if (ferror(s->file)) s->z_err = Z_ERRNO; +- return EOF; +- } +- s->stream.next_in = s->inbuf; +- } +- s->stream.avail_in--; +- return *(s->stream.next_in)++; +-} +- +-/* =========================================================================== +- Check the gzip header of a gz_stream opened for reading. Set the stream +- mode to transparent if the gzip magic header is not present; set s->err +- to Z_DATA_ERROR if the magic header is present but the rest of the header +- is incorrect. +- IN assertion: the stream s has already been created sucessfully; +- s->stream.avail_in is zero for the first time, but may be non-zero +- for concatenated .gz files. +-*/ +-local void check_header(s) +- gz_stream *s; +-{ +- int method; /* method byte */ +- int flags; /* flags byte */ +- uInt len; +- int c; +- +- /* Assure two bytes in the buffer so we can peek ahead -- handle case +- where first byte of header is at the end of the buffer after the last +- gzip segment */ +- len = s->stream.avail_in; +- if (len < 2) { +- if (len) s->inbuf[0] = s->stream.next_in[0]; +- errno = 0; +- len = (uInt)fread(s->inbuf + len, 1, Z_BUFSIZE >> len, s->file); +- if (len == 0 && ferror(s->file)) s->z_err = Z_ERRNO; +- s->stream.avail_in += len; +- s->stream.next_in = s->inbuf; +- if (s->stream.avail_in < 2) { +- s->transparent = s->stream.avail_in; +- return; +- } +- } +- +- /* Peek ahead to check the gzip magic header */ +- if (s->stream.next_in[0] != gz_magic[0] || +- s->stream.next_in[1] != gz_magic[1]) { +- s->transparent = 1; +- return; +- } +- s->stream.avail_in -= 2; +- s->stream.next_in += 2; +- +- /* Check the rest of the gzip header */ +- method = get_byte(s); +- flags = get_byte(s); +- if (method != Z_DEFLATED || (flags & RESERVED) != 0) { +- s->z_err = Z_DATA_ERROR; +- return; +- } +- +- /* Discard time, xflags and OS code: */ +- for (len = 0; len < 6; len++) (void)get_byte(s); +- +- if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ +- len = (uInt)get_byte(s); +- len += ((uInt)get_byte(s))<<8; +- /* len is garbage if EOF but the loop below will quit anyway */ +- while (len-- != 0 && get_byte(s) != EOF) ; +- } +- if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ +- while ((c = get_byte(s)) != 0 && c != EOF) ; +- } +- if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ +- while ((c = get_byte(s)) != 0 && c != EOF) ; +- } +- if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ +- for (len = 0; len < 2; len++) (void)get_byte(s); +- } +- s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; +-} +- +- /* =========================================================================== +- * Cleanup then free the given gz_stream. Return a zlib error code. +- Try freeing in the reverse order of allocations. +- */ +-local int destroy (s) +- gz_stream *s; +-{ +- int err = Z_OK; +- +- if (!s) return Z_STREAM_ERROR; +- +- TRYFREE(s->msg); +- +- if (s->stream.state != NULL) { +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- err = Z_STREAM_ERROR; +-#else +- err = deflateEnd(&(s->stream)); +-#endif +- } else if (s->mode == 'r') { +- err = inflateEnd(&(s->stream)); +- } +- } +- if (s->file != NULL && fclose(s->file)) { +-#ifdef ESPIPE +- if (errno != ESPIPE) /* fclose is broken for pipes in HP/UX */ +-#endif +- err = Z_ERRNO; +- } +- if (s->z_err < 0) err = s->z_err; +- +- TRYFREE(s->inbuf); +- TRYFREE(s->outbuf); +- TRYFREE(s->path); +- TRYFREE(s); +- return err; +-} +- +-/* =========================================================================== +- Reads the given number of uncompressed bytes from the compressed file. +- gzread returns the number of bytes actually read (0 for end of file). +-*/ +-int ZEXPORT gzread (file, buf, len) +- gzFile file; +- voidp buf; +- unsigned len; +-{ +- gz_stream *s = (gz_stream*)file; +- Bytef *start = (Bytef*)buf; /* starting point for crc computation */ +- Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ +- +- if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; +- +- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1; +- if (s->z_err == Z_STREAM_END) return 0; /* EOF */ +- +- next_out = (Byte*)buf; +- s->stream.next_out = (Bytef*)buf; +- s->stream.avail_out = len; +- +- if (s->stream.avail_out && s->back != EOF) { +- *next_out++ = s->back; +- s->stream.next_out++; +- s->stream.avail_out--; +- s->back = EOF; +- s->out++; +- start++; +- if (s->last) { +- s->z_err = Z_STREAM_END; +- return 1; +- } +- } +- +- while (s->stream.avail_out != 0) { +- +- if (s->transparent) { +- /* Copy first the lookahead bytes: */ +- uInt n = s->stream.avail_in; +- if (n > s->stream.avail_out) n = s->stream.avail_out; +- if (n > 0) { +- zmemcpy(s->stream.next_out, s->stream.next_in, n); +- next_out += n; +- s->stream.next_out = next_out; +- s->stream.next_in += n; +- s->stream.avail_out -= n; +- s->stream.avail_in -= n; +- } +- if (s->stream.avail_out > 0) { +- s->stream.avail_out -= +- (uInt)fread(next_out, 1, s->stream.avail_out, s->file); +- } +- len -= s->stream.avail_out; +- s->in += len; +- s->out += len; +- if (len == 0) s->z_eof = 1; +- return (int)len; +- } +- if (s->stream.avail_in == 0 && !s->z_eof) { +- +- errno = 0; +- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); +- if (s->stream.avail_in == 0) { +- s->z_eof = 1; +- if (ferror(s->file)) { +- s->z_err = Z_ERRNO; +- break; +- } +- } +- s->stream.next_in = s->inbuf; +- } +- s->in += s->stream.avail_in; +- s->out += s->stream.avail_out; +- s->z_err = inflate(&(s->stream), Z_NO_FLUSH); +- s->in -= s->stream.avail_in; +- s->out -= s->stream.avail_out; +- +- if (s->z_err == Z_STREAM_END) { +- /* Check CRC and original size */ +- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); +- start = s->stream.next_out; +- +- if (getLong(s) != s->crc) { +- s->z_err = Z_DATA_ERROR; +- } else { +- (void)getLong(s); +- /* The uncompressed length returned by above getlong() may be +- * different from s->out in case of concatenated .gz files. +- * Check for such files: +- */ +- check_header(s); +- if (s->z_err == Z_OK) { +- inflateReset(&(s->stream)); +- s->crc = crc32(0L, Z_NULL, 0); +- } +- } +- } +- if (s->z_err != Z_OK || s->z_eof) break; +- } +- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); +- +- if (len == s->stream.avail_out && +- (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO)) +- return -1; +- return (int)(len - s->stream.avail_out); +-} +- +- +-/* =========================================================================== +- Reads one byte from the compressed file. gzgetc returns this byte +- or -1 in case of end of file or error. +-*/ +-int ZEXPORT gzgetc(file) +- gzFile file; +-{ +- unsigned char c; +- +- return gzread(file, &c, 1) == 1 ? c : -1; +-} +- +- +-/* =========================================================================== +- Push one byte back onto the stream. +-*/ +-int ZEXPORT gzungetc(c, file) +- int c; +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r' || c == EOF || s->back != EOF) return EOF; +- s->back = c; +- s->out--; +- s->last = (s->z_err == Z_STREAM_END); +- if (s->last) s->z_err = Z_OK; +- s->z_eof = 0; +- return c; +-} +- +- +-/* =========================================================================== +- Reads bytes from the compressed file until len-1 characters are +- read, or a newline character is read and transferred to buf, or an +- end-of-file condition is encountered. The string is then terminated +- with a null character. +- gzgets returns buf, or Z_NULL in case of error. +- +- The current implementation is not optimized at all. +-*/ +-char * ZEXPORT gzgets(file, buf, len) +- gzFile file; +- char *buf; +- int len; +-{ +- char *b = buf; +- if (buf == Z_NULL || len <= 0) return Z_NULL; +- +- while (--len > 0 && gzread(file, buf, 1) == 1 && *buf++ != '\n') ; +- *buf = '\0'; +- return b == buf && len > 0 ? Z_NULL : b; +-} +- +- +-#ifndef NO_GZCOMPRESS +-/* =========================================================================== +- Writes the given number of uncompressed bytes into the compressed file. +- gzwrite returns the number of bytes actually written (0 in case of error). +-*/ +-int ZEXPORT gzwrite (file, buf, len) +- gzFile file; +- voidpc buf; +- unsigned len; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- s->stream.next_in = (Bytef*)buf; +- s->stream.avail_in = len; +- +- while (s->stream.avail_in != 0) { +- +- if (s->stream.avail_out == 0) { +- +- s->stream.next_out = s->outbuf; +- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { +- s->z_err = Z_ERRNO; +- break; +- } +- s->stream.avail_out = Z_BUFSIZE; +- } +- s->in += s->stream.avail_in; +- s->out += s->stream.avail_out; +- s->z_err = deflate(&(s->stream), Z_NO_FLUSH); +- s->in -= s->stream.avail_in; +- s->out -= s->stream.avail_out; +- if (s->z_err != Z_OK) break; +- } +- s->crc = crc32(s->crc, (const Bytef *)buf, len); +- +- return (int)(len - s->stream.avail_in); +-} +- +- +-/* =========================================================================== +- Converts, formats, and writes the args to the compressed file under +- control of the format string, as in fprintf. gzprintf returns the number of +- uncompressed bytes actually written (0 in case of error). +-*/ +-#ifdef STDC +-#include +- +-int ZEXPORTVA gzprintf (gzFile file, const char *format, /* args */ ...) +-{ +- char buf[Z_PRINTF_BUFSIZE]; +- va_list va; +- int len; +- +- buf[sizeof(buf) - 1] = 0; +- va_start(va, format); +-#ifdef NO_vsnprintf +-# ifdef HAS_vsprintf_void +- (void)vsprintf(buf, format, va); +- va_end(va); +- for (len = 0; len < sizeof(buf); len++) +- if (buf[len] == 0) break; +-# else +- len = vsprintf(buf, format, va); +- va_end(va); +-# endif +-#else +-# ifdef HAS_vsnprintf_void +- (void)vsnprintf(buf, sizeof(buf), format, va); +- va_end(va); +- len = strlen(buf); +-# else +- len = vsnprintf(buf, sizeof(buf), format, va); +- va_end(va); +-# endif +-#endif +- if (len <= 0 || len >= (int)sizeof(buf) || buf[sizeof(buf) - 1] != 0) +- return 0; +- return gzwrite(file, buf, (unsigned)len); +-} +-#else /* not ANSI C */ +- +-int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, +- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) +- gzFile file; +- const char *format; +- int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, +- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20; +-{ +- char buf[Z_PRINTF_BUFSIZE]; +- int len; +- +- buf[sizeof(buf) - 1] = 0; +-#ifdef NO_snprintf +-# ifdef HAS_sprintf_void +- sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, +- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); +- for (len = 0; len < sizeof(buf); len++) +- if (buf[len] == 0) break; +-# else +- len = sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, +- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); +-# endif +-#else +-# ifdef HAS_snprintf_void +- 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); +- len = strlen(buf); +-# else +- len = 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); +-# endif +-#endif +- if (len <= 0 || len >= sizeof(buf) || buf[sizeof(buf) - 1] != 0) +- return 0; +- return gzwrite(file, buf, len); +-} +-#endif +- +-/* =========================================================================== +- Writes c, converted to an unsigned char, into the compressed file. +- gzputc returns the value that was written, or -1 in case of error. +-*/ +-int ZEXPORT gzputc(file, c) +- gzFile file; +- int c; +-{ +- unsigned char cc = (unsigned char) c; /* required for big endian systems */ +- +- return gzwrite(file, &cc, 1) == 1 ? (int)cc : -1; +-} +- +- +-/* =========================================================================== +- Writes the given null-terminated string to the compressed file, excluding +- the terminating null character. +- gzputs returns the number of characters written, or -1 in case of error. +-*/ +-int ZEXPORT gzputs(file, s) +- gzFile file; +- const char *s; +-{ +- return gzwrite(file, (char*)s, (unsigned)strlen(s)); +-} +- +- +-/* =========================================================================== +- Flushes all pending output into the compressed file. The parameter +- flush is as in the deflate() function. +-*/ +-local int do_flush (file, flush) +- gzFile file; +- int flush; +-{ +- uInt len; +- int done = 0; +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- s->stream.avail_in = 0; /* should be zero already anyway */ +- +- for (;;) { +- len = Z_BUFSIZE - s->stream.avail_out; +- +- if (len != 0) { +- if ((uInt)fwrite(s->outbuf, 1, len, s->file) != len) { +- s->z_err = Z_ERRNO; +- return Z_ERRNO; +- } +- s->stream.next_out = s->outbuf; +- s->stream.avail_out = Z_BUFSIZE; +- } +- if (done) break; +- s->out += s->stream.avail_out; +- s->z_err = deflate(&(s->stream), flush); +- s->out -= s->stream.avail_out; +- +- /* Ignore the second of two consecutive flushes: */ +- if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK; +- +- /* deflate has finished flushing only when it hasn't used up +- * all the available space in the output buffer: +- */ +- done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); +- +- if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; +- } +- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +-} +- +-int ZEXPORT gzflush (file, flush) +- gzFile file; +- int flush; +-{ +- gz_stream *s = (gz_stream*)file; +- int err = do_flush (file, flush); +- +- if (err) return err; +- fflush(s->file); +- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +-} +-#endif /* NO_GZCOMPRESS */ +- +-/* =========================================================================== +- Sets the starting position for the next gzread or gzwrite on the given +- compressed file. The offset represents a number of bytes in the +- gzseek returns the resulting offset location as measured in bytes from +- the beginning of the uncompressed stream, or -1 in case of error. +- SEEK_END is not implemented, returns error. +- In this version of the library, gzseek can be extremely slow. +-*/ +-z_off_t ZEXPORT gzseek (file, offset, whence) +- gzFile file; +- z_off_t offset; +- int whence; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || whence == SEEK_END || +- s->z_err == Z_ERRNO || s->z_err == Z_DATA_ERROR) { +- return -1L; +- } +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- return -1L; +-#else +- if (whence == SEEK_SET) { +- offset -= s->in; +- } +- if (offset < 0) return -1L; +- +- /* At this point, offset is the number of zero bytes to write. */ +- if (s->inbuf == Z_NULL) { +- s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); /* for seeking */ +- if (s->inbuf == Z_NULL) return -1L; +- zmemzero(s->inbuf, Z_BUFSIZE); +- } +- while (offset > 0) { +- uInt size = Z_BUFSIZE; +- if (offset < Z_BUFSIZE) size = (uInt)offset; +- +- size = gzwrite(file, s->inbuf, size); +- if (size == 0) return -1L; +- +- offset -= size; +- } +- return s->in; +-#endif +- } +- /* Rest of function is for reading only */ +- +- /* compute absolute position */ +- if (whence == SEEK_CUR) { +- offset += s->out; +- } +- if (offset < 0) return -1L; +- +- if (s->transparent) { +- /* map to fseek */ +- s->back = EOF; +- s->stream.avail_in = 0; +- s->stream.next_in = s->inbuf; +- if (fseek(s->file, offset, SEEK_SET) < 0) return -1L; +- +- s->in = s->out = offset; +- return offset; +- } +- +- /* For a negative seek, rewind and use positive seek */ +- if (offset >= s->out) { +- offset -= s->out; +- } else if (gzrewind(file) < 0) { +- return -1L; +- } +- /* offset is now the number of bytes to skip. */ +- +- if (offset != 0 && s->outbuf == Z_NULL) { +- s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); +- if (s->outbuf == Z_NULL) return -1L; +- } +- if (offset && s->back != EOF) { +- s->back = EOF; +- s->out++; +- offset--; +- if (s->last) s->z_err = Z_STREAM_END; +- } +- while (offset > 0) { +- int size = Z_BUFSIZE; +- if (offset < Z_BUFSIZE) size = (int)offset; +- +- size = gzread(file, s->outbuf, (uInt)size); +- if (size <= 0) return -1L; +- offset -= size; +- } +- return s->out; +-} +- +-/* =========================================================================== +- Rewinds input file. +-*/ +-int ZEXPORT gzrewind (file) +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r') return -1; +- +- s->z_err = Z_OK; +- s->z_eof = 0; +- s->back = EOF; +- s->stream.avail_in = 0; +- s->stream.next_in = s->inbuf; +- s->crc = crc32(0L, Z_NULL, 0); +- if (!s->transparent) (void)inflateReset(&s->stream); +- s->in = 0; +- s->out = 0; +- return fseek(s->file, s->start, SEEK_SET); +-} +- +-/* =========================================================================== +- Returns the starting position for the next gzread or gzwrite on the +- given compressed file. This position represents a number of bytes in the +- uncompressed data stream. +-*/ +-z_off_t ZEXPORT gztell (file) +- gzFile file; +-{ +- return gzseek(file, 0L, SEEK_CUR); +-} +- +-/* =========================================================================== +- Returns 1 when EOF has previously been detected reading the given +- input stream, otherwise zero. +-*/ +-int ZEXPORT gzeof (file) +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- /* With concatenated compressed files that can have embedded +- * crc trailers, z_eof is no longer the only/best indicator of EOF +- * on a gz_stream. Handle end-of-stream error explicitly here. +- */ +- if (s == NULL || s->mode != 'r') return 0; +- if (s->z_eof) return 1; +- return s->z_err == Z_STREAM_END; +-} +- +-/* =========================================================================== +- Returns 1 if reading and doing so transparently, otherwise zero. +-*/ +-int ZEXPORT gzdirect (file) +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r') return 0; +- return s->transparent; +-} +- +-/* =========================================================================== +- Outputs a long in LSB order to the given file +-*/ +-local void putLong (file, x) +- FILE *file; +- uLong x; +-{ +- int n; +- for (n = 0; n < 4; n++) { +- fputc((int)(x & 0xff), file); +- x >>= 8; +- } +-} +- +-/* =========================================================================== +- Reads a long in LSB order from the given gz_stream. Sets z_err in case +- of error. +-*/ +-local uLong getLong (s) +- gz_stream *s; +-{ +- uLong x = (uLong)get_byte(s); +- int c; +- +- x += ((uLong)get_byte(s))<<8; +- x += ((uLong)get_byte(s))<<16; +- c = get_byte(s); +- if (c == EOF) s->z_err = Z_DATA_ERROR; +- x += ((uLong)c)<<24; +- return x; +-} +- +-/* =========================================================================== +- Flushes all pending output if necessary, closes the compressed file +- and deallocates all the (de)compression state. +-*/ +-int ZEXPORT gzclose (file) +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) return Z_STREAM_ERROR; +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- return Z_STREAM_ERROR; +-#else +- if (do_flush (file, Z_FINISH) != Z_OK) +- return destroy((gz_stream*)file); +- +- putLong (s->file, s->crc); +- putLong (s->file, (uLong)(s->in & 0xffffffff)); +-#endif +- } +- return destroy((gz_stream*)file); +-} +- +-#ifdef STDC +-# define zstrerror(errnum) strerror(errnum) +-#else +-# define zstrerror(errnum) "" +-#endif +- +-/* =========================================================================== +- Returns the error message for the last error which occurred on the +- given compressed file. errnum is set to zlib error number. If an +- error occurred in the file system and not in the compression library, +- errnum is set to Z_ERRNO and the application may consult errno +- to get the exact error code. +-*/ +-const char * ZEXPORT gzerror (file, errnum) +- gzFile file; +- int *errnum; +-{ +- char *m; +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) { +- *errnum = Z_STREAM_ERROR; +- return (const char*)ERR_MSG(Z_STREAM_ERROR); +- } +- *errnum = s->z_err; +- if (*errnum == Z_OK) return (const char*)""; +- +- m = (char*)(*errnum == Z_ERRNO ? zstrerror(errno) : s->stream.msg); +- +- if (m == NULL || *m == '\0') m = (char*)ERR_MSG(s->z_err); +- +- TRYFREE(s->msg); +- s->msg = (char*)ALLOC(strlen(s->path) + strlen(m) + 3); +- if (s->msg == Z_NULL) return (const char*)ERR_MSG(Z_MEM_ERROR); +- strcpy(s->msg, s->path); +- strcat(s->msg, ": "); +- strcat(s->msg, m); +- return (const char*)s->msg; +-} +- +-/* =========================================================================== +- Clear the error and end-of-file flags, and do the same for the real file. +-*/ +-void ZEXPORT gzclearerr (file) +- gzFile file; +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) return; +- if (s->z_err != Z_STREAM_END) s->z_err = Z_OK; +- s->z_eof = 0; +- clearerr(s->file); +-} +diff -ruN RJaCGH.orig/src/infback.c RJaCGH/src/infback.c +--- RJaCGH.orig/src/infback.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/infback.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,623 +0,0 @@ +-/* infback.c -- inflate using a call-back interface +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- This code is largely copied from inflate.c. Normally either infback.o or +- inflate.o would be linked into an application--not both. The interface +- with inffast.c is retained so that optimized assembler-coded versions of +- inflate_fast() can be used with either inflate.c or infback.c. +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +-/* function prototypes */ +-local void fixedtables OF((struct inflate_state FAR *state)); +- +-/* +- strm provides memory allocation functions in zalloc and zfree, or +- Z_NULL to use the library memory allocation functions. +- +- windowBits is in the range 8..15, and window is a user-supplied +- window and output buffer that is 2**windowBits bytes. +- */ +-int ZEXPORT inflateBackInit_(strm, windowBits, window, version, stream_size) +-z_streamp strm; +-int windowBits; +-unsigned char FAR *window; +-const char *version; +-int stream_size; +-{ +- struct inflate_state FAR *state; +- +- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || +- stream_size != (int)(sizeof(z_stream))) +- return Z_VERSION_ERROR; +- if (strm == Z_NULL || window == Z_NULL || +- windowBits < 8 || windowBits > 15) +- return Z_STREAM_ERROR; +- strm->msg = Z_NULL; /* in case we return an error */ +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- state = (struct inflate_state FAR *)ZALLOC(strm, 1, +- sizeof(struct inflate_state)); +- if (state == Z_NULL) return Z_MEM_ERROR; +- Tracev((stderr, "inflate: allocated\n")); +- strm->state = (struct internal_state FAR *)state; +- state->dmax = 32768U; +- state->wbits = windowBits; +- state->wsize = 1U << windowBits; +- state->window = window; +- state->write = 0; +- state->whave = 0; +- return Z_OK; +-} +- +-/* +- Return state with length and distance decoding tables and index sizes set to +- fixed code decoding. Normally this returns fixed tables from inffixed.h. +- If BUILDFIXED is defined, then instead this routine builds the tables the +- first time it's called, and returns those tables the first time and +- thereafter. This reduces the size of the code by about 2K bytes, in +- exchange for a little execution time. However, BUILDFIXED should not be +- used for threaded applications, since the rewriting of the tables and virgin +- may not be thread-safe. +- */ +-local void fixedtables(state) +-struct inflate_state FAR *state; +-{ +-#ifdef BUILDFIXED +- static int virgin = 1; +- static code *lenfix, *distfix; +- static code fixed[544]; +- +- /* build fixed huffman tables if first call (may not be thread safe) */ +- if (virgin) { +- unsigned sym, bits; +- static code *next; +- +- /* literal/length table */ +- sym = 0; +- while (sym < 144) state->lens[sym++] = 8; +- while (sym < 256) state->lens[sym++] = 9; +- while (sym < 280) state->lens[sym++] = 7; +- while (sym < 288) state->lens[sym++] = 8; +- next = fixed; +- lenfix = next; +- bits = 9; +- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); +- +- /* distance table */ +- sym = 0; +- while (sym < 32) state->lens[sym++] = 5; +- distfix = next; +- bits = 5; +- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); +- +- /* do this just once */ +- virgin = 0; +- } +-#else /* !BUILDFIXED */ +-# include "inffixed.h" +-#endif /* BUILDFIXED */ +- state->lencode = lenfix; +- state->lenbits = 9; +- state->distcode = distfix; +- state->distbits = 5; +-} +- +-/* Macros for inflateBack(): */ +- +-/* Load returned state from inflate_fast() */ +-#define LOAD() \ +- do { \ +- put = strm->next_out; \ +- left = strm->avail_out; \ +- next = strm->next_in; \ +- have = strm->avail_in; \ +- hold = state->hold; \ +- bits = state->bits; \ +- } while (0) +- +-/* Set state from registers for inflate_fast() */ +-#define RESTORE() \ +- do { \ +- strm->next_out = put; \ +- strm->avail_out = left; \ +- strm->next_in = next; \ +- strm->avail_in = have; \ +- state->hold = hold; \ +- state->bits = bits; \ +- } while (0) +- +-/* Clear the input bit accumulator */ +-#define INITBITS() \ +- do { \ +- hold = 0; \ +- bits = 0; \ +- } while (0) +- +-/* Assure that some input is available. If input is requested, but denied, +- then return a Z_BUF_ERROR from inflateBack(). */ +-#define PULL() \ +- do { \ +- if (have == 0) { \ +- have = in(in_desc, &next); \ +- if (have == 0) { \ +- next = Z_NULL; \ +- ret = Z_BUF_ERROR; \ +- goto inf_leave; \ +- } \ +- } \ +- } while (0) +- +-/* Get a byte of input into the bit accumulator, or return from inflateBack() +- with an error if there is no input available. */ +-#define PULLBYTE() \ +- do { \ +- PULL(); \ +- have--; \ +- hold += (unsigned long)(*next++) << bits; \ +- bits += 8; \ +- } while (0) +- +-/* Assure that there are at least n bits in the bit accumulator. If there is +- not enough available input to do that, then return from inflateBack() with +- an error. */ +-#define NEEDBITS(n) \ +- do { \ +- while (bits < (unsigned)(n)) \ +- PULLBYTE(); \ +- } while (0) +- +-/* Return the low n bits of the bit accumulator (n < 16) */ +-#define BITS(n) \ +- ((unsigned)hold & ((1U << (n)) - 1)) +- +-/* Remove n bits from the bit accumulator */ +-#define DROPBITS(n) \ +- do { \ +- hold >>= (n); \ +- bits -= (unsigned)(n); \ +- } while (0) +- +-/* Remove zero to seven bits as needed to go to a byte boundary */ +-#define BYTEBITS() \ +- do { \ +- hold >>= bits & 7; \ +- bits -= bits & 7; \ +- } while (0) +- +-/* Assure that some output space is available, by writing out the window +- if it's full. If the write fails, return from inflateBack() with a +- Z_BUF_ERROR. */ +-#define ROOM() \ +- do { \ +- if (left == 0) { \ +- put = state->window; \ +- left = state->wsize; \ +- state->whave = left; \ +- if (out(out_desc, put, left)) { \ +- ret = Z_BUF_ERROR; \ +- goto inf_leave; \ +- } \ +- } \ +- } while (0) +- +-/* +- strm provides the memory allocation functions and window buffer on input, +- and provides information on the unused input on return. For Z_DATA_ERROR +- returns, strm will also provide an error message. +- +- in() and out() are the call-back input and output functions. When +- inflateBack() needs more input, it calls in(). When inflateBack() has +- filled the window with output, or when it completes with data in the +- window, it calls out() to write out the data. The application must not +- change the provided input until in() is called again or inflateBack() +- returns. The application must not change the window/output buffer until +- inflateBack() returns. +- +- in() and out() are called with a descriptor parameter provided in the +- inflateBack() call. This parameter can be a structure that provides the +- information required to do the read or write, as well as accumulated +- information on the input and output such as totals and check values. +- +- in() should return zero on failure. out() should return non-zero on +- failure. If either in() or out() fails, than inflateBack() returns a +- Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it +- was in() or out() that caused in the error. Otherwise, inflateBack() +- returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format +- error, or Z_MEM_ERROR if it could not allocate memory for the state. +- inflateBack() can also return Z_STREAM_ERROR if the input parameters +- are not correct, i.e. strm is Z_NULL or the state was not initialized. +- */ +-int ZEXPORT inflateBack(strm, in, in_desc, out, out_desc) +-z_streamp strm; +-in_func in; +-void FAR *in_desc; +-out_func out; +-void FAR *out_desc; +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *next; /* next input */ +- unsigned char FAR *put; /* next output */ +- unsigned have, left; /* available input and output */ +- unsigned long hold; /* bit buffer */ +- unsigned bits; /* bits in bit buffer */ +- unsigned copy; /* number of stored or match bytes to copy */ +- unsigned char FAR *from; /* where to copy match bytes from */ +- code this; /* current decoding table entry */ +- code last; /* parent table entry */ +- unsigned len; /* length to copy for repeats, bits to drop */ +- int ret; /* return code */ +- static const unsigned short order[19] = /* permutation of code lengths */ +- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; +- +- /* Check that the strm exists and that the state was initialized */ +- if (strm == Z_NULL || strm->state == Z_NULL) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- +- /* Reset the state */ +- strm->msg = Z_NULL; +- state->mode = TYPE; +- state->last = 0; +- state->whave = 0; +- next = strm->next_in; +- have = next != Z_NULL ? strm->avail_in : 0; +- hold = 0; +- bits = 0; +- put = state->window; +- left = state->wsize; +- +- /* Inflate until end of block marked as last */ +- for (;;) +- switch (state->mode) { +- case TYPE: +- /* determine and dispatch block type */ +- if (state->last) { +- BYTEBITS(); +- state->mode = DONE; +- break; +- } +- NEEDBITS(3); +- state->last = BITS(1); +- DROPBITS(1); +- switch (BITS(2)) { +- case 0: /* stored block */ +- Tracev((stderr, "inflate: stored block%s\n", +- state->last ? " (last)" : "")); +- state->mode = STORED; +- break; +- case 1: /* fixed block */ +- fixedtables(state); +- Tracev((stderr, "inflate: fixed codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = LEN; /* decode codes */ +- break; +- case 2: /* dynamic block */ +- Tracev((stderr, "inflate: dynamic codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = TABLE; +- break; +- case 3: +- strm->msg = (char *)"invalid block type"; +- state->mode = BAD; +- } +- DROPBITS(2); +- break; +- +- case STORED: +- /* get and verify stored block length */ +- BYTEBITS(); /* go to byte boundary */ +- NEEDBITS(32); +- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { +- strm->msg = (char *)"invalid stored block lengths"; +- state->mode = BAD; +- break; +- } +- state->length = (unsigned)hold & 0xffff; +- Tracev((stderr, "inflate: stored length %u\n", +- state->length)); +- INITBITS(); +- +- /* copy stored block from input to output */ +- while (state->length != 0) { +- copy = state->length; +- PULL(); +- ROOM(); +- if (copy > have) copy = have; +- if (copy > left) copy = left; +- zmemcpy(put, next, copy); +- have -= copy; +- next += copy; +- left -= copy; +- put += copy; +- state->length -= copy; +- } +- Tracev((stderr, "inflate: stored end\n")); +- state->mode = TYPE; +- break; +- +- case TABLE: +- /* get dynamic table entries descriptor */ +- NEEDBITS(14); +- state->nlen = BITS(5) + 257; +- DROPBITS(5); +- state->ndist = BITS(5) + 1; +- DROPBITS(5); +- state->ncode = BITS(4) + 4; +- DROPBITS(4); +-#ifndef PKZIP_BUG_WORKAROUND +- if (state->nlen > 286 || state->ndist > 30) { +- strm->msg = (char *)"too many length or distance symbols"; +- state->mode = BAD; +- break; +- } +-#endif +- Tracev((stderr, "inflate: table sizes ok\n")); +- +- /* get code length code lengths (not a typo) */ +- state->have = 0; +- while (state->have < state->ncode) { +- NEEDBITS(3); +- state->lens[order[state->have++]] = (unsigned short)BITS(3); +- DROPBITS(3); +- } +- while (state->have < 19) +- state->lens[order[state->have++]] = 0; +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 7; +- ret = inflate_table(CODES, state->lens, 19, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid code lengths set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: code lengths ok\n")); +- +- /* get length and distance code code lengths */ +- state->have = 0; +- while (state->have < state->nlen + state->ndist) { +- for (;;) { +- this = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if (this.val < 16) { +- NEEDBITS(this.bits); +- DROPBITS(this.bits); +- state->lens[state->have++] = this.val; +- } +- else { +- if (this.val == 16) { +- NEEDBITS(this.bits + 2); +- DROPBITS(this.bits); +- if (state->have == 0) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- len = (unsigned)(state->lens[state->have - 1]); +- copy = 3 + BITS(2); +- DROPBITS(2); +- } +- else if (this.val == 17) { +- NEEDBITS(this.bits + 3); +- DROPBITS(this.bits); +- len = 0; +- copy = 3 + BITS(3); +- DROPBITS(3); +- } +- else { +- NEEDBITS(this.bits + 7); +- DROPBITS(this.bits); +- len = 0; +- copy = 11 + BITS(7); +- DROPBITS(7); +- } +- if (state->have + copy > state->nlen + state->ndist) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- while (copy--) +- state->lens[state->have++] = (unsigned short)len; +- } +- } +- +- /* handle error breaks in while */ +- if (state->mode == BAD) break; +- +- /* build code tables */ +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 9; +- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid literal/lengths set"; +- state->mode = BAD; +- break; +- } +- state->distcode = (code const FAR *)(state->next); +- state->distbits = 6; +- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, +- &(state->next), &(state->distbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid distances set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: codes ok\n")); +- state->mode = LEN; +- +- case LEN: +- /* use inflate_fast() if we have enough input and output */ +- if (have >= 6 && left >= 258) { +- RESTORE(); +- if (state->whave < state->wsize) +- state->whave = state->wsize - left; +- inflate_fast(strm, state->wsize); +- LOAD(); +- break; +- } +- +- /* get a literal, length, or end-of-block code */ +- for (;;) { +- this = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if (this.op && (this.op & 0xf0) == 0) { +- last = this; +- for (;;) { +- this = state->lencode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + this.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(this.bits); +- state->length = (unsigned)this.val; +- +- /* process literal */ +- if (this.op == 0) { +- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", this.val)); +- ROOM(); +- *put++ = (unsigned char)(state->length); +- left--; +- state->mode = LEN; +- break; +- } +- +- /* process end of block */ +- if (this.op & 32) { +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- +- /* invalid code */ +- if (this.op & 64) { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- +- /* length code -- get extra bits, if any */ +- state->extra = (unsigned)(this.op) & 15; +- if (state->extra != 0) { +- NEEDBITS(state->extra); +- state->length += BITS(state->extra); +- DROPBITS(state->extra); +- } +- Tracevv((stderr, "inflate: length %u\n", state->length)); +- +- /* get distance code */ +- for (;;) { +- this = state->distcode[BITS(state->distbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if ((this.op & 0xf0) == 0) { +- last = this; +- for (;;) { +- this = state->distcode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + this.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(this.bits); +- if (this.op & 64) { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- state->offset = (unsigned)this.val; +- +- /* get distance extra bits, if any */ +- state->extra = (unsigned)(this.op) & 15; +- if (state->extra != 0) { +- NEEDBITS(state->extra); +- state->offset += BITS(state->extra); +- DROPBITS(state->extra); +- } +- if (state->offset > state->wsize - (state->whave < state->wsize ? +- left : 0)) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- Tracevv((stderr, "inflate: distance %u\n", state->offset)); +- +- /* copy match from window to output */ +- do { +- ROOM(); +- copy = state->wsize - state->offset; +- if (copy < left) { +- from = put + copy; +- copy = left - copy; +- } +- else { +- from = put - state->offset; +- copy = left; +- } +- if (copy > state->length) copy = state->length; +- state->length -= copy; +- left -= copy; +- do { +- *put++ = *from++; +- } while (--copy); +- } while (state->length != 0); +- break; +- +- case DONE: +- /* inflate stream terminated properly -- write leftover output */ +- ret = Z_STREAM_END; +- if (left < state->wsize) { +- if (out(out_desc, state->window, state->wsize - left)) +- ret = Z_BUF_ERROR; +- } +- goto inf_leave; +- +- case BAD: +- ret = Z_DATA_ERROR; +- goto inf_leave; +- +- default: /* can't happen, but makes compilers happy */ +- ret = Z_STREAM_ERROR; +- goto inf_leave; +- } +- +- /* Return unused input */ +- inf_leave: +- strm->next_in = next; +- strm->avail_in = have; +- return ret; +-} +- +-int ZEXPORT inflateBackEnd(strm) +-z_streamp strm; +-{ +- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- Tracev((stderr, "inflate: end\n")); +- return Z_OK; +-} +diff -ruN RJaCGH.orig/src/inffast.c RJaCGH/src/inffast.c +--- RJaCGH.orig/src/inffast.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inffast.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,318 +0,0 @@ +-/* inffast.c -- fast decoding +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +-#ifndef ASMINF +- +-/* Allow machine dependent optimization for post-increment or pre-increment. +- Based on testing to date, +- Pre-increment preferred for: +- - PowerPC G3 (Adler) +- - MIPS R5000 (Randers-Pehrson) +- Post-increment preferred for: +- - none +- No measurable difference: +- - Pentium III (Anderson) +- - M68060 (Nikl) +- */ +-#ifdef POSTINC +-# define OFF 0 +-# define PUP(a) *(a)++ +-#else +-# define OFF 1 +-# define PUP(a) *++(a) +-#endif +- +-/* +- Decode literal, length, and distance codes and write out the resulting +- literal and match bytes until either not enough input or output is +- available, an end-of-block is encountered, or a data error is encountered. +- When large enough input and output buffers are supplied to inflate(), for +- example, a 16K input buffer and a 64K output buffer, more than 95% of the +- inflate execution time is spent in this routine. +- +- Entry assumptions: +- +- state->mode == LEN +- strm->avail_in >= 6 +- strm->avail_out >= 258 +- start >= strm->avail_out +- state->bits < 8 +- +- On return, state->mode is one of: +- +- LEN -- ran out of enough output space or enough available input +- TYPE -- reached end of block code, inflate() to interpret next block +- BAD -- error in block data +- +- Notes: +- +- - The maximum input bits used by a length/distance pair is 15 bits for the +- length code, 5 bits for the length extra, 15 bits for the distance code, +- and 13 bits for the distance extra. This totals 48 bits, or six bytes. +- Therefore if strm->avail_in >= 6, then there is enough input to avoid +- checking for available input while decoding. +- +- - The maximum bytes that a single length/distance pair can output is 258 +- bytes, which is the maximum length that can be coded. inflate_fast() +- requires strm->avail_out >= 258 for each loop to avoid checking for +- output space. +- */ +-void inflate_fast(strm, start) +-z_streamp strm; +-unsigned start; /* inflate()'s starting value for strm->avail_out */ +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *in; /* local strm->next_in */ +- unsigned char FAR *last; /* while in < last, enough input available */ +- unsigned char FAR *out; /* local strm->next_out */ +- unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ +- unsigned char FAR *end; /* while out < end, enough space available */ +-#ifdef INFLATE_STRICT +- unsigned dmax; /* maximum distance from zlib header */ +-#endif +- unsigned wsize; /* window size or zero if not using window */ +- unsigned whave; /* valid bytes in the window */ +- unsigned write; /* window write index */ +- unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ +- unsigned long hold; /* local strm->hold */ +- unsigned bits; /* local strm->bits */ +- code const FAR *lcode; /* local strm->lencode */ +- code const FAR *dcode; /* local strm->distcode */ +- unsigned lmask; /* mask for first level of length codes */ +- unsigned dmask; /* mask for first level of distance codes */ +- code this; /* retrieved table entry */ +- unsigned op; /* code bits, operation, extra bits, or */ +- /* window position, window bytes to copy */ +- unsigned len; /* match length, unused bytes */ +- unsigned dist; /* match distance */ +- unsigned char FAR *from; /* where to copy match from */ +- +- /* copy state to local variables */ +- state = (struct inflate_state FAR *)strm->state; +- in = strm->next_in - OFF; +- last = in + (strm->avail_in - 5); +- out = strm->next_out - OFF; +- beg = out - (start - strm->avail_out); +- end = out + (strm->avail_out - 257); +-#ifdef INFLATE_STRICT +- dmax = state->dmax; +-#endif +- wsize = state->wsize; +- whave = state->whave; +- write = state->write; +- window = state->window; +- hold = state->hold; +- bits = state->bits; +- lcode = state->lencode; +- dcode = state->distcode; +- lmask = (1U << state->lenbits) - 1; +- dmask = (1U << state->distbits) - 1; +- +- /* decode literals and length/distances until end-of-block or not enough +- input data or output space */ +- do { +- if (bits < 15) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- this = lcode[hold & lmask]; +- dolen: +- op = (unsigned)(this.bits); +- hold >>= op; +- bits -= op; +- op = (unsigned)(this.op); +- if (op == 0) { /* literal */ +- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", this.val)); +- PUP(out) = (unsigned char)(this.val); +- } +- else if (op & 16) { /* length base */ +- len = (unsigned)(this.val); +- op &= 15; /* number of extra bits */ +- if (op) { +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- len += (unsigned)hold & ((1U << op) - 1); +- hold >>= op; +- bits -= op; +- } +- Tracevv((stderr, "inflate: length %u\n", len)); +- if (bits < 15) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- this = dcode[hold & dmask]; +- dodist: +- op = (unsigned)(this.bits); +- hold >>= op; +- bits -= op; +- op = (unsigned)(this.op); +- if (op & 16) { /* distance base */ +- dist = (unsigned)(this.val); +- op &= 15; /* number of extra bits */ +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- } +- dist += (unsigned)hold & ((1U << op) - 1); +-#ifdef INFLATE_STRICT +- if (dist > dmax) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +-#endif +- hold >>= op; +- bits -= op; +- Tracevv((stderr, "inflate: distance %u\n", dist)); +- op = (unsigned)(out - beg); /* max distance in output */ +- if (dist > op) { /* see if copy from window */ +- op = dist - op; /* distance back in window */ +- if (op > whave) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- from = window - OFF; +- if (write == 0) { /* very common case */ +- from += wsize - op; +- if (op < len) { /* some from window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- else if (write < op) { /* wrap around window */ +- from += wsize + write - op; +- op -= write; +- if (op < len) { /* some from end of window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = window - OFF; +- if (write < len) { /* some from start of window */ +- op = write; +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- } +- else { /* contiguous in window */ +- from += write - op; +- if (op < len) { /* some from window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- while (len > 2) { +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- len -= 3; +- } +- if (len) { +- PUP(out) = PUP(from); +- if (len > 1) +- PUP(out) = PUP(from); +- } +- } +- else { +- from = out - dist; /* copy direct from output */ +- do { /* minimum length is three */ +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- len -= 3; +- } while (len > 2); +- if (len) { +- PUP(out) = PUP(from); +- if (len > 1) +- PUP(out) = PUP(from); +- } +- } +- } +- else if ((op & 64) == 0) { /* 2nd level distance code */ +- this = dcode[this.val + (hold & ((1U << op) - 1))]; +- goto dodist; +- } +- else { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- } +- else if ((op & 64) == 0) { /* 2nd level length code */ +- this = lcode[this.val + (hold & ((1U << op) - 1))]; +- goto dolen; +- } +- else if (op & 32) { /* end-of-block */ +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- else { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- } while (in < last && out < end); +- +- /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ +- len = bits >> 3; +- in -= len; +- bits -= len << 3; +- hold &= (1U << bits) - 1; +- +- /* update state and return */ +- strm->next_in = in + OFF; +- strm->next_out = out + OFF; +- strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); +- strm->avail_out = (unsigned)(out < end ? +- 257 + (end - out) : 257 - (out - end)); +- state->hold = hold; +- state->bits = bits; +- return; +-} +- +-/* +- inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): +- - Using bit fields for code structure +- - Different op definition to avoid & for extra bits (do & for table bits) +- - Three separate decoding do-loops for direct, window, and write == 0 +- - Special case for distance > 1 copies to do overlapped load and store copy +- - Explicit branch predictions (based on measured branch probabilities) +- - Deferring match copy and interspersed it with decoding subsequent codes +- - Swapping literal/length else +- - Swapping window/direct else +- - Larger unrolled copy loops (three is about right) +- - Moving len -= 3 statement into middle of loop +- */ +- +-#endif /* !ASMINF */ +diff -ruN RJaCGH.orig/src/inffast.h RJaCGH/src/inffast.h +--- RJaCGH.orig/src/inffast.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inffast.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,11 +0,0 @@ +-/* inffast.h -- header to use inffast.c +- * Copyright (C) 1995-2003 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-void inflate_fast OF((z_streamp strm, unsigned start)); +diff -ruN RJaCGH.orig/src/inffixed.h RJaCGH/src/inffixed.h +--- RJaCGH.orig/src/inffixed.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inffixed.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,94 +0,0 @@ +- /* inffixed.h -- table for decoding fixed codes +- * Generated automatically by makefixed(). +- */ +- +- /* WARNING: this file should *not* be used by applications. It +- is part of the implementation of the compression library and +- is subject to change. Applications should only use zlib.h. +- */ +- +- static const code lenfix[512] = { +- {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48}, +- {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128}, +- {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59}, +- {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176}, +- {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20}, +- {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100}, +- {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8}, +- {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216}, +- {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76}, +- {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114}, +- {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2}, +- {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148}, +- {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42}, +- {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86}, +- {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15}, +- {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236}, +- {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62}, +- {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, +- {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31}, +- {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162}, +- {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25}, +- {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105}, +- {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4}, +- {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202}, +- {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69}, +- {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125}, +- {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13}, +- {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195}, +- {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35}, +- {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91}, +- {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19}, +- {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246}, +- {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55}, +- {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135}, +- {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99}, +- {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190}, +- {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16}, +- {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96}, +- {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6}, +- {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209}, +- {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72}, +- {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116}, +- {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4}, +- {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153}, +- {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44}, +- {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82}, +- {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11}, +- {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, +- {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58}, +- {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138}, +- {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51}, +- {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173}, +- {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30}, +- {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110}, +- {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0}, +- {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195}, +- {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65}, +- {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121}, +- {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9}, +- {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258}, +- {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37}, +- {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93}, +- {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23}, +- {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251}, +- {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51}, +- {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, +- {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67}, +- {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183}, +- {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23}, +- {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103}, +- {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9}, +- {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223}, +- {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79}, +- {0,9,255} +- }; +- +- static const code distfix[32] = { +- {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025}, +- {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193}, +- {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385}, +- {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577}, +- {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073}, +- {22,5,193},{64,5,0} +- }; +diff -ruN RJaCGH.orig/src/inflate.c RJaCGH/src/inflate.c +--- RJaCGH.orig/src/inflate.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inflate.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1368 +0,0 @@ +-/* inflate.c -- zlib decompression +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * Change history: +- * +- * 1.2.beta0 24 Nov 2002 +- * - First version -- complete rewrite of inflate to simplify code, avoid +- * creation of window when not needed, minimize use of window when it is +- * needed, make inffast.c even faster, implement gzip decoding, and to +- * improve code readability and style over the previous zlib inflate code +- * +- * 1.2.beta1 25 Nov 2002 +- * - Use pointers for available input and output checking in inffast.c +- * - Remove input and output counters in inffast.c +- * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 +- * - Remove unnecessary second byte pull from length extra in inffast.c +- * - Unroll direct copy to three copies per loop in inffast.c +- * +- * 1.2.beta2 4 Dec 2002 +- * - Change external routine names to reduce potential conflicts +- * - Correct filename to inffixed.h for fixed tables in inflate.c +- * - Make hbuf[] unsigned char to match parameter type in inflate.c +- * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) +- * to avoid negation problem on Alphas (64 bit) in inflate.c +- * +- * 1.2.beta3 22 Dec 2002 +- * - Add comments on state->bits assertion in inffast.c +- * - Add comments on op field in inftrees.h +- * - Fix bug in reuse of allocated window after inflateReset() +- * - Remove bit fields--back to byte structure for speed +- * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths +- * - Change post-increments to pre-increments in inflate_fast(), PPC biased? +- * - Add compile time option, POSTINC, to use post-increments instead (Intel?) +- * - Make MATCH copy in inflate() much faster for when inflate_fast() not used +- * - Use local copies of stream next and avail values, as well as local bit +- * buffer and bit count in inflate()--for speed when inflate_fast() not used +- * +- * 1.2.beta4 1 Jan 2003 +- * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings +- * - Move a comment on output buffer sizes from inffast.c to inflate.c +- * - Add comments in inffast.c to introduce the inflate_fast() routine +- * - Rearrange window copies in inflate_fast() for speed and simplification +- * - Unroll last copy for window match in inflate_fast() +- * - Use local copies of window variables in inflate_fast() for speed +- * - Pull out common write == 0 case for speed in inflate_fast() +- * - Make op and len in inflate_fast() unsigned for consistency +- * - Add FAR to lcode and dcode declarations in inflate_fast() +- * - Simplified bad distance check in inflate_fast() +- * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new +- * source file infback.c to provide a call-back interface to inflate for +- * programs like gzip and unzip -- uses window as output buffer to avoid +- * window copying +- * +- * 1.2.beta5 1 Jan 2003 +- * - Improved inflateBack() interface to allow the caller to provide initial +- * input in strm. +- * - Fixed stored blocks bug in inflateBack() +- * +- * 1.2.beta6 4 Jan 2003 +- * - Added comments in inffast.c on effectiveness of POSTINC +- * - Typecasting all around to reduce compiler warnings +- * - Changed loops from while (1) or do {} while (1) to for (;;), again to +- * make compilers happy +- * - Changed type of window in inflateBackInit() to unsigned char * +- * +- * 1.2.beta7 27 Jan 2003 +- * - Changed many types to unsigned or unsigned short to avoid warnings +- * - Added inflateCopy() function +- * +- * 1.2.0 9 Mar 2003 +- * - Changed inflateBack() interface to provide separate opaque descriptors +- * for the in() and out() functions +- * - Changed inflateBack() argument and in_func typedef to swap the length +- * and buffer address return values for the input function +- * - Check next_in and next_out for Z_NULL on entry to inflate() +- * +- * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +-#ifdef MAKEFIXED +-# ifndef BUILDFIXED +-# define BUILDFIXED +-# endif +-#endif +- +-/* function prototypes */ +-local void fixedtables OF((struct inflate_state FAR *state)); +-local int updatewindow OF((z_streamp strm, unsigned out)); +-#ifdef BUILDFIXED +- void makefixed OF((void)); +-#endif +-local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, +- unsigned len)); +- +-int ZEXPORT inflateReset(strm) +-z_streamp strm; +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- strm->total_in = strm->total_out = state->total = 0; +- strm->msg = Z_NULL; +- strm->adler = 1; /* to support ill-conceived Java test suite */ +- state->mode = HEAD; +- state->last = 0; +- state->havedict = 0; +- state->dmax = 32768U; +- state->head = Z_NULL; +- state->wsize = 0; +- state->whave = 0; +- state->write = 0; +- state->hold = 0; +- state->bits = 0; +- state->lencode = state->distcode = state->next = state->codes; +- Tracev((stderr, "inflate: reset\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflatePrime(strm, bits, value) +-z_streamp strm; +-int bits; +-int value; +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR; +- value &= (1L << bits) - 1; +- state->hold += value << state->bits; +- state->bits += bits; +- return Z_OK; +-} +- +-int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size) +-z_streamp strm; +-int windowBits; +-const char *version; +-int stream_size; +-{ +- struct inflate_state FAR *state; +- +- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || +- stream_size != (int)(sizeof(z_stream))) +- return Z_VERSION_ERROR; +- if (strm == Z_NULL) return Z_STREAM_ERROR; +- strm->msg = Z_NULL; /* in case we return an error */ +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- state = (struct inflate_state FAR *) +- ZALLOC(strm, 1, sizeof(struct inflate_state)); +- if (state == Z_NULL) return Z_MEM_ERROR; +- Tracev((stderr, "inflate: allocated\n")); +- strm->state = (struct internal_state FAR *)state; +- if (windowBits < 0) { +- state->wrap = 0; +- windowBits = -windowBits; +- } +- else { +- state->wrap = (windowBits >> 4) + 1; +-#ifdef GUNZIP +- if (windowBits < 48) windowBits &= 15; +-#endif +- } +- if (windowBits < 8 || windowBits > 15) { +- ZFREE(strm, state); +- strm->state = Z_NULL; +- return Z_STREAM_ERROR; +- } +- state->wbits = (unsigned)windowBits; +- state->window = Z_NULL; +- return inflateReset(strm); +-} +- +-int ZEXPORT inflateInit_(strm, version, stream_size) +-z_streamp strm; +-const char *version; +-int stream_size; +-{ +- return inflateInit2_(strm, DEF_WBITS, version, stream_size); +-} +- +-/* +- Return state with length and distance decoding tables and index sizes set to +- fixed code decoding. Normally this returns fixed tables from inffixed.h. +- If BUILDFIXED is defined, then instead this routine builds the tables the +- first time it's called, and returns those tables the first time and +- thereafter. This reduces the size of the code by about 2K bytes, in +- exchange for a little execution time. However, BUILDFIXED should not be +- used for threaded applications, since the rewriting of the tables and virgin +- may not be thread-safe. +- */ +-local void fixedtables(state) +-struct inflate_state FAR *state; +-{ +-#ifdef BUILDFIXED +- static int virgin = 1; +- static code *lenfix, *distfix; +- static code fixed[544]; +- +- /* build fixed huffman tables if first call (may not be thread safe) */ +- if (virgin) { +- unsigned sym, bits; +- static code *next; +- +- /* literal/length table */ +- sym = 0; +- while (sym < 144) state->lens[sym++] = 8; +- while (sym < 256) state->lens[sym++] = 9; +- while (sym < 280) state->lens[sym++] = 7; +- while (sym < 288) state->lens[sym++] = 8; +- next = fixed; +- lenfix = next; +- bits = 9; +- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); +- +- /* distance table */ +- sym = 0; +- while (sym < 32) state->lens[sym++] = 5; +- distfix = next; +- bits = 5; +- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); +- +- /* do this just once */ +- virgin = 0; +- } +-#else /* !BUILDFIXED */ +-# include "inffixed.h" +-#endif /* BUILDFIXED */ +- state->lencode = lenfix; +- state->lenbits = 9; +- state->distcode = distfix; +- state->distbits = 5; +-} +- +-#ifdef MAKEFIXED +-#include +- +-/* +- Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also +- defines BUILDFIXED, so the tables are built on the fly. makefixed() writes +- those tables to stdout, which would be piped to inffixed.h. A small program +- can simply call makefixed to do this: +- +- void makefixed(void); +- +- int main(void) +- { +- makefixed(); +- return 0; +- } +- +- Then that can be linked with zlib built with MAKEFIXED defined and run: +- +- a.out > inffixed.h +- */ +-void makefixed() +-{ +- unsigned low, size; +- struct inflate_state state; +- +- fixedtables(&state); +- puts(" /* inffixed.h -- table for decoding fixed codes"); +- puts(" * Generated automatically by makefixed()."); +- puts(" */"); +- puts(""); +- puts(" /* WARNING: this file should *not* be used by applications."); +- puts(" It is part of the implementation of this library and is"); +- puts(" subject to change. Applications should only use zlib.h."); +- puts(" */"); +- puts(""); +- size = 1U << 9; +- printf(" static const code lenfix[%u] = {", size); +- low = 0; +- for (;;) { +- if ((low % 7) == 0) printf("\n "); +- printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits, +- state.lencode[low].val); +- if (++low == size) break; +- putchar(','); +- } +- puts("\n };"); +- size = 1U << 5; +- printf("\n static const code distfix[%u] = {", size); +- low = 0; +- for (;;) { +- if ((low % 6) == 0) printf("\n "); +- printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, +- state.distcode[low].val); +- if (++low == size) break; +- putchar(','); +- } +- puts("\n };"); +-} +-#endif /* MAKEFIXED */ +- +-/* +- Update the window with the last wsize (normally 32K) bytes written before +- returning. If window does not exist yet, create it. This is only called +- when a window is already in use, or when output has been written during this +- inflate call, but the end of the deflate stream has not been reached yet. +- It is also called to create a window for dictionary data when a dictionary +- is loaded. +- +- Providing output buffers larger than 32K to inflate() should provide a speed +- advantage, since only the last 32K of output is copied to the sliding window +- upon return from inflate(), and since all distances after the first 32K of +- output will fall in the output data, making match copies simpler and faster. +- The advantage may be dependent on the size of the processor's data caches. +- */ +-local int updatewindow(strm, out) +-z_streamp strm; +-unsigned out; +-{ +- struct inflate_state FAR *state; +- unsigned copy, dist; +- +- state = (struct inflate_state FAR *)strm->state; +- +- /* if it hasn't been done already, allocate space for the window */ +- if (state->window == Z_NULL) { +- state->window = (unsigned char FAR *) +- ZALLOC(strm, 1U << state->wbits, +- sizeof(unsigned char)); +- if (state->window == Z_NULL) return 1; +- } +- +- /* if window not in use yet, initialize */ +- if (state->wsize == 0) { +- state->wsize = 1U << state->wbits; +- state->write = 0; +- state->whave = 0; +- } +- +- /* copy state->wsize or less output bytes into the circular window */ +- copy = out - strm->avail_out; +- if (copy >= state->wsize) { +- zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); +- state->write = 0; +- state->whave = state->wsize; +- } +- else { +- dist = state->wsize - state->write; +- if (dist > copy) dist = copy; +- zmemcpy(state->window + state->write, strm->next_out - copy, dist); +- copy -= dist; +- if (copy) { +- zmemcpy(state->window, strm->next_out - copy, copy); +- state->write = copy; +- state->whave = state->wsize; +- } +- else { +- state->write += dist; +- if (state->write == state->wsize) state->write = 0; +- if (state->whave < state->wsize) state->whave += dist; +- } +- } +- return 0; +-} +- +-/* Macros for inflate(): */ +- +-/* check function to use adler32() for zlib or crc32() for gzip */ +-#ifdef GUNZIP +-# define UPDATE(check, buf, len) \ +- (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) +-#else +-# define UPDATE(check, buf, len) adler32(check, buf, len) +-#endif +- +-/* check macros for header crc */ +-#ifdef GUNZIP +-# define CRC2(check, word) \ +- do { \ +- hbuf[0] = (unsigned char)(word); \ +- hbuf[1] = (unsigned char)((word) >> 8); \ +- check = crc32(check, hbuf, 2); \ +- } while (0) +- +-# define CRC4(check, word) \ +- do { \ +- hbuf[0] = (unsigned char)(word); \ +- hbuf[1] = (unsigned char)((word) >> 8); \ +- hbuf[2] = (unsigned char)((word) >> 16); \ +- hbuf[3] = (unsigned char)((word) >> 24); \ +- check = crc32(check, hbuf, 4); \ +- } while (0) +-#endif +- +-/* Load registers with state in inflate() for speed */ +-#define LOAD() \ +- do { \ +- put = strm->next_out; \ +- left = strm->avail_out; \ +- next = strm->next_in; \ +- have = strm->avail_in; \ +- hold = state->hold; \ +- bits = state->bits; \ +- } while (0) +- +-/* Restore state from registers in inflate() */ +-#define RESTORE() \ +- do { \ +- strm->next_out = put; \ +- strm->avail_out = left; \ +- strm->next_in = next; \ +- strm->avail_in = have; \ +- state->hold = hold; \ +- state->bits = bits; \ +- } while (0) +- +-/* Clear the input bit accumulator */ +-#define INITBITS() \ +- do { \ +- hold = 0; \ +- bits = 0; \ +- } while (0) +- +-/* Get a byte of input into the bit accumulator, or return from inflate() +- if there is no input available. */ +-#define PULLBYTE() \ +- do { \ +- if (have == 0) goto inf_leave; \ +- have--; \ +- hold += (unsigned long)(*next++) << bits; \ +- bits += 8; \ +- } while (0) +- +-/* Assure that there are at least n bits in the bit accumulator. If there is +- not enough available input to do that, then return from inflate(). */ +-#define NEEDBITS(n) \ +- do { \ +- while (bits < (unsigned)(n)) \ +- PULLBYTE(); \ +- } while (0) +- +-/* Return the low n bits of the bit accumulator (n < 16) */ +-#define BITS(n) \ +- ((unsigned)hold & ((1U << (n)) - 1)) +- +-/* Remove n bits from the bit accumulator */ +-#define DROPBITS(n) \ +- do { \ +- hold >>= (n); \ +- bits -= (unsigned)(n); \ +- } while (0) +- +-/* Remove zero to seven bits as needed to go to a byte boundary */ +-#define BYTEBITS() \ +- do { \ +- hold >>= bits & 7; \ +- bits -= bits & 7; \ +- } while (0) +- +-/* Reverse the bytes in a 32-bit value */ +-#define REVERSE(q) \ +- ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ +- (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) +- +-/* +- inflate() uses a state machine to process as much input data and generate as +- much output data as possible before returning. The state machine is +- structured roughly as follows: +- +- for (;;) switch (state) { +- ... +- case STATEn: +- if (not enough input data or output space to make progress) +- return; +- ... make progress ... +- state = STATEm; +- break; +- ... +- } +- +- so when inflate() is called again, the same case is attempted again, and +- if the appropriate resources are provided, the machine proceeds to the +- next state. The NEEDBITS() macro is usually the way the state evaluates +- whether it can proceed or should return. NEEDBITS() does the return if +- the requested bits are not available. The typical use of the BITS macros +- is: +- +- NEEDBITS(n); +- ... do something with BITS(n) ... +- DROPBITS(n); +- +- where NEEDBITS(n) either returns from inflate() if there isn't enough +- input left to load n bits into the accumulator, or it continues. BITS(n) +- gives the low n bits in the accumulator. When done, DROPBITS(n) drops +- the low n bits off the accumulator. INITBITS() clears the accumulator +- and sets the number of available bits to zero. BYTEBITS() discards just +- enough bits to put the accumulator on a byte boundary. After BYTEBITS() +- and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. +- +- NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return +- if there is no input available. The decoding of variable length codes uses +- PULLBYTE() directly in order to pull just enough bytes to decode the next +- code, and no more. +- +- Some states loop until they get enough input, making sure that enough +- state information is maintained to continue the loop where it left off +- if NEEDBITS() returns in the loop. For example, want, need, and keep +- would all have to actually be part of the saved state in case NEEDBITS() +- returns: +- +- case STATEw: +- while (want < need) { +- NEEDBITS(n); +- keep[want++] = BITS(n); +- DROPBITS(n); +- } +- state = STATEx; +- case STATEx: +- +- As shown above, if the next state is also the next case, then the break +- is omitted. +- +- A state may also return if there is not enough output space available to +- complete that state. Those states are copying stored data, writing a +- literal byte, and copying a matching string. +- +- When returning, a "goto inf_leave" is used to update the total counters, +- update the check value, and determine whether any progress has been made +- during that inflate() call in order to return the proper return code. +- Progress is defined as a change in either strm->avail_in or strm->avail_out. +- When there is a window, goto inf_leave will update the window with the last +- output written. If a goto inf_leave occurs in the middle of decompression +- and there is no window currently, goto inf_leave will create one and copy +- output to the window for the next call of inflate(). +- +- In this implementation, the flush parameter of inflate() only affects the +- return code (per zlib.h). inflate() always writes as much as possible to +- strm->next_out, given the space available and the provided input--the effect +- documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers +- the allocation of and copying into a sliding window until necessary, which +- provides the effect documented in zlib.h for Z_FINISH when the entire input +- stream available. So the only thing the flush parameter actually does is: +- when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it +- will return Z_BUF_ERROR if it has not reached the end of the stream. +- */ +- +-int ZEXPORT inflate(strm, flush) +-z_streamp strm; +-int flush; +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *next; /* next input */ +- unsigned char FAR *put; /* next output */ +- unsigned have, left; /* available input and output */ +- unsigned long hold; /* bit buffer */ +- unsigned bits; /* bits in bit buffer */ +- unsigned in, out; /* save starting available input and output */ +- unsigned copy; /* number of stored or match bytes to copy */ +- unsigned char FAR *from; /* where to copy match bytes from */ +- code this; /* current decoding table entry */ +- code last; /* parent table entry */ +- unsigned len; /* length to copy for repeats, bits to drop */ +- int ret; /* return code */ +-#ifdef GUNZIP +- unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ +-#endif +- static const unsigned short order[19] = /* permutation of code lengths */ +- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; +- +- if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL || +- (strm->next_in == Z_NULL && strm->avail_in != 0)) +- return Z_STREAM_ERROR; +- +- state = (struct inflate_state FAR *)strm->state; +- if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ +- LOAD(); +- in = have; +- out = left; +- ret = Z_OK; +- for (;;) +- switch (state->mode) { +- case HEAD: +- if (state->wrap == 0) { +- state->mode = TYPEDO; +- break; +- } +- NEEDBITS(16); +-#ifdef GUNZIP +- if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ +- state->check = crc32(0L, Z_NULL, 0); +- CRC2(state->check, hold); +- INITBITS(); +- state->mode = FLAGS; +- break; +- } +- state->flags = 0; /* expect zlib header */ +- if (state->head != Z_NULL) +- state->head->done = -1; +- if (!(state->wrap & 1) || /* check if zlib header allowed */ +-#else +- if ( +-#endif +- ((BITS(8) << 8) + (hold >> 8)) % 31) { +- strm->msg = (char *)"incorrect header check"; +- state->mode = BAD; +- break; +- } +- if (BITS(4) != Z_DEFLATED) { +- strm->msg = (char *)"unknown compression method"; +- state->mode = BAD; +- break; +- } +- DROPBITS(4); +- len = BITS(4) + 8; +- if (len > state->wbits) { +- strm->msg = (char *)"invalid window size"; +- state->mode = BAD; +- break; +- } +- state->dmax = 1U << len; +- Tracev((stderr, "inflate: zlib header ok\n")); +- strm->adler = state->check = adler32(0L, Z_NULL, 0); +- state->mode = hold & 0x200 ? DICTID : TYPE; +- INITBITS(); +- break; +-#ifdef GUNZIP +- case FLAGS: +- NEEDBITS(16); +- state->flags = (int)(hold); +- if ((state->flags & 0xff) != Z_DEFLATED) { +- strm->msg = (char *)"unknown compression method"; +- state->mode = BAD; +- break; +- } +- if (state->flags & 0xe000) { +- strm->msg = (char *)"unknown header flags set"; +- state->mode = BAD; +- break; +- } +- if (state->head != Z_NULL) +- state->head->text = (int)((hold >> 8) & 1); +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- state->mode = TIME; +- case TIME: +- NEEDBITS(32); +- if (state->head != Z_NULL) +- state->head->time = hold; +- if (state->flags & 0x0200) CRC4(state->check, hold); +- INITBITS(); +- state->mode = OS; +- case OS: +- NEEDBITS(16); +- if (state->head != Z_NULL) { +- state->head->xflags = (int)(hold & 0xff); +- state->head->os = (int)(hold >> 8); +- } +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- state->mode = EXLEN; +- case EXLEN: +- if (state->flags & 0x0400) { +- NEEDBITS(16); +- state->length = (unsigned)(hold); +- if (state->head != Z_NULL) +- state->head->extra_len = (unsigned)hold; +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- } +- else if (state->head != Z_NULL) +- state->head->extra = Z_NULL; +- state->mode = EXTRA; +- case EXTRA: +- if (state->flags & 0x0400) { +- copy = state->length; +- if (copy > have) copy = have; +- if (copy) { +- if (state->head != Z_NULL && +- state->head->extra != Z_NULL) { +- len = state->head->extra_len - state->length; +- zmemcpy(state->head->extra + len, next, +- len + copy > state->head->extra_max ? +- state->head->extra_max - len : copy); +- } +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- state->length -= copy; +- } +- if (state->length) goto inf_leave; +- } +- state->length = 0; +- state->mode = NAME; +- case NAME: +- if (state->flags & 0x0800) { +- if (have == 0) goto inf_leave; +- copy = 0; +- do { +- len = (unsigned)(next[copy++]); +- if (state->head != Z_NULL && +- state->head->name != Z_NULL && +- state->length < state->head->name_max) +- state->head->name[state->length++] = len; +- } while (len && copy < have); +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- if (len) goto inf_leave; +- } +- else if (state->head != Z_NULL) +- state->head->name = Z_NULL; +- state->length = 0; +- state->mode = COMMENT; +- case COMMENT: +- if (state->flags & 0x1000) { +- if (have == 0) goto inf_leave; +- copy = 0; +- do { +- len = (unsigned)(next[copy++]); +- if (state->head != Z_NULL && +- state->head->comment != Z_NULL && +- state->length < state->head->comm_max) +- state->head->comment[state->length++] = len; +- } while (len && copy < have); +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- if (len) goto inf_leave; +- } +- else if (state->head != Z_NULL) +- state->head->comment = Z_NULL; +- state->mode = HCRC; +- case HCRC: +- if (state->flags & 0x0200) { +- NEEDBITS(16); +- if (hold != (state->check & 0xffff)) { +- strm->msg = (char *)"header crc mismatch"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- } +- if (state->head != Z_NULL) { +- state->head->hcrc = (int)((state->flags >> 9) & 1); +- state->head->done = 1; +- } +- strm->adler = state->check = crc32(0L, Z_NULL, 0); +- state->mode = TYPE; +- break; +-#endif +- case DICTID: +- NEEDBITS(32); +- strm->adler = state->check = REVERSE(hold); +- INITBITS(); +- state->mode = DICT; +- case DICT: +- if (state->havedict == 0) { +- RESTORE(); +- return Z_NEED_DICT; +- } +- strm->adler = state->check = adler32(0L, Z_NULL, 0); +- state->mode = TYPE; +- case TYPE: +- if (flush == Z_BLOCK) goto inf_leave; +- case TYPEDO: +- if (state->last) { +- BYTEBITS(); +- state->mode = CHECK; +- break; +- } +- NEEDBITS(3); +- state->last = BITS(1); +- DROPBITS(1); +- switch (BITS(2)) { +- case 0: /* stored block */ +- Tracev((stderr, "inflate: stored block%s\n", +- state->last ? " (last)" : "")); +- state->mode = STORED; +- break; +- case 1: /* fixed block */ +- fixedtables(state); +- Tracev((stderr, "inflate: fixed codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = LEN; /* decode codes */ +- break; +- case 2: /* dynamic block */ +- Tracev((stderr, "inflate: dynamic codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = TABLE; +- break; +- case 3: +- strm->msg = (char *)"invalid block type"; +- state->mode = BAD; +- } +- DROPBITS(2); +- break; +- case STORED: +- BYTEBITS(); /* go to byte boundary */ +- NEEDBITS(32); +- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { +- strm->msg = (char *)"invalid stored block lengths"; +- state->mode = BAD; +- break; +- } +- state->length = (unsigned)hold & 0xffff; +- Tracev((stderr, "inflate: stored length %u\n", +- state->length)); +- INITBITS(); +- state->mode = COPY; +- case COPY: +- copy = state->length; +- if (copy) { +- if (copy > have) copy = have; +- if (copy > left) copy = left; +- if (copy == 0) goto inf_leave; +- zmemcpy(put, next, copy); +- have -= copy; +- next += copy; +- left -= copy; +- put += copy; +- state->length -= copy; +- break; +- } +- Tracev((stderr, "inflate: stored end\n")); +- state->mode = TYPE; +- break; +- case TABLE: +- NEEDBITS(14); +- state->nlen = BITS(5) + 257; +- DROPBITS(5); +- state->ndist = BITS(5) + 1; +- DROPBITS(5); +- state->ncode = BITS(4) + 4; +- DROPBITS(4); +-#ifndef PKZIP_BUG_WORKAROUND +- if (state->nlen > 286 || state->ndist > 30) { +- strm->msg = (char *)"too many length or distance symbols"; +- state->mode = BAD; +- break; +- } +-#endif +- Tracev((stderr, "inflate: table sizes ok\n")); +- state->have = 0; +- state->mode = LENLENS; +- case LENLENS: +- while (state->have < state->ncode) { +- NEEDBITS(3); +- state->lens[order[state->have++]] = (unsigned short)BITS(3); +- DROPBITS(3); +- } +- while (state->have < 19) +- state->lens[order[state->have++]] = 0; +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 7; +- ret = inflate_table(CODES, state->lens, 19, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid code lengths set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: code lengths ok\n")); +- state->have = 0; +- state->mode = CODELENS; +- case CODELENS: +- while (state->have < state->nlen + state->ndist) { +- for (;;) { +- this = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if (this.val < 16) { +- NEEDBITS(this.bits); +- DROPBITS(this.bits); +- state->lens[state->have++] = this.val; +- } +- else { +- if (this.val == 16) { +- NEEDBITS(this.bits + 2); +- DROPBITS(this.bits); +- if (state->have == 0) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- len = state->lens[state->have - 1]; +- copy = 3 + BITS(2); +- DROPBITS(2); +- } +- else if (this.val == 17) { +- NEEDBITS(this.bits + 3); +- DROPBITS(this.bits); +- len = 0; +- copy = 3 + BITS(3); +- DROPBITS(3); +- } +- else { +- NEEDBITS(this.bits + 7); +- DROPBITS(this.bits); +- len = 0; +- copy = 11 + BITS(7); +- DROPBITS(7); +- } +- if (state->have + copy > state->nlen + state->ndist) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- while (copy--) +- state->lens[state->have++] = (unsigned short)len; +- } +- } +- +- /* handle error breaks in while */ +- if (state->mode == BAD) break; +- +- /* build code tables */ +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 9; +- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid literal/lengths set"; +- state->mode = BAD; +- break; +- } +- state->distcode = (code const FAR *)(state->next); +- state->distbits = 6; +- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, +- &(state->next), &(state->distbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid distances set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: codes ok\n")); +- state->mode = LEN; +- case LEN: +- if (have >= 6 && left >= 258) { +- RESTORE(); +- inflate_fast(strm, out); +- LOAD(); +- break; +- } +- for (;;) { +- this = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if (this.op && (this.op & 0xf0) == 0) { +- last = this; +- for (;;) { +- this = state->lencode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + this.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(this.bits); +- state->length = (unsigned)this.val; +- if ((int)(this.op) == 0) { +- Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", this.val)); +- state->mode = LIT; +- break; +- } +- if (this.op & 32) { +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- if (this.op & 64) { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- state->extra = (unsigned)(this.op) & 15; +- state->mode = LENEXT; +- case LENEXT: +- if (state->extra) { +- NEEDBITS(state->extra); +- state->length += BITS(state->extra); +- DROPBITS(state->extra); +- } +- Tracevv((stderr, "inflate: length %u\n", state->length)); +- state->mode = DIST; +- case DIST: +- for (;;) { +- this = state->distcode[BITS(state->distbits)]; +- if ((unsigned)(this.bits) <= bits) break; +- PULLBYTE(); +- } +- if ((this.op & 0xf0) == 0) { +- last = this; +- for (;;) { +- this = state->distcode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + this.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(this.bits); +- if (this.op & 64) { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- state->offset = (unsigned)this.val; +- state->extra = (unsigned)(this.op) & 15; +- state->mode = DISTEXT; +- case DISTEXT: +- if (state->extra) { +- NEEDBITS(state->extra); +- state->offset += BITS(state->extra); +- DROPBITS(state->extra); +- } +-#ifdef INFLATE_STRICT +- if (state->offset > state->dmax) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +-#endif +- if (state->offset > state->whave + out - left) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- Tracevv((stderr, "inflate: distance %u\n", state->offset)); +- state->mode = MATCH; +- case MATCH: +- if (left == 0) goto inf_leave; +- copy = out - left; +- if (state->offset > copy) { /* copy from window */ +- copy = state->offset - copy; +- if (copy > state->write) { +- copy -= state->write; +- from = state->window + (state->wsize - copy); +- } +- else +- from = state->window + (state->write - copy); +- if (copy > state->length) copy = state->length; +- } +- else { /* copy from output */ +- from = put - state->offset; +- copy = state->length; +- } +- if (copy > left) copy = left; +- left -= copy; +- state->length -= copy; +- do { +- *put++ = *from++; +- } while (--copy); +- if (state->length == 0) state->mode = LEN; +- break; +- case LIT: +- if (left == 0) goto inf_leave; +- *put++ = (unsigned char)(state->length); +- left--; +- state->mode = LEN; +- break; +- case CHECK: +- if (state->wrap) { +- NEEDBITS(32); +- out -= left; +- strm->total_out += out; +- state->total += out; +- if (out) +- strm->adler = state->check = +- UPDATE(state->check, put - out, out); +- out = left; +- if (( +-#ifdef GUNZIP +- state->flags ? hold : +-#endif +- REVERSE(hold)) != state->check) { +- strm->msg = (char *)"incorrect data check"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- Tracev((stderr, "inflate: check matches trailer\n")); +- } +-#ifdef GUNZIP +- state->mode = LENGTH; +- case LENGTH: +- if (state->wrap && state->flags) { +- NEEDBITS(32); +- if (hold != (state->total & 0xffffffffUL)) { +- strm->msg = (char *)"incorrect length check"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- Tracev((stderr, "inflate: length matches trailer\n")); +- } +-#endif +- state->mode = DONE; +- case DONE: +- ret = Z_STREAM_END; +- goto inf_leave; +- case BAD: +- ret = Z_DATA_ERROR; +- goto inf_leave; +- case MEM: +- return Z_MEM_ERROR; +- case SYNC: +- default: +- return Z_STREAM_ERROR; +- } +- +- /* +- Return from inflate(), updating the total counts and the check value. +- If there was no progress during the inflate() call, return a buffer +- error. Call updatewindow() to create and/or update the window state. +- Note: a memory error from inflate() is non-recoverable. +- */ +- inf_leave: +- RESTORE(); +- if (state->wsize || (state->mode < CHECK && out != strm->avail_out)) +- if (updatewindow(strm, out)) { +- state->mode = MEM; +- return Z_MEM_ERROR; +- } +- in -= strm->avail_in; +- out -= strm->avail_out; +- strm->total_in += in; +- strm->total_out += out; +- state->total += out; +- if (state->wrap && out) +- strm->adler = state->check = +- UPDATE(state->check, strm->next_out - out, out); +- strm->data_type = state->bits + (state->last ? 64 : 0) + +- (state->mode == TYPE ? 128 : 0); +- if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) +- ret = Z_BUF_ERROR; +- return ret; +-} +- +-int ZEXPORT inflateEnd(strm) +-z_streamp strm; +-{ +- struct inflate_state FAR *state; +- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (state->window != Z_NULL) ZFREE(strm, state->window); +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- Tracev((stderr, "inflate: end\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength) +-z_streamp strm; +-const Bytef *dictionary; +-uInt dictLength; +-{ +- struct inflate_state FAR *state; +- unsigned long id; +- +- /* check state */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (state->wrap != 0 && state->mode != DICT) +- return Z_STREAM_ERROR; +- +- /* check for correct dictionary id */ +- if (state->mode == DICT) { +- id = adler32(0L, Z_NULL, 0); +- id = adler32(id, dictionary, dictLength); +- if (id != state->check) +- return Z_DATA_ERROR; +- } +- +- /* copy dictionary to window */ +- if (updatewindow(strm, strm->avail_out)) { +- state->mode = MEM; +- return Z_MEM_ERROR; +- } +- if (dictLength > state->wsize) { +- zmemcpy(state->window, dictionary + dictLength - state->wsize, +- state->wsize); +- state->whave = state->wsize; +- } +- else { +- zmemcpy(state->window + state->wsize - dictLength, dictionary, +- dictLength); +- state->whave = dictLength; +- } +- state->havedict = 1; +- Tracev((stderr, "inflate: dictionary set\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflateGetHeader(strm, head) +-z_streamp strm; +-gz_headerp head; +-{ +- struct inflate_state FAR *state; +- +- /* check state */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; +- +- /* save header structure */ +- state->head = head; +- head->done = 0; +- return Z_OK; +-} +- +-/* +- Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found +- or when out of input. When called, *have is the number of pattern bytes +- found in order so far, in 0..3. On return *have is updated to the new +- state. If on return *have equals four, then the pattern was found and the +- return value is how many bytes were read including the last byte of the +- pattern. If *have is less than four, then the pattern has not been found +- yet and the return value is len. In the latter case, syncsearch() can be +- called again with more data and the *have state. *have is initialized to +- zero for the first call. +- */ +-local unsigned syncsearch(have, buf, len) +-unsigned FAR *have; +-unsigned char FAR *buf; +-unsigned len; +-{ +- unsigned got; +- unsigned next; +- +- got = *have; +- next = 0; +- while (next < len && got < 4) { +- if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) +- got++; +- else if (buf[next]) +- got = 0; +- else +- got = 4 - got; +- next++; +- } +- *have = got; +- return next; +-} +- +-int ZEXPORT inflateSync(strm) +-z_streamp strm; +-{ +- unsigned len; /* number of bytes to look at or looked at */ +- unsigned long in, out; /* temporary to save total_in and total_out */ +- unsigned char buf[4]; /* to restore bit buffer to byte string */ +- struct inflate_state FAR *state; +- +- /* check parameters */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; +- +- /* if first time, start search in bit buffer */ +- if (state->mode != SYNC) { +- state->mode = SYNC; +- state->hold <<= state->bits & 7; +- state->bits -= state->bits & 7; +- len = 0; +- while (state->bits >= 8) { +- buf[len++] = (unsigned char)(state->hold); +- state->hold >>= 8; +- state->bits -= 8; +- } +- state->have = 0; +- syncsearch(&(state->have), buf, len); +- } +- +- /* search available input */ +- len = syncsearch(&(state->have), strm->next_in, strm->avail_in); +- strm->avail_in -= len; +- strm->next_in += len; +- strm->total_in += len; +- +- /* return no joy or set up to restart inflate() on a new block */ +- if (state->have != 4) return Z_DATA_ERROR; +- in = strm->total_in; out = strm->total_out; +- inflateReset(strm); +- strm->total_in = in; strm->total_out = out; +- state->mode = TYPE; +- return Z_OK; +-} +- +-/* +- Returns true if inflate is currently at the end of a block generated by +- Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP +- implementation to provide an additional safety check. PPP uses +- Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored +- block. When decompressing, PPP checks that at the end of input packet, +- inflate is waiting for these length bytes. +- */ +-int ZEXPORT inflateSyncPoint(strm) +-z_streamp strm; +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- return state->mode == STORED && state->bits == 0; +-} +- +-int ZEXPORT inflateCopy(dest, source) +-z_streamp dest; +-z_streamp source; +-{ +- struct inflate_state FAR *state; +- struct inflate_state FAR *copy; +- unsigned char FAR *window; +- unsigned wsize; +- +- /* check input */ +- if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL || +- source->zalloc == (alloc_func)0 || source->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)source->state; +- +- /* allocate space */ +- copy = (struct inflate_state FAR *) +- ZALLOC(source, 1, sizeof(struct inflate_state)); +- if (copy == Z_NULL) return Z_MEM_ERROR; +- window = Z_NULL; +- if (state->window != Z_NULL) { +- window = (unsigned char FAR *) +- ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); +- if (window == Z_NULL) { +- ZFREE(source, copy); +- return Z_MEM_ERROR; +- } +- } +- +- /* copy state */ +- zmemcpy(dest, source, sizeof(z_stream)); +- zmemcpy(copy, state, sizeof(struct inflate_state)); +- if (state->lencode >= state->codes && +- state->lencode <= state->codes + ENOUGH - 1) { +- copy->lencode = copy->codes + (state->lencode - state->codes); +- copy->distcode = copy->codes + (state->distcode - state->codes); +- } +- copy->next = copy->codes + (state->next - state->codes); +- if (window != Z_NULL) { +- wsize = 1U << state->wbits; +- zmemcpy(window, state->window, wsize); +- } +- copy->window = window; +- dest->state = (struct internal_state FAR *)copy; +- return Z_OK; +-} +diff -ruN RJaCGH.orig/src/inflate.h RJaCGH/src/inflate.h +--- RJaCGH.orig/src/inflate.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inflate.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,115 +0,0 @@ +-/* inflate.h -- internal inflate state definition +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* define NO_GZIP when compiling if you want to disable gzip header and +- trailer decoding by inflate(). NO_GZIP would be used to avoid linking in +- the crc code when it is not needed. For shared libraries, gzip decoding +- should be left enabled. */ +-#ifndef NO_GZIP +-# define GUNZIP +-#endif +- +-/* Possible inflate modes between inflate() calls */ +-typedef enum { +- HEAD, /* i: waiting for magic header */ +- FLAGS, /* i: waiting for method and flags (gzip) */ +- TIME, /* i: waiting for modification time (gzip) */ +- OS, /* i: waiting for extra flags and operating system (gzip) */ +- EXLEN, /* i: waiting for extra length (gzip) */ +- EXTRA, /* i: waiting for extra bytes (gzip) */ +- NAME, /* i: waiting for end of file name (gzip) */ +- COMMENT, /* i: waiting for end of comment (gzip) */ +- HCRC, /* i: waiting for header crc (gzip) */ +- DICTID, /* i: waiting for dictionary check value */ +- DICT, /* waiting for inflateSetDictionary() call */ +- TYPE, /* i: waiting for type bits, including last-flag bit */ +- TYPEDO, /* i: same, but skip check to exit inflate on new block */ +- STORED, /* i: waiting for stored size (length and complement) */ +- COPY, /* i/o: waiting for input or output to copy stored block */ +- TABLE, /* i: waiting for dynamic block table lengths */ +- LENLENS, /* i: waiting for code length code lengths */ +- CODELENS, /* i: waiting for length/lit and distance code lengths */ +- LEN, /* i: waiting for length/lit code */ +- LENEXT, /* i: waiting for length extra bits */ +- DIST, /* i: waiting for distance code */ +- DISTEXT, /* i: waiting for distance extra bits */ +- MATCH, /* o: waiting for output space to copy string */ +- LIT, /* o: waiting for output space to write literal */ +- CHECK, /* i: waiting for 32-bit check value */ +- LENGTH, /* i: waiting for 32-bit length (gzip) */ +- DONE, /* finished check, done -- remain here until reset */ +- BAD, /* got a data error -- remain here until reset */ +- MEM, /* got an inflate() memory error -- remain here until reset */ +- SYNC /* looking for synchronization bytes to restart inflate() */ +-} inflate_mode; +- +-/* +- State transitions between above modes - +- +- (most modes can go to the BAD or MEM mode -- not shown for clarity) +- +- Process header: +- HEAD -> (gzip) or (zlib) +- (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME +- NAME -> COMMENT -> HCRC -> TYPE +- (zlib) -> DICTID or TYPE +- DICTID -> DICT -> TYPE +- Read deflate blocks: +- TYPE -> STORED or TABLE or LEN or CHECK +- STORED -> COPY -> TYPE +- TABLE -> LENLENS -> CODELENS -> LEN +- Read deflate codes: +- LEN -> LENEXT or LIT or TYPE +- LENEXT -> DIST -> DISTEXT -> MATCH -> LEN +- LIT -> LEN +- Process trailer: +- CHECK -> LENGTH -> DONE +- */ +- +-/* state maintained between inflate() calls. Approximately 7K bytes. */ +-struct inflate_state { +- inflate_mode mode; /* current inflate mode */ +- int last; /* true if processing last block */ +- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ +- int havedict; /* true if dictionary provided */ +- int flags; /* gzip header method and flags (0 if zlib) */ +- unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ +- unsigned long check; /* protected copy of check value */ +- unsigned long total; /* protected copy of output count */ +- gz_headerp head; /* where to save gzip header information */ +- /* sliding window */ +- unsigned wbits; /* log base 2 of requested window size */ +- unsigned wsize; /* window size or zero if not using window */ +- unsigned whave; /* valid bytes in the window */ +- unsigned write; /* window write index */ +- unsigned char FAR *window; /* allocated sliding window, if needed */ +- /* bit accumulator */ +- unsigned long hold; /* input bit accumulator */ +- unsigned bits; /* number of bits in "in" */ +- /* for string and stored block copying */ +- unsigned length; /* literal or length of data to copy */ +- unsigned offset; /* distance back to copy string from */ +- /* for table and code decoding */ +- unsigned extra; /* extra bits needed */ +- /* fixed and dynamic code tables */ +- code const FAR *lencode; /* starting table for length/literal codes */ +- code const FAR *distcode; /* starting table for distance codes */ +- unsigned lenbits; /* index bits for lencode */ +- unsigned distbits; /* index bits for distcode */ +- /* dynamic table building */ +- unsigned ncode; /* number of code length code lengths */ +- unsigned nlen; /* number of length code lengths */ +- unsigned ndist; /* number of distance code lengths */ +- unsigned have; /* number of code lengths in lens[] */ +- code FAR *next; /* next available space in codes[] */ +- unsigned short lens[320]; /* temporary storage for code lengths */ +- unsigned short work[288]; /* work area for code table building */ +- code codes[ENOUGH]; /* space for code tables */ +-}; +diff -ruN RJaCGH.orig/src/inftrees.c RJaCGH/src/inftrees.c +--- RJaCGH.orig/src/inftrees.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inftrees.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,329 +0,0 @@ +-/* inftrees.c -- generate Huffman trees for efficient decoding +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +- +-#define MAXBITS 15 +- +-const char inflate_copyright[] = +- " inflate 1.2.3 Copyright 1995-2005 Mark Adler "; +-/* +- If you use the zlib library in a product, an acknowledgment is welcome +- in the documentation of your product. If for some reason you cannot +- include such an acknowledgment, I would appreciate that you keep this +- copyright string in the executable of your product. +- */ +- +-/* +- Build a set of tables to decode the provided canonical Huffman code. +- The code lengths are lens[0..codes-1]. The result starts at *table, +- whose indices are 0..2^bits-1. work is a writable array of at least +- lens shorts, which is used as a work area. type is the type of code +- to be generated, CODES, LENS, or DISTS. On return, zero is success, +- -1 is an invalid code, and +1 means that ENOUGH isn't enough. table +- on return points to the next available entry's address. bits is the +- requested root table index bits, and on return it is the actual root +- table index bits. It will differ if the request is greater than the +- longest code or if it is less than the shortest code. +- */ +-int inflate_table(type, lens, codes, table, bits, work) +-codetype type; +-unsigned short FAR *lens; +-unsigned codes; +-code FAR * FAR *table; +-unsigned FAR *bits; +-unsigned short FAR *work; +-{ +- unsigned len; /* a code's length in bits */ +- unsigned sym; /* index of code symbols */ +- unsigned min, max; /* minimum and maximum code lengths */ +- unsigned root; /* number of index bits for root table */ +- unsigned curr; /* number of index bits for current table */ +- unsigned drop; /* code bits to drop for sub-table */ +- int left; /* number of prefix codes available */ +- unsigned used; /* code entries in table used */ +- unsigned huff; /* Huffman code */ +- unsigned incr; /* for incrementing code, index */ +- unsigned fill; /* index for replicating entries */ +- unsigned low; /* low bits for current root entry */ +- unsigned mask; /* mask for low root bits */ +- code this; /* table entry for duplication */ +- code FAR *next; /* next available space in table */ +- const unsigned short FAR *base; /* base value table to use */ +- const unsigned short FAR *extra; /* extra bits table to use */ +- int end; /* use base and extra for symbol > end */ +- unsigned short count[MAXBITS+1]; /* number of codes of each length */ +- unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ +- static const unsigned short lbase[31] = { /* Length codes 257..285 base */ +- 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, +- 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; +- static const unsigned short lext[31] = { /* Length codes 257..285 extra */ +- 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, +- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 201, 196}; +- static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ +- 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, +- 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, +- 8193, 12289, 16385, 24577, 0, 0}; +- static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ +- 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, +- 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, +- 28, 28, 29, 29, 64, 64}; +- +- /* +- Process a set of code lengths to create a canonical Huffman code. The +- code lengths are lens[0..codes-1]. Each length corresponds to the +- symbols 0..codes-1. The Huffman code is generated by first sorting the +- symbols by length from short to long, and retaining the symbol order +- for codes with equal lengths. Then the code starts with all zero bits +- for the first code of the shortest length, and the codes are integer +- increments for the same length, and zeros are appended as the length +- increases. For the deflate format, these bits are stored backwards +- from their more natural integer increment ordering, and so when the +- decoding tables are built in the large loop below, the integer codes +- are incremented backwards. +- +- This routine assumes, but does not check, that all of the entries in +- lens[] are in the range 0..MAXBITS. The caller must assure this. +- 1..MAXBITS is interpreted as that code length. zero means that that +- symbol does not occur in this code. +- +- The codes are sorted by computing a count of codes for each length, +- creating from that a table of starting indices for each length in the +- sorted table, and then entering the symbols in order in the sorted +- table. The sorted table is work[], with that space being provided by +- the caller. +- +- The length counts are used for other purposes as well, i.e. finding +- the minimum and maximum length codes, determining if there are any +- codes at all, checking for a valid set of lengths, and looking ahead +- at length counts to determine sub-table sizes when building the +- decoding tables. +- */ +- +- /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ +- for (len = 0; len <= MAXBITS; len++) +- count[len] = 0; +- for (sym = 0; sym < codes; sym++) +- count[lens[sym]]++; +- +- /* bound code lengths, force root to be within code lengths */ +- root = *bits; +- for (max = MAXBITS; max >= 1; max--) +- if (count[max] != 0) break; +- if (root > max) root = max; +- if (max == 0) { /* no symbols to code at all */ +- this.op = (unsigned char)64; /* invalid code marker */ +- this.bits = (unsigned char)1; +- this.val = (unsigned short)0; +- *(*table)++ = this; /* make a table to force an error */ +- *(*table)++ = this; +- *bits = 1; +- return 0; /* no symbols, but wait for decoding to report error */ +- } +- for (min = 1; min <= MAXBITS; min++) +- if (count[min] != 0) break; +- if (root < min) root = min; +- +- /* check for an over-subscribed or incomplete set of lengths */ +- left = 1; +- for (len = 1; len <= MAXBITS; len++) { +- left <<= 1; +- left -= count[len]; +- if (left < 0) return -1; /* over-subscribed */ +- } +- if (left > 0 && (type == CODES || max != 1)) +- return -1; /* incomplete set */ +- +- /* generate offsets into symbol table for each length for sorting */ +- offs[1] = 0; +- for (len = 1; len < MAXBITS; len++) +- offs[len + 1] = offs[len] + count[len]; +- +- /* sort symbols by length, by symbol order within each length */ +- for (sym = 0; sym < codes; sym++) +- if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; +- +- /* +- Create and fill in decoding tables. In this loop, the table being +- filled is at next and has curr index bits. The code being used is huff +- with length len. That code is converted to an index by dropping drop +- bits off of the bottom. For codes where len is less than drop + curr, +- those top drop + curr - len bits are incremented through all values to +- fill the table with replicated entries. +- +- root is the number of index bits for the root table. When len exceeds +- root, sub-tables are created pointed to by the root entry with an index +- of the low root bits of huff. This is saved in low to check for when a +- new sub-table should be started. drop is zero when the root table is +- being filled, and drop is root when sub-tables are being filled. +- +- When a new sub-table is needed, it is necessary to look ahead in the +- code lengths to determine what size sub-table is needed. The length +- counts are used for this, and so count[] is decremented as codes are +- entered in the tables. +- +- used keeps track of how many table entries have been allocated from the +- provided *table space. It is checked when a LENS table is being made +- against the space in *table, ENOUGH, minus the maximum space needed by +- the worst case distance code, MAXD. This should never happen, but the +- sufficiency of ENOUGH has not been proven exhaustively, hence the check. +- This assumes that when type == LENS, bits == 9. +- +- sym increments through all symbols, and the loop terminates when +- all codes of length max, i.e. all codes, have been processed. This +- routine permits incomplete codes, so another loop after this one fills +- in the rest of the decoding tables with invalid code markers. +- */ +- +- /* set up for code type */ +- switch (type) { +- case CODES: +- base = extra = work; /* dummy value--not used */ +- end = 19; +- break; +- case LENS: +- base = lbase; +- base -= 257; +- extra = lext; +- extra -= 257; +- end = 256; +- break; +- default: /* DISTS */ +- base = dbase; +- extra = dext; +- end = -1; +- } +- +- /* initialize state for loop */ +- huff = 0; /* starting code */ +- sym = 0; /* starting code symbol */ +- len = min; /* starting code length */ +- next = *table; /* current table to fill in */ +- curr = root; /* current table index bits */ +- drop = 0; /* current bits to drop from code for index */ +- low = (unsigned)(-1); /* trigger new sub-table when len > root */ +- used = 1U << root; /* use root table entries */ +- mask = used - 1; /* mask for comparing low */ +- +- /* check available table space */ +- if (type == LENS && used >= ENOUGH - MAXD) +- return 1; +- +- /* process all codes and make table entries */ +- for (;;) { +- /* create table entry */ +- this.bits = (unsigned char)(len - drop); +- if ((int)(work[sym]) < end) { +- this.op = (unsigned char)0; +- this.val = work[sym]; +- } +- else if ((int)(work[sym]) > end) { +- this.op = (unsigned char)(extra[work[sym]]); +- this.val = base[work[sym]]; +- } +- else { +- this.op = (unsigned char)(32 + 64); /* end of block */ +- this.val = 0; +- } +- +- /* replicate for those indices with low len bits equal to huff */ +- incr = 1U << (len - drop); +- fill = 1U << curr; +- min = fill; /* save offset to next table */ +- do { +- fill -= incr; +- next[(huff >> drop) + fill] = this; +- } while (fill != 0); +- +- /* backwards increment the len-bit code huff */ +- incr = 1U << (len - 1); +- while (huff & incr) +- incr >>= 1; +- if (incr != 0) { +- huff &= incr - 1; +- huff += incr; +- } +- else +- huff = 0; +- +- /* go to next symbol, update count, len */ +- sym++; +- if (--(count[len]) == 0) { +- if (len == max) break; +- len = lens[work[sym]]; +- } +- +- /* create new sub-table if needed */ +- if (len > root && (huff & mask) != low) { +- /* if first time, transition to sub-tables */ +- if (drop == 0) +- drop = root; +- +- /* increment past last table */ +- next += min; /* here min is 1 << curr */ +- +- /* determine length of next table */ +- curr = len - drop; +- left = (int)(1 << curr); +- while (curr + drop < max) { +- left -= count[curr + drop]; +- if (left <= 0) break; +- curr++; +- left <<= 1; +- } +- +- /* check for enough space */ +- used += 1U << curr; +- if (type == LENS && used >= ENOUGH - MAXD) +- return 1; +- +- /* point entry in root table to sub-table */ +- low = huff & mask; +- (*table)[low].op = (unsigned char)curr; +- (*table)[low].bits = (unsigned char)root; +- (*table)[low].val = (unsigned short)(next - *table); +- } +- } +- +- /* +- Fill in rest of table for incomplete codes. This loop is similar to the +- loop above in incrementing huff for table indices. It is assumed that +- len is equal to curr + drop, so there is no loop needed to increment +- through high index bits. When the current sub-table is filled, the loop +- drops back to the root table to fill in any remaining entries there. +- */ +- this.op = (unsigned char)64; /* invalid code marker */ +- this.bits = (unsigned char)(len - drop); +- this.val = (unsigned short)0; +- while (huff != 0) { +- /* when done with sub-table, drop back to root table */ +- if (drop != 0 && (huff & mask) != low) { +- drop = 0; +- len = root; +- next = *table; +- this.bits = (unsigned char)len; +- } +- +- /* put invalid code marker in table */ +- next[huff >> drop] = this; +- +- /* backwards increment the len-bit code huff */ +- incr = 1U << (len - 1); +- while (huff & incr) +- incr >>= 1; +- if (incr != 0) { +- huff &= incr - 1; +- huff += incr; +- } +- else +- huff = 0; +- } +- +- /* set return parameters */ +- *table += used; +- *bits = root; +- return 0; +-} +diff -ruN RJaCGH.orig/src/inftrees.h RJaCGH/src/inftrees.h +--- RJaCGH.orig/src/inftrees.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/inftrees.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,55 +0,0 @@ +-/* inftrees.h -- header to use inftrees.c +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* Structure for decoding tables. Each entry provides either the +- information needed to do the operation requested by the code that +- indexed that table entry, or it provides a pointer to another +- table that indexes more bits of the code. op indicates whether +- the entry is a pointer to another table, a literal, a length or +- distance, an end-of-block, or an invalid code. For a table +- pointer, the low four bits of op is the number of index bits of +- that table. For a length or distance, the low four bits of op +- is the number of extra bits to get after the code. bits is +- the number of bits in this code or part of the code to drop off +- of the bit buffer. val is the actual byte to output in the case +- of a literal, the base length or distance, or the offset from +- the current table to the next table. Each entry is four bytes. */ +-typedef struct { +- unsigned char op; /* operation, extra bits, table bits */ +- unsigned char bits; /* bits in this part of the code */ +- unsigned short val; /* offset in table or code value */ +-} code; +- +-/* op values as set by inflate_table(): +- 00000000 - literal +- 0000tttt - table link, tttt != 0 is the number of table index bits +- 0001eeee - length or distance, eeee is the number of extra bits +- 01100000 - end of block +- 01000000 - invalid code +- */ +- +-/* Maximum size of dynamic tree. The maximum found in a long but non- +- exhaustive search was 1444 code structures (852 for length/literals +- and 592 for distances, the latter actually the result of an +- exhaustive search). The true maximum is not known, but the value +- below is more than safe. */ +-#define ENOUGH 2048 +-#define MAXD 592 +- +-/* Type of code to build for inftable() */ +-typedef enum { +- CODES, +- LENS, +- DISTS +-} codetype; +- +-extern int inflate_table OF((codetype type, unsigned short FAR *lens, +- unsigned codes, code FAR * FAR *table, +- unsigned FAR *bits, unsigned short FAR *work)); +diff -ruN RJaCGH.orig/src/Makevars RJaCGH/src/Makevars +--- RJaCGH.orig/src/Makevars 1970-01-01 01:00:00.000000000 +0100 ++++ RJaCGH/src/Makevars 2009-05-17 21:17:23.000000000 +0200 +@@ -0,0 +1 @@ ++PKG_LIBS=-lz +\ No newline at end of file +diff -ruN RJaCGH.orig/src/trees.c RJaCGH/src/trees.c +--- RJaCGH.orig/src/trees.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/trees.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1219 +0,0 @@ +-/* trees.c -- output deflated data using Huffman coding +- * Copyright (C) 1995-2005 Jean-loup Gailly +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * ALGORITHM +- * +- * The "deflation" process uses several Huffman trees. The more +- * common source values are represented by shorter bit sequences. +- * +- * Each code tree is stored in a compressed form which is itself +- * a Huffman encoding of the lengths of all the code strings (in +- * ascending order by source values). The actual code strings are +- * reconstructed from the lengths in the inflate process, as described +- * in the deflate specification. +- * +- * REFERENCES +- * +- * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". +- * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc +- * +- * Storer, James A. +- * Data Compression: Methods and Theory, pp. 49-50. +- * Computer Science Press, 1988. ISBN 0-7167-8156-5. +- * +- * Sedgewick, R. +- * Algorithms, p290. +- * Addison-Wesley, 1983. ISBN 0-201-06672-6. +- */ +- +-/* @(#) $Id$ */ +- +-/* #define GEN_TREES_H */ +- +-#include "deflate.h" +- +-#ifdef DEBUG +-# include +-#endif +- +-/* =========================================================================== +- * Constants +- */ +- +-#define MAX_BL_BITS 7 +-/* Bit length codes must not exceed MAX_BL_BITS bits */ +- +-#define END_BLOCK 256 +-/* end of block literal code */ +- +-#define REP_3_6 16 +-/* repeat previous bit length 3-6 times (2 bits of repeat count) */ +- +-#define REPZ_3_10 17 +-/* repeat a zero length 3-10 times (3 bits of repeat count) */ +- +-#define REPZ_11_138 18 +-/* repeat a zero length 11-138 times (7 bits of repeat count) */ +- +-local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ +- = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; +- +-local const int extra_dbits[D_CODES] /* extra bits for each distance code */ +- = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; +- +-local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ +- = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; +- +-local const uch bl_order[BL_CODES] +- = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; +-/* The lengths of the bit length codes are sent in order of decreasing +- * probability, to avoid transmitting the lengths for unused bit length codes. +- */ +- +-#define Buf_size (8 * 2*sizeof(char)) +-/* Number of bits used within bi_buf. (bi_buf might be implemented on +- * more than 16 bits on some systems.) +- */ +- +-/* =========================================================================== +- * Local data. These are initialized only once. +- */ +- +-#define DIST_CODE_LEN 512 /* see definition of array dist_code below */ +- +-#if defined(GEN_TREES_H) || !defined(STDC) +-/* non ANSI compilers may not accept trees.h */ +- +-local ct_data static_ltree[L_CODES+2]; +-/* The static literal tree. Since the bit lengths are imposed, there is no +- * need for the L_CODES extra codes used during heap construction. However +- * The codes 286 and 287 are needed to build a canonical tree (see _tr_init +- * below). +- */ +- +-local ct_data static_dtree[D_CODES]; +-/* The static distance tree. (Actually a trivial tree since all codes use +- * 5 bits.) +- */ +- +-uch _dist_code[DIST_CODE_LEN]; +-/* Distance codes. The first 256 values correspond to the distances +- * 3 .. 258, the last 256 values correspond to the top 8 bits of +- * the 15 bit distances. +- */ +- +-uch _length_code[MAX_MATCH-MIN_MATCH+1]; +-/* length code for each normalized match length (0 == MIN_MATCH) */ +- +-local int base_length[LENGTH_CODES]; +-/* First normalized length for each code (0 = MIN_MATCH) */ +- +-local int base_dist[D_CODES]; +-/* First normalized distance for each code (0 = distance of 1) */ +- +-#else +-# include "trees.h" +-#endif /* GEN_TREES_H */ +- +-struct static_tree_desc_s { +- const ct_data *static_tree; /* static tree or NULL */ +- const intf *extra_bits; /* extra bits for each code or NULL */ +- int extra_base; /* base index for extra_bits */ +- int elems; /* max number of elements in the tree */ +- int max_length; /* max bit length for the codes */ +-}; +- +-local static_tree_desc static_l_desc = +-{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; +- +-local static_tree_desc static_d_desc = +-{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; +- +-local static_tree_desc static_bl_desc = +-{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; +- +-/* =========================================================================== +- * Local (static) routines in this file. +- */ +- +-local void tr_static_init OF((void)); +-local void init_block OF((deflate_state *s)); +-local void pqdownheap OF((deflate_state *s, ct_data *tree, int k)); +-local void gen_bitlen OF((deflate_state *s, tree_desc *desc)); +-local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count)); +-local void build_tree OF((deflate_state *s, tree_desc *desc)); +-local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code)); +-local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); +-local int build_bl_tree OF((deflate_state *s)); +-local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, +- int blcodes)); +-local void compress_block OF((deflate_state *s, ct_data *ltree, +- ct_data *dtree)); +-local void set_data_type OF((deflate_state *s)); +-local unsigned bi_reverse OF((unsigned value, int length)); +-local void bi_windup OF((deflate_state *s)); +-local void bi_flush OF((deflate_state *s)); +-local void copy_block OF((deflate_state *s, charf *buf, unsigned len, +- int header)); +- +-#ifdef GEN_TREES_H +-local void gen_trees_header OF((void)); +-#endif +- +-#ifndef DEBUG +-# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) +- /* Send a code of the given tree. c and tree must not have side effects */ +- +-#else /* DEBUG */ +-# define send_code(s, c, tree) \ +- { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ +- send_bits(s, tree[c].Code, tree[c].Len); } +-#endif +- +-/* =========================================================================== +- * Output a short LSB first on the stream. +- * IN assertion: there is enough room in pendingBuf. +- */ +-#define put_short(s, w) { \ +- put_byte(s, (uch)((w) & 0xff)); \ +- put_byte(s, (uch)((ush)(w) >> 8)); \ +-} +- +-/* =========================================================================== +- * Send a value on a given number of bits. +- * IN assertion: length <= 16 and value fits in length bits. +- */ +-#ifdef DEBUG +-local void send_bits OF((deflate_state *s, int value, int length)); +- +-local void send_bits(s, value, length) +- deflate_state *s; +- int value; /* value to send */ +- int length; /* number of bits */ +-{ +- Tracevv((stderr," l %2d v %4x ", length, value)); +- Assert(length > 0 && length <= 15, "invalid length"); +- s->bits_sent += (ulg)length; +- +- /* If not enough room in bi_buf, use (valid) bits from bi_buf and +- * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) +- * unused bits in value. +- */ +- if (s->bi_valid > (int)Buf_size - length) { +- s->bi_buf |= (value << s->bi_valid); +- put_short(s, s->bi_buf); +- s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); +- s->bi_valid += length - Buf_size; +- } else { +- s->bi_buf |= value << s->bi_valid; +- s->bi_valid += length; +- } +-} +-#else /* !DEBUG */ +- +-#define send_bits(s, value, length) \ +-{ int len = length;\ +- if (s->bi_valid > (int)Buf_size - len) {\ +- int val = value;\ +- s->bi_buf |= (val << s->bi_valid);\ +- put_short(s, s->bi_buf);\ +- s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ +- s->bi_valid += len - Buf_size;\ +- } else {\ +- s->bi_buf |= (value) << s->bi_valid;\ +- s->bi_valid += len;\ +- }\ +-} +-#endif /* DEBUG */ +- +- +-/* the arguments must not have side effects */ +- +-/* =========================================================================== +- * Initialize the various 'constant' tables. +- */ +-local void tr_static_init() +-{ +-#if defined(GEN_TREES_H) || !defined(STDC) +- static int static_init_done = 0; +- int n; /* iterates over tree elements */ +- int bits; /* bit counter */ +- int length; /* length value */ +- int code; /* code value */ +- int dist; /* distance index */ +- ush bl_count[MAX_BITS+1]; +- /* number of codes at each bit length for an optimal tree */ +- +- if (static_init_done) return; +- +- /* For some embedded targets, global variables are not initialized: */ +- static_l_desc.static_tree = static_ltree; +- static_l_desc.extra_bits = extra_lbits; +- static_d_desc.static_tree = static_dtree; +- static_d_desc.extra_bits = extra_dbits; +- static_bl_desc.extra_bits = extra_blbits; +- +- /* Initialize the mapping length (0..255) -> length code (0..28) */ +- length = 0; +- for (code = 0; code < LENGTH_CODES-1; code++) { +- base_length[code] = length; +- for (n = 0; n < (1< dist code (0..29) */ +- dist = 0; +- for (code = 0 ; code < 16; code++) { +- base_dist[code] = dist; +- for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ +- for ( ; code < D_CODES; code++) { +- base_dist[code] = dist << 7; +- for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { +- _dist_code[256 + dist++] = (uch)code; +- } +- } +- Assert (dist == 256, "tr_static_init: 256+dist != 512"); +- +- /* Construct the codes of the static literal tree */ +- for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; +- n = 0; +- while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; +- while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; +- while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; +- while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; +- /* Codes 286 and 287 do not exist, but we must include them in the +- * tree construction to get a canonical Huffman tree (longest code +- * all ones) +- */ +- gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); +- +- /* The static distance tree is trivial: */ +- for (n = 0; n < D_CODES; n++) { +- static_dtree[n].Len = 5; +- static_dtree[n].Code = bi_reverse((unsigned)n, 5); +- } +- static_init_done = 1; +- +-# ifdef GEN_TREES_H +- gen_trees_header(); +-# endif +-#endif /* defined(GEN_TREES_H) || !defined(STDC) */ +-} +- +-/* =========================================================================== +- * Genererate the file trees.h describing the static trees. +- */ +-#ifdef GEN_TREES_H +-# ifndef DEBUG +-# include +-# endif +- +-# define SEPARATOR(i, last, width) \ +- ((i) == (last)? "\n};\n\n" : \ +- ((i) % (width) == (width)-1 ? ",\n" : ", ")) +- +-void gen_trees_header() +-{ +- FILE *header = fopen("trees.h", "w"); +- int i; +- +- Assert (header != NULL, "Can't open trees.h"); +- fprintf(header, +- "/* header created automatically with -DGEN_TREES_H */\n\n"); +- +- fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); +- for (i = 0; i < L_CODES+2; i++) { +- fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, +- static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); +- } +- +- fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); +- for (i = 0; i < D_CODES; i++) { +- fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, +- static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); +- } +- +- fprintf(header, "const uch _dist_code[DIST_CODE_LEN] = {\n"); +- for (i = 0; i < DIST_CODE_LEN; i++) { +- fprintf(header, "%2u%s", _dist_code[i], +- SEPARATOR(i, DIST_CODE_LEN-1, 20)); +- } +- +- fprintf(header, "const uch _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); +- for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { +- fprintf(header, "%2u%s", _length_code[i], +- SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); +- } +- +- fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); +- for (i = 0; i < LENGTH_CODES; i++) { +- fprintf(header, "%1u%s", base_length[i], +- SEPARATOR(i, LENGTH_CODES-1, 20)); +- } +- +- fprintf(header, "local const int base_dist[D_CODES] = {\n"); +- for (i = 0; i < D_CODES; i++) { +- fprintf(header, "%5u%s", base_dist[i], +- SEPARATOR(i, D_CODES-1, 10)); +- } +- +- fclose(header); +-} +-#endif /* GEN_TREES_H */ +- +-/* =========================================================================== +- * Initialize the tree data structures for a new zlib stream. +- */ +-void _tr_init(s) +- deflate_state *s; +-{ +- tr_static_init(); +- +- s->l_desc.dyn_tree = s->dyn_ltree; +- s->l_desc.stat_desc = &static_l_desc; +- +- s->d_desc.dyn_tree = s->dyn_dtree; +- s->d_desc.stat_desc = &static_d_desc; +- +- s->bl_desc.dyn_tree = s->bl_tree; +- s->bl_desc.stat_desc = &static_bl_desc; +- +- s->bi_buf = 0; +- s->bi_valid = 0; +- s->last_eob_len = 8; /* enough lookahead for inflate */ +-#ifdef DEBUG +- s->compressed_len = 0L; +- s->bits_sent = 0L; +-#endif +- +- /* Initialize the first block of the first file: */ +- init_block(s); +-} +- +-/* =========================================================================== +- * Initialize a new block. +- */ +-local void init_block(s) +- deflate_state *s; +-{ +- int n; /* iterates over tree elements */ +- +- /* Initialize the trees. */ +- for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; +- for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; +- for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; +- +- s->dyn_ltree[END_BLOCK].Freq = 1; +- s->opt_len = s->static_len = 0L; +- s->last_lit = s->matches = 0; +-} +- +-#define SMALLEST 1 +-/* Index within the heap array of least frequent node in the Huffman tree */ +- +- +-/* =========================================================================== +- * Remove the smallest element from the heap and recreate the heap with +- * one less element. Updates heap and heap_len. +- */ +-#define pqremove(s, tree, top) \ +-{\ +- top = s->heap[SMALLEST]; \ +- s->heap[SMALLEST] = s->heap[s->heap_len--]; \ +- pqdownheap(s, tree, SMALLEST); \ +-} +- +-/* =========================================================================== +- * Compares to subtrees, using the tree depth as tie breaker when +- * the subtrees have equal frequency. This minimizes the worst case length. +- */ +-#define smaller(tree, n, m, depth) \ +- (tree[n].Freq < tree[m].Freq || \ +- (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) +- +-/* =========================================================================== +- * Restore the heap property by moving down the tree starting at node k, +- * exchanging a node with the smallest of its two sons if necessary, stopping +- * when the heap property is re-established (each father smaller than its +- * two sons). +- */ +-local void pqdownheap(s, tree, k) +- deflate_state *s; +- ct_data *tree; /* the tree to restore */ +- int k; /* node to move down */ +-{ +- int v = s->heap[k]; +- int j = k << 1; /* left son of k */ +- while (j <= s->heap_len) { +- /* Set j to the smallest of the two sons: */ +- if (j < s->heap_len && +- smaller(tree, s->heap[j+1], s->heap[j], s->depth)) { +- j++; +- } +- /* Exit if v is smaller than both sons */ +- if (smaller(tree, v, s->heap[j], s->depth)) break; +- +- /* Exchange v with the smallest son */ +- s->heap[k] = s->heap[j]; k = j; +- +- /* And continue down the tree, setting j to the left son of k */ +- j <<= 1; +- } +- s->heap[k] = v; +-} +- +-/* =========================================================================== +- * Compute the optimal bit lengths for a tree and update the total bit length +- * for the current block. +- * IN assertion: the fields freq and dad are set, heap[heap_max] and +- * above are the tree nodes sorted by increasing frequency. +- * OUT assertions: the field len is set to the optimal bit length, the +- * array bl_count contains the frequencies for each bit length. +- * The length opt_len is updated; static_len is also updated if stree is +- * not null. +- */ +-local void gen_bitlen(s, desc) +- deflate_state *s; +- tree_desc *desc; /* the tree descriptor */ +-{ +- ct_data *tree = desc->dyn_tree; +- int max_code = desc->max_code; +- const ct_data *stree = desc->stat_desc->static_tree; +- const intf *extra = desc->stat_desc->extra_bits; +- int base = desc->stat_desc->extra_base; +- int max_length = desc->stat_desc->max_length; +- int h; /* heap index */ +- int n, m; /* iterate over the tree elements */ +- int bits; /* bit length */ +- int xbits; /* extra bits */ +- ush f; /* frequency */ +- int overflow = 0; /* number of elements with bit length too large */ +- +- for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; +- +- /* In a first pass, compute the optimal bit lengths (which may +- * overflow in the case of the bit length tree). +- */ +- tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ +- +- for (h = s->heap_max+1; h < HEAP_SIZE; h++) { +- n = s->heap[h]; +- bits = tree[tree[n].Dad].Len + 1; +- if (bits > max_length) bits = max_length, overflow++; +- tree[n].Len = (ush)bits; +- /* We overwrite tree[n].Dad which is no longer needed */ +- +- if (n > max_code) continue; /* not a leaf node */ +- +- s->bl_count[bits]++; +- xbits = 0; +- if (n >= base) xbits = extra[n-base]; +- f = tree[n].Freq; +- s->opt_len += (ulg)f * (bits + xbits); +- if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits); +- } +- if (overflow == 0) return; +- +- Trace((stderr,"\nbit length overflow\n")); +- /* This happens for example on obj2 and pic of the Calgary corpus */ +- +- /* Find the first bit length which could increase: */ +- do { +- bits = max_length-1; +- while (s->bl_count[bits] == 0) bits--; +- s->bl_count[bits]--; /* move one leaf down the tree */ +- s->bl_count[bits+1] += 2; /* move one overflow item as its brother */ +- s->bl_count[max_length]--; +- /* The brother of the overflow item also moves one step up, +- * but this does not affect bl_count[max_length] +- */ +- overflow -= 2; +- } while (overflow > 0); +- +- /* Now recompute all bit lengths, scanning in increasing frequency. +- * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all +- * lengths instead of fixing only the wrong ones. This idea is taken +- * from 'ar' written by Haruhiko Okumura.) +- */ +- for (bits = max_length; bits != 0; bits--) { +- n = s->bl_count[bits]; +- while (n != 0) { +- m = s->heap[--h]; +- if (m > max_code) continue; +- if ((unsigned) tree[m].Len != (unsigned) bits) { +- Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); +- s->opt_len += ((long)bits - (long)tree[m].Len) +- *(long)tree[m].Freq; +- tree[m].Len = (ush)bits; +- } +- n--; +- } +- } +-} +- +-/* =========================================================================== +- * Generate the codes for a given tree and bit counts (which need not be +- * optimal). +- * IN assertion: the array bl_count contains the bit length statistics for +- * the given tree and the field len is set for all tree elements. +- * OUT assertion: the field code is set for all tree elements of non +- * zero code length. +- */ +-local void gen_codes (tree, max_code, bl_count) +- ct_data *tree; /* the tree to decorate */ +- int max_code; /* largest code with non zero frequency */ +- ushf *bl_count; /* number of codes at each bit length */ +-{ +- ush next_code[MAX_BITS+1]; /* next code value for each bit length */ +- ush code = 0; /* running code value */ +- int bits; /* bit index */ +- int n; /* code index */ +- +- /* The distribution counts are first used to generate the code values +- * without bit reversal. +- */ +- for (bits = 1; bits <= MAX_BITS; bits++) { +- next_code[bits] = code = (code + bl_count[bits-1]) << 1; +- } +- /* Check that the bit counts in bl_count are consistent. The last code +- * must be all ones. +- */ +- Assert (code + bl_count[MAX_BITS]-1 == (1<dyn_tree; +- const ct_data *stree = desc->stat_desc->static_tree; +- int elems = desc->stat_desc->elems; +- int n, m; /* iterate over heap elements */ +- int max_code = -1; /* largest code with non zero frequency */ +- int node; /* new node being created */ +- +- /* Construct the initial heap, with least frequent element in +- * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. +- * heap[0] is not used. +- */ +- s->heap_len = 0, s->heap_max = HEAP_SIZE; +- +- for (n = 0; n < elems; n++) { +- if (tree[n].Freq != 0) { +- s->heap[++(s->heap_len)] = max_code = n; +- s->depth[n] = 0; +- } else { +- tree[n].Len = 0; +- } +- } +- +- /* The pkzip format requires that at least one distance code exists, +- * and that at least one bit should be sent even if there is only one +- * possible code. So to avoid special checks later on we force at least +- * two codes of non zero frequency. +- */ +- while (s->heap_len < 2) { +- node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); +- tree[node].Freq = 1; +- s->depth[node] = 0; +- s->opt_len--; if (stree) s->static_len -= stree[node].Len; +- /* node is 0 or 1 so it does not have extra bits */ +- } +- desc->max_code = max_code; +- +- /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, +- * establish sub-heaps of increasing lengths: +- */ +- for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); +- +- /* Construct the Huffman tree by repeatedly combining the least two +- * frequent nodes. +- */ +- node = elems; /* next internal node of the tree */ +- do { +- pqremove(s, tree, n); /* n = node of least frequency */ +- m = s->heap[SMALLEST]; /* m = node of next least frequency */ +- +- s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ +- s->heap[--(s->heap_max)] = m; +- +- /* Create a new node father of n and m */ +- tree[node].Freq = tree[n].Freq + tree[m].Freq; +- s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? +- s->depth[n] : s->depth[m]) + 1); +- tree[n].Dad = tree[m].Dad = (ush)node; +-#ifdef DUMP_BL_TREE +- if (tree == s->bl_tree) { +- fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", +- node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); +- } +-#endif +- /* and insert the new node in the heap */ +- s->heap[SMALLEST] = node++; +- pqdownheap(s, tree, SMALLEST); +- +- } while (s->heap_len >= 2); +- +- s->heap[--(s->heap_max)] = s->heap[SMALLEST]; +- +- /* At this point, the fields freq and dad are set. We can now +- * generate the bit lengths. +- */ +- gen_bitlen(s, (tree_desc *)desc); +- +- /* The field len is now set, we can generate the bit codes */ +- gen_codes ((ct_data *)tree, max_code, s->bl_count); +-} +- +-/* =========================================================================== +- * Scan a literal or distance tree to determine the frequencies of the codes +- * in the bit length tree. +- */ +-local void scan_tree (s, tree, max_code) +- deflate_state *s; +- ct_data *tree; /* the tree to be scanned */ +- int max_code; /* and its largest code of non zero frequency */ +-{ +- int n; /* iterates over all tree elements */ +- int prevlen = -1; /* last emitted length */ +- int curlen; /* length of current code */ +- int nextlen = tree[0].Len; /* length of next code */ +- int count = 0; /* repeat count of the current code */ +- int max_count = 7; /* max repeat count */ +- int min_count = 4; /* min repeat count */ +- +- if (nextlen == 0) max_count = 138, min_count = 3; +- tree[max_code+1].Len = (ush)0xffff; /* guard */ +- +- for (n = 0; n <= max_code; n++) { +- curlen = nextlen; nextlen = tree[n+1].Len; +- if (++count < max_count && curlen == nextlen) { +- continue; +- } else if (count < min_count) { +- s->bl_tree[curlen].Freq += count; +- } else if (curlen != 0) { +- if (curlen != prevlen) s->bl_tree[curlen].Freq++; +- s->bl_tree[REP_3_6].Freq++; +- } else if (count <= 10) { +- s->bl_tree[REPZ_3_10].Freq++; +- } else { +- s->bl_tree[REPZ_11_138].Freq++; +- } +- count = 0; prevlen = curlen; +- if (nextlen == 0) { +- max_count = 138, min_count = 3; +- } else if (curlen == nextlen) { +- max_count = 6, min_count = 3; +- } else { +- max_count = 7, min_count = 4; +- } +- } +-} +- +-/* =========================================================================== +- * Send a literal or distance tree in compressed form, using the codes in +- * bl_tree. +- */ +-local void send_tree (s, tree, max_code) +- deflate_state *s; +- ct_data *tree; /* the tree to be scanned */ +- int max_code; /* and its largest code of non zero frequency */ +-{ +- int n; /* iterates over all tree elements */ +- int prevlen = -1; /* last emitted length */ +- int curlen; /* length of current code */ +- int nextlen = tree[0].Len; /* length of next code */ +- int count = 0; /* repeat count of the current code */ +- int max_count = 7; /* max repeat count */ +- int min_count = 4; /* min repeat count */ +- +- /* tree[max_code+1].Len = -1; */ /* guard already set */ +- if (nextlen == 0) max_count = 138, min_count = 3; +- +- for (n = 0; n <= max_code; n++) { +- curlen = nextlen; nextlen = tree[n+1].Len; +- if (++count < max_count && curlen == nextlen) { +- continue; +- } else if (count < min_count) { +- do { send_code(s, curlen, s->bl_tree); } while (--count != 0); +- +- } else if (curlen != 0) { +- if (curlen != prevlen) { +- send_code(s, curlen, s->bl_tree); count--; +- } +- Assert(count >= 3 && count <= 6, " 3_6?"); +- send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2); +- +- } else if (count <= 10) { +- send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3); +- +- } else { +- send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7); +- } +- count = 0; prevlen = curlen; +- if (nextlen == 0) { +- max_count = 138, min_count = 3; +- } else if (curlen == nextlen) { +- max_count = 6, min_count = 3; +- } else { +- max_count = 7, min_count = 4; +- } +- } +-} +- +-/* =========================================================================== +- * Construct the Huffman tree for the bit lengths and return the index in +- * bl_order of the last bit length code to send. +- */ +-local int build_bl_tree(s) +- deflate_state *s; +-{ +- int max_blindex; /* index of last bit length code of non zero freq */ +- +- /* Determine the bit length frequencies for literal and distance trees */ +- scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); +- scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); +- +- /* Build the bit length tree: */ +- build_tree(s, (tree_desc *)(&(s->bl_desc))); +- /* opt_len now includes the length of the tree representations, except +- * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. +- */ +- +- /* Determine the number of bit length codes to send. The pkzip format +- * requires that at least 4 bit length codes be sent. (appnote.txt says +- * 3 but the actual value used is 4.) +- */ +- for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { +- if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; +- } +- /* Update opt_len to include the bit length tree and counts */ +- s->opt_len += 3*(max_blindex+1) + 5+5+4; +- Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", +- s->opt_len, s->static_len)); +- +- return max_blindex; +-} +- +-/* =========================================================================== +- * Send the header for a block using dynamic Huffman trees: the counts, the +- * lengths of the bit length codes, the literal tree and the distance tree. +- * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. +- */ +-local void send_all_trees(s, lcodes, dcodes, blcodes) +- deflate_state *s; +- int lcodes, dcodes, blcodes; /* number of codes for each tree */ +-{ +- int rank; /* index in bl_order */ +- +- Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); +- Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, +- "too many codes"); +- Tracev((stderr, "\nbl counts: ")); +- send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */ +- send_bits(s, dcodes-1, 5); +- send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */ +- for (rank = 0; rank < blcodes; rank++) { +- Tracev((stderr, "\nbl code %2d ", bl_order[rank])); +- send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); +- } +- Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); +- +- send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */ +- Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); +- +- send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */ +- Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); +-} +- +-/* =========================================================================== +- * Send a stored block +- */ +-void _tr_stored_block(s, buf, stored_len, eof) +- deflate_state *s; +- charf *buf; /* input block */ +- ulg stored_len; /* length of input block */ +- int eof; /* true if this is the last block for a file */ +-{ +- send_bits(s, (STORED_BLOCK<<1)+eof, 3); /* send block type */ +-#ifdef DEBUG +- s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; +- s->compressed_len += (stored_len + 4) << 3; +-#endif +- copy_block(s, buf, (unsigned)stored_len, 1); /* with header */ +-} +- +-/* =========================================================================== +- * Send one empty static block to give enough lookahead for inflate. +- * This takes 10 bits, of which 7 may remain in the bit buffer. +- * The current inflate code requires 9 bits of lookahead. If the +- * last two codes for the previous block (real code plus EOB) were coded +- * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode +- * the last real code. In this case we send two empty static blocks instead +- * of one. (There are no problems if the previous block is stored or fixed.) +- * To simplify the code, we assume the worst case of last real code encoded +- * on one bit only. +- */ +-void _tr_align(s) +- deflate_state *s; +-{ +- send_bits(s, STATIC_TREES<<1, 3); +- send_code(s, END_BLOCK, static_ltree); +-#ifdef DEBUG +- s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ +-#endif +- bi_flush(s); +- /* Of the 10 bits for the empty block, we have already sent +- * (10 - bi_valid) bits. The lookahead for the last real code (before +- * the EOB of the previous block) was thus at least one plus the length +- * of the EOB plus what we have just sent of the empty static block. +- */ +- if (1 + s->last_eob_len + 10 - s->bi_valid < 9) { +- send_bits(s, STATIC_TREES<<1, 3); +- send_code(s, END_BLOCK, static_ltree); +-#ifdef DEBUG +- s->compressed_len += 10L; +-#endif +- bi_flush(s); +- } +- s->last_eob_len = 7; +-} +- +-/* =========================================================================== +- * Determine the best encoding for the current block: dynamic trees, static +- * trees or store, and output the encoded block to the zip file. +- */ +-void _tr_flush_block(s, buf, stored_len, eof) +- deflate_state *s; +- charf *buf; /* input block, or NULL if too old */ +- ulg stored_len; /* length of input block */ +- int eof; /* true if this is the last block for a file */ +-{ +- ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ +- int max_blindex = 0; /* index of last bit length code of non zero freq */ +- +- /* Build the Huffman trees unless a stored block is forced */ +- if (s->level > 0) { +- +- /* Check if the file is binary or text */ +- if (stored_len > 0 && s->strm->data_type == Z_UNKNOWN) +- set_data_type(s); +- +- /* Construct the literal and distance trees */ +- build_tree(s, (tree_desc *)(&(s->l_desc))); +- Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, +- s->static_len)); +- +- build_tree(s, (tree_desc *)(&(s->d_desc))); +- Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, +- s->static_len)); +- /* At this point, opt_len and static_len are the total bit lengths of +- * the compressed block data, excluding the tree representations. +- */ +- +- /* Build the bit length tree for the above two trees, and get the index +- * in bl_order of the last bit length code to send. +- */ +- max_blindex = build_bl_tree(s); +- +- /* Determine the best encoding. Compute the block lengths in bytes. */ +- opt_lenb = (s->opt_len+3+7)>>3; +- static_lenb = (s->static_len+3+7)>>3; +- +- Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", +- opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, +- s->last_lit)); +- +- if (static_lenb <= opt_lenb) opt_lenb = static_lenb; +- +- } else { +- Assert(buf != (char*)0, "lost buf"); +- opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ +- } +- +-#ifdef FORCE_STORED +- if (buf != (char*)0) { /* force stored block */ +-#else +- if (stored_len+4 <= opt_lenb && buf != (char*)0) { +- /* 4: two words for the lengths */ +-#endif +- /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. +- * Otherwise we can't have processed more than WSIZE input bytes since +- * the last block flush, because compression would have been +- * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to +- * transform a block into a stored block. +- */ +- _tr_stored_block(s, buf, stored_len, eof); +- +-#ifdef FORCE_STATIC +- } else if (static_lenb >= 0) { /* force static trees */ +-#else +- } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { +-#endif +- send_bits(s, (STATIC_TREES<<1)+eof, 3); +- compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); +-#ifdef DEBUG +- s->compressed_len += 3 + s->static_len; +-#endif +- } else { +- send_bits(s, (DYN_TREES<<1)+eof, 3); +- send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, +- max_blindex+1); +- compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); +-#ifdef DEBUG +- s->compressed_len += 3 + s->opt_len; +-#endif +- } +- Assert (s->compressed_len == s->bits_sent, "bad compressed size"); +- /* The above check is made mod 2^32, for files larger than 512 MB +- * and uLong implemented on 32 bits. +- */ +- init_block(s); +- +- if (eof) { +- bi_windup(s); +-#ifdef DEBUG +- s->compressed_len += 7; /* align on byte boundary */ +-#endif +- } +- Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3, +- s->compressed_len-7*eof)); +-} +- +-/* =========================================================================== +- * Save the match info and tally the frequency counts. Return true if +- * the current block must be flushed. +- */ +-int _tr_tally (s, dist, lc) +- deflate_state *s; +- unsigned dist; /* distance of matched string */ +- unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ +-{ +- s->d_buf[s->last_lit] = (ush)dist; +- s->l_buf[s->last_lit++] = (uch)lc; +- if (dist == 0) { +- /* lc is the unmatched char */ +- s->dyn_ltree[lc].Freq++; +- } else { +- s->matches++; +- /* Here, lc is the match length - MIN_MATCH */ +- dist--; /* dist = match distance - 1 */ +- Assert((ush)dist < (ush)MAX_DIST(s) && +- (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && +- (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); +- +- s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++; +- s->dyn_dtree[d_code(dist)].Freq++; +- } +- +-#ifdef TRUNCATE_BLOCK +- /* Try to guess if it is profitable to stop the current block here */ +- if ((s->last_lit & 0x1fff) == 0 && s->level > 2) { +- /* Compute an upper bound for the compressed length */ +- ulg out_length = (ulg)s->last_lit*8L; +- ulg in_length = (ulg)((long)s->strstart - s->block_start); +- int dcode; +- for (dcode = 0; dcode < D_CODES; dcode++) { +- out_length += (ulg)s->dyn_dtree[dcode].Freq * +- (5L+extra_dbits[dcode]); +- } +- out_length >>= 3; +- Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ", +- s->last_lit, in_length, out_length, +- 100L - out_length*100L/in_length)); +- if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1; +- } +-#endif +- return (s->last_lit == s->lit_bufsize-1); +- /* We avoid equality with lit_bufsize because of wraparound at 64K +- * on 16 bit machines and because stored blocks are restricted to +- * 64K-1 bytes. +- */ +-} +- +-/* =========================================================================== +- * Send the block data compressed using the given Huffman trees +- */ +-local void compress_block(s, ltree, dtree) +- deflate_state *s; +- ct_data *ltree; /* literal tree */ +- ct_data *dtree; /* distance tree */ +-{ +- unsigned dist; /* distance of matched string */ +- int lc; /* match length or unmatched char (if dist == 0) */ +- unsigned lx = 0; /* running index in l_buf */ +- unsigned code; /* the code to send */ +- int extra; /* number of extra bits to send */ +- +- if (s->last_lit != 0) do { +- dist = s->d_buf[lx]; +- lc = s->l_buf[lx++]; +- if (dist == 0) { +- send_code(s, lc, ltree); /* send a literal byte */ +- Tracecv(isgraph(lc), (stderr," '%c' ", lc)); +- } else { +- /* Here, lc is the match length - MIN_MATCH */ +- code = _length_code[lc]; +- send_code(s, code+LITERALS+1, ltree); /* send the length code */ +- extra = extra_lbits[code]; +- if (extra != 0) { +- lc -= base_length[code]; +- send_bits(s, lc, extra); /* send the extra length bits */ +- } +- dist--; /* dist is now the match distance - 1 */ +- code = d_code(dist); +- Assert (code < D_CODES, "bad d_code"); +- +- send_code(s, code, dtree); /* send the distance code */ +- extra = extra_dbits[code]; +- if (extra != 0) { +- dist -= base_dist[code]; +- send_bits(s, dist, extra); /* send the extra distance bits */ +- } +- } /* literal or match pair ? */ +- +- /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */ +- Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx, +- "pendingBuf overflow"); +- +- } while (lx < s->last_lit); +- +- send_code(s, END_BLOCK, ltree); +- s->last_eob_len = ltree[END_BLOCK].Len; +-} +- +-/* =========================================================================== +- * Set the data type to BINARY or TEXT, using a crude approximation: +- * set it to Z_TEXT if all symbols are either printable characters (33 to 255) +- * or white spaces (9 to 13, or 32); or set it to Z_BINARY otherwise. +- * IN assertion: the fields Freq of dyn_ltree are set. +- */ +-local void set_data_type(s) +- deflate_state *s; +-{ +- int n; +- +- for (n = 0; n < 9; n++) +- if (s->dyn_ltree[n].Freq != 0) +- break; +- if (n == 9) +- for (n = 14; n < 32; n++) +- if (s->dyn_ltree[n].Freq != 0) +- break; +- s->strm->data_type = (n == 32) ? Z_TEXT : Z_BINARY; +-} +- +-/* =========================================================================== +- * Reverse the first len bits of a code, using straightforward code (a faster +- * method would use a table) +- * IN assertion: 1 <= len <= 15 +- */ +-local unsigned bi_reverse(code, len) +- unsigned code; /* the value to invert */ +- int len; /* its bit length */ +-{ +- register unsigned res = 0; +- do { +- res |= code & 1; +- code >>= 1, res <<= 1; +- } while (--len > 0); +- return res >> 1; +-} +- +-/* =========================================================================== +- * Flush the bit buffer, keeping at most 7 bits in it. +- */ +-local void bi_flush(s) +- deflate_state *s; +-{ +- if (s->bi_valid == 16) { +- put_short(s, s->bi_buf); +- s->bi_buf = 0; +- s->bi_valid = 0; +- } else if (s->bi_valid >= 8) { +- put_byte(s, (Byte)s->bi_buf); +- s->bi_buf >>= 8; +- s->bi_valid -= 8; +- } +-} +- +-/* =========================================================================== +- * Flush the bit buffer and align the output on a byte boundary +- */ +-local void bi_windup(s) +- deflate_state *s; +-{ +- if (s->bi_valid > 8) { +- put_short(s, s->bi_buf); +- } else if (s->bi_valid > 0) { +- put_byte(s, (Byte)s->bi_buf); +- } +- s->bi_buf = 0; +- s->bi_valid = 0; +-#ifdef DEBUG +- s->bits_sent = (s->bits_sent+7) & ~7; +-#endif +-} +- +-/* =========================================================================== +- * Copy a stored block, storing first the length and its +- * one's complement if requested. +- */ +-local void copy_block(s, buf, len, header) +- deflate_state *s; +- charf *buf; /* the input data */ +- unsigned len; /* its length */ +- int header; /* true if block header must be written */ +-{ +- bi_windup(s); /* align on byte boundary */ +- s->last_eob_len = 8; /* enough lookahead for inflate */ +- +- if (header) { +- put_short(s, (ush)len); +- put_short(s, (ush)~len); +-#ifdef DEBUG +- s->bits_sent += 2*16; +-#endif +- } +-#ifdef DEBUG +- s->bits_sent += (ulg)len<<3; +-#endif +- while (len--) { +- put_byte(s, *buf++); +- } +-} +diff -ruN RJaCGH.orig/src/trees.h RJaCGH/src/trees.h +--- RJaCGH.orig/src/trees.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/trees.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,128 +0,0 @@ +-/* header created automatically with -DGEN_TREES_H */ +- +-local const ct_data static_ltree[L_CODES+2] = { +-{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, +-{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, +-{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, +-{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, +-{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, +-{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, +-{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, +-{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, +-{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, +-{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, +-{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, +-{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, +-{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, +-{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, +-{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, +-{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, +-{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, +-{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, +-{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, +-{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, +-{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, +-{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, +-{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, +-{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, +-{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, +-{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, +-{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, +-{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, +-{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, +-{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, +-{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, +-{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, +-{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, +-{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, +-{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, +-{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, +-{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, +-{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, +-{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, +-{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, +-{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, +-{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, +-{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, +-{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, +-{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, +-{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, +-{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, +-{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, +-{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, +-{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, +-{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, +-{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, +-{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, +-{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, +-{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, +-{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, +-{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, +-{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} +-}; +- +-local const ct_data static_dtree[D_CODES] = { +-{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, +-{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, +-{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, +-{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, +-{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, +-{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} +-}; +- +-const uch _dist_code[DIST_CODE_LEN] = { +- 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, +- 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, +-10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, +-11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, +-12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, +-13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, +-13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, +-18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, +-23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 +-}; +- +-const uch _length_code[MAX_MATCH-MIN_MATCH+1]= { +- 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, +-13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, +-17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, +-19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, +-21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, +-22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, +-23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +-25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 +-}; +- +-local const int base_length[LENGTH_CODES] = { +-0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, +-64, 80, 96, 112, 128, 160, 192, 224, 0 +-}; +- +-local const int base_dist[D_CODES] = { +- 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, +- 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, +- 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 +-}; +- +diff -ruN RJaCGH.orig/src/uncompr.c RJaCGH/src/uncompr.c +--- RJaCGH.orig/src/uncompr.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/uncompr.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,61 +0,0 @@ +-/* uncompr.c -- decompress a memory buffer +- * Copyright (C) 1995-2003 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-/* =========================================================================== +- Decompresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be large enough to hold the +- entire uncompressed data. (The size of the uncompressed data must have +- been saved previously by the compressor and transmitted to the decompressor +- by some mechanism outside the scope of this compression library.) +- Upon exit, destLen is the actual size of the compressed buffer. +- This function can be used to decompress a whole file at once if the +- input file is mmap'ed. +- +- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer, or Z_DATA_ERROR if the input data was corrupted. +-*/ +-int ZEXPORT uncompress (dest, destLen, source, sourceLen) +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +-{ +- z_stream stream; +- int err; +- +- stream.next_in = (Bytef*)source; +- stream.avail_in = (uInt)sourceLen; +- /* Check for source > 64K on 16-bit machine: */ +- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +- +- stream.next_out = dest; +- stream.avail_out = (uInt)*destLen; +- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; +- +- stream.zalloc = (alloc_func)0; +- stream.zfree = (free_func)0; +- +- err = inflateInit(&stream); +- if (err != Z_OK) return err; +- +- err = inflate(&stream, Z_FINISH); +- if (err != Z_STREAM_END) { +- inflateEnd(&stream); +- if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) +- return Z_DATA_ERROR; +- return err; +- } +- *destLen = stream.total_out; +- +- err = inflateEnd(&stream); +- return err; +-} +diff -ruN RJaCGH.orig/src/zconf.h RJaCGH/src/zconf.h +--- RJaCGH.orig/src/zconf.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/zconf.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,332 +0,0 @@ +-/* zconf.h -- configuration of the zlib compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#ifndef ZCONF_H +-#define ZCONF_H +- +-/* +- * If you *really* need a unique prefix for all types and library functions, +- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. +- */ +-#ifdef Z_PREFIX +-# define deflateInit_ z_deflateInit_ +-# define deflate z_deflate +-# define deflateEnd z_deflateEnd +-# define inflateInit_ z_inflateInit_ +-# define inflate z_inflate +-# define inflateEnd z_inflateEnd +-# define deflateInit2_ z_deflateInit2_ +-# define deflateSetDictionary z_deflateSetDictionary +-# define deflateCopy z_deflateCopy +-# define deflateReset z_deflateReset +-# define deflateParams z_deflateParams +-# define deflateBound z_deflateBound +-# define deflatePrime z_deflatePrime +-# define inflateInit2_ z_inflateInit2_ +-# define inflateSetDictionary z_inflateSetDictionary +-# define inflateSync z_inflateSync +-# define inflateSyncPoint z_inflateSyncPoint +-# define inflateCopy z_inflateCopy +-# define inflateReset z_inflateReset +-# define inflateBack z_inflateBack +-# define inflateBackEnd z_inflateBackEnd +-# define compress z_compress +-# define compress2 z_compress2 +-# define compressBound z_compressBound +-# define uncompress z_uncompress +-# define adler32 z_adler32 +-# define crc32 z_crc32 +-# define get_crc_table z_get_crc_table +-# define zError z_zError +- +-# define alloc_func z_alloc_func +-# define free_func z_free_func +-# define in_func z_in_func +-# define out_func z_out_func +-# define Byte z_Byte +-# define uInt z_uInt +-# define uLong z_uLong +-# define Bytef z_Bytef +-# define charf z_charf +-# define intf z_intf +-# define uIntf z_uIntf +-# define uLongf z_uLongf +-# define voidpf z_voidpf +-# define voidp z_voidp +-#endif +- +-#if defined(__MSDOS__) && !defined(MSDOS) +-# define MSDOS +-#endif +-#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) +-# define OS2 +-#endif +-#if defined(_WINDOWS) && !defined(WINDOWS) +-# define WINDOWS +-#endif +-#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) +-# ifndef WIN32 +-# define WIN32 +-# endif +-#endif +-#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) +-# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) +-# ifndef SYS16BIT +-# define SYS16BIT +-# endif +-# endif +-#endif +- +-/* +- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more +- * than 64k bytes at a time (needed on systems with 16-bit int). +- */ +-#ifdef SYS16BIT +-# define MAXSEG_64K +-#endif +-#ifdef MSDOS +-# define UNALIGNED_OK +-#endif +- +-#ifdef __STDC_VERSION__ +-# ifndef STDC +-# define STDC +-# endif +-# if __STDC_VERSION__ >= 199901L +-# ifndef STDC99 +-# define STDC99 +-# endif +-# endif +-#endif +-#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) +-# define STDC +-#endif +- +-#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ +-# define STDC +-#endif +- +-#ifndef STDC +-# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ +-# define const /* note: need a more gentle solution here */ +-# endif +-#endif +- +-/* Some Mac compilers merge all .h files incorrectly: */ +-#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) +-# define NO_DUMMY_DECL +-#endif +- +-/* Maximum value for memLevel in deflateInit2 */ +-#ifndef MAX_MEM_LEVEL +-# ifdef MAXSEG_64K +-# define MAX_MEM_LEVEL 8 +-# else +-# define MAX_MEM_LEVEL 9 +-# endif +-#endif +- +-/* Maximum value for windowBits in deflateInit2 and inflateInit2. +- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files +- * created by gzip. (Files created by minigzip can still be extracted by +- * gzip.) +- */ +-#ifndef MAX_WBITS +-# define MAX_WBITS 15 /* 32K LZ77 window */ +-#endif +- +-/* The memory requirements for deflate are (in bytes): +- (1 << (windowBits+2)) + (1 << (memLevel+9)) +- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) +- plus a few kilobytes for small objects. For example, if you want to reduce +- the default memory requirements from 256K to 128K, compile with +- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" +- Of course this will generally degrade compression (there's no free lunch). +- +- The memory requirements for inflate are (in bytes) 1 << windowBits +- that is, 32K for windowBits=15 (default value) plus a few kilobytes +- for small objects. +-*/ +- +- /* Type declarations */ +- +-#ifndef OF /* function prototypes */ +-# ifdef STDC +-# define OF(args) args +-# else +-# define OF(args) () +-# endif +-#endif +- +-/* The following definitions for FAR are needed only for MSDOS mixed +- * model programming (small or medium model with some far allocations). +- * This was tested only with MSC; for other MSDOS compilers you may have +- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, +- * just define FAR to be empty. +- */ +-#ifdef SYS16BIT +-# if defined(M_I86SM) || defined(M_I86MM) +- /* MSC small or medium model */ +-# define SMALL_MEDIUM +-# ifdef _MSC_VER +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-# if (defined(__SMALL__) || defined(__MEDIUM__)) +- /* Turbo C small or medium model */ +-# define SMALL_MEDIUM +-# ifdef __BORLANDC__ +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-#endif +- +-#if defined(WINDOWS) || defined(WIN32) +- /* If building or using zlib as a DLL, define ZLIB_DLL. +- * This is not mandatory, but it offers a little performance increase. +- */ +-# ifdef ZLIB_DLL +-# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) +-# ifdef ZLIB_INTERNAL +-# define ZEXTERN extern __declspec(dllexport) +-# else +-# define ZEXTERN extern __declspec(dllimport) +-# endif +-# endif +-# endif /* ZLIB_DLL */ +- /* If building or using zlib with the WINAPI/WINAPIV calling convention, +- * define ZLIB_WINAPI. +- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. +- */ +-# ifdef ZLIB_WINAPI +-# ifdef FAR +-# undef FAR +-# endif +-# include +- /* No need for _export, use ZLIB.DEF instead. */ +- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ +-# define ZEXPORT WINAPI +-# ifdef WIN32 +-# define ZEXPORTVA WINAPIV +-# else +-# define ZEXPORTVA FAR CDECL +-# endif +-# endif +-#endif +- +-#if defined (__BEOS__) +-# ifdef ZLIB_DLL +-# ifdef ZLIB_INTERNAL +-# define ZEXPORT __declspec(dllexport) +-# define ZEXPORTVA __declspec(dllexport) +-# else +-# define ZEXPORT __declspec(dllimport) +-# define ZEXPORTVA __declspec(dllimport) +-# endif +-# endif +-#endif +- +-#ifndef ZEXTERN +-# define ZEXTERN extern +-#endif +-#ifndef ZEXPORT +-# define ZEXPORT +-#endif +-#ifndef ZEXPORTVA +-# define ZEXPORTVA +-#endif +- +-#ifndef FAR +-# define FAR +-#endif +- +-#if !defined(__MACTYPES__) +-typedef unsigned char Byte; /* 8 bits */ +-#endif +-typedef unsigned int uInt; /* 16 bits or more */ +-typedef unsigned long uLong; /* 32 bits or more */ +- +-#ifdef SMALL_MEDIUM +- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ +-# define Bytef Byte FAR +-#else +- typedef Byte FAR Bytef; +-#endif +-typedef char FAR charf; +-typedef int FAR intf; +-typedef uInt FAR uIntf; +-typedef uLong FAR uLongf; +- +-#ifdef STDC +- typedef void const *voidpc; +- typedef void FAR *voidpf; +- typedef void *voidp; +-#else +- typedef Byte const *voidpc; +- typedef Byte FAR *voidpf; +- typedef Byte *voidp; +-#endif +- +-#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ +-# include /* for off_t */ +-# include /* for SEEK_* and off_t */ +-# ifdef VMS +-# include /* for off_t */ +-# endif +-# define z_off_t off_t +-#endif +-#ifndef SEEK_SET +-# define SEEK_SET 0 /* Seek from beginning of file. */ +-# define SEEK_CUR 1 /* Seek from current position. */ +-# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ +-#endif +-#ifndef z_off_t +-# define z_off_t long +-#endif +- +-#if defined(__OS400__) +-# define NO_vsnprintf +-#endif +- +-#if defined(__MVS__) +-# define NO_vsnprintf +-# ifdef FAR +-# undef FAR +-# endif +-#endif +- +-/* MVS linker does not support external names larger than 8 bytes */ +-#if defined(__MVS__) +-# pragma map(deflateInit_,"DEIN") +-# pragma map(deflateInit2_,"DEIN2") +-# pragma map(deflateEnd,"DEEND") +-# pragma map(deflateBound,"DEBND") +-# pragma map(inflateInit_,"ININ") +-# pragma map(inflateInit2_,"ININ2") +-# pragma map(inflateEnd,"INEND") +-# pragma map(inflateSync,"INSY") +-# pragma map(inflateSetDictionary,"INSEDI") +-# pragma map(compressBound,"CMBND") +-# pragma map(inflate_table,"INTABL") +-# pragma map(inflate_fast,"INFA") +-# pragma map(inflate_copyright,"INCOPY") +-#endif +- +-#endif /* ZCONF_H */ +diff -ruN RJaCGH.orig/src/zconf.in.h RJaCGH/src/zconf.in.h +--- RJaCGH.orig/src/zconf.in.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/zconf.in.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,332 +0,0 @@ +-/* zconf.h -- configuration of the zlib compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#ifndef ZCONF_H +-#define ZCONF_H +- +-/* +- * If you *really* need a unique prefix for all types and library functions, +- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. +- */ +-#ifdef Z_PREFIX +-# define deflateInit_ z_deflateInit_ +-# define deflate z_deflate +-# define deflateEnd z_deflateEnd +-# define inflateInit_ z_inflateInit_ +-# define inflate z_inflate +-# define inflateEnd z_inflateEnd +-# define deflateInit2_ z_deflateInit2_ +-# define deflateSetDictionary z_deflateSetDictionary +-# define deflateCopy z_deflateCopy +-# define deflateReset z_deflateReset +-# define deflateParams z_deflateParams +-# define deflateBound z_deflateBound +-# define deflatePrime z_deflatePrime +-# define inflateInit2_ z_inflateInit2_ +-# define inflateSetDictionary z_inflateSetDictionary +-# define inflateSync z_inflateSync +-# define inflateSyncPoint z_inflateSyncPoint +-# define inflateCopy z_inflateCopy +-# define inflateReset z_inflateReset +-# define inflateBack z_inflateBack +-# define inflateBackEnd z_inflateBackEnd +-# define compress z_compress +-# define compress2 z_compress2 +-# define compressBound z_compressBound +-# define uncompress z_uncompress +-# define adler32 z_adler32 +-# define crc32 z_crc32 +-# define get_crc_table z_get_crc_table +-# define zError z_zError +- +-# define alloc_func z_alloc_func +-# define free_func z_free_func +-# define in_func z_in_func +-# define out_func z_out_func +-# define Byte z_Byte +-# define uInt z_uInt +-# define uLong z_uLong +-# define Bytef z_Bytef +-# define charf z_charf +-# define intf z_intf +-# define uIntf z_uIntf +-# define uLongf z_uLongf +-# define voidpf z_voidpf +-# define voidp z_voidp +-#endif +- +-#if defined(__MSDOS__) && !defined(MSDOS) +-# define MSDOS +-#endif +-#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) +-# define OS2 +-#endif +-#if defined(_WINDOWS) && !defined(WINDOWS) +-# define WINDOWS +-#endif +-#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) +-# ifndef WIN32 +-# define WIN32 +-# endif +-#endif +-#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) +-# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) +-# ifndef SYS16BIT +-# define SYS16BIT +-# endif +-# endif +-#endif +- +-/* +- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more +- * than 64k bytes at a time (needed on systems with 16-bit int). +- */ +-#ifdef SYS16BIT +-# define MAXSEG_64K +-#endif +-#ifdef MSDOS +-# define UNALIGNED_OK +-#endif +- +-#ifdef __STDC_VERSION__ +-# ifndef STDC +-# define STDC +-# endif +-# if __STDC_VERSION__ >= 199901L +-# ifndef STDC99 +-# define STDC99 +-# endif +-# endif +-#endif +-#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) +-# define STDC +-#endif +- +-#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ +-# define STDC +-#endif +- +-#ifndef STDC +-# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ +-# define const /* note: need a more gentle solution here */ +-# endif +-#endif +- +-/* Some Mac compilers merge all .h files incorrectly: */ +-#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) +-# define NO_DUMMY_DECL +-#endif +- +-/* Maximum value for memLevel in deflateInit2 */ +-#ifndef MAX_MEM_LEVEL +-# ifdef MAXSEG_64K +-# define MAX_MEM_LEVEL 8 +-# else +-# define MAX_MEM_LEVEL 9 +-# endif +-#endif +- +-/* Maximum value for windowBits in deflateInit2 and inflateInit2. +- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files +- * created by gzip. (Files created by minigzip can still be extracted by +- * gzip.) +- */ +-#ifndef MAX_WBITS +-# define MAX_WBITS 15 /* 32K LZ77 window */ +-#endif +- +-/* The memory requirements for deflate are (in bytes): +- (1 << (windowBits+2)) + (1 << (memLevel+9)) +- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) +- plus a few kilobytes for small objects. For example, if you want to reduce +- the default memory requirements from 256K to 128K, compile with +- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" +- Of course this will generally degrade compression (there's no free lunch). +- +- The memory requirements for inflate are (in bytes) 1 << windowBits +- that is, 32K for windowBits=15 (default value) plus a few kilobytes +- for small objects. +-*/ +- +- /* Type declarations */ +- +-#ifndef OF /* function prototypes */ +-# ifdef STDC +-# define OF(args) args +-# else +-# define OF(args) () +-# endif +-#endif +- +-/* The following definitions for FAR are needed only for MSDOS mixed +- * model programming (small or medium model with some far allocations). +- * This was tested only with MSC; for other MSDOS compilers you may have +- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, +- * just define FAR to be empty. +- */ +-#ifdef SYS16BIT +-# if defined(M_I86SM) || defined(M_I86MM) +- /* MSC small or medium model */ +-# define SMALL_MEDIUM +-# ifdef _MSC_VER +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-# if (defined(__SMALL__) || defined(__MEDIUM__)) +- /* Turbo C small or medium model */ +-# define SMALL_MEDIUM +-# ifdef __BORLANDC__ +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-#endif +- +-#if defined(WINDOWS) || defined(WIN32) +- /* If building or using zlib as a DLL, define ZLIB_DLL. +- * This is not mandatory, but it offers a little performance increase. +- */ +-# ifdef ZLIB_DLL +-# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) +-# ifdef ZLIB_INTERNAL +-# define ZEXTERN extern __declspec(dllexport) +-# else +-# define ZEXTERN extern __declspec(dllimport) +-# endif +-# endif +-# endif /* ZLIB_DLL */ +- /* If building or using zlib with the WINAPI/WINAPIV calling convention, +- * define ZLIB_WINAPI. +- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. +- */ +-# ifdef ZLIB_WINAPI +-# ifdef FAR +-# undef FAR +-# endif +-# include +- /* No need for _export, use ZLIB.DEF instead. */ +- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ +-# define ZEXPORT WINAPI +-# ifdef WIN32 +-# define ZEXPORTVA WINAPIV +-# else +-# define ZEXPORTVA FAR CDECL +-# endif +-# endif +-#endif +- +-#if defined (__BEOS__) +-# ifdef ZLIB_DLL +-# ifdef ZLIB_INTERNAL +-# define ZEXPORT __declspec(dllexport) +-# define ZEXPORTVA __declspec(dllexport) +-# else +-# define ZEXPORT __declspec(dllimport) +-# define ZEXPORTVA __declspec(dllimport) +-# endif +-# endif +-#endif +- +-#ifndef ZEXTERN +-# define ZEXTERN extern +-#endif +-#ifndef ZEXPORT +-# define ZEXPORT +-#endif +-#ifndef ZEXPORTVA +-# define ZEXPORTVA +-#endif +- +-#ifndef FAR +-# define FAR +-#endif +- +-#if !defined(__MACTYPES__) +-typedef unsigned char Byte; /* 8 bits */ +-#endif +-typedef unsigned int uInt; /* 16 bits or more */ +-typedef unsigned long uLong; /* 32 bits or more */ +- +-#ifdef SMALL_MEDIUM +- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ +-# define Bytef Byte FAR +-#else +- typedef Byte FAR Bytef; +-#endif +-typedef char FAR charf; +-typedef int FAR intf; +-typedef uInt FAR uIntf; +-typedef uLong FAR uLongf; +- +-#ifdef STDC +- typedef void const *voidpc; +- typedef void FAR *voidpf; +- typedef void *voidp; +-#else +- typedef Byte const *voidpc; +- typedef Byte FAR *voidpf; +- typedef Byte *voidp; +-#endif +- +-#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ +-# include /* for off_t */ +-# include /* for SEEK_* and off_t */ +-# ifdef VMS +-# include /* for off_t */ +-# endif +-# define z_off_t off_t +-#endif +-#ifndef SEEK_SET +-# define SEEK_SET 0 /* Seek from beginning of file. */ +-# define SEEK_CUR 1 /* Seek from current position. */ +-# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ +-#endif +-#ifndef z_off_t +-# define z_off_t long +-#endif +- +-#if defined(__OS400__) +-# define NO_vsnprintf +-#endif +- +-#if defined(__MVS__) +-# define NO_vsnprintf +-# ifdef FAR +-# undef FAR +-# endif +-#endif +- +-/* MVS linker does not support external names larger than 8 bytes */ +-#if defined(__MVS__) +-# pragma map(deflateInit_,"DEIN") +-# pragma map(deflateInit2_,"DEIN2") +-# pragma map(deflateEnd,"DEEND") +-# pragma map(deflateBound,"DEBND") +-# pragma map(inflateInit_,"ININ") +-# pragma map(inflateInit2_,"ININ2") +-# pragma map(inflateEnd,"INEND") +-# pragma map(inflateSync,"INSY") +-# pragma map(inflateSetDictionary,"INSEDI") +-# pragma map(compressBound,"CMBND") +-# pragma map(inflate_table,"INTABL") +-# pragma map(inflate_fast,"INFA") +-# pragma map(inflate_copyright,"INCOPY") +-#endif +- +-#endif /* ZCONF_H */ +diff -ruN RJaCGH.orig/src/zlib.h RJaCGH/src/zlib.h +--- RJaCGH.orig/src/zlib.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/zlib.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1357 +0,0 @@ +-/* zlib.h -- interface of the 'zlib' general purpose compression library +- version 1.2.3, July 18th, 2005 +- +- Copyright (C) 1995-2005 Jean-loup Gailly and Mark Adler +- +- This software is provided 'as-is', without any express or implied +- warranty. In no event will the authors be held liable for any damages +- arising from the use of this software. +- +- Permission is granted to anyone to use this software for any purpose, +- including commercial applications, and to alter it and redistribute it +- freely, subject to the following restrictions: +- +- 1. The origin of this software must not be misrepresented; you must not +- claim that you wrote the original software. If you use this software +- in a product, an acknowledgment in the product documentation would be +- appreciated but is not required. +- 2. Altered source versions must be plainly marked as such, and must not be +- misrepresented as being the original software. +- 3. This notice may not be removed or altered from any source distribution. +- +- Jean-loup Gailly Mark Adler +- jloup@gzip.org madler@alumni.caltech.edu +- +- +- The data format used by the zlib library is described by RFCs (Request for +- Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt +- (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). +-*/ +- +-#ifndef ZLIB_H +-#define ZLIB_H +- +-#include "zconf.h" +- +-#ifdef __cplusplus +-extern "C" { +-#endif +- +-#define ZLIB_VERSION "1.2.3" +-#define ZLIB_VERNUM 0x1230 +- +-/* +- The 'zlib' compression library provides in-memory compression and +- decompression functions, including integrity checks of the uncompressed +- data. This version of the library supports only one compression method +- (deflation) but other algorithms will be added later and will have the same +- stream interface. +- +- Compression can be done in a single step if the buffers are large +- enough (for example if an input file is mmap'ed), or can be done by +- repeated calls of the compression function. In the latter case, the +- application must provide more input and/or consume the output +- (providing more output space) before each call. +- +- The compressed data format used by default by the in-memory functions is +- the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped +- around a deflate stream, which is itself documented in RFC 1951. +- +- The library also supports reading and writing files in gzip (.gz) format +- with an interface similar to that of stdio using the functions that start +- with "gz". The gzip format is different from the zlib format. gzip is a +- gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. +- +- This library can optionally read and write gzip streams in memory as well. +- +- The zlib format was designed to be compact and fast for use in memory +- and on communications channels. The gzip format was designed for single- +- file compression on file systems, has a larger header than zlib to maintain +- directory information, and uses a different, slower check method than zlib. +- +- The library does not install any signal handler. The decoder checks +- the consistency of the compressed data, so the library should never +- crash even in case of corrupted input. +-*/ +- +-typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); +-typedef void (*free_func) OF((voidpf opaque, voidpf address)); +- +-struct internal_state; +- +-typedef struct z_stream_s { +- Bytef *next_in; /* next input byte */ +- uInt avail_in; /* number of bytes available at next_in */ +- uLong total_in; /* total nb of input bytes read so far */ +- +- Bytef *next_out; /* next output byte should be put there */ +- uInt avail_out; /* remaining free space at next_out */ +- uLong total_out; /* total nb of bytes output so far */ +- +- char *msg; /* last error message, NULL if no error */ +- struct internal_state FAR *state; /* not visible by applications */ +- +- alloc_func zalloc; /* used to allocate the internal state */ +- free_func zfree; /* used to free the internal state */ +- voidpf opaque; /* private data object passed to zalloc and zfree */ +- +- int data_type; /* best guess about the data type: binary or text */ +- uLong adler; /* adler32 value of the uncompressed data */ +- uLong reserved; /* reserved for future use */ +-} z_stream; +- +-typedef z_stream FAR *z_streamp; +- +-/* +- gzip header information passed to and from zlib routines. See RFC 1952 +- for more details on the meanings of these fields. +-*/ +-typedef struct gz_header_s { +- int text; /* true if compressed data believed to be text */ +- uLong time; /* modification time */ +- int xflags; /* extra flags (not used when writing a gzip file) */ +- int os; /* operating system */ +- Bytef *extra; /* pointer to extra field or Z_NULL if none */ +- uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ +- uInt extra_max; /* space at extra (only when reading header) */ +- Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ +- uInt name_max; /* space at name (only when reading header) */ +- Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ +- uInt comm_max; /* space at comment (only when reading header) */ +- int hcrc; /* true if there was or will be a header crc */ +- int done; /* true when done reading gzip header (not used +- when writing a gzip file) */ +-} gz_header; +- +-typedef gz_header FAR *gz_headerp; +- +-/* +- 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 +- has dropped to zero. The application must initialize zalloc, zfree and +- opaque before calling the init function. All other fields are set by the +- compression library and must not be updated by the application. +- +- The opaque value provided by the application will be passed as the first +- parameter for calls of zalloc and zfree. This can be useful for custom +- memory management. The compression library attaches no meaning to the +- opaque value. +- +- zalloc must return Z_NULL if there is not enough memory for the object. +- If zlib is used in a multi-threaded application, zalloc and zfree must be +- thread safe. +- +- On 16-bit systems, the functions zalloc and zfree must be able to allocate +- exactly 65536 bytes, but will not be required to allocate more than this +- if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, +- pointers returned by zalloc for objects of exactly 65536 bytes *must* +- have their offset normalized to zero. The default allocation function +- provided by this library ensures this (see zutil.c). To reduce memory +- requirements and avoid any allocation of 64K objects, at the expense of +- compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). +- +- The fields total_in and total_out can be used for statistics or +- progress reports. After compression, total_in holds the total size of +- the uncompressed data and may be saved for use in the decompressor +- (particularly if the decompressor wants to decompress everything in +- a single step). +-*/ +- +- /* constants */ +- +-#define Z_NO_FLUSH 0 +-#define Z_PARTIAL_FLUSH 1 /* will be removed, use Z_SYNC_FLUSH instead */ +-#define Z_SYNC_FLUSH 2 +-#define Z_FULL_FLUSH 3 +-#define Z_FINISH 4 +-#define Z_BLOCK 5 +-/* Allowed flush values; see deflate() and inflate() below for details */ +- +-#define Z_OK 0 +-#define Z_STREAM_END 1 +-#define Z_NEED_DICT 2 +-#define Z_ERRNO (-1) +-#define Z_STREAM_ERROR (-2) +-#define Z_DATA_ERROR (-3) +-#define Z_MEM_ERROR (-4) +-#define Z_BUF_ERROR (-5) +-#define Z_VERSION_ERROR (-6) +-/* Return codes for the compression/decompression functions. Negative +- * values are errors, positive values are used for special but normal events. +- */ +- +-#define Z_NO_COMPRESSION 0 +-#define Z_BEST_SPEED 1 +-#define Z_BEST_COMPRESSION 9 +-#define Z_DEFAULT_COMPRESSION (-1) +-/* compression levels */ +- +-#define Z_FILTERED 1 +-#define Z_HUFFMAN_ONLY 2 +-#define Z_RLE 3 +-#define Z_FIXED 4 +-#define Z_DEFAULT_STRATEGY 0 +-/* compression strategy; see deflateInit2() below for details */ +- +-#define Z_BINARY 0 +-#define Z_TEXT 1 +-#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ +-#define Z_UNKNOWN 2 +-/* Possible values of the data_type field (though see inflate()) */ +- +-#define Z_DEFLATED 8 +-/* The deflate compression method (the only one supported in this version) */ +- +-#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ +- +-#define zlib_version zlibVersion() +-/* for compatibility with versions < 1.0.2 */ +- +- /* basic functions */ +- +-ZEXTERN const char * ZEXPORT zlibVersion OF((void)); +-/* The application can compare zlibVersion and ZLIB_VERSION for consistency. +- If the first character differs, the library code actually used is +- not compatible with the zlib.h header file used by the application. +- This check is automatically made by deflateInit and inflateInit. +- */ +- +-/* +-ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); +- +- Initializes the internal stream state for compression. The fields +- zalloc, zfree and opaque must be initialized before by the caller. +- If zalloc and zfree are set to Z_NULL, deflateInit updates them to +- use default allocation functions. +- +- The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: +- 1 gives best speed, 9 gives best compression, 0 gives no compression at +- all (the input data is simply copied a block at a time). +- Z_DEFAULT_COMPRESSION requests a default compromise between speed and +- compression (currently equivalent to level 6). +- +- deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if level is not a valid compression level, +- Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible +- with the version assumed by the caller (ZLIB_VERSION). +- msg is set to null if there is no error message. deflateInit does not +- perform any compression: this will be done by deflate(). +-*/ +- +- +-ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); +-/* +- deflate compresses as much data as possible, and stops when the input +- buffer becomes empty or the output buffer becomes full. It may introduce some +- output latency (reading input without producing any output) except when +- forced to flush. +- +- The detailed semantics are as follows. deflate performs one or both of the +- following actions: +- +- - Compress more input starting at next_in and update next_in and avail_in +- accordingly. If not all input can be processed (because there is not +- enough room in the output buffer), next_in and avail_in are updated and +- processing will resume at this point for the next call of deflate(). +- +- - Provide more output starting at next_out and update next_out and avail_out +- accordingly. This action is forced if the parameter flush is non zero. +- Forcing flush frequently degrades the compression ratio, so this parameter +- should be set only when necessary (in interactive applications). +- Some output may be provided even if flush is not set. +- +- Before the call of deflate(), the application should ensure that at least +- one of the actions is possible, by providing more input and/or consuming +- more output, and updating avail_in or avail_out accordingly; avail_out +- should never be zero before the call. The application can consume the +- compressed output when it wants, for example when the output buffer is full +- (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK +- and with zero avail_out, it must be called again after making room in the +- output buffer because there might be more output pending. +- +- Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to +- decide how much data to accumualte before producing output, in order to +- maximize compression. +- +- If the parameter flush is set to Z_SYNC_FLUSH, all pending output is +- flushed to the output buffer and the output is aligned on a byte boundary, so +- that the decompressor can get all input data available so far. (In particular +- avail_in is zero after the call if enough output space has been provided +- before the call.) Flushing may degrade compression for some compression +- algorithms and so it should be used only when necessary. +- +- If flush is set to Z_FULL_FLUSH, all output is flushed as with +- Z_SYNC_FLUSH, and the compression state is reset so that decompression can +- restart from this point if previous compressed data has been damaged or if +- random access is desired. Using Z_FULL_FLUSH too often can seriously degrade +- compression. +- +- If deflate returns with avail_out == 0, this function must be called again +- with the same value of the flush parameter and more output space (updated +- avail_out), until the flush is complete (deflate returns with non-zero +- avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that +- avail_out is greater than six to avoid repeated flush markers due to +- avail_out == 0 on return. +- +- If the parameter flush is set to Z_FINISH, pending input is processed, +- pending output is flushed and deflate returns with Z_STREAM_END if there +- was enough output space; if deflate returns with Z_OK, this function must be +- called again with Z_FINISH and more output space (updated avail_out) but no +- more input data, until it returns with Z_STREAM_END or an error. After +- deflate has returned Z_STREAM_END, the only possible operations on the +- stream are deflateReset or deflateEnd. +- +- Z_FINISH can be used immediately after deflateInit if all the compression +- is to be done in a single step. In this case, avail_out must be at least +- the value returned by deflateBound (see below). If deflate does not return +- Z_STREAM_END, then it must be called again as described above. +- +- deflate() sets strm->adler to the adler32 checksum of all input read +- so far (that is, total_in bytes). +- +- deflate() may update strm->data_type if it can make a good guess about +- the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered +- binary. This field is only for information purposes and does not affect +- the compression algorithm in any manner. +- +- deflate() returns Z_OK if some progress has been made (more input +- processed or more output produced), Z_STREAM_END if all input has been +- consumed and all output has been produced (only when flush is set to +- Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example +- if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible +- (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not +- fatal, and deflate() can be called again with more input and more output +- space to continue compressing. +-*/ +- +- +-ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); +-/* +- All dynamically allocated data structures for this stream are freed. +- This function discards any unprocessed input and does not flush any +- pending output. +- +- deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the +- stream state was inconsistent, Z_DATA_ERROR if the stream was freed +- prematurely (some input or output was discarded). In the error case, +- msg may be set but then points to a static string (which must not be +- deallocated). +-*/ +- +- +-/* +-ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); +- +- Initializes the internal stream state for decompression. The fields +- next_in, avail_in, zalloc, zfree and opaque must be initialized before by +- the caller. If next_in is not Z_NULL and avail_in is large enough (the exact +- value depends on the compression method), inflateInit determines the +- compression method from the zlib header and allocates all data structures +- accordingly; otherwise the allocation will be deferred to the first call of +- inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to +- use default allocation functions. +- +- inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_VERSION_ERROR if the zlib library version is incompatible with the +- version assumed by the caller. msg is set to null if there is no error +- message. inflateInit does not perform any decompression apart from reading +- the zlib header if present: this will be done by inflate(). (So next_in and +- avail_in may be modified, but next_out and avail_out are unchanged.) +-*/ +- +- +-ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); +-/* +- inflate decompresses as much data as possible, and stops when the input +- buffer becomes empty or the output buffer becomes full. It may introduce +- some output latency (reading input without producing any output) except when +- forced to flush. +- +- The detailed semantics are as follows. inflate performs one or both of the +- following actions: +- +- - Decompress more input starting at next_in and update next_in and avail_in +- accordingly. If not all input can be processed (because there is not +- enough room in the output buffer), next_in is updated and processing +- will resume at this point for the next call of inflate(). +- +- - Provide more output starting at next_out and update next_out and avail_out +- accordingly. inflate() provides as much output as possible, until there +- is no more input data or no more space in the output buffer (see below +- about the flush parameter). +- +- Before the call of inflate(), the application should ensure that at least +- one of the actions is possible, by providing more input and/or consuming +- more output, and updating the next_* and avail_* values accordingly. +- The application can consume the uncompressed output when it wants, for +- example when the output buffer is full (avail_out == 0), or after each +- call of inflate(). If inflate returns Z_OK and with zero avail_out, it +- must be called again after making room in the output buffer because there +- might be more output pending. +- +- The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, +- Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much +- output as possible to the output buffer. Z_BLOCK requests that inflate() stop +- if and when it gets to the next deflate block boundary. When decoding the +- zlib or gzip format, this will cause inflate() to return immediately after +- the header and before the first block. When doing a raw inflate, inflate() +- will go ahead and process the first block, and will return when it gets to +- the end of that block, or when it runs out of data. +- +- The Z_BLOCK option assists in appending to or combining deflate streams. +- Also to assist in this, on return inflate() will set strm->data_type to the +- number of unused bits in the last byte taken from strm->next_in, plus 64 +- if inflate() is currently decoding the last block in the deflate stream, +- plus 128 if inflate() returned immediately after decoding an end-of-block +- code or decoding the complete header up to just before the first byte of the +- deflate stream. The end-of-block will not be indicated until all of the +- uncompressed data from that block has been written to strm->next_out. The +- number of unused bits may in general be greater than seven, except when +- bit 7 of data_type is set, in which case the number of unused bits will be +- less than eight. +- +- inflate() should normally be called until it returns Z_STREAM_END or an +- error. However if all decompression is to be performed in a single step +- (a single call of inflate), the parameter flush should be set to +- Z_FINISH. In this case all pending input is processed and all pending +- output is flushed; avail_out must be large enough to hold all the +- uncompressed data. (The size of the uncompressed data may have been saved +- by the compressor for this purpose.) The next operation on this stream must +- be inflateEnd to deallocate the decompression state. The use of Z_FINISH +- is never required, but can be used to inform inflate that a faster approach +- may be used for the single inflate() call. +- +- In this implementation, inflate() always flushes as much output as +- possible to the output buffer, and always uses the faster approach on the +- first call. So the only effect of the flush parameter in this implementation +- is on the return value of inflate(), as noted below, or when it returns early +- because Z_BLOCK is used. +- +- If a preset dictionary is needed after this call (see inflateSetDictionary +- below), inflate sets strm->adler to the adler32 checksum of the 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() checks that its computed adler32 +- checksum is equal to that saved by the compressor and returns Z_STREAM_END +- only if the checksum is correct. +- +- inflate() will decompress and check either zlib-wrapped or gzip-wrapped +- deflate data. The header type is detected automatically. Any information +- contained in the gzip header is not retained, so applications that need that +- information should instead use raw inflate, see inflateInit2() below, or +- inflateBack() and perform their own processing of the gzip header and +- trailer. +- +- inflate() returns Z_OK if some progress has been made (more input processed +- or more output produced), Z_STREAM_END if the end of the compressed data has +- been reached and all uncompressed output has been produced, Z_NEED_DICT if a +- preset dictionary is needed at this point, Z_DATA_ERROR if the input data was +- corrupted (input stream not conforming to the zlib format or incorrect check +- value), Z_STREAM_ERROR if the stream structure was inconsistent (for example +- if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, +- Z_BUF_ERROR if no progress is possible or if there was not enough room in the +- output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and +- inflate() can be called again with more input and more output space to +- continue decompressing. If Z_DATA_ERROR is returned, the application may then +- call inflateSync() to look for a good compression block if a partial recovery +- of the data is desired. +-*/ +- +- +-ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); +-/* +- All dynamically allocated data structures for this stream are freed. +- This function discards any unprocessed input and does not flush any +- pending output. +- +- inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state +- was inconsistent. In the error case, msg may be set but then points to a +- static string (which must not be deallocated). +-*/ +- +- /* Advanced functions */ +- +-/* +- The following functions are needed only in some special applications. +-*/ +- +-/* +-ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, +- int level, +- int method, +- int windowBits, +- int memLevel, +- int strategy)); +- +- This is another version of deflateInit with more compression options. The +- fields next_in, zalloc, zfree and opaque must be initialized before by +- the caller. +- +- The method parameter is the compression method. It must be Z_DEFLATED in +- this version of the library. +- +- The windowBits parameter is the base two logarithm of the window size +- (the size of the history buffer). It should be in the range 8..15 for this +- version of the library. Larger values of this parameter result in better +- compression at the expense of memory usage. The default value is 15 if +- deflateInit is used instead. +- +- windowBits can also be -8..-15 for raw deflate. In this case, -windowBits +- determines the window size. deflate() will then generate raw deflate data +- with no zlib header or trailer, and will not compute an adler32 check value. +- +- windowBits can also be greater than 15 for optional gzip encoding. Add +- 16 to windowBits to write a simple gzip header and trailer around the +- compressed data instead of a zlib wrapper. The gzip header will have no +- file name, no extra data, no comment, no modification time (set to zero), +- no header crc, and the operating system will be set to 255 (unknown). If a +- gzip stream is being written, strm->adler is a crc32 instead of an adler32. +- +- The memLevel parameter specifies how much memory should be allocated +- for the internal compression state. memLevel=1 uses minimum memory but +- is slow and reduces compression ratio; memLevel=9 uses maximum memory +- for optimal speed. The default value is 8. See zconf.h for total memory +- usage as a function of windowBits and memLevel. +- +- The strategy parameter is used to tune the compression algorithm. Use the +- value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a +- filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no +- string match), or Z_RLE to limit match distances to one (run-length +- encoding). Filtered data consists mostly of small values with a somewhat +- random distribution. In this case, the compression algorithm is tuned to +- compress them better. The effect of Z_FILTERED is to force more Huffman +- coding and less string matching; it is somewhat intermediate between +- Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as +- Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy +- parameter only affects the compression ratio but not the correctness of the +- compressed output even if it is not set appropriately. Z_FIXED prevents the +- use of dynamic Huffman codes, allowing for a simpler decoder for special +- applications. +- +- deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid +- method). msg is set to null if there is no error message. deflateInit2 does +- not perform any compression: this will be done by deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, +- const Bytef *dictionary, +- uInt dictLength)); +-/* +- Initializes the compression dictionary from the given byte sequence +- without producing any compressed output. This function must be called +- immediately after deflateInit, deflateInit2 or deflateReset, before any +- call of deflate. The compressor and decompressor must use exactly the same +- dictionary (see inflateSetDictionary). +- +- The dictionary should consist of strings (byte sequences) that are likely +- to be encountered later in the data to be compressed, with the most commonly +- used strings preferably put towards the end of the dictionary. Using a +- dictionary is most useful when the data to be compressed is short and can be +- predicted with good accuracy; the data can then be compressed better than +- with the default empty dictionary. +- +- Depending on the size of the compression data structures selected by +- deflateInit or deflateInit2, a part of the dictionary may in effect be +- discarded, for example if the dictionary is larger than the window size in +- deflate or deflate2. Thus the strings most likely to be useful should be +- put at the end of the dictionary, not at the front. In addition, the +- current implementation of deflate will use at most the window size minus +- 262 bytes of the provided dictionary. +- +- Upon return of this function, strm->adler is set to the adler32 value +- of the dictionary; the decompressor may later use this value to determine +- which dictionary has been used by the compressor. (The adler32 value +- applies to the whole dictionary even if only a subset of the dictionary is +- actually used by the compressor.) If a raw deflate was requested, then the +- adler32 value is not computed and strm->adler is not set. +- +- deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a +- parameter is invalid (such as NULL dictionary) or the stream state is +- inconsistent (for example if deflate has already been called for this stream +- or if the compression method is bsort). deflateSetDictionary does not +- perform any compression: this will be done by deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, +- z_streamp source)); +-/* +- Sets the destination stream as a complete copy of the source stream. +- +- This function can be useful when several compression strategies will be +- tried, for example when there are several ways of pre-processing the input +- data with a filter. The streams that will be discarded should then be freed +- by calling deflateEnd. Note that deflateCopy duplicates the internal +- compression state which can be quite large, so this strategy is slow and +- can consume lots of memory. +- +- deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent +- (such as zalloc being NULL). msg is left unchanged in both source and +- destination. +-*/ +- +-ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); +-/* +- This function is equivalent to deflateEnd followed by deflateInit, +- but does not free and reallocate all the internal compression state. +- The stream will keep the same compression level and any other attributes +- that may have been set by deflateInit2. +- +- deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent (such as zalloc or state being NULL). +-*/ +- +-ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, +- int level, +- int strategy)); +-/* +- Dynamically update the compression level and compression strategy. The +- interpretation of level and strategy is as in deflateInit2. This can be +- used to switch between compression and straight copy of the input data, or +- to switch to a different kind of input data requiring a different +- strategy. If the compression level is changed, the input available so far +- is compressed with the old level (and may be flushed); the new level will +- take effect only at the next call of deflate(). +- +- Before the call of deflateParams, the stream state must be set as for +- a call of deflate(), since the currently available input may have to +- be compressed and flushed. In particular, strm->avail_out must be non-zero. +- +- deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source +- stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR +- if strm->avail_out was zero. +-*/ +- +-ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, +- int good_length, +- int max_lazy, +- int nice_length, +- int max_chain)); +-/* +- Fine tune deflate's internal compression parameters. This should only be +- used by someone who understands the algorithm used by zlib's deflate for +- searching for the best matching string, and even then only by the most +- fanatic optimizer trying to squeeze out the last compressed bit for their +- specific input data. Read the deflate.c source code for the meaning of the +- max_lazy, good_length, nice_length, and max_chain parameters. +- +- deflateTune() can be called after deflateInit() or deflateInit2(), and +- returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. +- */ +- +-ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, +- uLong sourceLen)); +-/* +- deflateBound() returns an upper bound on the compressed size after +- deflation of sourceLen bytes. It must be called after deflateInit() +- or deflateInit2(). This would be used to allocate an output buffer +- for deflation in a single pass, and so would be called before deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, +- int bits, +- int value)); +-/* +- deflatePrime() inserts bits in the deflate output stream. The intent +- is that this function is used to start off the deflate output with the +- bits leftover from a previous deflate stream when appending to it. As such, +- this function can only be used for raw deflate, and must be used before the +- first deflate() call after a deflateInit2() or deflateReset(). bits must be +- less than or equal to 16, and that many of the least significant bits of +- value will be inserted in the output. +- +- deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, +- gz_headerp head)); +-/* +- deflateSetHeader() provides gzip header information for when a gzip +- stream is requested by deflateInit2(). deflateSetHeader() may be called +- after deflateInit2() or deflateReset() and before the first call of +- deflate(). The text, time, os, extra field, name, and comment information +- in the provided gz_header structure are written to the gzip header (xflag is +- ignored -- the extra flags are set according to the compression level). The +- caller must assure that, if not Z_NULL, name and comment are terminated with +- a zero byte, and that if extra is not Z_NULL, that extra_len bytes are +- available there. If hcrc is true, a gzip header crc is included. Note that +- the current versions of the command-line version of gzip (up through version +- 1.3.x) do not support header crc's, and will report that it is a "multi-part +- gzip file" and give up. +- +- If deflateSetHeader is not used, the default gzip header has text false, +- the time set to zero, and os set to 255, with no extra, name, or comment +- fields. The gzip header is returned to the default state by deflateReset(). +- +- deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-/* +-ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, +- int windowBits)); +- +- This is another version of inflateInit with an extra parameter. The +- fields next_in, avail_in, zalloc, zfree and opaque must be initialized +- before by the caller. +- +- The windowBits parameter is the base two logarithm of the maximum window +- size (the size of the history buffer). It should be in the range 8..15 for +- this version of the library. The default value is 15 if inflateInit is used +- instead. windowBits must be greater than or equal to the windowBits value +- provided to deflateInit2() while compressing, or it must be equal to 15 if +- deflateInit2() was not used. If a compressed stream with a larger window +- size is given as input, inflate() will return with the error code +- Z_DATA_ERROR instead of trying to allocate a larger window. +- +- windowBits can also be -8..-15 for raw inflate. In this case, -windowBits +- determines the window size. inflate() will then process raw deflate data, +- not looking for a zlib or gzip header, not generating a check value, and not +- looking for any check values for comparison at the end of the stream. This +- is for use with other formats that use the deflate compressed data format +- such as zip. Those formats provide their own check values. If a custom +- format is developed using the raw deflate format for compressed data, it is +- recommended that a check value such as an adler32 or a crc32 be applied to +- the uncompressed data as is done in the zlib, gzip, and zip formats. For +- most applications, the zlib format should be used as is. Note that comments +- above on the use in deflateInit2() applies to the magnitude of windowBits. +- +- windowBits can also be greater than 15 for optional gzip decoding. Add +- 32 to windowBits to enable zlib and gzip decoding with automatic header +- detection, or add 16 to decode only the gzip format (the zlib format will +- return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is +- a crc32 instead of an adler32. +- +- inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). msg +- is set to null if there is no error message. inflateInit2 does not perform +- any decompression apart from reading the zlib header if present: this will +- be done by inflate(). (So next_in and avail_in may be modified, but next_out +- and avail_out are unchanged.) +-*/ +- +-ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, +- const Bytef *dictionary, +- uInt dictLength)); +-/* +- Initializes the decompression dictionary from the given uncompressed byte +- sequence. This function must be called immediately after a call of inflate, +- if that call returned Z_NEED_DICT. The dictionary chosen by the compressor +- can be determined from the adler32 value returned by that call of inflate. +- The compressor and decompressor must use exactly the same dictionary (see +- deflateSetDictionary). For raw inflate, this function can be called +- immediately after inflateInit2() or inflateReset() and before any call of +- inflate() to set the dictionary. The application must insure that the +- dictionary that was used for compression is provided. +- +- inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a +- parameter is invalid (such as NULL dictionary) or the stream state is +- inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the +- expected one (incorrect adler32 value). inflateSetDictionary does not +- perform any decompression: this will be done by subsequent calls of +- inflate(). +-*/ +- +-ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); +-/* +- Skips invalid compressed data until a full flush point (see above the +- description of deflate with Z_FULL_FLUSH) can be found, or until all +- available input is skipped. No output is provided. +- +- inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR +- if no more input was provided, Z_DATA_ERROR if no flush point has been found, +- or Z_STREAM_ERROR if the stream structure was inconsistent. In the success +- case, the application may save the current current value of total_in which +- indicates where valid compressed data was found. In the error case, the +- application may repeatedly call inflateSync, providing more input each time, +- until success or end of the input data. +-*/ +- +-ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, +- z_streamp source)); +-/* +- Sets the destination stream as a complete copy of the source stream. +- +- This function can be useful when randomly accessing a large stream. The +- first pass through the stream can periodically record the inflate state, +- allowing restarting inflate at those points when randomly accessing the +- stream. +- +- inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent +- (such as zalloc being NULL). msg is left unchanged in both source and +- destination. +-*/ +- +-ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); +-/* +- This function is equivalent to inflateEnd followed by inflateInit, +- but does not free and reallocate all the internal decompression state. +- The stream will keep attributes that may have been set by inflateInit2. +- +- inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent (such as zalloc or state being NULL). +-*/ +- +-ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, +- int bits, +- int value)); +-/* +- This function inserts bits in the inflate input stream. The intent is +- that this function is used to start inflating at a bit position in the +- middle of a byte. The provided bits will be used before any bytes are used +- from next_in. This function should only be used with raw inflate, and +- should be used before the first inflate() call after inflateInit2() or +- inflateReset(). bits must be less than or equal to 16, and that many of the +- least significant bits of value will be inserted in the input. +- +- inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, +- gz_headerp head)); +-/* +- inflateGetHeader() requests that gzip header information be stored in the +- provided gz_header structure. inflateGetHeader() may be called after +- inflateInit2() or inflateReset(), and before the first call of inflate(). +- As inflate() processes the gzip stream, head->done is zero until the header +- is completed, at which time head->done is set to one. If a zlib stream is +- being decoded, then head->done is set to -1 to indicate that there will be +- no gzip header information forthcoming. Note that Z_BLOCK can be used to +- force inflate() to return immediately after header processing is complete +- and before any actual data is decompressed. +- +- The text, time, xflags, and os fields are filled in with the gzip header +- contents. hcrc is set to true if there is a header CRC. (The header CRC +- was valid if done is set to one.) If extra is not Z_NULL, then extra_max +- contains the maximum number of bytes to write to extra. Once done is true, +- extra_len contains the actual extra field length, and extra contains the +- extra field, or that field truncated if extra_max is less than extra_len. +- If name is not Z_NULL, then up to name_max characters are written there, +- terminated with a zero unless the length is greater than name_max. If +- comment is not Z_NULL, then up to comm_max characters are written there, +- terminated with a zero unless the length is greater than comm_max. When +- any of extra, name, or comment are not Z_NULL and the respective field is +- not present in the header, then that field is set to Z_NULL to signal its +- absence. This allows the use of deflateSetHeader() with the returned +- structure to duplicate the header. However if those fields are set to +- allocated memory, then the application will need to save those pointers +- elsewhere so that they can be eventually freed. +- +- If inflateGetHeader is not used, then the header information is simply +- discarded. The header is always checked for validity, including the header +- CRC if present. inflateReset() will reset the process to discard the header +- information. The application would need to call inflateGetHeader() again to +- retrieve the header from the next gzip stream. +- +- inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-/* +-ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, +- unsigned char FAR *window)); +- +- Initialize the internal stream state for decompression using inflateBack() +- calls. The fields zalloc, zfree and opaque in strm must be initialized +- before the call. If zalloc and zfree are Z_NULL, then the default library- +- derived memory allocation routines are used. windowBits is the base two +- logarithm of the window size, in the range 8..15. window is a caller +- supplied buffer of that size. Except for special applications where it is +- assured that deflate was used with small window sizes, windowBits must be 15 +- and a 32K byte window must be supplied to be able to decompress general +- deflate streams. +- +- See inflateBack() for the usage of these routines. +- +- inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of +- the paramaters are invalid, Z_MEM_ERROR if the internal state could not +- be allocated, or Z_VERSION_ERROR if the version of the library does not +- match the version of the header file. +-*/ +- +-typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); +-typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); +- +-ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, +- in_func in, void FAR *in_desc, +- out_func out, void FAR *out_desc)); +-/* +- inflateBack() does a raw inflate with a single call using a call-back +- interface for input and output. This is more efficient than inflate() for +- file i/o applications in that it avoids copying between the output and the +- sliding window by simply making the window itself the output buffer. This +- function trusts the application to not change the output buffer passed by +- the output function, at least until inflateBack() returns. +- +- inflateBackInit() must be called first to allocate the internal state +- and to initialize the state with the user-provided window buffer. +- inflateBack() may then be used multiple times to inflate a complete, raw +- deflate stream with each call. inflateBackEnd() is then called to free +- the allocated state. +- +- A raw deflate stream is one with no zlib or gzip header or trailer. +- This routine would normally be used in a utility that reads zip or gzip +- files and writes out uncompressed files. The utility would decode the +- header and process the trailer on its own, hence this routine expects +- only the raw deflate stream to decompress. This is different from the +- normal behavior of inflate(), which expects either a zlib or gzip header and +- trailer around the deflate stream. +- +- inflateBack() uses two subroutines supplied by the caller that are then +- called by inflateBack() for input and output. inflateBack() calls those +- routines until it reads a complete deflate stream and writes out all of the +- uncompressed data, or until it encounters an error. The function's +- parameters and return types are defined above in the in_func and out_func +- typedefs. inflateBack() will call in(in_desc, &buf) which should return the +- number of bytes of provided input, and a pointer to that input in buf. If +- there is no input available, in() must return zero--buf is ignored in that +- case--and inflateBack() will return a buffer error. inflateBack() will call +- out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() +- should return zero on success, or non-zero on failure. If out() returns +- non-zero, inflateBack() will return with an error. Neither in() nor out() +- are permitted to change the contents of the window provided to +- inflateBackInit(), which is also the buffer that out() uses to write from. +- The length written by out() will be at most the window size. Any non-zero +- amount of input may be provided by in(). +- +- For convenience, inflateBack() can be provided input on the first call by +- setting strm->next_in and strm->avail_in. If that input is exhausted, then +- in() will be called. Therefore strm->next_in must be initialized before +- calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called +- immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in +- must also be initialized, and then if strm->avail_in is not zero, input will +- initially be taken from strm->next_in[0 .. strm->avail_in - 1]. +- +- The in_desc and out_desc parameters of inflateBack() is passed as the +- first parameter of in() and out() respectively when they are called. These +- descriptors can be optionally used to pass any information that the caller- +- supplied in() and out() functions need to do their job. +- +- On return, inflateBack() will set strm->next_in and strm->avail_in to +- pass back any unused input that was provided by the last in() call. The +- return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR +- if in() or out() returned an error, Z_DATA_ERROR if there was a format +- error in the deflate stream (in which case strm->msg is set to indicate the +- nature of the error), or Z_STREAM_ERROR if the stream was not properly +- initialized. In the case of Z_BUF_ERROR, an input or output error can be +- distinguished using strm->next_in which will be Z_NULL only if in() returned +- an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to +- out() returning non-zero. (in() will always be called before out(), so +- strm->next_in is assured to be defined if out() returns non-zero.) Note +- that inflateBack() cannot return Z_OK. +-*/ +- +-ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); +-/* +- All memory allocated by inflateBackInit() is freed. +- +- inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream +- state was inconsistent. +-*/ +- +-ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); +-/* Return flags indicating compile-time options. +- +- Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: +- 1.0: size of uInt +- 3.2: size of uLong +- 5.4: size of voidpf (pointer) +- 7.6: size of z_off_t +- +- Compiler, assembler, and debug options: +- 8: DEBUG +- 9: ASMV or ASMINF -- use ASM code +- 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention +- 11: 0 (reserved) +- +- One-time table building (smaller code, but not thread-safe if true): +- 12: BUILDFIXED -- build static block decoding tables when needed +- 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed +- 14,15: 0 (reserved) +- +- Library content (indicates missing functionality): +- 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking +- deflate code when not needed) +- 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect +- and decode gzip streams (to avoid linking crc code) +- 18-19: 0 (reserved) +- +- Operation variations (changes in library functionality): +- 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate +- 21: FASTEST -- deflate algorithm with only one, lowest compression level +- 22,23: 0 (reserved) +- +- The sprintf variant used by gzprintf (zero is best): +- 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format +- 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! +- 26: 0 = returns value, 1 = void -- 1 means inferred string length returned +- +- Remainder: +- 27-31: 0 (reserved) +- */ +- +- +- /* utility functions */ +- +-/* +- The following utility functions are implemented on top of the +- basic stream-oriented functions. To simplify the interface, some +- default options are assumed (compression level and memory usage, +- standard memory allocation functions). The source code of these +- utility functions can easily be modified if you need special options. +-*/ +- +-ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen)); +-/* +- Compresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be at least the value returned +- by compressBound(sourceLen). Upon exit, destLen is the actual size of the +- compressed buffer. +- This function can be used to compress a whole file at once if the +- input file is mmap'ed. +- compress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer. +-*/ +- +-ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen, +- int level)); +-/* +- Compresses the source buffer into the destination buffer. The level +- parameter has the same meaning as in deflateInit. sourceLen is the byte +- length of the source buffer. Upon entry, destLen is the total size of the +- destination buffer, which must be at least the value returned by +- compressBound(sourceLen). Upon exit, destLen is the actual size of the +- compressed buffer. +- +- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_BUF_ERROR if there was not enough room in the output buffer, +- Z_STREAM_ERROR if the level parameter is invalid. +-*/ +- +-ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); +-/* +- compressBound() returns an upper bound on the compressed size after +- compress() or compress2() on sourceLen bytes. It would be used before +- a compress() or compress2() call to allocate the destination buffer. +-*/ +- +-ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen)); +-/* +- Decompresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be large enough to hold the +- entire uncompressed data. (The size of the uncompressed data must have +- been saved previously by the compressor and transmitted to the decompressor +- by some mechanism outside the scope of this compression library.) +- Upon exit, destLen is the actual size of the compressed buffer. +- This function can be used to decompress a whole file at once if the +- input file is mmap'ed. +- +- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. +-*/ +- +- +-typedef voidp gzFile; +- +-ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); +-/* +- Opens a gzip (.gz) file for reading or writing. The mode parameter +- is as in fopen ("rb" or "wb") but can also include a compression level +- ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for +- Huffman only compression as in "wb1h", or 'R' for run-length encoding +- as in "wb1R". (See the description of deflateInit2 for more information +- about the strategy parameter.) +- +- gzopen can be used to read a file which is not in gzip format; in this +- case gzread will directly read from the file without decompression. +- +- gzopen returns NULL if the file could not be opened or if there was +- insufficient memory to allocate the (de)compression state; errno +- can be checked to distinguish the two cases (if errno is zero, the +- zlib error is Z_MEM_ERROR). */ +- +-ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); +-/* +- gzdopen() associates a gzFile with the file descriptor fd. File +- descriptors are obtained from calls like open, dup, creat, pipe or +- fileno (in the file has been previously opened with fopen). +- The mode parameter is as in gzopen. +- The next call of gzclose on the returned gzFile will also close the +- file descriptor fd, just like fclose(fdopen(fd), mode) closes the file +- descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). +- gzdopen returns NULL if there was insufficient memory to allocate +- the (de)compression state. +-*/ +- +-ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); +-/* +- Dynamically update the compression level or strategy. See the description +- of deflateInit2 for the meaning of these parameters. +- gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not +- opened for writing. +-*/ +- +-ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); +-/* +- Reads the given number of uncompressed bytes from the compressed file. +- If the input file was not in gzip format, gzread copies the given number +- of bytes into the buffer. +- gzread returns the number of uncompressed bytes actually read (0 for +- end of file, -1 for error). */ +- +-ZEXTERN int ZEXPORT gzwrite OF((gzFile file, +- voidpc buf, unsigned len)); +-/* +- Writes the given number of uncompressed bytes into the compressed file. +- gzwrite returns the number of uncompressed bytes actually written +- (0 in case of error). +-*/ +- +-ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); +-/* +- Converts, formats, and writes the args to the compressed file under +- control of the format string, as in fprintf. gzprintf returns the number of +- uncompressed bytes actually written (0 in case of error). The number of +- uncompressed bytes written is limited to 4095. The caller should assure that +- this limit is not exceeded. If it is exceeded, then gzprintf() will return +- return an error (0) with nothing written. In this case, there may also be a +- buffer overflow with unpredictable consequences, which is possible only if +- zlib was compiled with the insecure functions sprintf() or vsprintf() +- because the secure snprintf() or vsnprintf() functions were not available. +-*/ +- +-ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); +-/* +- Writes the given null-terminated string to the compressed file, excluding +- the terminating null character. +- gzputs returns the number of characters written, or -1 in case of error. +-*/ +- +-ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); +-/* +- Reads bytes from the compressed file until len-1 characters are read, or +- a newline character is read and transferred to buf, or an end-of-file +- condition is encountered. The string is then terminated with a null +- character. +- gzgets returns buf, or Z_NULL in case of error. +-*/ +- +-ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); +-/* +- Writes c, converted to an unsigned char, into the compressed file. +- gzputc returns the value that was written, or -1 in case of error. +-*/ +- +-ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); +-/* +- Reads one byte from the compressed file. gzgetc returns this byte +- or -1 in case of end of file or error. +-*/ +- +-ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); +-/* +- Push one character back onto the stream to be read again later. +- Only one character of push-back is allowed. gzungetc() returns the +- character pushed, or -1 on failure. gzungetc() will fail if a +- character has been pushed but not read yet, or if c is -1. The pushed +- character will be discarded if the stream is repositioned with gzseek() +- or gzrewind(). +-*/ +- +-ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); +-/* +- Flushes all pending output into the compressed file. The parameter +- flush is as in the deflate() function. The return value is the zlib +- error number (see function gzerror below). gzflush returns Z_OK if +- the flush parameter is Z_FINISH and all output could be flushed. +- gzflush should be called only when strictly necessary because it can +- degrade compression. +-*/ +- +-ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, +- z_off_t offset, int whence)); +-/* +- Sets the starting position for the next gzread or gzwrite on the +- given compressed file. The offset represents a number of bytes in the +- uncompressed data stream. The whence parameter is defined as in lseek(2); +- the value SEEK_END is not supported. +- If the file is opened for reading, this function is emulated but can be +- extremely slow. If the file is opened for writing, only forward seeks are +- supported; gzseek then compresses a sequence of zeroes up to the new +- starting position. +- +- gzseek returns the resulting offset location as measured in bytes from +- the beginning of the uncompressed stream, or -1 in case of error, in +- particular if the file is opened for writing and the new starting position +- would be before the current position. +-*/ +- +-ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); +-/* +- Rewinds the given file. This function is supported only for reading. +- +- gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) +-*/ +- +-ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); +-/* +- Returns the starting position for the next gzread or gzwrite on the +- given compressed file. This position represents a number of bytes in the +- uncompressed data stream. +- +- gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +-*/ +- +-ZEXTERN int ZEXPORT gzeof OF((gzFile file)); +-/* +- Returns 1 when EOF has previously been detected reading the given +- input stream, otherwise zero. +-*/ +- +-ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); +-/* +- Returns 1 if file is being read directly without decompression, otherwise +- zero. +-*/ +- +-ZEXTERN int ZEXPORT gzclose OF((gzFile file)); +-/* +- Flushes all pending output if necessary, closes the compressed file +- and deallocates all the (de)compression state. The return value is the zlib +- error number (see function gzerror below). +-*/ +- +-ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); +-/* +- Returns the error message for the last error which occurred on the +- given compressed file. errnum is set to zlib error number. If an +- error occurred in the file system and not in the compression library, +- errnum is set to Z_ERRNO and the application may consult errno +- to get the exact error code. +-*/ +- +-ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); +-/* +- Clears the error and end-of-file flags for file. This is analogous to the +- clearerr() function in stdio. This is useful for continuing to read a gzip +- file that is being written concurrently. +-*/ +- +- /* checksum functions */ +- +-/* +- These functions are not related to compression but are exported +- anyway because they might be useful in applications using the +- compression library. +-*/ +- +-ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); +-/* +- Update a running Adler-32 checksum with the bytes buf[0..len-1] and +- return the updated checksum. If buf is NULL, this function returns +- the required initial value for the checksum. +- An Adler-32 checksum is almost as reliable as a CRC32 but can be computed +- much faster. Usage example: +- +- uLong adler = adler32(0L, Z_NULL, 0); +- +- while (read_buffer(buffer, length) != EOF) { +- adler = adler32(adler, buffer, length); +- } +- if (adler != original_adler) error(); +-*/ +- +-ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, +- z_off_t len2)); +-/* +- Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 +- and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for +- each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of +- seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. +-*/ +- +-ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); +-/* +- Update a running CRC-32 with the bytes buf[0..len-1] and return the +- updated CRC-32. If buf is NULL, this function returns the required initial +- value for the 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: +- +- uLong crc = crc32(0L, Z_NULL, 0); +- +- while (read_buffer(buffer, length) != EOF) { +- crc = crc32(crc, buffer, length); +- } +- if (crc != original_crc) error(); +-*/ +- +-ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); +- +-/* +- Combine two CRC-32 check values into one. For two sequences of bytes, +- seq1 and seq2 with lengths len1 and len2, CRC-32 check values were +- calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 +- check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and +- len2. +-*/ +- +- +- /* various hacks, don't look :) */ +- +-/* deflateInit and inflateInit are macros to allow checking the zlib version +- * and the compiler's view of z_stream: +- */ +-ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, +- int windowBits, int memLevel, +- int strategy, const char *version, +- int stream_size)); +-ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, +- unsigned char FAR *window, +- const char *version, +- int stream_size)); +-#define deflateInit(strm, level) \ +- deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateInit(strm) \ +- inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) +-#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ +- deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ +- (strategy), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateInit2(strm, windowBits) \ +- inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateBackInit(strm, windowBits, window) \ +- inflateBackInit_((strm), (windowBits), (window), \ +- ZLIB_VERSION, sizeof(z_stream)) +- +- +-#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) +- struct internal_state {int dummy;}; /* hack for buggy compilers */ +-#endif +- +-ZEXTERN const char * ZEXPORT zError OF((int)); +-ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); +-ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); +- +-#ifdef __cplusplus +-} +-#endif +- +-#endif /* ZLIB_H */ +diff -ruN RJaCGH.orig/src/zutil.c RJaCGH/src/zutil.c +--- RJaCGH.orig/src/zutil.c 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/zutil.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,318 +0,0 @@ +-/* zutil.c -- target dependent utility functions for the compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id$ */ +- +-#include "zutil.h" +- +-#ifndef NO_DUMMY_DECL +-struct internal_state {int dummy;}; /* for buggy compilers */ +-#endif +- +-const char * const z_errmsg[10] = { +-"need dictionary", /* Z_NEED_DICT 2 */ +-"stream end", /* Z_STREAM_END 1 */ +-"", /* Z_OK 0 */ +-"file error", /* Z_ERRNO (-1) */ +-"stream error", /* Z_STREAM_ERROR (-2) */ +-"data error", /* Z_DATA_ERROR (-3) */ +-"insufficient memory", /* Z_MEM_ERROR (-4) */ +-"buffer error", /* Z_BUF_ERROR (-5) */ +-"incompatible version",/* Z_VERSION_ERROR (-6) */ +-""}; +- +- +-const char * ZEXPORT zlibVersion() +-{ +- return ZLIB_VERSION; +-} +- +-uLong ZEXPORT zlibCompileFlags() +-{ +- uLong flags; +- +- flags = 0; +- switch (sizeof(uInt)) { +- case 2: break; +- case 4: flags += 1; break; +- case 8: flags += 2; break; +- default: flags += 3; +- } +- switch (sizeof(uLong)) { +- case 2: break; +- case 4: flags += 1 << 2; break; +- case 8: flags += 2 << 2; break; +- default: flags += 3 << 2; +- } +- switch (sizeof(voidpf)) { +- case 2: break; +- case 4: flags += 1 << 4; break; +- case 8: flags += 2 << 4; break; +- default: flags += 3 << 4; +- } +- switch (sizeof(z_off_t)) { +- case 2: break; +- case 4: flags += 1 << 6; break; +- case 8: flags += 2 << 6; break; +- default: flags += 3 << 6; +- } +-#ifdef DEBUG +- flags += 1 << 8; +-#endif +-#if defined(ASMV) || defined(ASMINF) +- flags += 1 << 9; +-#endif +-#ifdef ZLIB_WINAPI +- flags += 1 << 10; +-#endif +-#ifdef BUILDFIXED +- flags += 1 << 12; +-#endif +-#ifdef DYNAMIC_CRC_TABLE +- flags += 1 << 13; +-#endif +-#ifdef NO_GZCOMPRESS +- flags += 1L << 16; +-#endif +-#ifdef NO_GZIP +- flags += 1L << 17; +-#endif +-#ifdef PKZIP_BUG_WORKAROUND +- flags += 1L << 20; +-#endif +-#ifdef FASTEST +- flags += 1L << 21; +-#endif +-#ifdef STDC +-# ifdef NO_vsnprintf +- flags += 1L << 25; +-# ifdef HAS_vsprintf_void +- flags += 1L << 26; +-# endif +-# else +-# ifdef HAS_vsnprintf_void +- flags += 1L << 26; +-# endif +-# endif +-#else +- flags += 1L << 24; +-# ifdef NO_snprintf +- flags += 1L << 25; +-# ifdef HAS_sprintf_void +- flags += 1L << 26; +-# endif +-# else +-# ifdef HAS_snprintf_void +- flags += 1L << 26; +-# endif +-# endif +-#endif +- return flags; +-} +- +-#ifdef DEBUG +- +-# ifndef verbose +-# define verbose 0 +-# endif +-int z_verbose = verbose; +- +-void z_error (m) +- char *m; +-{ +- fprintf(stderr, "%s\n", m); +- exit(1); +-} +-#endif +- +-/* exported to allow conversion of error code to string for compress() and +- * uncompress() +- */ +-const char * ZEXPORT zError(err) +- int err; +-{ +- return ERR_MSG(err); +-} +- +-#if defined(_WIN32_WCE) +- /* The Microsoft C Run-Time Library for Windows CE doesn't have +- * errno. We define it as a global variable to simplify porting. +- * Its value is always 0 and should not be used. +- */ +- int errno = 0; +-#endif +- +-#ifndef HAVE_MEMCPY +- +-void zmemcpy(dest, source, len) +- Bytef* dest; +- const Bytef* source; +- uInt len; +-{ +- if (len == 0) return; +- do { +- *dest++ = *source++; /* ??? to be unrolled */ +- } while (--len != 0); +-} +- +-int zmemcmp(s1, s2, len) +- const Bytef* s1; +- const Bytef* s2; +- uInt len; +-{ +- uInt j; +- +- for (j = 0; j < len; j++) { +- if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1; +- } +- return 0; +-} +- +-void zmemzero(dest, len) +- Bytef* dest; +- uInt len; +-{ +- if (len == 0) return; +- do { +- *dest++ = 0; /* ??? to be unrolled */ +- } while (--len != 0); +-} +-#endif +- +- +-#ifdef SYS16BIT +- +-#ifdef __TURBOC__ +-/* Turbo C in 16-bit mode */ +- +-# define MY_ZCALLOC +- +-/* Turbo C malloc() does not allow dynamic allocation of 64K bytes +- * and farmalloc(64K) returns a pointer with an offset of 8, so we +- * must fix the pointer. Warning: the pointer must be put back to its +- * original form in order to free it, use zcfree(). +- */ +- +-#define MAX_PTR 10 +-/* 10*64K = 640K */ +- +-local int next_ptr = 0; +- +-typedef struct ptr_table_s { +- voidpf org_ptr; +- voidpf new_ptr; +-} ptr_table; +- +-local ptr_table table[MAX_PTR]; +-/* This table is used to remember the original form of pointers +- * to large buffers (64K). Such pointers are normalized with a zero offset. +- * Since MSDOS is not a preemptive multitasking OS, this table is not +- * protected from concurrent access. This hack doesn't work anyway on +- * a protected system like OS/2. Use Microsoft C instead. +- */ +- +-voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +-{ +- voidpf buf = opaque; /* just to make some compilers happy */ +- ulg bsize = (ulg)items*size; +- +- /* If we allocate less than 65520 bytes, we assume that farmalloc +- * will return a usable pointer which doesn't have to be normalized. +- */ +- if (bsize < 65520L) { +- buf = farmalloc(bsize); +- if (*(ush*)&buf != 0) return buf; +- } else { +- buf = farmalloc(bsize + 16L); +- } +- if (buf == NULL || next_ptr >= MAX_PTR) return NULL; +- table[next_ptr].org_ptr = buf; +- +- /* Normalize the pointer to seg:0 */ +- *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4; +- *(ush*)&buf = 0; +- table[next_ptr++].new_ptr = buf; +- return buf; +-} +- +-void zcfree (voidpf opaque, voidpf ptr) +-{ +- int n; +- if (*(ush*)&ptr != 0) { /* object < 64K */ +- farfree(ptr); +- return; +- } +- /* Find the original pointer */ +- for (n = 0; n < next_ptr; n++) { +- if (ptr != table[n].new_ptr) continue; +- +- farfree(table[n].org_ptr); +- while (++n < next_ptr) { +- table[n-1] = table[n]; +- } +- next_ptr--; +- return; +- } +- ptr = opaque; /* just to make some compilers happy */ +- Assert(0, "zcfree: ptr not found"); +-} +- +-#endif /* __TURBOC__ */ +- +- +-#ifdef M_I86 +-/* Microsoft C in 16-bit mode */ +- +-# define MY_ZCALLOC +- +-#if (!defined(_MSC_VER) || (_MSC_VER <= 600)) +-# define _halloc halloc +-# define _hfree hfree +-#endif +- +-voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +-{ +- if (opaque) opaque = 0; /* to make compiler happy */ +- return _halloc((long)items, size); +-} +- +-void zcfree (voidpf opaque, voidpf ptr) +-{ +- if (opaque) opaque = 0; /* to make compiler happy */ +- _hfree(ptr); +-} +- +-#endif /* M_I86 */ +- +-#endif /* SYS16BIT */ +- +- +-#ifndef MY_ZCALLOC /* Any system without a special alloc function */ +- +-#ifndef STDC +-extern voidp malloc OF((uInt size)); +-extern voidp calloc OF((uInt items, uInt size)); +-extern void free OF((voidpf ptr)); +-#endif +- +-voidpf zcalloc (opaque, items, size) +- voidpf opaque; +- unsigned items; +- unsigned size; +-{ +- if (opaque) items += size - size; /* make compiler happy */ +- return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) : +- (voidpf)calloc(items, size); +-} +- +-void zcfree (opaque, ptr) +- voidpf opaque; +- voidpf ptr; +-{ +- free(ptr); +- if (opaque) return; /* make compiler happy */ +-} +- +-#endif /* MY_ZCALLOC */ +diff -ruN RJaCGH.orig/src/zutil.h RJaCGH/src/zutil.h +--- RJaCGH.orig/src/zutil.h 2009-03-04 12:51:20.000000000 +0100 ++++ RJaCGH/src/zutil.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,269 +0,0 @@ +-/* zutil.h -- internal interface and configuration of the compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* @(#) $Id$ */ +- +-#ifndef ZUTIL_H +-#define ZUTIL_H +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-#ifdef STDC +-# ifndef _WIN32_WCE +-# include +-# endif +-# include +-# include +-#endif +-#ifdef NO_ERRNO_H +-# ifdef _WIN32_WCE +- /* The Microsoft C Run-Time Library for Windows CE doesn't have +- * errno. We define it as a global variable to simplify porting. +- * Its value is always 0 and should not be used. We rename it to +- * avoid conflict with other libraries that use the same workaround. +- */ +-# define errno z_errno +-# endif +- extern int errno; +-#else +-# ifndef _WIN32_WCE +-# include +-# endif +-#endif +- +-#ifndef local +-# define local static +-#endif +-/* compile with -Dlocal if your debugger can't find static symbols */ +- +-typedef unsigned char uch; +-typedef uch FAR uchf; +-typedef unsigned short ush; +-typedef ush FAR ushf; +-typedef unsigned long ulg; +- +-extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ +-/* (size given to avoid silly warnings with Visual C++) */ +- +-#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] +- +-#define ERR_RETURN(strm,err) \ +- return (strm->msg = (char*)ERR_MSG(err), (err)) +-/* To be used only when the state is known to be valid */ +- +- /* common constants */ +- +-#ifndef DEF_WBITS +-# define DEF_WBITS MAX_WBITS +-#endif +-/* default windowBits for decompression. MAX_WBITS is for compression only */ +- +-#if MAX_MEM_LEVEL >= 8 +-# define DEF_MEM_LEVEL 8 +-#else +-# define DEF_MEM_LEVEL MAX_MEM_LEVEL +-#endif +-/* default memLevel */ +- +-#define STORED_BLOCK 0 +-#define STATIC_TREES 1 +-#define DYN_TREES 2 +-/* The three kinds of block type */ +- +-#define MIN_MATCH 3 +-#define MAX_MATCH 258 +-/* The minimum and maximum match lengths */ +- +-#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ +- +- /* target dependencies */ +- +-#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) +-# define OS_CODE 0x00 +-# if defined(__TURBOC__) || defined(__BORLANDC__) +-# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) +- /* Allow compilation with ANSI keywords only enabled */ +- void _Cdecl farfree( void *block ); +- void *_Cdecl farmalloc( unsigned long nbytes ); +-# else +-# include +-# endif +-# else /* MSC or DJGPP */ +-# include +-# endif +-#endif +- +-#ifdef AMIGA +-# define OS_CODE 0x01 +-#endif +- +-#if defined(VAXC) || defined(VMS) +-# define OS_CODE 0x02 +-# define F_OPEN(name, mode) \ +- fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") +-#endif +- +-#if defined(ATARI) || defined(atarist) +-# define OS_CODE 0x05 +-#endif +- +-#ifdef OS2 +-# define OS_CODE 0x06 +-# ifdef M_I86 +- #include +-# endif +-#endif +- +-#if defined(MACOS) || defined(TARGET_OS_MAC) +-# define OS_CODE 0x07 +-# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os +-# include /* for fdopen */ +-# else +-# ifndef fdopen +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-# endif +-# endif +-#endif +- +-#ifdef TOPS20 +-# define OS_CODE 0x0a +-#endif +- +-#ifdef WIN32 +-# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ +-# define OS_CODE 0x0b +-# endif +-#endif +- +-#ifdef __50SERIES /* Prime/PRIMOS */ +-# define OS_CODE 0x0f +-#endif +- +-#if defined(_BEOS_) || defined(RISCOS) +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-#endif +- +-#if (defined(_MSC_VER) && (_MSC_VER > 600)) +-# if defined(_WIN32_WCE) +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-# ifndef _PTRDIFF_T_DEFINED +- typedef int ptrdiff_t; +-# define _PTRDIFF_T_DEFINED +-# endif +-# else +-# define fdopen(fd,type) _fdopen(fd,type) +-# endif +-#endif +- +- /* common defaults */ +- +-#ifndef OS_CODE +-# define OS_CODE 0x03 /* assume Unix */ +-#endif +- +-#ifndef F_OPEN +-# define F_OPEN(name, mode) fopen((name), (mode)) +-#endif +- +- /* functions */ +- +-#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) +-# ifndef HAVE_VSNPRINTF +-# define HAVE_VSNPRINTF +-# endif +-#endif +-#if defined(__CYGWIN__) +-# ifndef HAVE_VSNPRINTF +-# define HAVE_VSNPRINTF +-# endif +-#endif +-#ifndef HAVE_VSNPRINTF +-# ifdef MSDOS +- /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), +- but for now we just assume it doesn't. */ +-# define NO_vsnprintf +-# endif +-# ifdef __TURBOC__ +-# define NO_vsnprintf +-# endif +-# ifdef WIN32 +- /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +-# if !defined(vsnprintf) && !defined(NO_vsnprintf) +-# define vsnprintf _vsnprintf +-# endif +-# endif +-# ifdef __SASC +-# define NO_vsnprintf +-# endif +-#endif +-#ifdef VMS +-# define NO_vsnprintf +-#endif +- +-#if defined(pyr) +-# define NO_MEMCPY +-#endif +-#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) +- /* Use our own functions for small and medium model with MSC <= 5.0. +- * You may have to use the same strategy for Borland C (untested). +- * The __SC__ check is for Symantec. +- */ +-# define NO_MEMCPY +-#endif +-#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) +-# define HAVE_MEMCPY +-#endif +-#ifdef HAVE_MEMCPY +-# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ +-# define zmemcpy _fmemcpy +-# define zmemcmp _fmemcmp +-# define zmemzero(dest, len) _fmemset(dest, 0, len) +-# else +-# define zmemcpy memcpy +-# define zmemcmp memcmp +-# define zmemzero(dest, len) memset(dest, 0, len) +-# endif +-#else +- extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); +- extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); +- extern void zmemzero OF((Bytef* dest, uInt len)); +-#endif +- +-/* Diagnostic functions */ +-#ifdef DEBUG +-# include +- extern int z_verbose; +- extern void z_error OF((char *m)); +-# define Assert(cond,msg) {if(!(cond)) z_error(msg);} +-# define Trace(x) {if (z_verbose>=0) fprintf x ;} +-# define Tracev(x) {if (z_verbose>0) fprintf x ;} +-# define Tracevv(x) {if (z_verbose>1) fprintf x ;} +-# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} +-# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} +-#else +-# define Assert(cond,msg) +-# define Trace(x) +-# define Tracev(x) +-# define Tracevv(x) +-# define Tracec(c,x) +-# define Tracecv(c,x) +-#endif +- +- +-voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); +-void zcfree OF((voidpf opaque, voidpf ptr)); +- +-#define ZALLOC(strm, items, size) \ +- (*((strm)->zalloc))((strm)->opaque, (items), (size)) +-#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) +-#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} +- +-#endif /* ZUTIL_H */ diff --git a/branch/split_build/inst/etc/patches/RLadyBug/00list b/branch/split_build/inst/etc/patches/RLadyBug/00list new file mode 100644 index 0000000..914fc88 --- /dev/null +++ b/branch/split_build/inst/etc/patches/RLadyBug/00list @@ -0,0 +1,2 @@ +00list +01_bash_path.patch diff --git a/branch/split_build/inst/etc/patches/RLadyBug/01_bash_path.patch b/branch/split_build/inst/etc/patches/RLadyBug/01_bash_path.patch new file mode 100644 index 0000000..0881a0b --- /dev/null +++ b/branch/split_build/inst/etc/patches/RLadyBug/01_bash_path.patch @@ -0,0 +1,26 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_bash_path.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Correct bash path + +@DPATCH@ + +diff -ru RLadyBug.orig/inst/LadyBug/bin/ladybug.sh RLadyBug/inst/LadyBug/bin/ladybug.sh +--- RLadyBug.orig/inst/LadyBug/bin/ladybug.sh 2008-01-04 11:01:24.000000000 +0100 ++++ RLadyBug/inst/LadyBug/bin/ladybug.sh 2009-05-12 03:34:02.000000000 +0200 +@@ -1,4 +1,4 @@ +-#!/usr/bin/bash ++#!/bin/bash + + #The "executable" version just uses the jar files in the bin directory + #In case you made modifications to the LadyBug source and +diff -ru RLadyBug.orig/inst/LadyBug/bin/simsellke.sh RLadyBug/inst/LadyBug/bin/simsellke.sh +--- RLadyBug.orig/inst/LadyBug/bin/simsellke.sh 2008-01-04 11:01:24.000000000 +0100 ++++ RLadyBug/inst/LadyBug/bin/simsellke.sh 2009-05-12 03:34:19.000000000 +0200 +@@ -1,4 +1,4 @@ +-#!/usr/bin/bash ++#!/bin/bash + + #The exec version just uses the jar files in the bin directory + #In case you made modifications to the LadyBug source and diff --git a/branch/split_build/inst/etc/patches/Rpad/00list b/branch/split_build/inst/etc/patches/Rpad/00list new file mode 100644 index 0000000..e7ce1d4 --- /dev/null +++ b/branch/split_build/inst/etc/patches/Rpad/00list @@ -0,0 +1 @@ +01_installRpadWWW.sh_conversion.patch diff --git a/branch/split_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch b/branch/split_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch new file mode 100644 index 0000000..402836a --- /dev/null +++ b/branch/split_build/inst/etc/patches/Rpad/01_installRpadWWW.sh_conversion.patch @@ -0,0 +1,176 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_installRpadWWW.sh_conversion.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: dos to unix fileconversion + +@DPATCH@ + +diff -Naur Rpad.orig/inst/serverversion/installRpadWWW.sh Rpad/inst/serverversion/installRpadWWW.sh +--- Rpad.orig/inst/serverversion/installRpadWWW.sh 2007-04-24 17:47:26.000000000 +0200 ++++ Rpad/inst/serverversion/installRpadWWW.sh 2009-04-09 04:25:13.000000000 +0200 +@@ -1,82 +1,82 @@ +-#!/bin/sh +-# This installs the extra server files for Rpad on Debian. +-# The defaults are to install to /var/www/Rpad. +-# usage: +-# installRpadWWW.sh directory tree +-# examples: +-# installRpadWWW.sh /var/www/Rpad +-# installRpadWWW.sh /var/www/Rpad /testingdir +-# installRpadWWW.sh /var/www/anotherdir +- +-RPAD=/var/www/Rpad +-TREE=/. +-if [ $# -eq 1 ]; then +- RPAD=$1 +-fi +-if [ $# -eq 2 ]; then +- RPAD=$1 +- TREE=$2 +-fi +- +-# copy the base files +-mkdir -p $RPAD +-cp -r ../basehtml/* $RPAD +-cp -r ../basehtml/.RpadStartup.R $RPAD +- +-# fix the directory permissions +-chmod a+w $TREE$RPAD +-chmod a+w $TREE$RPAD/server +-chmod a+x $TREE$RPAD/server/*.pl +- +-# this link makes the help menu work +-ln -s /usr/lib/R $TREE$RPAD/R +- +-# make a name for the apache config file +-conf_d_name=`echo $RPAD | sed s^/^.^g` +- +-# apache configuration file (cgi or mod_perl) +-mkdir -p $TREE/etc/apache2/conf.d +-cat >> $TREE/etc/apache2/conf.d/Rpad$conf_d_name << EOF +- +- +- # requires mod_perl +- SetHandler perl-script +- PerlResponseHandler ModPerl::PerlRun +- PerlOptions +ParseHeaders +- Options -Indexes +ExecCGI +- +- +- Options +ExecCGI +- AddHandler cgi-script .pl +- +- ExpiresActive on +- ExpiresDefault "now plus 0 seconds" +- +- +-AddType text/x-component .htc +-AddType text/html .Rpad +-EOF +- +-# apache2 configuration file (cgi or mod_perl) +-mkdir -p $TREE/etc/apache/conf.d +-cat >> $TREE/etc/apache/conf.d/Rpad$conf_d_name << EOF +- +- +- # requires mod_perl +- SetHandler perl-script +- PerlHandler Apache::Registry +- Options +ExecCGI +- PerlSendHeader ON +- +- +- Options +ExecCGI +- AddHandler cgi-script .pl +- +- ExpiresActive on +- ExpiresDefault "now plus 0 seconds" +- +- +-AddType text/x-component .htc +-AddType text/html .Rpad +-EOF +- ++#!/bin/sh ++# This installs the extra server files for Rpad on Debian. ++# The defaults are to install to /var/www/Rpad. ++# usage: ++# installRpadWWW.sh directory tree ++# examples: ++# installRpadWWW.sh /var/www/Rpad ++# installRpadWWW.sh /var/www/Rpad /testingdir ++# installRpadWWW.sh /var/www/anotherdir ++ ++RPAD=/var/www/Rpad ++TREE=/. ++if [ $# -eq 1 ]; then ++ RPAD=$1 ++fi ++if [ $# -eq 2 ]; then ++ RPAD=$1 ++ TREE=$2 ++fi ++ ++# copy the base files ++mkdir -p $RPAD ++cp -r ../basehtml/* $RPAD ++cp -r ../basehtml/.RpadStartup.R $RPAD ++ ++# fix the directory permissions ++chmod a+w $TREE$RPAD ++chmod a+w $TREE$RPAD/server ++chmod a+x $TREE$RPAD/server/*.pl ++ ++# this link makes the help menu work ++ln -s /usr/lib/R $TREE$RPAD/R ++ ++# make a name for the apache config file ++conf_d_name=`echo $RPAD | sed s^/^.^g` ++ ++# apache configuration file (cgi or mod_perl) ++mkdir -p $TREE/etc/apache2/conf.d ++cat >> $TREE/etc/apache2/conf.d/Rpad$conf_d_name << EOF ++ ++ ++ # requires mod_perl ++ SetHandler perl-script ++ PerlResponseHandler ModPerl::PerlRun ++ PerlOptions +ParseHeaders ++ Options -Indexes +ExecCGI ++ ++ ++ Options +ExecCGI ++ AddHandler cgi-script .pl ++ ++ ExpiresActive on ++ ExpiresDefault "now plus 0 seconds" ++ ++ ++AddType text/x-component .htc ++AddType text/html .Rpad ++EOF ++ ++# apache2 configuration file (cgi or mod_perl) ++mkdir -p $TREE/etc/apache/conf.d ++cat >> $TREE/etc/apache/conf.d/Rpad$conf_d_name << EOF ++ ++ ++ # requires mod_perl ++ SetHandler perl-script ++ PerlHandler Apache::Registry ++ Options +ExecCGI ++ PerlSendHeader ON ++ ++ ++ Options +ExecCGI ++ AddHandler cgi-script .pl ++ ++ ExpiresActive on ++ ExpiresDefault "now plus 0 seconds" ++ ++ ++AddType text/x-component .htc ++AddType text/html .Rpad ++EOF ++ diff --git a/branch/split_build/inst/etc/patches/SuppDists/00list b/branch/split_build/inst/etc/patches/SuppDists/00list new file mode 100644 index 0000000..e562cca --- /dev/null +++ b/branch/split_build/inst/etc/patches/SuppDists/00list @@ -0,0 +1,2 @@ +00list +01_DESCRIPTION.patch diff --git a/branch/split_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch b/branch/split_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch new file mode 100644 index 0000000..7637a37 --- /dev/null +++ b/branch/split_build/inst/etc/patches/SuppDists/01_DESCRIPTION.patch @@ -0,0 +1,17 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_DESCRIPTION.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Add a space to separate Package: and SuppDists + +@DPATCH@ + +diff -ru SuppDists.orig/DESCRIPTION SuppDists/DESCRIPTION +--- SuppDists.orig/DESCRIPTION 2008-03-05 17:23:55.000000000 +0100 ++++ SuppDists/DESCRIPTION 2009-05-11 04:57:47.000000000 +0200 +@@ -1,4 +1,4 @@ +-Package:SuppDists ++Package: SuppDists + Version: 1.1-2 + Date: 2008/03/05 + Title: Supplementary distributions diff --git a/branch/split_build/inst/etc/patches/dlmap/00list b/branch/split_build/inst/etc/patches/dlmap/00list new file mode 100644 index 0000000..288e6b7 --- /dev/null +++ b/branch/split_build/inst/etc/patches/dlmap/00list @@ -0,0 +1 @@ +01_DESCRIPTION.patch diff --git a/branch/split_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch b/branch/split_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch new file mode 100644 index 0000000..83ca8db --- /dev/null +++ b/branch/split_build/inst/etc/patches/dlmap/01_DESCRIPTION.patch @@ -0,0 +1,21 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_DESCRIPTION.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Add extended Description + +@DPATCH@ + +diff -ru dlmap.orig/DESCRIPTION dlmap/DESCRIPTION +--- dlmap.orig/DESCRIPTION 2008-11-14 11:15:01.000000000 +0100 ++++ dlmap/DESCRIPTION 2009-05-18 04:13:29.000000000 +0200 +@@ -5,7 +5,8 @@ + Date: 2008-11-11 + Author: Emma Huang and Andrew George + Maintainer: Emma Huang +-Description: ++Description: Detection Localization ++ Mapping for QTL + License: GPL 2 + Depends: qtl, ibdreg + Suggests: nlme, asreml diff --git a/branch/split_build/inst/etc/patches/rSymPy/00list b/branch/split_build/inst/etc/patches/rSymPy/00list new file mode 100644 index 0000000..4589bc4 --- /dev/null +++ b/branch/split_build/inst/etc/patches/rSymPy/00list @@ -0,0 +1 @@ +01_python_path.patch diff --git a/branch/split_build/inst/etc/patches/rSymPy/01_python_path.patch b/branch/split_build/inst/etc/patches/rSymPy/01_python_path.patch new file mode 100644 index 0000000..b6561a5 --- /dev/null +++ b/branch/split_build/inst/etc/patches/rSymPy/01_python_path.patch @@ -0,0 +1,17 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_python_path.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Correct python path + +@DPATCH@ + +diff -ru rSymPy.orig/inst/jython/Lib/cgi.py rSymPy/inst/jython/Lib/cgi.py +--- rSymPy.orig/inst/jython/Lib/cgi.py 2009-01-09 22:02:24.000000000 +0100 ++++ rSymPy/inst/jython/Lib/cgi.py 2009-05-17 21:45:54.000000000 +0200 +@@ -1,4 +1,4 @@ +-#! /usr/local/bin/python ++#! /usr/bin/python + + # NOTE: the above "/usr/local/bin/python" is NOT a mistake. It is + # intentionally NOT "/usr/bin/env python". On many systems diff --git a/branch/split_build/inst/etc/patches/seqinr/00list b/branch/split_build/inst/etc/patches/seqinr/00list new file mode 100644 index 0000000..428554e --- /dev/null +++ b/branch/split_build/inst/etc/patches/seqinr/00list @@ -0,0 +1 @@ +01_remove_zlib.patch diff --git a/branch/split_build/inst/etc/patches/seqinr/01_remove_zlib.patch b/branch/split_build/inst/etc/patches/seqinr/01_remove_zlib.patch new file mode 100644 index 0000000..b2cae05 --- /dev/null +++ b/branch/split_build/inst/etc/patches/seqinr/01_remove_zlib.patch @@ -0,0 +1,11059 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_remove_zlib_src.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Remove zlib + +@DPATCH@ + +diff -ruN seqinr.orig/src/adler32.c seqinr/src/adler32.c +--- seqinr.orig/src/adler32.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/adler32.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,153 +0,0 @@ +-/* adler32.c -- compute the Adler-32 checksum of a data stream +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id: adler32.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-#define BASE 65521UL /* largest prime smaller than 65536 */ +-#define NMAX 5552 +-/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */ +- +-#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;} +-#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); +-#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); +-#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); +-#define DO16(buf) DO8(buf,0); DO8(buf,8); +- +-/* use NO_DIVIDE if your processor does not do division in hardware */ +-#ifdef NO_DIVIDE +-# define MOD(a) \ +- do { \ +- if (a >= (BASE << 16)) a -= (BASE << 16); \ +- if (a >= (BASE << 15)) a -= (BASE << 15); \ +- if (a >= (BASE << 14)) a -= (BASE << 14); \ +- if (a >= (BASE << 13)) a -= (BASE << 13); \ +- if (a >= (BASE << 12)) a -= (BASE << 12); \ +- if (a >= (BASE << 11)) a -= (BASE << 11); \ +- if (a >= (BASE << 10)) a -= (BASE << 10); \ +- if (a >= (BASE << 9)) a -= (BASE << 9); \ +- if (a >= (BASE << 8)) a -= (BASE << 8); \ +- if (a >= (BASE << 7)) a -= (BASE << 7); \ +- if (a >= (BASE << 6)) a -= (BASE << 6); \ +- if (a >= (BASE << 5)) a -= (BASE << 5); \ +- if (a >= (BASE << 4)) a -= (BASE << 4); \ +- if (a >= (BASE << 3)) a -= (BASE << 3); \ +- if (a >= (BASE << 2)) a -= (BASE << 2); \ +- if (a >= (BASE << 1)) a -= (BASE << 1); \ +- if (a >= BASE) a -= BASE; \ +- } while (0) +-# define MOD4(a) \ +- do { \ +- if (a >= (BASE << 4)) a -= (BASE << 4); \ +- if (a >= (BASE << 3)) a -= (BASE << 3); \ +- if (a >= (BASE << 2)) a -= (BASE << 2); \ +- if (a >= (BASE << 1)) a -= (BASE << 1); \ +- if (a >= BASE) a -= BASE; \ +- } while (0) +-#else +-# define MOD(a) a %= BASE +-# define MOD4(a) a %= BASE +-#endif +- +-/* ========================================================================= */ +-uLong ZEXPORT adler32(uLong adler, const Bytef *buf, uInt len) +-/* +- uLong adler; +- const Bytef *buf; +- uInt len; +-*/ +-{ +- unsigned long sum2; +- unsigned n; +- +- /* split Adler-32 into component sums */ +- sum2 = (adler >> 16) & 0xffff; +- adler &= 0xffff; +- +- /* in case user likes doing a byte at a time, keep it fast */ +- if (len == 1) { +- adler += buf[0]; +- if (adler >= BASE) +- adler -= BASE; +- sum2 += adler; +- if (sum2 >= BASE) +- sum2 -= BASE; +- return adler | (sum2 << 16); +- } +- +- /* initial Adler-32 value (deferred check for len == 1 speed) */ +- if (buf == Z_NULL) +- return 1L; +- +- /* in case short lengths are provided, keep it somewhat fast */ +- if (len < 16) { +- while (len--) { +- adler += *buf++; +- sum2 += adler; +- } +- if (adler >= BASE) +- adler -= BASE; +- MOD4(sum2); /* only added so many BASE's */ +- return adler | (sum2 << 16); +- } +- +- /* do length NMAX blocks -- requires just one modulo operation */ +- while (len >= NMAX) { +- len -= NMAX; +- n = NMAX / 16; /* NMAX is divisible by 16 */ +- do { +- DO16(buf); /* 16 sums unrolled */ +- buf += 16; +- } while (--n); +- MOD(adler); +- MOD(sum2); +- } +- +- /* do remaining bytes (less than NMAX, still just one modulo) */ +- if (len) { /* avoid modulos if none remaining */ +- while (len >= 16) { +- len -= 16; +- DO16(buf); +- buf += 16; +- } +- while (len--) { +- adler += *buf++; +- sum2 += adler; +- } +- MOD(adler); +- MOD(sum2); +- } +- +- /* return recombined sums */ +- return adler | (sum2 << 16); +-} +- +-/* ========================================================================= */ +-uLong ZEXPORT adler32_combine(uLong adler1, uLong adler2, z_off_t len2) +-/* +- uLong adler1; +- uLong adler2; +- z_off_t len2; +-*/ +-{ +- unsigned long sum1; +- unsigned long sum2; +- unsigned rem; +- +- /* the derivation of this formula is left as an exercise for the reader */ +- rem = (unsigned)(len2 % BASE); +- sum1 = adler1 & 0xffff; +- sum2 = rem * sum1; +- MOD(sum2); +- sum1 += (adler2 & 0xffff) + BASE - 1; +- sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem; +- if (sum1 > BASE) sum1 -= BASE; +- if (sum1 > BASE) sum1 -= BASE; +- if (sum2 > (BASE << 1)) sum2 -= (BASE << 1); +- if (sum2 > BASE) sum2 -= BASE; +- return sum1 | (sum2 << 16); +-} +diff -ruN seqinr.orig/src/compress.c seqinr/src/compress.c +--- seqinr.orig/src/compress.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/compress.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,84 +0,0 @@ +-/* compress.c -- compress a memory buffer +- * Copyright (C) 1995-2003 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id: compress.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-/* =========================================================================== +- Compresses the source buffer into the destination buffer. The level +- parameter has the same meaning as in deflateInit. sourceLen is the byte +- length of the source buffer. Upon entry, destLen is the total size of the +- destination buffer, which must be at least 0.1% larger than sourceLen plus +- 12 bytes. Upon exit, destLen is the actual size of the compressed buffer. +- +- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_BUF_ERROR if there was not enough room in the output buffer, +- Z_STREAM_ERROR if the level parameter is invalid. +-*/ +-int ZEXPORT compress2 (Bytef *dest, uLongf *destLen, const Bytef *source, +- uLong sourceLen, int level) +-/* +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +- int level; +-*/ +-{ +- z_stream stream; +- int err; +- +- stream.next_in = (Bytef*)source; +- stream.avail_in = (uInt)sourceLen; +-#ifdef MAXSEG_64K +- /* Check for source > 64K on 16-bit machine: */ +- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +-#endif +- stream.next_out = dest; +- stream.avail_out = (uInt)*destLen; +- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; +- +- stream.zalloc = (alloc_func)0; +- stream.zfree = (free_func)0; +- stream.opaque = (voidpf)0; +- +- err = deflateInit(&stream, level); +- if (err != Z_OK) return err; +- +- err = deflate(&stream, Z_FINISH); +- if (err != Z_STREAM_END) { +- deflateEnd(&stream); +- return err == Z_OK ? Z_BUF_ERROR : err; +- } +- *destLen = stream.total_out; +- +- err = deflateEnd(&stream); +- return err; +-} +- +-/* =========================================================================== +- */ +-int ZEXPORT compress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) +-/* +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +-*/ +-{ +- return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION); +-} +- +-/* =========================================================================== +- If the default memLevel or windowBits for deflateInit() is changed, then +- this function needs to be updated. +- */ +-uLong ZEXPORT compressBound (uLong sourceLen) +-/* uLong sourceLen; */ +-{ +- return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + 11; +-} +diff -ruN seqinr.orig/src/crc32.c seqinr/src/crc32.c +--- seqinr.orig/src/crc32.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/crc32.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,437 +0,0 @@ +-/* crc32.c -- compute the CRC-32 of a data stream +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- * +- * Thanks to Rodney Brown for his contribution of faster +- * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing +- * tables for updating the shift register in one step with three exclusive-ors +- * instead of four steps with four exclusive-ors. This results in about a +- * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3. +- */ +- +-/* @(#) $Id: crc32.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ +- +-/* +- Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore +- protection on the static variables used to control the first-use generation +- of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should +- first call get_crc_table() to initialize the tables before allowing more than +- one thread to use crc32(). +- */ +- +-#ifdef MAKECRCH +-# include +-# ifndef DYNAMIC_CRC_TABLE +-# define DYNAMIC_CRC_TABLE +-# endif /* !DYNAMIC_CRC_TABLE */ +-#endif /* MAKECRCH */ +- +-#include "zutil.h" /* for STDC and FAR definitions */ +- +-#define local static +- +-/* Find a four-byte integer type for crc32_little() and crc32_big(). */ +-#ifndef NOBYFOUR +-# ifdef STDC /* need ANSI C limits.h to determine sizes */ +-# include +-# define BYFOUR +-# if (UINT_MAX == 0xffffffffUL) +- typedef unsigned int u4; +-# else +-# if (ULONG_MAX == 0xffffffffUL) +- typedef unsigned long u4; +-# else +-# if (USHRT_MAX == 0xffffffffUL) +- typedef unsigned short u4; +-# else +-# undef BYFOUR /* can't find a four-byte integer type! */ +-# endif +-# endif +-# endif +-# endif /* STDC */ +-#endif /* !NOBYFOUR */ +- +-/* Definitions for doing the crc four data bytes at a time. */ +-#ifdef BYFOUR +-# define REV(w) (((w)>>24)+(((w)>>8)&0xff00)+ \ +- (((w)&0xff00)<<8)+(((w)&0xff)<<24)) +- local unsigned long crc32_little OF((unsigned long, +- const unsigned char FAR *, unsigned)); +- local unsigned long crc32_big OF((unsigned long, +- const unsigned char FAR *, unsigned)); +-# define TBLS 8 +-#else +-# define TBLS 1 +-#endif /* BYFOUR */ +- +-/* Local functions for crc concatenation */ +-local unsigned long gf2_matrix_times OF((unsigned long *mat, +- unsigned long vec)); +-local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat)); +- +-#ifdef DYNAMIC_CRC_TABLE +- +-local volatile int crc_table_empty = 1; +-local unsigned long FAR crc_table[TBLS][256]; +-local void make_crc_table OF((void)); +-#ifdef MAKECRCH +- local void write_table OF((FILE *, const unsigned long FAR *)); +-#endif /* MAKECRCH */ +-/* +- Generate tables 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 first table is simply the CRC of all possible eight bit values. This is +- all the information needed to generate CRCs on data a byte at a time for all +- combinations of CRC register values and incoming bytes. The remaining tables +- allow for word-at-a-time CRC calculation for both big-endian and little- +- endian machines, where a word is four bytes. +-*/ +-local void make_crc_table() +-{ +- unsigned long c; +- int n, k; +- unsigned long poly; /* polynomial exclusive-or pattern */ +- /* terms of polynomial defining this crc (except x^32): */ +- static volatile int first = 1; /* flag to limit concurrent making */ +- static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26}; +- +- /* See if another task is already doing this (not thread-safe, but better +- than nothing -- significantly reduces duration of vulnerability in +- case the advice about DYNAMIC_CRC_TABLE is ignored) */ +- if (first) { +- first = 0; +- +- /* make exclusive-or pattern from polynomial (0xedb88320UL) */ +- poly = 0UL; +- for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++) +- poly |= 1UL << (31 - p[n]); +- +- /* generate a crc for every 8-bit value */ +- for (n = 0; n < 256; n++) { +- c = (unsigned long)n; +- for (k = 0; k < 8; k++) +- c = c & 1 ? poly ^ (c >> 1) : c >> 1; +- crc_table[0][n] = c; +- } +- +-#ifdef BYFOUR +- /* generate crc for each value followed by one, two, and three zeros, +- and then the byte reversal of those as well as the first table */ +- for (n = 0; n < 256; n++) { +- c = crc_table[0][n]; +- crc_table[4][n] = REV(c); +- for (k = 1; k < 4; k++) { +- c = crc_table[0][c & 0xff] ^ (c >> 8); +- crc_table[k][n] = c; +- crc_table[k + 4][n] = REV(c); +- } +- } +-#endif /* BYFOUR */ +- +- crc_table_empty = 0; +- } +- else { /* not first */ +- /* wait for the other guy to finish (not efficient, but rare) */ +- while (crc_table_empty) +- ; +- } +- +-#ifdef MAKECRCH +- /* write out CRC tables to crc32.h */ +- { +- FILE *out; +- +- out = fopen("crc32.h", "w"); +- if (out == NULL) return; +- fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n"); +- fprintf(out, " * Generated automatically by crc32.c\n */\n\n"); +- fprintf(out, "local const unsigned long FAR "); +- fprintf(out, "crc_table[TBLS][256] =\n{\n {\n"); +- write_table(out, crc_table[0]); +-# ifdef BYFOUR +- fprintf(out, "#ifdef BYFOUR\n"); +- for (k = 1; k < 8; k++) { +- fprintf(out, " },\n {\n"); +- write_table(out, crc_table[k]); +- } +- fprintf(out, "#endif\n"); +-# endif /* BYFOUR */ +- fprintf(out, " }\n};\n"); +- fclose(out); +- } +-#endif /* MAKECRCH */ +-} +- +-#ifdef MAKECRCH +-local void write_table(out, table) +- FILE *out; +- const unsigned long FAR *table; +-{ +- int n; +- +- for (n = 0; n < 256; n++) +- fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n], +- n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", ")); +-} +-#endif /* MAKECRCH */ +- +-#else /* !DYNAMIC_CRC_TABLE */ +-/* ======================================================================== +- * Tables of CRC-32s of all single-byte values, made by make_crc_table(). +- */ +-#include "crc32.h" +-#endif /* DYNAMIC_CRC_TABLE */ +- +-/* ========================================================================= +- * This function can be used by asm versions of crc32() +- */ +-const unsigned long FAR * ZEXPORT get_crc_table() +-{ +-#ifdef DYNAMIC_CRC_TABLE +- if (crc_table_empty) +- make_crc_table(); +-#endif /* DYNAMIC_CRC_TABLE */ +- return (const unsigned long FAR *)crc_table; +-} +- +-/* ========================================================================= */ +-#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8) +-#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1 +- +-/* ========================================================================= */ +-unsigned long ZEXPORT crc32(unsigned long crc, const unsigned char FAR *buf, +- unsigned len) +-/* +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-*/ +-{ +- if (buf == Z_NULL) return 0UL; +- +-#ifdef DYNAMIC_CRC_TABLE +- if (crc_table_empty) +- make_crc_table(); +-#endif /* DYNAMIC_CRC_TABLE */ +- +-#ifdef BYFOUR +- if (sizeof(void *) == sizeof(ptrdiff_t)) { +- u4 endian; +- +- endian = 1; +- if (*((unsigned char *)(&endian))) +- return crc32_little(crc, buf, len); +- else +- return crc32_big(crc, buf, len); +- } +-#endif /* BYFOUR */ +- crc = crc ^ 0xffffffffUL; +- while (len >= 8) { +- DO8; +- len -= 8; +- } +- if (len) do { +- DO1; +- } while (--len); +- return crc ^ 0xffffffffUL; +-} +- +-#ifdef BYFOUR +- +-/* ========================================================================= */ +-#define DOLIT4 c ^= *buf4++; \ +- c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \ +- crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24] +-#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4 +- +-/* ========================================================================= */ +-local unsigned long crc32_little(unsigned long crc, const unsigned char FAR *buf, unsigned len) +-/* +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-*/ +-{ +- register u4 c; +- register const u4 FAR *buf4; +- +- c = (u4)crc; +- c = ~c; +- while (len && ((ptrdiff_t)buf & 3)) { +- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); +- len--; +- } +- +- buf4 = (const u4 FAR *)(const void FAR *)buf; +- while (len >= 32) { +- DOLIT32; +- len -= 32; +- } +- while (len >= 4) { +- DOLIT4; +- len -= 4; +- } +- buf = (const unsigned char FAR *)buf4; +- +- if (len) do { +- c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); +- } while (--len); +- c = ~c; +- return (unsigned long)c; +-} +- +-/* ========================================================================= */ +-#define DOBIG4 c ^= *++buf4; \ +- c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \ +- crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24] +-#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4 +- +-/* ========================================================================= */ +-local unsigned long crc32_big(unsigned long crc, +- const unsigned char FAR *buf, unsigned len) +-/* +- unsigned long crc; +- const unsigned char FAR *buf; +- unsigned len; +-*/ +-{ +- register u4 c; +- register const u4 FAR *buf4; +- +- c = REV((u4)crc); +- c = ~c; +- while (len && ((ptrdiff_t)buf & 3)) { +- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); +- len--; +- } +- +- buf4 = (const u4 FAR *)(const void FAR *)buf; +- buf4--; +- while (len >= 32) { +- DOBIG32; +- len -= 32; +- } +- while (len >= 4) { +- DOBIG4; +- len -= 4; +- } +- buf4++; +- buf = (const unsigned char FAR *)buf4; +- +- if (len) do { +- c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); +- } while (--len); +- c = ~c; +- return (unsigned long)(REV(c)); +-} +- +-#endif /* BYFOUR */ +- +-#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */ +- +-/* ========================================================================= */ +-local unsigned long gf2_matrix_times(unsigned long *mat, unsigned long vec) +-/* +- unsigned long *mat; +- unsigned long vec; +-*/ +-{ +- unsigned long sum; +- +- sum = 0; +- while (vec) { +- if (vec & 1) +- sum ^= *mat; +- vec >>= 1; +- mat++; +- } +- return sum; +-} +- +-/* ========================================================================= */ +-local void gf2_matrix_square(unsigned long *square, unsigned long *mat) +-/* +- unsigned long *square; +- unsigned long *mat; +-*/ +-{ +- int n; +- +- for (n = 0; n < GF2_DIM; n++) +- square[n] = gf2_matrix_times(mat, mat[n]); +-} +- +-/* ========================================================================= */ +-uLong ZEXPORT crc32_combine(uLong crc1, uLong crc2, z_off_t len2) +-/* +- uLong crc1; +- uLong crc2; +- z_off_t len2; +-*/ +-{ +- int n; +- unsigned long row; +- unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */ +- unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */ +- +- /* degenerate case */ +- if (len2 == 0) +- return crc1; +- +- /* put operator for one zero bit in odd */ +- odd[0] = 0xedb88320L; /* CRC-32 polynomial */ +- row = 1; +- for (n = 1; n < GF2_DIM; n++) { +- odd[n] = row; +- row <<= 1; +- } +- +- /* put operator for two zero bits in even */ +- gf2_matrix_square(even, odd); +- +- /* put operator for four zero bits in odd */ +- gf2_matrix_square(odd, even); +- +- /* apply len2 zeros to crc1 (first square will put the operator for one +- zero byte, eight zero bits, in even) */ +- do { +- /* apply zeros operator for this bit of len2 */ +- gf2_matrix_square(even, odd); +- if (len2 & 1) +- crc1 = gf2_matrix_times(even, crc1); +- len2 >>= 1; +- +- /* if no more bits set, then done */ +- if (len2 == 0) +- break; +- +- /* another iteration of the loop with odd and even swapped */ +- gf2_matrix_square(odd, even); +- if (len2 & 1) +- crc1 = gf2_matrix_times(odd, crc1); +- len2 >>= 1; +- +- /* if no more bits set, then done */ +- } while (len2 != 0); +- +- /* return combined crc */ +- crc1 ^= crc2; +- return crc1; +-} +diff -ruN seqinr.orig/src/crc32.h seqinr/src/crc32.h +--- seqinr.orig/src/crc32.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/crc32.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,441 +0,0 @@ +-/* crc32.h -- tables for rapid CRC calculation +- * Generated automatically by crc32.c +- */ +- +-local const unsigned long FAR crc_table[TBLS][256] = +-{ +- { +- 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL, +- 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL, +- 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, +- 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL, +- 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL, +- 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL, +- 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, +- 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL, +- 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL, +- 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL, +- 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, +- 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL, +- 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL, +- 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL, +- 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, +- 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL, +- 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL, +- 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL, +- 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, +- 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL, +- 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL, +- 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL, +- 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, +- 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL, +- 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL, +- 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL, +- 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, +- 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL, +- 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL, +- 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL, +- 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, +- 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL, +- 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL, +- 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL, +- 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, +- 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL, +- 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL, +- 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL, +- 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, +- 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL, +- 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL, +- 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL, +- 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, +- 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL, +- 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL, +- 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL, +- 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, +- 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL, +- 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL, +- 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL, +- 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, +- 0x2d02ef8dUL +-#ifdef BYFOUR +- }, +- { +- 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL, +- 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL, +- 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL, +- 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL, +- 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL, +- 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL, +- 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL, +- 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL, +- 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL, +- 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL, +- 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL, +- 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL, +- 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL, +- 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL, +- 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL, +- 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL, +- 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL, +- 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL, +- 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL, +- 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL, +- 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL, +- 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL, +- 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL, +- 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL, +- 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL, +- 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL, +- 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL, +- 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL, +- 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL, +- 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL, +- 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL, +- 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL, +- 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL, +- 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL, +- 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL, +- 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL, +- 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL, +- 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL, +- 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL, +- 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL, +- 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL, +- 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL, +- 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL, +- 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL, +- 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL, +- 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL, +- 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL, +- 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL, +- 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL, +- 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL, +- 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL, +- 0x9324fd72UL +- }, +- { +- 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL, +- 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL, +- 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL, +- 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL, +- 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL, +- 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL, +- 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL, +- 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL, +- 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL, +- 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL, +- 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL, +- 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL, +- 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL, +- 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL, +- 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL, +- 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL, +- 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL, +- 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL, +- 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL, +- 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL, +- 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL, +- 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL, +- 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL, +- 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL, +- 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL, +- 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL, +- 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL, +- 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL, +- 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL, +- 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL, +- 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL, +- 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL, +- 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL, +- 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL, +- 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL, +- 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL, +- 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL, +- 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL, +- 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL, +- 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL, +- 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL, +- 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL, +- 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL, +- 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL, +- 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL, +- 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL, +- 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL, +- 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL, +- 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL, +- 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL, +- 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL, +- 0xbe9834edUL +- }, +- { +- 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL, +- 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL, +- 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL, +- 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL, +- 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL, +- 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL, +- 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL, +- 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL, +- 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL, +- 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL, +- 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL, +- 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL, +- 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL, +- 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL, +- 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL, +- 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL, +- 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL, +- 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL, +- 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL, +- 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL, +- 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL, +- 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL, +- 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL, +- 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL, +- 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL, +- 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL, +- 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL, +- 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL, +- 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL, +- 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL, +- 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL, +- 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL, +- 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL, +- 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL, +- 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL, +- 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL, +- 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL, +- 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL, +- 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL, +- 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL, +- 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL, +- 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL, +- 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL, +- 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL, +- 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL, +- 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL, +- 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL, +- 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL, +- 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL, +- 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL, +- 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL, +- 0xde0506f1UL +- }, +- { +- 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL, +- 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL, +- 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL, +- 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL, +- 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL, +- 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL, +- 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL, +- 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL, +- 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL, +- 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL, +- 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL, +- 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL, +- 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL, +- 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL, +- 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL, +- 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL, +- 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL, +- 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL, +- 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL, +- 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL, +- 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL, +- 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL, +- 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL, +- 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL, +- 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL, +- 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL, +- 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL, +- 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL, +- 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL, +- 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL, +- 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL, +- 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL, +- 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL, +- 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL, +- 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL, +- 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL, +- 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL, +- 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL, +- 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL, +- 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL, +- 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL, +- 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL, +- 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL, +- 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL, +- 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL, +- 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL, +- 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL, +- 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL, +- 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL, +- 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL, +- 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL, +- 0x8def022dUL +- }, +- { +- 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL, +- 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL, +- 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL, +- 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL, +- 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL, +- 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL, +- 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL, +- 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL, +- 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL, +- 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL, +- 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL, +- 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL, +- 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL, +- 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL, +- 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL, +- 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL, +- 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL, +- 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL, +- 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL, +- 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL, +- 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL, +- 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL, +- 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL, +- 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL, +- 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL, +- 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL, +- 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL, +- 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL, +- 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL, +- 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL, +- 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL, +- 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL, +- 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL, +- 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL, +- 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL, +- 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL, +- 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL, +- 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL, +- 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL, +- 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL, +- 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL, +- 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL, +- 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL, +- 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL, +- 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL, +- 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL, +- 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL, +- 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL, +- 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL, +- 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL, +- 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL, +- 0x72fd2493UL +- }, +- { +- 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL, +- 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL, +- 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL, +- 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL, +- 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL, +- 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL, +- 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL, +- 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL, +- 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL, +- 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL, +- 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL, +- 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL, +- 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL, +- 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL, +- 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL, +- 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL, +- 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL, +- 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL, +- 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL, +- 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL, +- 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL, +- 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL, +- 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL, +- 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL, +- 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL, +- 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL, +- 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL, +- 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL, +- 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL, +- 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL, +- 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL, +- 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL, +- 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL, +- 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL, +- 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL, +- 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL, +- 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL, +- 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL, +- 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL, +- 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL, +- 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL, +- 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL, +- 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL, +- 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL, +- 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL, +- 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL, +- 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL, +- 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL, +- 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL, +- 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL, +- 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL, +- 0xed3498beUL +- }, +- { +- 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL, +- 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL, +- 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL, +- 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL, +- 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL, +- 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL, +- 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL, +- 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL, +- 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL, +- 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL, +- 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL, +- 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL, +- 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL, +- 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL, +- 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL, +- 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL, +- 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL, +- 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL, +- 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL, +- 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL, +- 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL, +- 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL, +- 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL, +- 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL, +- 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL, +- 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL, +- 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL, +- 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL, +- 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL, +- 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL, +- 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL, +- 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL, +- 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL, +- 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL, +- 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL, +- 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL, +- 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL, +- 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL, +- 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL, +- 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL, +- 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL, +- 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL, +- 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL, +- 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL, +- 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL, +- 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL, +- 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL, +- 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL, +- 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL, +- 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL, +- 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL, +- 0xf10605deUL +-#endif +- } +-}; +diff -ruN seqinr.orig/src/deflate.c seqinr/src/deflate.c +--- seqinr.orig/src/deflate.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/deflate.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1711 +0,0 @@ +-/* deflate.c -- compress data using the deflation algorithm +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * ALGORITHM +- * +- * The "deflation" process depends on being able to identify portions +- * of the input text which are identical to earlier input (within a +- * sliding window trailing behind the input currently being processed). +- * +- * The most straightforward technique turns out to be the fastest for +- * most input files: try all possible matches and select the longest. +- * The key feature of this algorithm is that insertions into the string +- * dictionary are very simple and thus fast, and deletions are avoided +- * completely. Insertions are performed at each input character, whereas +- * string matches are performed only when the previous match ends. So it +- * is preferable to spend more time in matches to allow very fast string +- * insertions and avoid deletions. The matching algorithm for small +- * strings is inspired from that of Rabin & Karp. A brute force approach +- * is used to find longer strings when a small match has been found. +- * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze +- * (by Leonid Broukhis). +- * A previous version of this file used a more sophisticated algorithm +- * (by Fiala and Greene) which is guaranteed to run in linear amortized +- * time, but has a larger average cost, uses more memory and is patented. +- * However the F&G algorithm may be faster for some highly redundant +- * files if the parameter max_chain_length (described below) is too large. +- * +- * ACKNOWLEDGEMENTS +- * +- * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and +- * I found it in 'freeze' written by Leonid Broukhis. +- * Thanks to many people for bug reports and testing. +- * +- * REFERENCES +- * +- * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". +- * Available in http://www.ietf.org/rfc/rfc1951.txt +- * +- * A description of the Rabin and Karp algorithm is given in the book +- * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. +- * +- * Fiala,E.R., and Greene,D.H. +- * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 +- * +- */ +- +-/* @(#) $Id: deflate.c,v 1.1.2.1 2007-04-19 09:40:17 penel Exp $ */ +- +-#include "deflate.h" +- +-const char deflate_copyright[] = +- " deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly "; +-/* +- If you use the zlib library in a product, an acknowledgment is welcome +- in the documentation of your product. If for some reason you cannot +- include such an acknowledgment, I would appreciate that you keep this +- copyright string in the executable of your product. +- */ +- +-/* =========================================================================== +- * Function prototypes. +- */ +-typedef enum { +- need_more, /* block not completed, need more input or more output */ +- block_done, /* block flush performed */ +- finish_started, /* finish started, need only more output at next deflate */ +- finish_done /* finish done, accept no more input or output */ +-} block_state; +- +-typedef block_state (*compress_func) OF((deflate_state *s, int flush)); +-/* Compression function. Returns the block state after the call. */ +- +-local void fill_window OF((deflate_state *s)); +-local block_state deflate_stored OF((deflate_state *s, int flush)); +-local block_state deflate_fast OF((deflate_state *s, int flush)); +-#ifndef FASTEST +-local block_state deflate_slow OF((deflate_state *s, int flush)); +-#endif +-local void lm_init OF((deflate_state *s)); +-local void putShortMSB OF((deflate_state *s, uInt b)); +-local void flush_pending OF((z_streamp strm)); +-local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size)); +-#ifndef FASTEST +-#ifdef ASMV +- void match_init OF((void)); /* asm code initialization */ +- uInt longest_match OF((deflate_state *s, IPos cur_match)); +-#else +-local uInt longest_match OF((deflate_state *s, IPos cur_match)); +-#endif +-#endif +-local uInt longest_match_fast OF((deflate_state *s, IPos cur_match)); +- +-#ifdef DEBUG +-local void check_match OF((deflate_state *s, IPos start, IPos match, +- int length)); +-#endif +- +-/* =========================================================================== +- * Local data +- */ +- +-#define NIL 0 +-/* Tail of hash chains */ +- +-#ifndef TOO_FAR +-# define TOO_FAR 4096 +-#endif +-/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ +- +-#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +-/* Minimum amount of lookahead, except at the end of the input file. +- * See deflate.c for comments about the MIN_MATCH+1. +- */ +- +-/* Values for max_lazy_match, good_match and max_chain_length, depending on +- * the desired pack level (0..9). The values given below have been tuned to +- * exclude worst case performance for pathological files. Better values may be +- * found for specific files. +- */ +-typedef struct config_s { +- ush good_length; /* reduce lazy search above this match length */ +- ush max_lazy; /* do not perform lazy search above this match length */ +- ush nice_length; /* quit search above this match length */ +- ush max_chain; +- compress_func func; +-} config; +- +-#ifdef FASTEST +-local const config configuration_table[2] = { +-/* good lazy nice chain */ +-/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +-/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ +-#else +-local const config configuration_table[10] = { +-/* good lazy nice chain */ +-/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +-/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ +-/* 2 */ {4, 5, 16, 8, deflate_fast}, +-/* 3 */ {4, 6, 32, 32, deflate_fast}, +- +-/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ +-/* 5 */ {8, 16, 32, 32, deflate_slow}, +-/* 6 */ {8, 16, 128, 128, deflate_slow}, +-/* 7 */ {8, 32, 128, 256, deflate_slow}, +-/* 8 */ {32, 128, 258, 1024, deflate_slow}, +-/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ +-#endif +- +-/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 +- * For deflate_fast() (levels <= 3) good is ignored and lazy has a different +- * meaning. +- */ +- +-#define EQUAL 0 +-/* result of memcmp for equal strings */ +- +-#ifndef NO_DUMMY_DECL +-struct static_tree_desc_s {int dummy;}; /* for buggy compilers */ +-#endif +- +-/* =========================================================================== +- * Update a hash value with the given input byte +- * IN assertion: all calls to to UPDATE_HASH are made with consecutive +- * input characters, so that a running hash key can be computed from the +- * previous key instead of complete recalculation each time. +- */ +-#define UPDATE_HASH(s,h,c) (h = (((h)<hash_shift) ^ (c)) & s->hash_mask) +- +- +-/* =========================================================================== +- * Insert string str in the dictionary and set match_head to the previous head +- * of the hash chain (the most recent string with same hash key). Return +- * the previous length of the hash chain. +- * If this file is compiled with -DFASTEST, the compression level is forced +- * to 1, and no hash chains are maintained. +- * IN assertion: all calls to to INSERT_STRING are made with consecutive +- * input characters and the first MIN_MATCH bytes of str are valid +- * (except for the last MIN_MATCH-1 bytes of the input file). +- */ +-#ifdef FASTEST +-#define INSERT_STRING(s, str, match_head) \ +- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ +- match_head = s->head[s->ins_h], \ +- s->head[s->ins_h] = (Pos)(str)) +-#else +-#define INSERT_STRING(s, str, match_head) \ +- (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ +- match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ +- s->head[s->ins_h] = (Pos)(str)) +-#endif +- +-/* =========================================================================== +- * Initialize the hash table (avoiding 64K overflow for 16 bit systems). +- * prev[] will be initialized on the fly. +- */ +-#define CLEAR_HASH(s) \ +- s->head[s->hash_size-1] = NIL; \ +- zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head)); +- +-/* ========================================================================= */ +-int ZEXPORT deflateInit_(z_streamp strm, int level, const char *version, +- int stream_size) +-/* +- z_streamp strm; +- int level; +- const char *version; +- int stream_size; +-*/ +-{ +- return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, +- Z_DEFAULT_STRATEGY, version, stream_size); +- /* To do: ignore strm->next_in if we use it as window */ +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateInit2_(z_streamp strm, int level, int method, +- int windowBits, int memLevel, int strategy, +- const char *version, int stream_size) +-/* +- z_streamp strm; +- int level; +- int method; +- int windowBits; +- int memLevel; +- int strategy; +- const char *version; +- int stream_size; +-*/ +-{ +- deflate_state *s; +- int wrap = 1; +- static const char my_version[] = ZLIB_VERSION; +- +- ushf *overlay; +- /* We overlay pending_buf and d_buf+l_buf. This works since the average +- * output size for (length,distance) codes is <= 24 bits. +- */ +- +- if (version == Z_NULL || version[0] != my_version[0] || +- stream_size != sizeof(z_stream)) { +- return Z_VERSION_ERROR; +- } +- if (strm == Z_NULL) return Z_STREAM_ERROR; +- +- strm->msg = Z_NULL; +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- +-#ifdef FASTEST +- if (level != 0) level = 1; +-#else +- if (level == Z_DEFAULT_COMPRESSION) level = 6; +-#endif +- +- if (windowBits < 0) { /* suppress zlib wrapper */ +- wrap = 0; +- windowBits = -windowBits; +- } +-#ifdef GZIP +- else if (windowBits > 15) { +- wrap = 2; /* write gzip wrapper instead */ +- windowBits -= 16; +- } +-#endif +- if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || +- windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || +- strategy < 0 || strategy > Z_FIXED) { +- return Z_STREAM_ERROR; +- } +- if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ +- s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); +- if (s == Z_NULL) return Z_MEM_ERROR; +- strm->state = (struct internal_state FAR *)s; +- s->strm = strm; +- +- s->wrap = wrap; +- s->gzhead = Z_NULL; +- s->w_bits = windowBits; +- s->w_size = 1 << s->w_bits; +- s->w_mask = s->w_size - 1; +- +- s->hash_bits = memLevel + 7; +- s->hash_size = 1 << s->hash_bits; +- s->hash_mask = s->hash_size - 1; +- s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH); +- +- s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); +- s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); +- s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); +- +- s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ +- +- overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2); +- s->pending_buf = (uchf *) overlay; +- s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L); +- +- if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || +- s->pending_buf == Z_NULL) { +- s->status = FINISH_STATE; +- strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); +- deflateEnd (strm); +- return Z_MEM_ERROR; +- } +- s->d_buf = overlay + s->lit_bufsize/sizeof(ush); +- s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize; +- +- s->level = level; +- s->strategy = strategy; +- s->method = (Byte)method; +- +- return deflateReset(strm); +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateSetDictionary (z_streamp strm, const Bytef *dictionary, +- uInt dictLength) +-/* +- z_streamp strm; +- const Bytef *dictionary; +- uInt dictLength; +-*/ +-{ +- deflate_state *s; +- uInt length = dictLength; +- uInt n; +- IPos hash_head = 0; +- +- if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL || +- strm->state->wrap == 2 || +- (strm->state->wrap == 1 && strm->state->status != INIT_STATE)) +- return Z_STREAM_ERROR; +- +- s = strm->state; +- if (s->wrap) +- strm->adler = adler32(strm->adler, dictionary, dictLength); +- +- if (length < MIN_MATCH) return Z_OK; +- if (length > MAX_DIST(s)) { +- length = MAX_DIST(s); +- dictionary += dictLength - length; /* use the tail of the dictionary */ +- } +- zmemcpy(s->window, dictionary, length); +- s->strstart = length; +- s->block_start = (long)length; +- +- /* Insert all strings in the hash table (except for the last two bytes). +- * s->lookahead stays null, so s->ins_h will be recomputed at the next +- * call of fill_window. +- */ +- s->ins_h = s->window[0]; +- UPDATE_HASH(s, s->ins_h, s->window[1]); +- for (n = 0; n <= length - MIN_MATCH; n++) { +- INSERT_STRING(s, n, hash_head); +- } +- if (hash_head) hash_head = 0; /* to make compiler happy */ +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateReset (z_streamp strm) +-/* z_streamp strm; */ +-{ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL || +- strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) { +- return Z_STREAM_ERROR; +- } +- +- strm->total_in = strm->total_out = 0; +- strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ +- strm->data_type = Z_UNKNOWN; +- +- s = (deflate_state *)strm->state; +- s->pending = 0; +- s->pending_out = s->pending_buf; +- +- if (s->wrap < 0) { +- s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ +- } +- s->status = s->wrap ? INIT_STATE : BUSY_STATE; +- strm->adler = +-#ifdef GZIP +- s->wrap == 2 ? crc32(0L, Z_NULL, 0) : +-#endif +- adler32(0L, Z_NULL, 0); +- s->last_flush = Z_NO_FLUSH; +- +- _tr_init(s); +- lm_init(s); +- +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateSetHeader (z_streamp strm, gz_headerp head) +-/* +- z_streamp strm; +- gz_headerp head; +-*/ +-{ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- if (strm->state->wrap != 2) return Z_STREAM_ERROR; +- strm->state->gzhead = head; +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflatePrime (z_streamp strm, int bits, int value) +-{ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- strm->state->bi_valid = bits; +- strm->state->bi_buf = (ush)(value & ((1 << bits) - 1)); +- return Z_OK; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateParams(z_streamp strm, int level, int strategy) +-{ +- deflate_state *s; +- compress_func func; +- int err = Z_OK; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- s = strm->state; +- +-#ifdef FASTEST +- if (level != 0) level = 1; +-#else +- if (level == Z_DEFAULT_COMPRESSION) level = 6; +-#endif +- if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { +- return Z_STREAM_ERROR; +- } +- func = configuration_table[s->level].func; +- +- if (func != configuration_table[level].func && strm->total_in != 0) { +- /* Flush the last buffer: */ +- err = deflate(strm, Z_PARTIAL_FLUSH); +- } +- if (s->level != level) { +- s->level = level; +- s->max_lazy_match = configuration_table[level].max_lazy; +- s->good_match = configuration_table[level].good_length; +- s->nice_match = configuration_table[level].nice_length; +- s->max_chain_length = configuration_table[level].max_chain; +- } +- s->strategy = strategy; +- return err; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateTune(z_streamp strm, int good_length, int max_lazy, +- int nice_length, int max_chain) +-{ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- s = strm->state; +- s->good_match = good_length; +- s->max_lazy_match = max_lazy; +- s->nice_match = nice_length; +- s->max_chain_length = max_chain; +- return Z_OK; +-} +- +-/* ========================================================================= +- * For the default windowBits of 15 and memLevel of 8, this function returns +- * a close to exact, as well as small, upper bound on the compressed size. +- * They are coded as constants here for a reason--if the #define's are +- * changed, then this function needs to be changed as well. The return +- * value for 15 and 8 only works for those exact settings. +- * +- * For any setting other than those defaults for windowBits and memLevel, +- * the value returned is a conservative worst case for the maximum expansion +- * resulting from using fixed blocks instead of stored blocks, which deflate +- * can emit on compressed data for some combinations of the parameters. +- * +- * This function could be more sophisticated to provide closer upper bounds +- * for every combination of windowBits and memLevel, as well as wrap. +- * But even the conservative upper bound of about 14% expansion does not +- * seem onerous for output buffer allocation. +- */ +-uLong ZEXPORT deflateBound(z_streamp strm, uLong sourceLen) +-{ +- deflate_state *s; +- uLong destLen; +- +- /* conservative upper bound */ +- destLen = sourceLen + +- ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 11; +- +- /* if can't get parameters, return conservative bound */ +- if (strm == Z_NULL || strm->state == Z_NULL) +- return destLen; +- +- /* if not default parameters, return conservative bound */ +- s = strm->state; +- if (s->w_bits != 15 || s->hash_bits != 8 + 7) +- return destLen; +- +- /* default settings: return tight bound for that case */ +- return compressBound(sourceLen); +-} +- +-/* ========================================================================= +- * Put a short in the pending buffer. The 16-bit value is put in MSB order. +- * IN assertion: the stream state is correct and there is enough room in +- * pending_buf. +- */ +-local void putShortMSB (deflate_state *s, uInt b) +-{ +- put_byte(s, (Byte)(b >> 8)); +- put_byte(s, (Byte)(b & 0xff)); +-} +- +-/* ========================================================================= +- * Flush as much pending output as possible. All deflate() output goes +- * through this function so some applications may wish to modify it +- * to avoid allocating a large strm->next_out buffer and copying into it. +- * (See also read_buf()). +- */ +-local void flush_pending(z_streamp strm) +-{ +- unsigned len = strm->state->pending; +- +- if (len > strm->avail_out) len = strm->avail_out; +- if (len == 0) return; +- +- zmemcpy(strm->next_out, strm->state->pending_out, len); +- strm->next_out += len; +- strm->state->pending_out += len; +- strm->total_out += len; +- strm->avail_out -= len; +- strm->state->pending -= len; +- if (strm->state->pending == 0) { +- strm->state->pending_out = strm->state->pending_buf; +- } +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflate (z_streamp strm, int flush) +-{ +- int old_flush; /* value of flush param for previous deflate call */ +- deflate_state *s; +- +- if (strm == Z_NULL || strm->state == Z_NULL || +- flush > Z_FINISH || flush < 0) { +- return Z_STREAM_ERROR; +- } +- s = strm->state; +- +- if (strm->next_out == Z_NULL || +- (strm->next_in == Z_NULL && strm->avail_in != 0) || +- (s->status == FINISH_STATE && flush != Z_FINISH)) { +- ERR_RETURN(strm, Z_STREAM_ERROR); +- } +- if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); +- +- s->strm = strm; /* just in case */ +- old_flush = s->last_flush; +- s->last_flush = flush; +- +- /* Write the header */ +- if (s->status == INIT_STATE) { +-#ifdef GZIP +- if (s->wrap == 2) { +- strm->adler = crc32(0L, Z_NULL, 0); +- put_byte(s, 31); +- put_byte(s, 139); +- put_byte(s, 8); +- if (s->gzhead == NULL) { +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, 0); +- put_byte(s, s->level == 9 ? 2 : +- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? +- 4 : 0)); +- put_byte(s, OS_CODE); +- s->status = BUSY_STATE; +- } +- else { +- put_byte(s, (s->gzhead->text ? 1 : 0) + +- (s->gzhead->hcrc ? 2 : 0) + +- (s->gzhead->extra == Z_NULL ? 0 : 4) + +- (s->gzhead->name == Z_NULL ? 0 : 8) + +- (s->gzhead->comment == Z_NULL ? 0 : 16) +- ); +- put_byte(s, (Byte)(s->gzhead->time & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); +- put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); +- put_byte(s, s->level == 9 ? 2 : +- (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? +- 4 : 0)); +- put_byte(s, s->gzhead->os & 0xff); +- if (s->gzhead->extra != NULL) { +- put_byte(s, s->gzhead->extra_len & 0xff); +- put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); +- } +- if (s->gzhead->hcrc) +- strm->adler = crc32(strm->adler, s->pending_buf, +- s->pending); +- s->gzindex = 0; +- s->status = EXTRA_STATE; +- } +- } +- else +-#endif +- { +- uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; +- uInt level_flags; +- +- if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) +- level_flags = 0; +- else if (s->level < 6) +- level_flags = 1; +- else if (s->level == 6) +- level_flags = 2; +- else +- level_flags = 3; +- header |= (level_flags << 6); +- if (s->strstart != 0) header |= PRESET_DICT; +- header += 31 - (header % 31); +- +- s->status = BUSY_STATE; +- putShortMSB(s, header); +- +- /* Save the adler32 of the preset dictionary: */ +- if (s->strstart != 0) { +- putShortMSB(s, (uInt)(strm->adler >> 16)); +- putShortMSB(s, (uInt)(strm->adler & 0xffff)); +- } +- strm->adler = adler32(0L, Z_NULL, 0); +- } +- } +-#ifdef GZIP +- if (s->status == EXTRA_STATE) { +- if (s->gzhead->extra != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- +- while (s->gzindex < (s->gzhead->extra_len & 0xffff)) { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) +- break; +- } +- put_byte(s, s->gzhead->extra[s->gzindex]); +- s->gzindex++; +- } +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (s->gzindex == s->gzhead->extra_len) { +- s->gzindex = 0; +- s->status = NAME_STATE; +- } +- } +- else +- s->status = NAME_STATE; +- } +- if (s->status == NAME_STATE) { +- if (s->gzhead->name != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- int val; +- +- do { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) { +- val = 1; +- break; +- } +- } +- val = s->gzhead->name[s->gzindex++]; +- put_byte(s, val); +- } while (val != 0); +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (val == 0) { +- s->gzindex = 0; +- s->status = COMMENT_STATE; +- } +- } +- else +- s->status = COMMENT_STATE; +- } +- if (s->status == COMMENT_STATE) { +- if (s->gzhead->comment != NULL) { +- uInt beg = s->pending; /* start of bytes to update crc */ +- int val; +- +- do { +- if (s->pending == s->pending_buf_size) { +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- flush_pending(strm); +- beg = s->pending; +- if (s->pending == s->pending_buf_size) { +- val = 1; +- break; +- } +- } +- val = s->gzhead->comment[s->gzindex++]; +- put_byte(s, val); +- } while (val != 0); +- if (s->gzhead->hcrc && s->pending > beg) +- strm->adler = crc32(strm->adler, s->pending_buf + beg, +- s->pending - beg); +- if (val == 0) +- s->status = HCRC_STATE; +- } +- else +- s->status = HCRC_STATE; +- } +- if (s->status == HCRC_STATE) { +- if (s->gzhead->hcrc) { +- if (s->pending + 2 > s->pending_buf_size) +- flush_pending(strm); +- if (s->pending + 2 <= s->pending_buf_size) { +- put_byte(s, (Byte)(strm->adler & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); +- strm->adler = crc32(0L, Z_NULL, 0); +- s->status = BUSY_STATE; +- } +- } +- else +- s->status = BUSY_STATE; +- } +-#endif +- +- /* Flush as much pending output as possible */ +- if (s->pending != 0) { +- flush_pending(strm); +- if (strm->avail_out == 0) { +- /* 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: +- */ +- s->last_flush = -1; +- return Z_OK; +- } +- +- /* Make sure there is something to do and avoid duplicate consecutive +- * flushes. For repeated and useless calls with Z_FINISH, we keep +- * returning Z_STREAM_END instead of Z_BUF_ERROR. +- */ +- } else if (strm->avail_in == 0 && flush <= old_flush && +- flush != Z_FINISH) { +- ERR_RETURN(strm, Z_BUF_ERROR); +- } +- +- /* User must not provide more input after the first FINISH: */ +- if (s->status == FINISH_STATE && strm->avail_in != 0) { +- ERR_RETURN(strm, Z_BUF_ERROR); +- } +- +- /* Start a new block or continue the current one. +- */ +- if (strm->avail_in != 0 || s->lookahead != 0 || +- (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { +- block_state bstate; +- +- bstate = (*(configuration_table[s->level].func))(s, flush); +- +- if (bstate == finish_started || bstate == finish_done) { +- s->status = FINISH_STATE; +- } +- if (bstate == need_more || bstate == finish_started) { +- if (strm->avail_out == 0) { +- s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ +- } +- return Z_OK; +- /* 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. +- */ +- } +- if (bstate == block_done) { +- if (flush == Z_PARTIAL_FLUSH) { +- _tr_align(s); +- } else { /* FULL_FLUSH or SYNC_FLUSH */ +- _tr_stored_block(s, (char*)0, 0L, 0); +- /* For a full flush, this empty block will be recognized +- * as a special marker by inflate_sync(). +- */ +- if (flush == Z_FULL_FLUSH) { +- CLEAR_HASH(s); /* forget history */ +- } +- } +- flush_pending(strm); +- if (strm->avail_out == 0) { +- s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ +- return Z_OK; +- } +- } +- } +- Assert(strm->avail_out > 0, "bug2"); +- +- if (flush != Z_FINISH) return Z_OK; +- if (s->wrap <= 0) return Z_STREAM_END; +- +- /* Write the trailer */ +-#ifdef GZIP +- if (s->wrap == 2) { +- put_byte(s, (Byte)(strm->adler & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); +- put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); +- put_byte(s, (Byte)(strm->total_in & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); +- put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); +- } +- else +-#endif +- { +- putShortMSB(s, (uInt)(strm->adler >> 16)); +- putShortMSB(s, (uInt)(strm->adler & 0xffff)); +- } +- flush_pending(strm); +- /* If avail_out is zero, the application will call deflate again +- * to flush the rest. +- */ +- if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ +- return s->pending != 0 ? Z_OK : Z_STREAM_END; +-} +- +-/* ========================================================================= */ +-int ZEXPORT deflateEnd (z_streamp strm) +-{ +- int status; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- +- status = strm->state->status; +- if (status != INIT_STATE && +- status != EXTRA_STATE && +- status != NAME_STATE && +- status != COMMENT_STATE && +- status != HCRC_STATE && +- status != BUSY_STATE && +- status != FINISH_STATE) { +- return Z_STREAM_ERROR; +- } +- +- /* Deallocate in reverse order of allocations: */ +- TRY_FREE(strm, strm->state->pending_buf); +- TRY_FREE(strm, strm->state->head); +- TRY_FREE(strm, strm->state->prev); +- TRY_FREE(strm, strm->state->window); +- +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- +- return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; +-} +- +-/* ========================================================================= +- * Copy the source state to the destination state. +- * To simplify the source, this is not supported for 16-bit MSDOS (which +- * doesn't have enough memory anyway to duplicate compression states). +- */ +-int ZEXPORT deflateCopy (z_streamp dest, z_streamp source) +-{ +-#ifdef MAXSEG_64K +- return Z_STREAM_ERROR; +-#else +- deflate_state *ds; +- deflate_state *ss; +- ushf *overlay; +- +- +- if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) { +- return Z_STREAM_ERROR; +- } +- +- ss = source->state; +- +- zmemcpy(dest, source, sizeof(z_stream)); +- +- ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); +- if (ds == Z_NULL) return Z_MEM_ERROR; +- dest->state = (struct internal_state FAR *) ds; +- zmemcpy(ds, ss, sizeof(deflate_state)); +- ds->strm = dest; +- +- ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); +- ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); +- ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); +- overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2); +- ds->pending_buf = (uchf *) overlay; +- +- if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || +- ds->pending_buf == Z_NULL) { +- deflateEnd (dest); +- return Z_MEM_ERROR; +- } +- /* following zmemcpy do not work for 16-bit MSDOS */ +- zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); +- zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos)); +- zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos)); +- zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size); +- +- ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); +- ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush); +- ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize; +- +- ds->l_desc.dyn_tree = ds->dyn_ltree; +- ds->d_desc.dyn_tree = ds->dyn_dtree; +- ds->bl_desc.dyn_tree = ds->bl_tree; +- +- return Z_OK; +-#endif /* MAXSEG_64K */ +-} +- +-/* =========================================================================== +- * Read a new buffer from the current input stream, update the adler32 +- * and total number of bytes read. All deflate() input goes through +- * this function so some applications may wish to modify it to avoid +- * allocating a large strm->next_in buffer and copying from it. +- * (See also flush_pending()). +- */ +-local int read_buf(z_streamp strm, Bytef *buf, unsigned size) +-{ +- unsigned len = strm->avail_in; +- +- if (len > size) len = size; +- if (len == 0) return 0; +- +- strm->avail_in -= len; +- +- if (strm->state->wrap == 1) { +- strm->adler = adler32(strm->adler, strm->next_in, len); +- } +-#ifdef GZIP +- else if (strm->state->wrap == 2) { +- strm->adler = crc32(strm->adler, strm->next_in, len); +- } +-#endif +- zmemcpy(buf, strm->next_in, len); +- strm->next_in += len; +- strm->total_in += len; +- +- return (int)len; +-} +- +-/* =========================================================================== +- * Initialize the "longest match" routines for a new zlib stream +- */ +-local void lm_init (deflate_state *s) +-{ +- s->window_size = (ulg)2L*s->w_size; +- +- CLEAR_HASH(s); +- +- /* Set the default configuration parameters: +- */ +- s->max_lazy_match = configuration_table[s->level].max_lazy; +- s->good_match = configuration_table[s->level].good_length; +- s->nice_match = configuration_table[s->level].nice_length; +- s->max_chain_length = configuration_table[s->level].max_chain; +- +- s->strstart = 0; +- s->block_start = 0L; +- s->lookahead = 0; +- s->match_length = s->prev_length = MIN_MATCH-1; +- s->match_available = 0; +- s->ins_h = 0; +-#ifndef FASTEST +-#ifdef ASMV +- match_init(); /* initialize the asm code */ +-#endif +-#endif +-} +- +-#ifndef FASTEST +-/* =========================================================================== +- * Set match_start to the longest match starting at the given string and +- * return its length. Matches shorter or equal to prev_length are discarded, +- * in which case the result is equal to prev_length and match_start is +- * garbage. +- * IN assertions: cur_match is the head of the hash chain for the current +- * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 +- * OUT assertion: the match length is not greater than s->lookahead. +- */ +-#ifndef ASMV +-/* For 80x86 and 680x0, an optimized version will be provided in match.asm or +- * match.S. The code will be functionally equivalent. +- */ +-local uInt longest_match(deflate_state *s, IPos cur_match) +- /* cur_match current match */ +-{ +- unsigned chain_length = s->max_chain_length;/* max hash chain length */ +- register Bytef *scan = s->window + s->strstart; /* current string */ +- register Bytef *match; /* matched string */ +- register int len; /* length of current match */ +- int best_len = s->prev_length; /* best match length so far */ +- int nice_match = s->nice_match; /* stop if match long enough */ +- IPos limit = s->strstart > (IPos)MAX_DIST(s) ? +- s->strstart - (IPos)MAX_DIST(s) : NIL; +- /* Stop when cur_match becomes <= limit. To simplify the code, +- * we prevent matches with the string of window index 0. +- */ +- Posf *prev = s->prev; +- uInt wmask = s->w_mask; +- +-#ifdef UNALIGNED_OK +- /* Compare two bytes at a time. Note: this is not always beneficial. +- * Try with and without -DUNALIGNED_OK to check. +- */ +- register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; +- register ush scan_start = *(ushf*)scan; +- register ush scan_end = *(ushf*)(scan+best_len-1); +-#else +- register Bytef *strend = s->window + s->strstart + MAX_MATCH; +- register Byte scan_end1 = scan[best_len-1]; +- register Byte scan_end = scan[best_len]; +-#endif +- +- /* 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. +- */ +- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); +- +- /* Do not waste too much time if we already have a good match: */ +- if (s->prev_length >= s->good_match) { +- chain_length >>= 2; +- } +- /* Do not look for matches beyond the end of the input. This is necessary +- * to make deflate deterministic. +- */ +- if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; +- +- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); +- +- do { +- Assert(cur_match < s->strstart, "no future"); +- match = s->window + cur_match; +- +- /* Skip to next match if the match length cannot increase +- * or if the match length is less than 2. Note that the checks below +- * for insufficient lookahead only occur occasionally for performance +- * reasons. Therefore uninitialized memory will be accessed, and +- * conditional jumps will be made that depend on those values. +- * However the length of the match is limited to the lookahead, so +- * the output of deflate is not affected by the uninitialized values. +- */ +-#if (defined(UNALIGNED_OK) && MAX_MATCH == 258) +- /* This code assumes sizeof(unsigned short) == 2. Do not use +- * UNALIGNED_OK if your compiler uses a different size. +- */ +- if (*(ushf*)(match+best_len-1) != scan_end || +- *(ushf*)match != scan_start) continue; +- +- /* It is not necessary to compare scan[2] and match[2] since they are +- * always equal when the other bytes match, given that the hash keys +- * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at +- * strstart+3, +5, ... up to strstart+257. We check for insufficient +- * lookahead only every 4th comparison; the 128th check will be made +- * 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 +- * to check more often for insufficient lookahead. +- */ +- Assert(scan[2] == match[2], "scan[2]?"); +- scan++, match++; +- do { +- } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- *(ushf*)(scan+=2) == *(ushf*)(match+=2) && +- scan < strend); +- /* The funny "do {}" generates better code on most compilers */ +- +- /* Here, scan <= window+strstart+257 */ +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- if (*scan == *match) scan++; +- +- len = (MAX_MATCH - 1) - (int)(strend-scan); +- scan = strend - (MAX_MATCH-1); +- +-#else /* UNALIGNED_OK */ +- +- if (match[best_len] != scan_end || +- match[best_len-1] != scan_end1 || +- *match != *scan || +- *++match != scan[1]) continue; +- +- /* The check at best_len-1 can be removed because it will be made +- * again later. (This heuristic is not always a win.) +- * It is not necessary to compare scan[2] and match[2] since they +- * are always equal when the other bytes match, given that +- * the hash keys are equal and that HASH_BITS >= 8. +- */ +- scan += 2, match++; +- Assert(*scan == *match, "match[2]?"); +- +- /* We check for insufficient lookahead only every 8th comparison; +- * the 256th check will be made at strstart+258. +- */ +- do { +- } while (*++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- scan < strend); +- +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- +- len = MAX_MATCH - (int)(strend - scan); +- scan = strend - MAX_MATCH; +- +-#endif /* UNALIGNED_OK */ +- +- if (len > best_len) { +- s->match_start = cur_match; +- best_len = len; +- if (len >= nice_match) break; +-#ifdef UNALIGNED_OK +- scan_end = *(ushf*)(scan+best_len-1); +-#else +- scan_end1 = scan[best_len-1]; +- scan_end = scan[best_len]; +-#endif +- } +- } while ((cur_match = prev[cur_match & wmask]) > limit +- && --chain_length != 0); +- +- if ((uInt)best_len <= s->lookahead) return (uInt)best_len; +- return s->lookahead; +-} +-#endif /* ASMV */ +-#endif /* FASTEST */ +- +-/* --------------------------------------------------------------------------- +- * Optimized version for level == 1 or strategy == Z_RLE only +- */ +-local uInt longest_match_fast(deflate_state *s, IPos cur_match) +-{ +- register Bytef *scan = s->window + s->strstart; /* current string */ +- register Bytef *match; /* matched string */ +- register int len; /* length of current match */ +- register Bytef *strend = s->window + s->strstart + MAX_MATCH; +- +- /* 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. +- */ +- Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); +- +- Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); +- +- Assert(cur_match < s->strstart, "no future"); +- +- match = s->window + cur_match; +- +- /* Return failure if the match length is less than 2: +- */ +- if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; +- +- /* The check at best_len-1 can be removed because it will be made +- * again later. (This heuristic is not always a win.) +- * It is not necessary to compare scan[2] and match[2] since they +- * are always equal when the other bytes match, given that +- * the hash keys are equal and that HASH_BITS >= 8. +- */ +- scan += 2, match += 2; +- Assert(*scan == *match, "match[2]?"); +- +- /* We check for insufficient lookahead only every 8th comparison; +- * the 256th check will be made at strstart+258. +- */ +- do { +- } while (*++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- *++scan == *++match && *++scan == *++match && +- scan < strend); +- +- Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); +- +- len = MAX_MATCH - (int)(strend - scan); +- +- if (len < MIN_MATCH) return MIN_MATCH - 1; +- +- s->match_start = cur_match; +- return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; +-} +- +-#ifdef DEBUG +-/* =========================================================================== +- * Check that the match at match_start is indeed a match. +- */ +-local void check_match(s, start, match, length) +- deflate_state *s; +- IPos start, match; +- int length; +-{ +- /* check that the match is indeed a match */ +- if (zmemcmp(s->window + match, +- s->window + start, length) != EQUAL) { +- fprintf(stderr, " start %u, match %u, length %d\n", +- start, match, length); +- do { +- fprintf(stderr, "%c%c", s->window[match++], s->window[start++]); +- } while (--length != 0); +- z_error("invalid match"); +- } +- if (z_verbose > 1) { +- fprintf(stderr,"\\[%d,%d]", start-match, length); +- do { putc(s->window[start++], stderr); } while (--length != 0); +- } +-} +-#else +-# define check_match(s, start, match, length) +-#endif /* DEBUG */ +- +-/* =========================================================================== +- * Fill the window when the lookahead becomes insufficient. +- * Updates strstart and lookahead. +- * +- * IN assertion: lookahead < MIN_LOOKAHEAD +- * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD +- * At least one byte has been read, or avail_in == 0; reads are +- * performed for at least two bytes (required for the zip translate_eol +- * option -- not supported here). +- */ +-local void fill_window(deflate_state *s) +-{ +- register unsigned n, m; +- register Posf *p; +- unsigned more; /* Amount of free space at the end of the window. */ +- uInt wsize = s->w_size; +- +- do { +- more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); +- +- /* Deal with !@#$% 64K limit: */ +- if (sizeof(int) <= 2) { +- if (more == 0 && s->strstart == 0 && s->lookahead == 0) { +- more = wsize; +- +- } else if (more == (unsigned)(-1)) { +- /* Very unlikely, but possible on 16 bit machine if +- * strstart == 0 && lookahead == 1 (input done a byte at time) +- */ +- more--; +- } +- } +- +- /* If the window is almost full and there is insufficient lookahead, +- * move the upper half to the lower one to make room in the upper half. +- */ +- if (s->strstart >= wsize+MAX_DIST(s)) { +- +- zmemcpy(s->window, s->window+wsize, (unsigned)wsize); +- s->match_start -= wsize; +- s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ +- s->block_start -= (long) wsize; +- +- /* Slide the hash table (could be avoided with 32 bit values +- at the expense of memory usage). We slide even when level == 0 +- to keep the hash table consistent if we switch back to level > 0 +- later. (Using level 0 permanently is not an optimal usage of +- zlib, so we don't care about this pathological case.) +- */ +- /* %%% avoid this when Z_RLE */ +- n = s->hash_size; +- p = &s->head[n]; +- do { +- m = *--p; +- *p = (Pos)(m >= wsize ? m-wsize : NIL); +- } while (--n); +- +- n = wsize; +-#ifndef FASTEST +- p = &s->prev[n]; +- do { +- m = *--p; +- *p = (Pos)(m >= wsize ? m-wsize : NIL); +- /* If n is not on any hash chain, prev[n] is garbage but +- * its value will never be used. +- */ +- } while (--n); +-#endif +- more += wsize; +- } +- if (s->strm->avail_in == 0) return; +- +- /* If there was no sliding: +- * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && +- * more == window_size - lookahead - strstart +- * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) +- * => more >= window_size - 2*WSIZE + 2 +- * In the BIG_MEM or MMAP case (not yet supported), +- * window_size == input_size + MIN_LOOKAHEAD && +- * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. +- * Otherwise, window_size == 2*WSIZE so more >= 2. +- * If there was sliding, more >= WSIZE. So in all cases, more >= 2. +- */ +- Assert(more >= 2, "more < 2"); +- +- n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); +- s->lookahead += n; +- +- /* Initialize the hash value now that we have some input: */ +- if (s->lookahead >= MIN_MATCH) { +- s->ins_h = s->window[s->strstart]; +- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +-#if MIN_MATCH != 3 +- Call UPDATE_HASH() MIN_MATCH-3 more times +-#endif +- } +- /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, +- * but this is not important since only literal bytes will be emitted. +- */ +- +- } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); +-} +- +-/* =========================================================================== +- * Flush the current block, with given end-of-file flag. +- * IN assertion: strstart is set to the end of the current match. +- */ +-#define FLUSH_BLOCK_ONLY(s, eof) { \ +- _tr_flush_block(s, (s->block_start >= 0L ? \ +- (charf *)&s->window[(unsigned)s->block_start] : \ +- (charf *)Z_NULL), \ +- (ulg)((long)s->strstart - s->block_start), \ +- (eof)); \ +- s->block_start = s->strstart; \ +- flush_pending(s->strm); \ +- Tracev((stderr,"[FLUSH]")); \ +-} +- +-/* Same but force premature exit if necessary. */ +-#define FLUSH_BLOCK(s, eof) { \ +- FLUSH_BLOCK_ONLY(s, eof); \ +- if (s->strm->avail_out == 0) return (eof) ? finish_started : need_more; \ +-} +- +-/* =========================================================================== +- * Copy without compression as much as possible from the input stream, return +- * the current block state. +- * This function does not insert new strings in the dictionary since +- * uncompressible data is probably not useful. This function is used +- * only for the level=0 compression option. +- * NOTE: this function should be optimized to avoid extra copying from +- * window to pending_buf. +- */ +-local block_state deflate_stored(deflate_state *s, int flush) +-{ +- /* Stored blocks are limited to 0xffff bytes, pending_buf is limited +- * to pending_buf_size, and each stored block has a 5 byte header: +- */ +- ulg max_block_size = 0xffff; +- ulg max_start; +- +- if (max_block_size > s->pending_buf_size - 5) { +- max_block_size = s->pending_buf_size - 5; +- } +- +- /* Copy as much as possible from input to output: */ +- for (;;) { +- /* Fill the window as much as possible: */ +- if (s->lookahead <= 1) { +- +- Assert(s->strstart < s->w_size+MAX_DIST(s) || +- s->block_start >= (long)s->w_size, "slide too late"); +- +- fill_window(s); +- if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more; +- +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- Assert(s->block_start >= 0L, "block gone"); +- +- s->strstart += s->lookahead; +- s->lookahead = 0; +- +- /* Emit a stored block if pending_buf will be full: */ +- max_start = s->block_start + max_block_size; +- if (s->strstart == 0 || (ulg)s->strstart >= max_start) { +- /* strstart == 0 is possible when wraparound on 16-bit machine */ +- s->lookahead = (uInt)(s->strstart - max_start); +- s->strstart = (uInt)max_start; +- FLUSH_BLOCK(s, 0); +- } +- /* Flush if we may have to slide, otherwise block_start may become +- * negative and the data will be gone: +- */ +- if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) { +- FLUSH_BLOCK(s, 0); +- } +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +- +-/* =========================================================================== +- * Compress as much as possible from the input stream, return the current +- * block state. +- * This function does not perform lazy evaluation of matches and inserts +- * new strings in the dictionary only for unmatched strings or for short +- * matches. It is used only for the fast compression options. +- */ +-local block_state deflate_fast(deflate_state *s, int flush) +-{ +- IPos hash_head = NIL; /* head of the hash chain */ +- int bflush; /* set if current block must be flushed */ +- +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the next match, plus MIN_MATCH bytes to insert the +- * string following the next match. +- */ +- if (s->lookahead < MIN_LOOKAHEAD) { +- fill_window(s); +- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* Insert the string window[strstart .. strstart+2] in the +- * dictionary, and set hash_head to the head of the hash chain: +- */ +- if (s->lookahead >= MIN_MATCH) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- +- /* Find the longest match, discarding those <= prev_length. +- * At this point we have always match_length < MIN_MATCH +- */ +- if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { +- /* To simplify the code, we prevent matches with the string +- * of window index 0 (in particular we have to avoid a match +- * of the string with itself at the start of the input file). +- */ +-#ifdef FASTEST +- if ((s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) || +- (s->strategy == Z_RLE && s->strstart - hash_head == 1)) { +- s->match_length = longest_match_fast (s, hash_head); +- } +-#else +- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { +- s->match_length = longest_match (s, hash_head); +- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { +- s->match_length = longest_match_fast (s, hash_head); +- } +-#endif +- /* longest_match() or longest_match_fast() sets match_start */ +- } +- if (s->match_length >= MIN_MATCH) { +- check_match(s, s->strstart, s->match_start, s->match_length); +- +- _tr_tally_dist(s, s->strstart - s->match_start, +- s->match_length - MIN_MATCH, bflush); +- +- s->lookahead -= s->match_length; +- +- /* Insert new strings in the hash table only if the match length +- * is not too large. This saves time but degrades compression. +- */ +-#ifndef FASTEST +- if (s->match_length <= s->max_insert_length && +- s->lookahead >= MIN_MATCH) { +- s->match_length--; /* string at strstart already in table */ +- do { +- s->strstart++; +- INSERT_STRING(s, s->strstart, hash_head); +- /* strstart never exceeds WSIZE-MAX_MATCH, so there are +- * always MIN_MATCH bytes ahead. +- */ +- } while (--s->match_length != 0); +- s->strstart++; +- } else +-#endif +- { +- s->strstart += s->match_length; +- s->match_length = 0; +- s->ins_h = s->window[s->strstart]; +- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +-#if MIN_MATCH != 3 +- Call UPDATE_HASH() MIN_MATCH-3 more times +-#endif +- /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not +- * matter since it will be recomputed at next deflate call. +- */ +- } +- } else { +- /* No match, output a literal byte */ +- Tracevv((stderr,"%c", s->window[s->strstart])); +- _tr_tally_lit (s, s->window[s->strstart], bflush); +- s->lookahead--; +- s->strstart++; +- } +- if (bflush) FLUSH_BLOCK(s, 0); +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +- +-#ifndef FASTEST +-/* =========================================================================== +- * Same as above, but achieves better compression. We use a lazy +- * evaluation for matches: a match is finally adopted only if there is +- * no better match at the next window position. +- */ +-local block_state deflate_slow(deflate_state *s, int flush) +-{ +- IPos hash_head = NIL; /* head of hash chain */ +- int bflush; /* set if current block must be flushed */ +- +- /* Process the input block. */ +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the next match, plus MIN_MATCH bytes to insert the +- * string following the next match. +- */ +- if (s->lookahead < MIN_LOOKAHEAD) { +- fill_window(s); +- if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* Insert the string window[strstart .. strstart+2] in the +- * dictionary, and set hash_head to the head of the hash chain: +- */ +- if (s->lookahead >= MIN_MATCH) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- +- /* Find the longest match, discarding those <= prev_length. +- */ +- s->prev_length = s->match_length, s->prev_match = s->match_start; +- s->match_length = MIN_MATCH-1; +- +- if (hash_head != NIL && s->prev_length < s->max_lazy_match && +- s->strstart - hash_head <= MAX_DIST(s)) { +- /* To simplify the code, we prevent matches with the string +- * of window index 0 (in particular we have to avoid a match +- * of the string with itself at the start of the input file). +- */ +- if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { +- s->match_length = longest_match (s, hash_head); +- } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { +- s->match_length = longest_match_fast (s, hash_head); +- } +- /* longest_match() or longest_match_fast() sets match_start */ +- +- if (s->match_length <= 5 && (s->strategy == Z_FILTERED +-#if TOO_FAR <= 32767 +- || (s->match_length == MIN_MATCH && +- s->strstart - s->match_start > TOO_FAR) +-#endif +- )) { +- +- /* If prev_match is also MIN_MATCH, match_start is garbage +- * but we will ignore the current match anyway. +- */ +- s->match_length = MIN_MATCH-1; +- } +- } +- /* If there was a match at the previous step and the current +- * match is not better, output the previous match: +- */ +- if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { +- uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; +- /* Do not insert strings in hash table beyond this. */ +- +- check_match(s, s->strstart-1, s->prev_match, s->prev_length); +- +- _tr_tally_dist(s, s->strstart -1 - s->prev_match, +- s->prev_length - MIN_MATCH, bflush); +- +- /* Insert in hash table all strings up to the end of the match. +- * strstart-1 and strstart are already inserted. If there is not +- * enough lookahead, the last two strings are not inserted in +- * the hash table. +- */ +- s->lookahead -= s->prev_length-1; +- s->prev_length -= 2; +- do { +- if (++s->strstart <= max_insert) { +- INSERT_STRING(s, s->strstart, hash_head); +- } +- } while (--s->prev_length != 0); +- s->match_available = 0; +- s->match_length = MIN_MATCH-1; +- s->strstart++; +- +- if (bflush) FLUSH_BLOCK(s, 0); +- +- } else if (s->match_available) { +- /* 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. +- */ +- Tracevv((stderr,"%c", s->window[s->strstart-1])); +- _tr_tally_lit(s, s->window[s->strstart-1], bflush); +- if (bflush) { +- FLUSH_BLOCK_ONLY(s, 0); +- } +- s->strstart++; +- s->lookahead--; +- if (s->strm->avail_out == 0) return need_more; +- } else { +- /* There is no previous match to compare with, wait for +- * the next step to decide. +- */ +- s->match_available = 1; +- s->strstart++; +- s->lookahead--; +- } +- } +- Assert (flush != Z_NO_FLUSH, "no flush?"); +- if (s->match_available) { +- Tracevv((stderr,"%c", s->window[s->strstart-1])); +- _tr_tally_lit(s, s->window[s->strstart-1], bflush); +- s->match_available = 0; +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +-#endif /* FASTEST */ +- +-#if 0 +-/* =========================================================================== +- * For Z_RLE, simply look for runs of bytes, generate matches only of distance +- * one. Do not maintain a hash table. (It will be regenerated if this run of +- * deflate switches away from Z_RLE.) +- */ +-local block_state deflate_rle(deflate_state *s, int flush) +-{ +- int bflush; /* set if current block must be flushed */ +- uInt run; /* length of run */ +- uInt max; /* maximum length of run */ +- uInt prev; /* byte at distance one to match */ +- Bytef *scan; /* scan for end of run */ +- +- for (;;) { +- /* Make sure that we always have enough lookahead, except +- * at the end of the input file. We need MAX_MATCH bytes +- * for the longest encodable run. +- */ +- if (s->lookahead < MAX_MATCH) { +- fill_window(s); +- if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) { +- return need_more; +- } +- if (s->lookahead == 0) break; /* flush the current block */ +- } +- +- /* See how many times the previous byte repeats */ +- run = 0; +- if (s->strstart > 0) { /* if there is a previous byte, that is */ +- max = s->lookahead < MAX_MATCH ? s->lookahead : MAX_MATCH; +- scan = s->window + s->strstart - 1; +- prev = *scan++; +- do { +- if (*scan++ != prev) +- break; +- } while (++run < max); +- } +- +- /* Emit match if have run of MIN_MATCH or longer, else emit literal */ +- if (run >= MIN_MATCH) { +- check_match(s, s->strstart, s->strstart - 1, run); +- _tr_tally_dist(s, 1, run - MIN_MATCH, bflush); +- s->lookahead -= run; +- s->strstart += run; +- } else { +- /* No match, output a literal byte */ +- Tracevv((stderr,"%c", s->window[s->strstart])); +- _tr_tally_lit (s, s->window[s->strstart], bflush); +- s->lookahead--; +- s->strstart++; +- } +- if (bflush) FLUSH_BLOCK(s, 0); +- } +- FLUSH_BLOCK(s, flush == Z_FINISH); +- return flush == Z_FINISH ? finish_done : block_done; +-} +-#endif +diff -ruN seqinr.orig/src/deflate.h seqinr/src/deflate.h +--- seqinr.orig/src/deflate.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/deflate.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,331 +0,0 @@ +-/* deflate.h -- internal compression state +- * Copyright (C) 1995-2004 Jean-loup Gailly +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* @(#) $Id: deflate.h,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ +- +-#ifndef DEFLATE_H +-#define DEFLATE_H +- +-#include "zutil.h" +- +-/* define NO_GZIP when compiling if you want to disable gzip header and +- trailer creation by deflate(). NO_GZIP would be used to avoid linking in +- the crc code when it is not needed. For shared libraries, gzip encoding +- should be left enabled. */ +-#ifndef NO_GZIP +-# define GZIP +-#endif +- +-/* =========================================================================== +- * Internal compression state. +- */ +- +-#define LENGTH_CODES 29 +-/* number of length codes, not counting the special END_BLOCK code */ +- +-#define LITERALS 256 +-/* number of literal bytes 0..255 */ +- +-#define L_CODES (LITERALS+1+LENGTH_CODES) +-/* number of Literal or Length codes, including the END_BLOCK code */ +- +-#define D_CODES 30 +-/* number of distance codes */ +- +-#define BL_CODES 19 +-/* number of codes used to transfer the bit lengths */ +- +-#define HEAP_SIZE (2*L_CODES+1) +-/* maximum heap size */ +- +-#define MAX_BITS 15 +-/* All codes must not exceed MAX_BITS bits */ +- +-#define INIT_STATE 42 +-#define EXTRA_STATE 69 +-#define NAME_STATE 73 +-#define COMMENT_STATE 91 +-#define HCRC_STATE 103 +-#define BUSY_STATE 113 +-#define FINISH_STATE 666 +-/* Stream status */ +- +- +-/* Data structure describing a single value and its code string. */ +-typedef struct ct_data_s { +- union { +- ush freq; /* frequency count */ +- ush code; /* bit string */ +- } fc; +- union { +- ush dad; /* father node in Huffman tree */ +- ush len; /* length of bit string */ +- } dl; +-} FAR ct_data; +- +-#define Freq fc.freq +-#define Code fc.code +-#define Dad dl.dad +-#define Len dl.len +- +-typedef struct static_tree_desc_s static_tree_desc; +- +-typedef struct tree_desc_s { +- ct_data *dyn_tree; /* the dynamic tree */ +- int max_code; /* largest code with non zero frequency */ +- static_tree_desc *stat_desc; /* the corresponding static tree */ +-} FAR tree_desc; +- +-typedef ush Pos; +-typedef Pos FAR Posf; +-typedef unsigned IPos; +- +-/* A Pos is an index in the character window. We use short instead of int to +- * save space in the various tables. IPos is used only for parameter passing. +- */ +- +-typedef struct internal_state { +- z_streamp strm; /* pointer back to this zlib stream */ +- int status; /* as the name implies */ +- Bytef *pending_buf; /* output still pending */ +- ulg pending_buf_size; /* size of pending_buf */ +- Bytef *pending_out; /* next pending byte to output to the stream */ +- uInt pending; /* nb of bytes in the pending buffer */ +- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ +- gz_headerp gzhead; /* gzip header information to write */ +- uInt gzindex; /* where in extra, name, or comment */ +- Byte method; /* STORED (for zip only) or DEFLATED */ +- int last_flush; /* value of flush param for previous deflate call */ +- +- /* used by deflate.c: */ +- +- uInt w_size; /* LZ77 window size (32K by default) */ +- uInt w_bits; /* log2(w_size) (8..16) */ +- uInt w_mask; /* w_size - 1 */ +- +- Bytef *window; +- /* Sliding window. Input bytes are read into the second half of the window, +- * and move to the first half later to keep a dictionary of at least wSize +- * bytes. With this organization, matches are limited to a distance of +- * wSize-MAX_MATCH bytes, but this ensures that IO is always +- * performed with a length multiple of the block size. Also, it limits +- * the window size to 64K, which is quite useful on MSDOS. +- * To do: use the user input buffer as sliding window. +- */ +- +- ulg window_size; +- /* Actual size of window: 2*wSize, except when the user input buffer +- * is directly used as sliding window. +- */ +- +- Posf *prev; +- /* Link to older string with same hash index. To limit the size of this +- * array to 64K, this link is maintained only for the last 32K strings. +- * An index in this array is thus a window index modulo 32K. +- */ +- +- Posf *head; /* Heads of the hash chains or NIL. */ +- +- uInt ins_h; /* hash index of string to be inserted */ +- uInt hash_size; /* number of elements in hash table */ +- uInt hash_bits; /* log2(hash_size) */ +- uInt hash_mask; /* hash_size-1 */ +- +- uInt hash_shift; +- /* Number of bits by which ins_h must be shifted at each input +- * step. It must be such that after MIN_MATCH steps, the oldest +- * byte no longer takes part in the hash key, that is: +- * hash_shift * MIN_MATCH >= hash_bits +- */ +- +- long block_start; +- /* Window position at the beginning of the current output block. Gets +- * negative when the window is moved backwards. +- */ +- +- uInt match_length; /* length of best match */ +- IPos prev_match; /* previous match */ +- int match_available; /* set if previous match exists */ +- uInt strstart; /* start of string to insert */ +- uInt match_start; /* start of matching string */ +- uInt lookahead; /* number of valid bytes ahead in window */ +- +- uInt prev_length; +- /* Length of the best match at previous step. Matches not greater than this +- * are discarded. This is used in the lazy match evaluation. +- */ +- +- uInt max_chain_length; +- /* To speed up deflation, hash chains are never searched beyond this +- * length. A higher limit improves compression ratio but degrades the +- * speed. +- */ +- +- uInt max_lazy_match; +- /* Attempt to find a better match only when the current match is strictly +- * smaller than this value. This mechanism is used only for compression +- * levels >= 4. +- */ +-# define max_insert_length max_lazy_match +- /* Insert new strings in the hash table only if the match length is not +- * greater than this length. This saves time but degrades compression. +- * max_insert_length is used only for compression levels <= 3. +- */ +- +- int level; /* compression level (1..9) */ +- int strategy; /* favor or force Huffman coding*/ +- +- uInt good_match; +- /* Use a faster search when the previous match is longer than this */ +- +- int nice_match; /* Stop searching when current match exceeds this */ +- +- /* used by trees.c: */ +- /* Didn't use ct_data typedef below to supress compiler warning */ +- struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */ +- struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */ +- struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */ +- +- struct tree_desc_s l_desc; /* desc. for literal tree */ +- struct tree_desc_s d_desc; /* desc. for distance tree */ +- struct tree_desc_s bl_desc; /* desc. for bit length tree */ +- +- ush bl_count[MAX_BITS+1]; +- /* number of codes at each bit length for an optimal tree */ +- +- int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ +- int heap_len; /* number of elements in the heap */ +- int heap_max; /* element of largest frequency */ +- /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. +- * The same heap array is used to build all trees. +- */ +- +- uch depth[2*L_CODES+1]; +- /* Depth of each subtree used as tie breaker for trees of equal frequency +- */ +- +- uchf *l_buf; /* buffer for literals or lengths */ +- +- uInt lit_bufsize; +- /* Size of match buffer for literals/lengths. There are 4 reasons for +- * limiting lit_bufsize to 64K: +- * - frequencies can be kept in 16 bit counters +- * - if compression is not successful for the first block, all input +- * data is still in the window so we can still emit a stored block even +- * when input comes from standard input. (This can also be done for +- * all blocks if lit_bufsize is not greater than 32K.) +- * - if compression is not successful for a file smaller than 64K, we can +- * even emit a stored file instead of a stored block (saving 5 bytes). +- * This is applicable only for zip (not gzip or zlib). +- * - creating new Huffman trees less frequently may not provide fast +- * adaptation to changes in the input data statistics. (Take for +- * example a binary file with poorly compressible code followed by +- * a highly compressible string table.) Smaller buffer sizes give +- * fast adaptation but have of course the overhead of transmitting +- * trees more frequently. +- * - I can't count above 4 +- */ +- +- uInt last_lit; /* running index in l_buf */ +- +- ushf *d_buf; +- /* Buffer for distances. To simplify the code, d_buf and l_buf have +- * the same number of elements. To use different lengths, an extra flag +- * array would be necessary. +- */ +- +- ulg opt_len; /* bit length of current block with optimal trees */ +- ulg static_len; /* bit length of current block with static trees */ +- uInt matches; /* number of string matches in current block */ +- int last_eob_len; /* bit length of EOB code for last block */ +- +-#ifdef DEBUG +- ulg compressed_len; /* total bit length of compressed file mod 2^32 */ +- ulg bits_sent; /* bit length of compressed data sent mod 2^32 */ +-#endif +- +- ush bi_buf; +- /* Output buffer. bits are inserted starting at the bottom (least +- * significant bits). +- */ +- int bi_valid; +- /* Number of valid bits in bi_buf. All bits above the last valid bit +- * are always zero. +- */ +- +-} FAR deflate_state; +- +-/* Output a byte on the stream. +- * IN assertion: there is enough room in pending_buf. +- */ +-#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);} +- +- +-#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +-/* Minimum amount of lookahead, except at the end of the input file. +- * See deflate.c for comments about the MIN_MATCH+1. +- */ +- +-#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD) +-/* In order to simplify the code, particularly on 16 bit machines, match +- * distances are limited to MAX_DIST instead of WSIZE. +- */ +- +- /* in trees.c */ +-void _tr_init OF((deflate_state *s)); +-int _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc)); +-void _tr_flush_block OF((deflate_state *s, charf *buf, ulg stored_len, +- int eof)); +-void _tr_align OF((deflate_state *s)); +-void _tr_stored_block OF((deflate_state *s, charf *buf, ulg stored_len, +- int eof)); +- +-#define d_code(dist) \ +- ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)]) +-/* Mapping from a distance to a distance code. dist is the distance - 1 and +- * must not have side effects. _dist_code[256] and _dist_code[257] are never +- * used. +- */ +- +-#ifndef DEBUG +-/* Inline versions of _tr_tally for speed: */ +- +-#if defined(GEN_TREES_H) || !defined(STDC) +- extern uch _length_code[]; +- extern uch _dist_code[]; +-#else +- extern const uch _length_code[]; +- extern const uch _dist_code[]; +-#endif +- +-# define _tr_tally_lit(s, c, flush) \ +- { uch cc = (c); \ +- s->d_buf[s->last_lit] = 0; \ +- s->l_buf[s->last_lit++] = cc; \ +- s->dyn_ltree[cc].Freq++; \ +- flush = (s->last_lit == s->lit_bufsize-1); \ +- } +-# define _tr_tally_dist(s, distance, length, flush) \ +- { uch len = (length); \ +- ush dist = (distance); \ +- s->d_buf[s->last_lit] = dist; \ +- s->l_buf[s->last_lit++] = len; \ +- dist--; \ +- s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \ +- s->dyn_dtree[d_code(dist)].Freq++; \ +- flush = (s->last_lit == s->lit_bufsize-1); \ +- } +-#else +-# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c) +-# define _tr_tally_dist(s, distance, length, flush) \ +- flush = _tr_tally(s, distance, length) +-#endif +- +-#endif /* DEFLATE_H */ +diff -ruN seqinr.orig/src/gzio.c seqinr/src/gzio.c +--- seqinr.orig/src/gzio.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/gzio.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1007 +0,0 @@ +-/* gzio.c -- IO on .gz files +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- * +- * Compile this file with -DNO_GZCOMPRESS to avoid the compression code. +- */ +- +-/* @(#) $Id: gzio.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ +- +-#ifdef HAVE_CONFIG_H +-#include +-#endif +- +-#include +- +-/***Supprime #if !defined(fdopen) && !defined(HAVE_FDOPEN) +-not used in R +-static FILE *fdopen(int fildes, const char *mode) +-{ +-} +-#endif +-**/ +- +-#include "zutil.h" +- +-/* R ADDITION */ +-#if defined(HAVE_OFF_T) && defined(HAVE_SEEKO) +-#define f_seek fseeko +-#define f_tell ftello +-#else +-#ifdef Win32 +-#define f_seek fseeko64 +-#define f_tell ftello64 +-#else +-#define f_seek fseek +-#define f_tell ftell +-#endif +-#endif +- +-#ifdef NO_DEFLATE /* for compatibility with old definition */ +-# define NO_GZCOMPRESS +-#endif +- +-#ifndef NO_DUMMY_DECL +-struct internal_state {int dummy;}; /* for buggy compilers */ +-#endif +- +-#ifndef Z_BUFSIZE +-# ifdef MAXSEG_64K +-# define Z_BUFSIZE 4096 /* minimize memory usage for 16-bit DOS */ +-# else +-# define Z_BUFSIZE 16384 +-# endif +-#endif +-#ifndef Z_PRINTF_BUFSIZE +-# define Z_PRINTF_BUFSIZE 4096 +-#endif +- +-#ifdef __MVS__ +-# pragma map (fdopen , "\174\174FDOPEN") +- FILE *fdopen(int, const char *); +-#endif +- +-#ifndef STDC +-extern voidp malloc OF((uInt size)); +-extern void free OF((voidpf ptr)); +-#endif +- +-#define ALLOC(size) malloc(size) +-#define TRYFREE(p) {if (p) free(p);} +- +-static int const gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ +- +-/* gzip flag byte */ +-#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +-#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ +-#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +-#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +-#define COMMENT 0x10 /* bit 4 set: file comment present */ +-#define RESERVED 0xE0 /* bits 5..7: reserved */ +- +-typedef struct gz_stream { +- z_stream stream; +- int z_err; /* error code for last stream operation */ +- int z_eof; /* set if end of input file */ +- FILE *file; /* .gz file */ +- Byte *inbuf; /* input buffer */ +- Byte *outbuf; /* output buffer */ +- uLong crc; /* crc32 of uncompressed data */ +- char *msg; /* error message */ +- char *path; /* path name for debugging only */ +- int transparent; /* 1 if input file is not a .gz file */ +- char mode; /* 'w' or 'r' */ +- z_off_t start; /* start of compressed data in file (header skipped) */ +- z_off_t in; /* bytes into deflate or inflate */ +- z_off_t out; /* bytes out of deflate or inflate */ +- int back; /* one character push-back */ +- int last; /* true if push-back is last character */ +-} gz_stream; +- +- +-local gzFile gz_open OF((const char *path, const char *mode, int fd)); +-local int do_flush OF((gzFile file, int flush)); +-local int get_byte OF((gz_stream *s)); +-local void check_header OF((gz_stream *s)); +-local int destroy OF((gz_stream *s)); +-local void putLong OF((FILE *file, uLong x)); +-local uLong getLong OF((gz_stream *s)); +- +-/* =========================================================================== +- Opens a gzip (.gz) file for reading or writing. The mode parameter +- is as in fopen ("rb" or "wb"). The file is given either by file descriptor +- or path name (if fd == -1). +- gz_open returns NULL if the file could not be opened or if there was +- insufficient memory to allocate the (de)compression state; errno +- can be checked to distinguish the two cases (if errno is zero, the +- zlib error is Z_MEM_ERROR). +-*/ +-local gzFile gz_open (const char *path, const char *mode, int fd) +-{ +- int err; +- int level = Z_DEFAULT_COMPRESSION; /* compression level */ +- int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */ +- char *p = (char*)mode; +- gz_stream *s; +- char fmode[80]; /* copy of mode, without the compression level */ +- char *m = fmode; +- +- if (!path || !mode) return Z_NULL; +- +- s = (gz_stream *)ALLOC(sizeof(gz_stream)); +- if (!s) return Z_NULL; +- +- s->stream.zalloc = (alloc_func)0; +- s->stream.zfree = (free_func)0; +- s->stream.opaque = (voidpf)0; +- s->stream.next_in = s->inbuf = Z_NULL; +- s->stream.next_out = s->outbuf = Z_NULL; +- s->stream.avail_in = s->stream.avail_out = 0; +- s->file = NULL; +- s->z_err = Z_OK; +- s->z_eof = 0; +- s->in = 0; +- s->out = 0; +- s->back = EOF; +- s->crc = crc32(0L, Z_NULL, 0); +- s->msg = NULL; +- s->transparent = 0; +- +- s->path = (char*)ALLOC(strlen(path)+1); +- if (s->path == NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- strcpy(s->path, path); /* do this early for debugging */ +- +- s->mode = '\0'; +- do { +- if (*p == 'r') s->mode = 'r'; +- if (*p == 'w' || *p == 'a') s->mode = 'w'; +- if (*p >= '0' && *p <= '9') { +- level = *p - '0'; +- } else if (*p == 'f') { +- strategy = Z_FILTERED; +- } else if (*p == 'h') { +- strategy = Z_HUFFMAN_ONLY; +- } else if (*p == 'R') { +- strategy = Z_RLE; +- } else { +- *m++ = *p; /* copy the mode */ +- } +- } while (*p++ && m != fmode + sizeof(fmode)); +- if (s->mode == '\0') return destroy(s), (gzFile)Z_NULL; +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- err = Z_STREAM_ERROR; +-#else +- err = deflateInit2(&(s->stream), level, +- Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, strategy); +- /* windowBits is passed < 0 to suppress zlib header */ +- +- s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); +-#endif +- if (err != Z_OK || s->outbuf == Z_NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- } else { +- s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); +- +- err = inflateInit2(&(s->stream), -MAX_WBITS); +- /* windowBits is passed < 0 to tell that there is no zlib header. +- * Note that in this case inflate *requires* an extra "dummy" byte +- * after the compressed stream in order to complete decompression and +- * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are +- * present after the compressed stream. +- */ +- if (err != Z_OK || s->inbuf == Z_NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- } +- s->stream.avail_out = Z_BUFSIZE; +- +- errno = 0; +- s->file = fd < 0 ? F_OPEN(path, fmode) : (FILE*)fdopen(fd, fmode); +- +- if (s->file == NULL) { +- return destroy(s), (gzFile)Z_NULL; +- } +- if (s->mode == 'w') { +- /* Write a very simple .gz header: +- */ +- fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], +- Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, OS_CODE); +- s->start = 10L; +- /* We use 10L instead of ftell(s->file) to because ftell causes an +- * fflush on some systems. This version of the library doesn't use +- * start anyway in write mode, so this initialization is not +- * necessary. +- */ +- } else { +- check_header(s); /* skip the .gz header */ +- s->start = f_tell(s->file) - s->stream.avail_in; +- } +- +- return (gzFile)s; +-} +- +-/* =========================================================================== +- Opens a gzip (.gz) file for reading or writing. +-*/ +-gzFile ZEXPORT gzopen (const char *path, const char *mode) +-{ +- return gz_open (path, mode, -1); +-} +- +-/* =========================================================================== +- Associate a gzFile with the file descriptor fd. fd is not dup'ed here +- to mimic the behavio(u)r of fdopen. +-*/ +-gzFile ZEXPORT gzdopen (int fd, const char *mode) +-{ +- char name[46]; /* allow for up to 128-bit integers */ +- +- if (fd < 0) return (gzFile)Z_NULL; +- sprintf(name, "", fd); /* for debugging */ +- +- return gz_open (name, mode, fd); +-} +- +-/* =========================================================================== +- * Update the compression level and strategy +- */ +-int ZEXPORT gzsetparams (gzFile file, int level, int strategy) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- /* Make room to allow flushing */ +- if (s->stream.avail_out == 0) { +- +- s->stream.next_out = s->outbuf; +- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { +- s->z_err = Z_ERRNO; +- } +- s->stream.avail_out = Z_BUFSIZE; +- } +- +- return deflateParams (&(s->stream), level, strategy); +-} +- +-/* =========================================================================== +- Read a byte from a gz_stream; update next_in and avail_in. Return EOF +- for end of file. +- IN assertion: the stream s has been sucessfully opened for reading. +-*/ +-local int get_byte(gz_stream *s) +-{ +- if (s->z_eof) return EOF; +- if (s->stream.avail_in == 0) { +- errno = 0; +- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); +- if (s->stream.avail_in == 0) { +- s->z_eof = 1; +- if (ferror(s->file)) s->z_err = Z_ERRNO; +- return EOF; +- } +- s->stream.next_in = s->inbuf; +- } +- s->stream.avail_in--; +- return *(s->stream.next_in)++; +-} +- +-/* =========================================================================== +- Check the gzip header of a gz_stream opened for reading. Set the stream +- mode to transparent if the gzip magic header is not present; set s->err +- to Z_DATA_ERROR if the magic header is present but the rest of the header +- is incorrect. +- IN assertion: the stream s has already been created sucessfully; +- s->stream.avail_in is zero for the first time, but may be non-zero +- for concatenated .gz files. +-*/ +-local void check_header(gz_stream *s) +-{ +- int method; /* method byte */ +- int flags; /* flags byte */ +- uInt len; +- int c; +- +- /* Assure two bytes in the buffer so we can peek ahead -- handle case +- where first byte of header is at the end of the buffer after the last +- gzip segment */ +- len = s->stream.avail_in; +- if (len < 2) { +- if (len) s->inbuf[0] = s->stream.next_in[0]; +- errno = 0; +- len = (uInt)fread(s->inbuf + len, 1, Z_BUFSIZE >> len, s->file); +- if (len == 0 && ferror(s->file)) s->z_err = Z_ERRNO; +- s->stream.avail_in += len; +- s->stream.next_in = s->inbuf; +- if (s->stream.avail_in < 2) { +- s->transparent = s->stream.avail_in; +- return; +- } +- } +- +- /* Peek ahead to check the gzip magic header */ +- if (s->stream.next_in[0] != gz_magic[0] || +- s->stream.next_in[1] != gz_magic[1]) { +- s->transparent = 1; +- return; +- } +- s->stream.avail_in -= 2; +- s->stream.next_in += 2; +- +- /* Check the rest of the gzip header */ +- method = get_byte(s); +- flags = get_byte(s); +- if (method != Z_DEFLATED || (flags & RESERVED) != 0) { +- s->z_err = Z_DATA_ERROR; +- return; +- } +- +- /* Discard time, xflags and OS code: */ +- for (len = 0; len < 6; len++) (void)get_byte(s); +- +- if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ +- len = (uInt)get_byte(s); +- len += ((uInt)get_byte(s))<<8; +- /* len is garbage if EOF but the loop below will quit anyway */ +- while (len-- != 0 && get_byte(s) != EOF) ; +- } +- if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ +- while ((c = get_byte(s)) != 0 && c != EOF) ; +- } +- if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ +- while ((c = get_byte(s)) != 0 && c != EOF) ; +- } +- if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ +- for (len = 0; len < 2; len++) (void)get_byte(s); +- } +- s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; +-} +- +- /* =========================================================================== +- * Cleanup then free the given gz_stream. Return a zlib error code. +- Try freeing in the reverse order of allocations. +- */ +-local int destroy (gz_stream *s) +-{ +- int err = Z_OK; +- +- if (!s) return Z_STREAM_ERROR; +- +- TRYFREE(s->msg); +- +- if (s->stream.state != NULL) { +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- err = Z_STREAM_ERROR; +-#else +- err = deflateEnd(&(s->stream)); +-#endif +- } else if (s->mode == 'r') { +- err = inflateEnd(&(s->stream)); +- } +- } +- if (s->file != NULL && fclose(s->file)) { +-#ifdef ESPIPE +- if (errno != ESPIPE) /* fclose is broken for pipes in HP/UX */ +-#endif +- err = Z_ERRNO; +- } +- if (s->z_err < 0) err = s->z_err; +- +- TRYFREE(s->inbuf); +- TRYFREE(s->outbuf); +- TRYFREE(s->path); +- TRYFREE(s); +- return err; +-} +- +-/* =========================================================================== +- Reads the given number of uncompressed bytes from the compressed file. +- gzread returns the number of bytes actually read (0 for end of file). +-*/ +-int ZEXPORT gzread (gzFile file, voidp buf, unsigned len) +-{ +- gz_stream *s = (gz_stream*)file; +- Bytef *start = (Bytef*)buf; /* starting point for crc computation */ +- Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ +- +- if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; +- +- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1; +- if (s->z_err == Z_STREAM_END) return 0; /* EOF */ +- +- next_out = (Byte*)buf; +- s->stream.next_out = (Bytef*)buf; +- s->stream.avail_out = len; +- +- if (s->stream.avail_out && s->back != EOF) { +- *next_out++ = s->back; +- s->stream.next_out++; +- s->stream.avail_out--; +- s->back = EOF; +- s->out++; +- start++; +- if (s->last) { +- s->z_err = Z_STREAM_END; +- return 1; +- } +- } +- +- while (s->stream.avail_out != 0) { +- +- if (s->transparent) { +- /* Copy first the lookahead bytes: */ +- uInt n = s->stream.avail_in; +- if (n > s->stream.avail_out) n = s->stream.avail_out; +- if (n > 0) { +- zmemcpy(s->stream.next_out, s->stream.next_in, n); +- next_out += n; +- s->stream.next_out = next_out; +- s->stream.next_in += n; +- s->stream.avail_out -= n; +- s->stream.avail_in -= n; +- } +- if (s->stream.avail_out > 0) { +- s->stream.avail_out -= +- (uInt)fread(next_out, 1, s->stream.avail_out, s->file); +- } +- len -= s->stream.avail_out; +- s->in += len; +- s->out += len; +- if (len == 0) s->z_eof = 1; +- return (int)len; +- } +- if (s->stream.avail_in == 0 && !s->z_eof) { +- +- errno = 0; +- s->stream.avail_in = (uInt)fread(s->inbuf, 1, Z_BUFSIZE, s->file); +- if (s->stream.avail_in == 0) { +- s->z_eof = 1; +- if (ferror(s->file)) { +- s->z_err = Z_ERRNO; +- break; +- } +- } +- s->stream.next_in = s->inbuf; +- } +- s->in += s->stream.avail_in; +- s->out += s->stream.avail_out; +- s->z_err = inflate(&(s->stream), Z_NO_FLUSH); +- s->in -= s->stream.avail_in; +- s->out -= s->stream.avail_out; +- +- if (s->z_err == Z_STREAM_END) { +- /* Check CRC and original size */ +- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); +- start = s->stream.next_out; +- +- if (getLong(s) != s->crc) { +- s->z_err = Z_DATA_ERROR; +- } else { +- (void)getLong(s); +- /* The uncompressed length returned by above getlong() may be +- * different from s->out in case of concatenated .gz files. +- * Check for such files: +- */ +- check_header(s); +- if (s->z_err == Z_OK) { +- inflateReset(&(s->stream)); +- s->crc = crc32(0L, Z_NULL, 0); +- } +- } +- } +- if (s->z_err != Z_OK || s->z_eof) break; +- } +- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); +- +- if (len == s->stream.avail_out && +- (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO)) +- return -1; +- return (int)(len - s->stream.avail_out); +-} +- +- +-/* =========================================================================== +- Reads one byte from the compressed file. gzgetc returns this byte +- or -1 in case of end of file or error. +-*/ +-int ZEXPORT gzgetc(gzFile file) +-{ +- unsigned char c; +- +- return gzread(file, &c, 1) == 1 ? c : -1; +-} +- +- +-/* =========================================================================== +- Push one byte back onto the stream. +-*/ +-int ZEXPORT gzungetc(int c, gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r' || c == EOF || s->back != EOF) return EOF; +- s->back = c; +- s->out--; +- s->last = (s->z_err == Z_STREAM_END); +- if (s->last) s->z_err = Z_OK; +- s->z_eof = 0; +- return c; +-} +- +- +-/* =========================================================================== +- Reads bytes from the compressed file until len-1 characters are +- read, or a newline character is read and transferred to buf, or an +- end-of-file condition is encountered. The string is then terminated +- with a null character. +- gzgets returns buf, or Z_NULL in case of error. +- +- The current implementation is not optimized at all. +-*/ +-char * ZEXPORT gzgets(gzFile file, char *buf, int len) +-{ +- char *b = buf; +- if (buf == Z_NULL || len <= 0) return Z_NULL; +- +- while (--len > 0 && gzread(file, buf, 1) == 1 && *buf++ != '\n') ; +- *buf = '\0'; +- return b == buf && len > 0 ? Z_NULL : b; +-} +- +- +-#ifndef NO_GZCOMPRESS +-/* =========================================================================== +- Writes the given number of uncompressed bytes into the compressed file. +- gzwrite returns the number of bytes actually written (0 in case of error). +-*/ +-int ZEXPORT gzwrite (gzFile file, voidpc buf, unsigned len) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- s->stream.next_in = (Bytef*)buf; +- s->stream.avail_in = len; +- +- while (s->stream.avail_in != 0) { +- +- if (s->stream.avail_out == 0) { +- +- s->stream.next_out = s->outbuf; +- if (fwrite(s->outbuf, 1, Z_BUFSIZE, s->file) != Z_BUFSIZE) { +- s->z_err = Z_ERRNO; +- break; +- } +- s->stream.avail_out = Z_BUFSIZE; +- } +- s->in += s->stream.avail_in; +- s->out += s->stream.avail_out; +- s->z_err = deflate(&(s->stream), Z_NO_FLUSH); +- s->in -= s->stream.avail_in; +- s->out -= s->stream.avail_out; +- if (s->z_err != Z_OK) break; +- } +- s->crc = crc32(s->crc, (const Bytef *)buf, len); +- +- return (int)(len - s->stream.avail_in); +-} +- +- +-#ifdef UNUSED +-/* =========================================================================== +- Converts, formats, and writes the args to the compressed file under +- control of the format string, as in fprintf. gzprintf returns the number of +- uncompressed bytes actually written (0 in case of error). +-*/ +-#ifdef STDC +-#include +- +-int ZEXPORTVA gzprintf (gzFile file, const char *format, /* args */ ...) +-{ +- char buf[Z_PRINTF_BUFSIZE]; +- va_list va; +- int len; +- +- buf[sizeof(buf) - 1] = 0; +- va_start(va, format); +-#ifdef NO_vsnprintf +-# ifdef HAS_vsprintf_void +- (void)vsprintf(buf, format, va); +- va_end(va); +- for (len = 0; len < sizeof(buf); len++) +- if (buf[len] == 0) break; +-# else +- len = vsprintf(buf, format, va); +- va_end(va); +-# endif +-#else +-# ifdef HAS_vsnprintf_void +- (void)vsnprintf(buf, sizeof(buf), format, va); +- va_end(va); +- len = strlen(buf); +-# else +- len = vsnprintf(buf, sizeof(buf), format, va); +- va_end(va); +-# endif +-#endif +- if (len <= 0 || len >= (int)sizeof(buf) || buf[sizeof(buf) - 1] != 0) +- return 0; +- return gzwrite(file, buf, (unsigned)len); +-} +-#else /* not ANSI C */ +- +-int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, +- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) +- gzFile file; +- const char *format; +- int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, +- a11, a12, a13, a14, a15, a16, a17, a18, a19, a20; +-{ +- char buf[Z_PRINTF_BUFSIZE]; +- int len; +- +- buf[sizeof(buf) - 1] = 0; +-#ifdef NO_snprintf +-# ifdef HAS_sprintf_void +- sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, +- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); +- for (len = 0; len < sizeof(buf); len++) +- if (buf[len] == 0) break; +-# else +- len = sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8, +- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20); +-# endif +-#else +-# ifdef HAS_snprintf_void +- 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); +- len = strlen(buf); +-# else +- len = 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); +-# endif +-#endif +- if (len <= 0 || len >= sizeof(buf) || buf[sizeof(buf) - 1] != 0) +- return 0; +- return gzwrite(file, buf, len); +-} +-#endif +-#endif /* UNUSED */ +- +-/* =========================================================================== +- Writes c, converted to an unsigned char, into the compressed file. +- gzputc returns the value that was written, or -1 in case of error. +-*/ +-int ZEXPORT gzputc(gzFile file, int c) +-{ +- unsigned char cc = (unsigned char) c; /* required for big endian systems */ +- +- return gzwrite(file, &cc, 1) == 1 ? (int)cc : -1; +-} +- +- +-/* =========================================================================== +- Writes the given null-terminated string to the compressed file, excluding +- the terminating null character. +- gzputs returns the number of characters written, or -1 in case of error. +-*/ +-int ZEXPORT gzputs(gzFile file, const char *s) +-{ +- return gzwrite(file, (char*)s, (unsigned)strlen(s)); +-} +- +- +-/* =========================================================================== +- Flushes all pending output into the compressed file. The parameter +- flush is as in the deflate() function. +-*/ +-local int do_flush (gzFile file, int flush) +-{ +- uInt len; +- int done = 0; +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; +- +- s->stream.avail_in = 0; /* should be zero already anyway */ +- +- for (;;) { +- len = Z_BUFSIZE - s->stream.avail_out; +- +- if (len != 0) { +- if ((uInt)fwrite(s->outbuf, 1, len, s->file) != len) { +- s->z_err = Z_ERRNO; +- return Z_ERRNO; +- } +- s->stream.next_out = s->outbuf; +- s->stream.avail_out = Z_BUFSIZE; +- } +- if (done) break; +- s->out += s->stream.avail_out; +- s->z_err = deflate(&(s->stream), flush); +- s->out -= s->stream.avail_out; +- +- /* Ignore the second of two consecutive flushes: */ +- if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK; +- +- /* deflate has finished flushing only when it hasn't used up +- * all the available space in the output buffer: +- */ +- done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); +- +- if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; +- } +- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +-} +- +-int ZEXPORT gzflush (gzFile file, int flush) +-{ +- gz_stream *s = (gz_stream*)file; +- int err = do_flush (file, flush); +- +- if (err) return err; +- fflush(s->file); +- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +-} +-#endif /* NO_GZCOMPRESS */ +- +-/* =========================================================================== +- Sets the starting position for the next gzread or gzwrite on the given +- compressed file. The offset represents a number of bytes in the +- gzseek returns the resulting offset location as measured in bytes from +- the beginning of the uncompressed stream, or -1 in case of error. +- SEEK_END is not implemented, returns error. +- In this version of the library, gzseek can be extremely slow. +-*/ +-z_off_t ZEXPORT gzseek (gzFile file, z_off_t offset, int whence) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || whence == SEEK_END || +- s->z_err == Z_ERRNO || s->z_err == Z_DATA_ERROR) { +- return -1L; +- } +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- return -1L; +-#else +- if (whence == SEEK_SET) { +- offset -= s->in; +- } +- if (offset < 0) return -1L; +- +- /* At this point, offset is the number of zero bytes to write. */ +- if (s->inbuf == Z_NULL) { +- s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); /* for seeking */ +- if (s->inbuf == Z_NULL) return -1L; +- zmemzero(s->inbuf, Z_BUFSIZE); +- } +- while (offset > 0) { +- uInt size = Z_BUFSIZE; +- if (offset < Z_BUFSIZE) size = (uInt)offset; +- +- size = gzwrite(file, s->inbuf, size); +- if (size == 0) return -1L; +- +- offset -= size; +- } +- return s->in; +-#endif +- } +- /* Rest of function is for reading only */ +- +- /* compute absolute position */ +- if (whence == SEEK_CUR) { +- offset += s->out; +- } +- if (offset < 0) return -1L; +- +- if (s->transparent) { +- /* map to fseek */ +- s->back = EOF; +- s->stream.avail_in = 0; +- s->stream.next_in = s->inbuf; +- if (f_seek(s->file, offset, SEEK_SET) < 0) return -1L; +- +- s->in = s->out = offset; +- return offset; +- } +- +- /* For a negative seek, rewind and use positive seek */ +- if (offset >= s->out) { +- offset -= s->out; +- } else if (gzrewind(file) < 0) { +- return -1L; +- } +- /* offset is now the number of bytes to skip. */ +- +- if (offset != 0 && s->outbuf == Z_NULL) { +- s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); +- if (s->outbuf == Z_NULL) return -1L; +- } +- if (offset && s->back != EOF) { +- s->back = EOF; +- s->out++; +- offset--; +- if (s->last) s->z_err = Z_STREAM_END; +- } +- while (offset > 0) { +- int size = Z_BUFSIZE; +- if (offset < Z_BUFSIZE) size = (int)offset; +- +- size = gzread(file, s->outbuf, (uInt)size); +- if (size <= 0) return -1L; +- offset -= size; +- } +- return s->out; +-} +- +-/* =========================================================================== +- Rewinds input file. +-*/ +-int ZEXPORT gzrewind (gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r') return -1; +- +- s->z_err = Z_OK; +- s->z_eof = 0; +- s->back = EOF; +- s->stream.avail_in = 0; +- s->stream.next_in = s->inbuf; +- s->crc = crc32(0L, Z_NULL, 0); +- if (!s->transparent) (void)inflateReset(&s->stream); +- s->in = 0; +- s->out = 0; +- return f_seek(s->file, s->start, SEEK_SET); +-} +- +-/* =========================================================================== +- Returns the starting position for the next gzread or gzwrite on the +- given compressed file. This position represents a number of bytes in the +- uncompressed data stream. +-*/ +-z_off_t ZEXPORT gztell (gzFile file) +-{ +- return gzseek(file, 0L, SEEK_CUR); +-} +- +-/* =========================================================================== +- Returns 1 when EOF has previously been detected reading the given +- input stream, otherwise zero. +-*/ +-int ZEXPORT gzeof (gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- /* With concatenated compressed files that can have embedded +- * crc trailers, z_eof is no longer the only/best indicator of EOF +- * on a gz_stream. Handle end-of-stream error explicitly here. +- */ +- if (s == NULL || s->mode != 'r') return 0; +- if (s->z_eof) return 1; +- return s->z_err == Z_STREAM_END; +-} +- +-/* =========================================================================== +- Returns 1 if reading and doing so transparently, otherwise zero. +-*/ +-int ZEXPORT gzdirect (gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL || s->mode != 'r') return 0; +- return s->transparent; +-} +- +-/* =========================================================================== +- Outputs a long in LSB order to the given file +-*/ +-local void putLong (FILE *file, uLong x) +-{ +- int n; +- for (n = 0; n < 4; n++) { +- fputc((int)(x & 0xff), file); +- x >>= 8; +- } +-} +- +-/* =========================================================================== +- Reads a long in LSB order from the given gz_stream. Sets z_err in case +- of error. +-*/ +-local uLong getLong (gz_stream *s) +-{ +- uLong x = (uLong)get_byte(s); +- int c; +- +- x += ((uLong)get_byte(s))<<8; +- x += ((uLong)get_byte(s))<<16; +- c = get_byte(s); +- if (c == EOF) s->z_err = Z_DATA_ERROR; +- x += ((uLong)c)<<24; +- return x; +-} +- +-/* =========================================================================== +- Flushes all pending output if necessary, closes the compressed file +- and deallocates all the (de)compression state. +-*/ +-int ZEXPORT gzclose (gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) return Z_STREAM_ERROR; +- +- if (s->mode == 'w') { +-#ifdef NO_GZCOMPRESS +- return Z_STREAM_ERROR; +-#else +- if (do_flush (file, Z_FINISH) != Z_OK) +- return destroy((gz_stream*)file); +- +- putLong (s->file, s->crc); +- putLong (s->file, (uLong)(s->in & 0xffffffff)); +-#endif +- } +- return destroy((gz_stream*)file); +-} +- +-#ifdef STDC +-# define zstrerror(errnum) strerror(errnum) +-#else +-# define zstrerror(errnum) "" +-#endif +- +-/* =========================================================================== +- Returns the error message for the last error which occurred on the +- given compressed file. errnum is set to zlib error number. If an +- error occurred in the file system and not in the compression library, +- errnum is set to Z_ERRNO and the application may consult errno +- to get the exact error code. +-*/ +-const char * ZEXPORT gzerror (gzFile file, int *errnum) +-{ +- char *m; +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) { +- *errnum = Z_STREAM_ERROR; +- return (const char*)ERR_MSG(Z_STREAM_ERROR); +- } +- *errnum = s->z_err; +- if (*errnum == Z_OK) return (const char*)""; +- +- m = (char*)(*errnum == Z_ERRNO ? zstrerror(errno) : s->stream.msg); +- +- if (m == NULL || *m == '\0') m = (char*)ERR_MSG(s->z_err); +- +- TRYFREE(s->msg); +- s->msg = (char*)ALLOC(strlen(s->path) + strlen(m) + 3); +- if (s->msg == Z_NULL) return (const char*)ERR_MSG(Z_MEM_ERROR); +- strcpy(s->msg, s->path); +- strcat(s->msg, ": "); +- strcat(s->msg, m); +- return (const char*)s->msg; +-} +- +-/* =========================================================================== +- Clear the error and end-of-file flags, and do the same for the real file. +-*/ +-void ZEXPORT gzclearerr (gzFile file) +-{ +- gz_stream *s = (gz_stream*)file; +- +- if (s == NULL) return; +- if (s->z_err != Z_STREAM_END) s->z_err = Z_OK; +- s->z_eof = 0; +- clearerr(s->file); +-} +diff -ruN seqinr.orig/src/infback.c seqinr/src/infback.c +--- seqinr.orig/src/infback.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/infback.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,628 +0,0 @@ +-/* infback.c -- inflate using a call-back interface +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- This code is largely copied from inflate.c. Normally either infback.o or +- inflate.o would be linked into an application--not both. The interface +- with inffast.c is retained so that optimized assembler-coded versions of +- inflate_fast() can be used with either inflate.c or infback.c. +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +-/* function prototypes */ +-local void fixedtables OF((struct inflate_state FAR *state)); +- +-/* +- strm provides memory allocation functions in zalloc and zfree, or +- Z_NULL to use the library memory allocation functions. +- +- windowBits is in the range 8..15, and window is a user-supplied +- window and output buffer that is 2**windowBits bytes. +- */ +-int ZEXPORT inflateBackInit_(z_streamp strm, int windowBits, +- unsigned char *window, const char *version, +- int stream_size) +-/* +-z_streamp strm; +-int windowBits; +-unsigned char FAR *window; +-const char *version; +-int stream_size; +-*/ +-{ +- struct inflate_state FAR *state; +- +- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || +- stream_size != (int)(sizeof(z_stream))) +- return Z_VERSION_ERROR; +- if (strm == Z_NULL || window == Z_NULL || +- windowBits < 8 || windowBits > 15) +- return Z_STREAM_ERROR; +- strm->msg = Z_NULL; /* in case we return an error */ +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- state = (struct inflate_state FAR *)ZALLOC(strm, 1, +- sizeof(struct inflate_state)); +- if (state == Z_NULL) return Z_MEM_ERROR; +- Tracev((stderr, "inflate: allocated\n")); +- strm->state = (struct internal_state FAR *)state; +- state->dmax = 32768U; +- state->wbits = windowBits; +- state->wsize = 1U << windowBits; +- state->window = window; +- state->write = 0; +- state->whave = 0; +- return Z_OK; +-} +- +-/* +- Return state with length and distance decoding tables and index sizes set to +- fixed code decoding. Normally this returns fixed tables from inffixed.h. +- If BUILDFIXED is defined, then instead this routine builds the tables the +- first time it's called, and returns those tables the first time and +- thereafter. This reduces the size of the code by about 2K bytes, in +- exchange for a little execution time. However, BUILDFIXED should not be +- used for threaded applications, since the rewriting of the tables and virgin +- may not be thread-safe. +- */ +-local void fixedtables(struct inflate_state FAR * state) +-{ +-#ifdef BUILDFIXED +- static int virgin = 1; +- static code *lenfix, *distfix; +- static code fixed[544]; +- +- /* build fixed huffman tables if first call (may not be thread safe) */ +- if (virgin) { +- unsigned sym, bits; +- static code *next; +- +- /* literal/length table */ +- sym = 0; +- while (sym < 144) state->lens[sym++] = 8; +- while (sym < 256) state->lens[sym++] = 9; +- while (sym < 280) state->lens[sym++] = 7; +- while (sym < 288) state->lens[sym++] = 8; +- next = fixed; +- lenfix = next; +- bits = 9; +- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); +- +- /* distance table */ +- sym = 0; +- while (sym < 32) state->lens[sym++] = 5; +- distfix = next; +- bits = 5; +- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); +- +- /* do this just once */ +- virgin = 0; +- } +-#else /* !BUILDFIXED */ +-# include "inffixed.h" +-#endif /* BUILDFIXED */ +- state->lencode = lenfix; +- state->lenbits = 9; +- state->distcode = distfix; +- state->distbits = 5; +-} +- +-/* Macros for inflateBack(): */ +- +-/* Load returned state from inflate_fast() */ +-#define LOAD() \ +- do { \ +- put = strm->next_out; \ +- left = strm->avail_out; \ +- next = strm->next_in; \ +- have = strm->avail_in; \ +- hold = state->hold; \ +- bits = state->bits; \ +- } while (0) +- +-/* Set state from registers for inflate_fast() */ +-#define RESTORE() \ +- do { \ +- strm->next_out = put; \ +- strm->avail_out = left; \ +- strm->next_in = next; \ +- strm->avail_in = have; \ +- state->hold = hold; \ +- state->bits = bits; \ +- } while (0) +- +-/* Clear the input bit accumulator */ +-#define INITBITS() \ +- do { \ +- hold = 0; \ +- bits = 0; \ +- } while (0) +- +-/* Assure that some input is available. If input is requested, but denied, +- then return a Z_BUF_ERROR from inflateBack(). */ +-#define PULL() \ +- do { \ +- if (have == 0) { \ +- have = in(in_desc, &next); \ +- if (have == 0) { \ +- next = Z_NULL; \ +- ret = Z_BUF_ERROR; \ +- goto inf_leave; \ +- } \ +- } \ +- } while (0) +- +-/* Get a byte of input into the bit accumulator, or return from inflateBack() +- with an error if there is no input available. */ +-#define PULLBYTE() \ +- do { \ +- PULL(); \ +- have--; \ +- hold += (unsigned long)(*next++) << bits; \ +- bits += 8; \ +- } while (0) +- +-/* Assure that there are at least n bits in the bit accumulator. If there is +- not enough available input to do that, then return from inflateBack() with +- an error. */ +-#define NEEDBITS(n) \ +- do { \ +- while (bits < (unsigned)(n)) \ +- PULLBYTE(); \ +- } while (0) +- +-/* Return the low n bits of the bit accumulator (n < 16) */ +-#define BITS(n) \ +- ((unsigned)hold & ((1U << (n)) - 1)) +- +-/* Remove n bits from the bit accumulator */ +-#define DROPBITS(n) \ +- do { \ +- hold >>= (n); \ +- bits -= (unsigned)(n); \ +- } while (0) +- +-/* Remove zero to seven bits as needed to go to a byte boundary */ +-#define BYTEBITS() \ +- do { \ +- hold >>= bits & 7; \ +- bits -= bits & 7; \ +- } while (0) +- +-/* Assure that some output space is available, by writing out the window +- if it's full. If the write fails, return from inflateBack() with a +- Z_BUF_ERROR. */ +-#define ROOM() \ +- do { \ +- if (left == 0) { \ +- put = state->window; \ +- left = state->wsize; \ +- state->whave = left; \ +- if (out(out_desc, put, left)) { \ +- ret = Z_BUF_ERROR; \ +- goto inf_leave; \ +- } \ +- } \ +- } while (0) +- +-/* +- strm provides the memory allocation functions and window buffer on input, +- and provides information on the unused input on return. For Z_DATA_ERROR +- returns, strm will also provide an error message. +- +- in() and out() are the call-back input and output functions. When +- inflateBack() needs more input, it calls in(). When inflateBack() has +- filled the window with output, or when it completes with data in the +- window, it calls out() to write out the data. The application must not +- change the provided input until in() is called again or inflateBack() +- returns. The application must not change the window/output buffer until +- inflateBack() returns. +- +- in() and out() are called with a descriptor parameter provided in the +- inflateBack() call. This parameter can be a structure that provides the +- information required to do the read or write, as well as accumulated +- information on the input and output such as totals and check values. +- +- in() should return zero on failure. out() should return non-zero on +- failure. If either in() or out() fails, than inflateBack() returns a +- Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it +- was in() or out() that caused in the error. Otherwise, inflateBack() +- returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format +- error, or Z_MEM_ERROR if it could not allocate memory for the state. +- inflateBack() can also return Z_STREAM_ERROR if the input parameters +- are not correct, i.e. strm is Z_NULL or the state was not initialized. +- */ +-int ZEXPORT inflateBack(z_streamp strm, in_func in, void FAR *in_desc, +- out_func out, void FAR *out_desc) +-/* +-z_streamp strm; +-in_func in; +-void FAR *in_desc; +-out_func out; +-void FAR *out_desc; +-*/ +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *next; /* next input */ +- unsigned char FAR *put; /* next output */ +- unsigned have, left; /* available input and output */ +- unsigned long hold; /* bit buffer */ +- unsigned bits; /* bits in bit buffer */ +- unsigned copy; /* number of stored or match bytes to copy */ +- unsigned char FAR *from; /* where to copy match bytes from */ +- code This; /* current decoding table entry */ +- code last; /* parent table entry */ +- unsigned len; /* length to copy for repeats, bits to drop */ +- int ret; /* return code */ +- static const unsigned short order[19] = /* permutation of code lengths */ +- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; +- +- /* Check that the strm exists and that the state was initialized */ +- if (strm == Z_NULL || strm->state == Z_NULL) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- +- /* Reset the state */ +- strm->msg = Z_NULL; +- state->mode = TYPE; +- state->last = 0; +- state->whave = 0; +- next = strm->next_in; +- have = next != Z_NULL ? strm->avail_in : 0; +- hold = 0; +- bits = 0; +- put = state->window; +- left = state->wsize; +- +- /* Inflate until end of block marked as last */ +- for (;;) +- switch (state->mode) { +- case TYPE: +- /* determine and dispatch block type */ +- if (state->last) { +- BYTEBITS(); +- state->mode = DONE; +- break; +- } +- NEEDBITS(3); +- state->last = BITS(1); +- DROPBITS(1); +- switch (BITS(2)) { +- case 0: /* stored block */ +- Tracev((stderr, "inflate: stored block%s\n", +- state->last ? " (last)" : "")); +- state->mode = STORED; +- break; +- case 1: /* fixed block */ +- fixedtables(state); +- Tracev((stderr, "inflate: fixed codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = LEN; /* decode codes */ +- break; +- case 2: /* dynamic block */ +- Tracev((stderr, "inflate: dynamic codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = TABLE; +- break; +- case 3: +- strm->msg = (char *)"invalid block type"; +- state->mode = BAD; +- } +- DROPBITS(2); +- break; +- +- case STORED: +- /* get and verify stored block length */ +- BYTEBITS(); /* go to byte boundary */ +- NEEDBITS(32); +- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { +- strm->msg = (char *)"invalid stored block lengths"; +- state->mode = BAD; +- break; +- } +- state->length = (unsigned)hold & 0xffff; +- Tracev((stderr, "inflate: stored length %u\n", +- state->length)); +- INITBITS(); +- +- /* copy stored block from input to output */ +- while (state->length != 0) { +- copy = state->length; +- PULL(); +- ROOM(); +- if (copy > have) copy = have; +- if (copy > left) copy = left; +- zmemcpy(put, next, copy); +- have -= copy; +- next += copy; +- left -= copy; +- put += copy; +- state->length -= copy; +- } +- Tracev((stderr, "inflate: stored end\n")); +- state->mode = TYPE; +- break; +- +- case TABLE: +- /* get dynamic table entries descriptor */ +- NEEDBITS(14); +- state->nlen = BITS(5) + 257; +- DROPBITS(5); +- state->ndist = BITS(5) + 1; +- DROPBITS(5); +- state->ncode = BITS(4) + 4; +- DROPBITS(4); +-#ifndef PKZIP_BUG_WORKAROUND +- if (state->nlen > 286 || state->ndist > 30) { +- strm->msg = (char *)"too many length or distance symbols"; +- state->mode = BAD; +- break; +- } +-#endif +- Tracev((stderr, "inflate: table sizes ok\n")); +- +- /* get code length code lengths (not a typo) */ +- state->have = 0; +- while (state->have < state->ncode) { +- NEEDBITS(3); +- state->lens[order[state->have++]] = (unsigned short)BITS(3); +- DROPBITS(3); +- } +- while (state->have < 19) +- state->lens[order[state->have++]] = 0; +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 7; +- ret = inflate_table(CODES, state->lens, 19, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid code lengths set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: code lengths ok\n")); +- +- /* get length and distance code code lengths */ +- state->have = 0; +- while (state->have < state->nlen + state->ndist) { +- for (;;) { +- This = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if (This.val < 16) { +- NEEDBITS(This.bits); +- DROPBITS(This.bits); +- state->lens[state->have++] = This.val; +- } +- else { +- if (This.val == 16) { +- NEEDBITS(This.bits + 2); +- DROPBITS(This.bits); +- if (state->have == 0) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- len = (unsigned)(state->lens[state->have - 1]); +- copy = 3 + BITS(2); +- DROPBITS(2); +- } +- else if (This.val == 17) { +- NEEDBITS(This.bits + 3); +- DROPBITS(This.bits); +- len = 0; +- copy = 3 + BITS(3); +- DROPBITS(3); +- } +- else { +- NEEDBITS(This.bits + 7); +- DROPBITS(This.bits); +- len = 0; +- copy = 11 + BITS(7); +- DROPBITS(7); +- } +- if (state->have + copy > state->nlen + state->ndist) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- while (copy--) +- state->lens[state->have++] = (unsigned short)len; +- } +- } +- +- /* handle error breaks in while */ +- if (state->mode == BAD) break; +- +- /* build code tables */ +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 9; +- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid literal/lengths set"; +- state->mode = BAD; +- break; +- } +- state->distcode = (code const FAR *)(state->next); +- state->distbits = 6; +- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, +- &(state->next), &(state->distbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid distances set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: codes ok\n")); +- state->mode = LEN; +- +- case LEN: +- /* use inflate_fast() if we have enough input and output */ +- if (have >= 6 && left >= 258) { +- RESTORE(); +- if (state->whave < state->wsize) +- state->whave = state->wsize - left; +- inflate_fast(strm, state->wsize); +- LOAD(); +- break; +- } +- +- /* get a literal, length, or end-of-block code */ +- for (;;) { +- This = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if (This.op && (This.op & 0xf0) == 0) { +- last = This; +- for (;;) { +- This = state->lencode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + This.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(This.bits); +- state->length = (unsigned)This.val; +- +- /* process literal */ +- if (This.op == 0) { +- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", This.val)); +- ROOM(); +- *put++ = (unsigned char)(state->length); +- left--; +- state->mode = LEN; +- break; +- } +- +- /* process end of block */ +- if (This.op & 32) { +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- +- /* invalid code */ +- if (This.op & 64) { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- +- /* length code -- get extra bits, if any */ +- state->extra = (unsigned)(This.op) & 15; +- if (state->extra != 0) { +- NEEDBITS(state->extra); +- state->length += BITS(state->extra); +- DROPBITS(state->extra); +- } +- Tracevv((stderr, "inflate: length %u\n", state->length)); +- +- /* get distance code */ +- for (;;) { +- This = state->distcode[BITS(state->distbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if ((This.op & 0xf0) == 0) { +- last = This; +- for (;;) { +- This = state->distcode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + This.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(This.bits); +- if (This.op & 64) { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- state->offset = (unsigned)This.val; +- +- /* get distance extra bits, if any */ +- state->extra = (unsigned)(This.op) & 15; +- if (state->extra != 0) { +- NEEDBITS(state->extra); +- state->offset += BITS(state->extra); +- DROPBITS(state->extra); +- } +- if (state->offset > state->wsize - (state->whave < state->wsize ? +- left : 0)) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- Tracevv((stderr, "inflate: distance %u\n", state->offset)); +- +- /* copy match from window to output */ +- do { +- ROOM(); +- copy = state->wsize - state->offset; +- if (copy < left) { +- from = put + copy; +- copy = left - copy; +- } +- else { +- from = put - state->offset; +- copy = left; +- } +- if (copy > state->length) copy = state->length; +- state->length -= copy; +- left -= copy; +- do { +- *put++ = *from++; +- } while (--copy); +- } while (state->length != 0); +- break; +- +- case DONE: +- /* inflate stream terminated properly -- write leftover output */ +- ret = Z_STREAM_END; +- if (left < state->wsize) { +- if (out(out_desc, state->window, state->wsize - left)) +- ret = Z_BUF_ERROR; +- } +- goto inf_leave; +- +- case BAD: +- ret = Z_DATA_ERROR; +- goto inf_leave; +- +- default: /* can't happen, but makes compilers happy */ +- ret = Z_STREAM_ERROR; +- goto inf_leave; +- } +- +- /* Return unused input */ +- inf_leave: +- strm->next_in = next; +- strm->avail_in = have; +- return ret; +-} +- +-int ZEXPORT inflateBackEnd(z_streamp strm) +-{ +- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- Tracev((stderr, "inflate: end\n")); +- return Z_OK; +-} +diff -ruN seqinr.orig/src/inffast.c seqinr/src/inffast.c +--- seqinr.orig/src/inffast.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inffast.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,320 +0,0 @@ +-/* inffast.c -- fast decoding +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +-#ifndef ASMINF +- +-/* Allow machine dependent optimization for post-increment or pre-increment. +- Based on testing to date, +- Pre-increment preferred for: +- - PowerPC G3 (Adler) +- - MIPS R5000 (Randers-Pehrson) +- Post-increment preferred for: +- - none +- No measurable difference: +- - Pentium III (Anderson) +- - M68060 (Nikl) +- */ +-#ifdef POSTINC +-# define OFF 0 +-# define PUP(a) *(a)++ +-#else +-# define OFF 1 +-# define PUP(a) *++(a) +-#endif +- +-/* +- Decode literal, length, and distance codes and write out the resulting +- literal and match bytes until either not enough input or output is +- available, an end-of-block is encountered, or a data error is encountered. +- When large enough input and output buffers are supplied to inflate(), for +- example, a 16K input buffer and a 64K output buffer, more than 95% of the +- inflate execution time is spent in this routine. +- +- Entry assumptions: +- +- state->mode == LEN +- strm->avail_in >= 6 +- strm->avail_out >= 258 +- start >= strm->avail_out +- state->bits < 8 +- +- On return, state->mode is one of: +- +- LEN -- ran out of enough output space or enough available input +- TYPE -- reached end of block code, inflate() to interpret next block +- BAD -- error in block data +- +- Notes: +- +- - The maximum input bits used by a length/distance pair is 15 bits for the +- length code, 5 bits for the length extra, 15 bits for the distance code, +- and 13 bits for the distance extra. This totals 48 bits, or six bytes. +- Therefore if strm->avail_in >= 6, then there is enough input to avoid +- checking for available input while decoding. +- +- - The maximum bytes that a single length/distance pair can output is 258 +- bytes, which is the maximum length that can be coded. inflate_fast() +- requires strm->avail_out >= 258 for each loop to avoid checking for +- output space. +- */ +-void inflate_fast(z_streamp strm, unsigned start) +-#if 0 +-z_streamp strm; +-unsigned start; /* inflate()'s starting value for strm->avail_out */ +-#endif +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *in; /* local strm->next_in */ +- unsigned char FAR *last; /* while in < last, enough input available */ +- unsigned char FAR *out; /* local strm->next_out */ +- unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ +- unsigned char FAR *end; /* while out < end, enough space available */ +-#ifdef INFLATE_STRICT +- unsigned dmax; /* maximum distance from zlib header */ +-#endif +- unsigned wsize; /* window size or zero if not using window */ +- unsigned whave; /* valid bytes in the window */ +- unsigned write; /* window write index */ +- unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ +- unsigned long hold; /* local strm->hold */ +- unsigned bits; /* local strm->bits */ +- code const FAR *lcode; /* local strm->lencode */ +- code const FAR *dcode; /* local strm->distcode */ +- unsigned lmask; /* mask for first level of length codes */ +- unsigned dmask; /* mask for first level of distance codes */ +- code This; /* retrieved table entry */ +- unsigned op; /* code bits, operation, extra bits, or */ +- /* window position, window bytes to copy */ +- unsigned len; /* match length, unused bytes */ +- unsigned dist; /* match distance */ +- unsigned char FAR *from; /* where to copy match from */ +- +- /* copy state to local variables */ +- state = (struct inflate_state FAR *)strm->state; +- in = strm->next_in - OFF; +- last = in + (strm->avail_in - 5); +- out = strm->next_out - OFF; +- beg = out - (start - strm->avail_out); +- end = out + (strm->avail_out - 257); +-#ifdef INFLATE_STRICT +- dmax = state->dmax; +-#endif +- wsize = state->wsize; +- whave = state->whave; +- write = state->write; +- window = state->window; +- hold = state->hold; +- bits = state->bits; +- lcode = state->lencode; +- dcode = state->distcode; +- lmask = (1U << state->lenbits) - 1; +- dmask = (1U << state->distbits) - 1; +- +- /* decode literals and length/distances until end-of-block or not enough +- input data or output space */ +- do { +- if (bits < 15) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- This = lcode[hold & lmask]; +- dolen: +- op = (unsigned)(This.bits); +- hold >>= op; +- bits -= op; +- op = (unsigned)(This.op); +- if (op == 0) { /* literal */ +- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", This.val)); +- PUP(out) = (unsigned char)(This.val); +- } +- else if (op & 16) { /* length base */ +- len = (unsigned)(This.val); +- op &= 15; /* number of extra bits */ +- if (op) { +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- len += (unsigned)hold & ((1U << op) - 1); +- hold >>= op; +- bits -= op; +- } +- Tracevv((stderr, "inflate: length %u\n", len)); +- if (bits < 15) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- This = dcode[hold & dmask]; +- dodist: +- op = (unsigned)(This.bits); +- hold >>= op; +- bits -= op; +- op = (unsigned)(This.op); +- if (op & 16) { /* distance base */ +- dist = (unsigned)(This.val); +- op &= 15; /* number of extra bits */ +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- if (bits < op) { +- hold += (unsigned long)(PUP(in)) << bits; +- bits += 8; +- } +- } +- dist += (unsigned)hold & ((1U << op) - 1); +-#ifdef INFLATE_STRICT +- if (dist > dmax) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +-#endif +- hold >>= op; +- bits -= op; +- Tracevv((stderr, "inflate: distance %u\n", dist)); +- op = (unsigned)(out - beg); /* max distance in output */ +- if (dist > op) { /* see if copy from window */ +- op = dist - op; /* distance back in window */ +- if (op > whave) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- from = window - OFF; +- if (write == 0) { /* very common case */ +- from += wsize - op; +- if (op < len) { /* some from window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- else if (write < op) { /* wrap around window */ +- from += wsize + write - op; +- op -= write; +- if (op < len) { /* some from end of window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = window - OFF; +- if (write < len) { /* some from start of window */ +- op = write; +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- } +- else { /* contiguous in window */ +- from += write - op; +- if (op < len) { /* some from window */ +- len -= op; +- do { +- PUP(out) = PUP(from); +- } while (--op); +- from = out - dist; /* rest from output */ +- } +- } +- while (len > 2) { +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- len -= 3; +- } +- if (len) { +- PUP(out) = PUP(from); +- if (len > 1) +- PUP(out) = PUP(from); +- } +- } +- else { +- from = out - dist; /* copy direct from output */ +- do { /* minimum length is three */ +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- PUP(out) = PUP(from); +- len -= 3; +- } while (len > 2); +- if (len) { +- PUP(out) = PUP(from); +- if (len > 1) +- PUP(out) = PUP(from); +- } +- } +- } +- else if ((op & 64) == 0) { /* 2nd level distance code */ +- This = dcode[This.val + (hold & ((1U << op) - 1))]; +- goto dodist; +- } +- else { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- } +- else if ((op & 64) == 0) { /* 2nd level length code */ +- This = lcode[This.val + (hold & ((1U << op) - 1))]; +- goto dolen; +- } +- else if (op & 32) { /* end-of-block */ +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- else { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- } while (in < last && out < end); +- +- /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ +- len = bits >> 3; +- in -= len; +- bits -= len << 3; +- hold &= (1U << bits) - 1; +- +- /* update state and return */ +- strm->next_in = in + OFF; +- strm->next_out = out + OFF; +- strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); +- strm->avail_out = (unsigned)(out < end ? +- 257 + (end - out) : 257 - (out - end)); +- state->hold = hold; +- state->bits = bits; +- return; +-} +- +-/* +- inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): +- - Using bit fields for code structure +- - Different op definition to avoid & for extra bits (do & for table bits) +- - Three separate decoding do-loops for direct, window, and write == 0 +- - Special case for distance > 1 copies to do overlapped load and store copy +- - Explicit branch predictions (based on measured branch probabilities) +- - Deferring match copy and interspersed it with decoding subsequent codes +- - Swapping literal/length else +- - Swapping window/direct else +- - Larger unrolled copy loops (three is about right) +- - Moving len -= 3 statement into middle of loop +- */ +- +-#endif /* !ASMINF */ +diff -ruN seqinr.orig/src/inffast.h seqinr/src/inffast.h +--- seqinr.orig/src/inffast.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inffast.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,11 +0,0 @@ +-/* inffast.h -- header to use inffast.c +- * Copyright (C) 1995-2003 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-void inflate_fast OF((z_streamp strm, unsigned start)); +diff -ruN seqinr.orig/src/inffixed.h seqinr/src/inffixed.h +--- seqinr.orig/src/inffixed.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inffixed.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,94 +0,0 @@ +- /* inffixed.h -- table for decoding fixed codes +- * Generated automatically by makefixed(). +- */ +- +- /* WARNING: this file should *not* be used by applications. It +- is part of the implementation of the compression library and +- is subject to change. Applications should only use zlib.h. +- */ +- +- static const code lenfix[512] = { +- {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48}, +- {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128}, +- {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59}, +- {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176}, +- {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20}, +- {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100}, +- {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8}, +- {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216}, +- {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76}, +- {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114}, +- {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2}, +- {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148}, +- {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42}, +- {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86}, +- {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15}, +- {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236}, +- {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62}, +- {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, +- {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31}, +- {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162}, +- {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25}, +- {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105}, +- {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4}, +- {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202}, +- {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69}, +- {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125}, +- {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13}, +- {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195}, +- {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35}, +- {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91}, +- {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19}, +- {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246}, +- {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55}, +- {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135}, +- {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99}, +- {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190}, +- {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16}, +- {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96}, +- {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6}, +- {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209}, +- {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72}, +- {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116}, +- {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4}, +- {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153}, +- {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44}, +- {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82}, +- {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11}, +- {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, +- {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58}, +- {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138}, +- {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51}, +- {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173}, +- {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30}, +- {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110}, +- {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0}, +- {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195}, +- {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65}, +- {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121}, +- {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9}, +- {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258}, +- {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37}, +- {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93}, +- {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23}, +- {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251}, +- {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51}, +- {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, +- {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67}, +- {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183}, +- {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23}, +- {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103}, +- {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9}, +- {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223}, +- {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79}, +- {0,9,255} +- }; +- +- static const code distfix[32] = { +- {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025}, +- {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193}, +- {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385}, +- {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577}, +- {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073}, +- {22,5,193},{64,5,0} +- }; +diff -ruN seqinr.orig/src/inflate.c seqinr/src/inflate.c +--- seqinr.orig/src/inflate.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inflate.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1341 +0,0 @@ +-/* inflate.c -- zlib decompression +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * Change history: +- * +- * 1.2.beta0 24 Nov 2002 +- * - First version -- complete rewrite of inflate to simplify code, avoid +- * creation of window when not needed, minimize use of window when it is +- * needed, make inffast.c even faster, implement gzip decoding, and to +- * improve code readability and style over the previous zlib inflate code +- * +- * 1.2.beta1 25 Nov 2002 +- * - Use pointers for available input and output checking in inffast.c +- * - Remove input and output counters in inffast.c +- * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 +- * - Remove unnecessary second byte pull from length extra in inffast.c +- * - Unroll direct copy to three copies per loop in inffast.c +- * +- * 1.2.beta2 4 Dec 2002 +- * - Change external routine names to reduce potential conflicts +- * - Correct filename to inffixed.h for fixed tables in inflate.c +- * - Make hbuf[] unsigned char to match parameter type in inflate.c +- * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) +- * to avoid negation problem on Alphas (64 bit) in inflate.c +- * +- * 1.2.beta3 22 Dec 2002 +- * - Add comments on state->bits assertion in inffast.c +- * - Add comments on op field in inftrees.h +- * - Fix bug in reuse of allocated window after inflateReset() +- * - Remove bit fields--back to byte structure for speed +- * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths +- * - Change post-increments to pre-increments in inflate_fast(), PPC biased? +- * - Add compile time option, POSTINC, to use post-increments instead (Intel?) +- * - Make MATCH copy in inflate() much faster for when inflate_fast() not used +- * - Use local copies of stream next and avail values, as well as local bit +- * buffer and bit count in inflate()--for speed when inflate_fast() not used +- * +- * 1.2.beta4 1 Jan 2003 +- * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings +- * - Move a comment on output buffer sizes from inffast.c to inflate.c +- * - Add comments in inffast.c to introduce the inflate_fast() routine +- * - Rearrange window copies in inflate_fast() for speed and simplification +- * - Unroll last copy for window match in inflate_fast() +- * - Use local copies of window variables in inflate_fast() for speed +- * - Pull out common write == 0 case for speed in inflate_fast() +- * - Make op and len in inflate_fast() unsigned for consistency +- * - Add FAR to lcode and dcode declarations in inflate_fast() +- * - Simplified bad distance check in inflate_fast() +- * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new +- * source file infback.c to provide a call-back interface to inflate for +- * programs like gzip and unzip -- uses window as output buffer to avoid +- * window copying +- * +- * 1.2.beta5 1 Jan 2003 +- * - Improved inflateBack() interface to allow the caller to provide initial +- * input in strm. +- * - Fixed stored blocks bug in inflateBack() +- * +- * 1.2.beta6 4 Jan 2003 +- * - Added comments in inffast.c on effectiveness of POSTINC +- * - Typecasting all around to reduce compiler warnings +- * - Changed loops from while (1) or do {} while (1) to for (;;), again to +- * make compilers happy +- * - Changed type of window in inflateBackInit() to unsigned char * +- * +- * 1.2.beta7 27 Jan 2003 +- * - Changed many types to unsigned or unsigned short to avoid warnings +- * - Added inflateCopy() function +- * +- * 1.2.0 9 Mar 2003 +- * - Changed inflateBack() interface to provide separate opaque descriptors +- * for the in() and out() functions +- * - Changed inflateBack() argument and in_func typedef to swap the length +- * and buffer address return values for the input function +- * - Check next_in and next_out for Z_NULL on entry to inflate() +- * +- * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +-#include "inflate.h" +-#include "inffast.h" +- +- +-#ifdef MAKEFIXED +-# ifndef BUILDFIXED +-# define BUILDFIXED +-# endif +-#endif +- +-/* function prototypes */ +-local void fixedtables OF((struct inflate_state FAR *state)); +-local int updatewindow OF((z_streamp strm, unsigned out)); +-#ifdef BUILDFIXED +- void makefixed OF((void)); +-#endif +-local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, +- unsigned len)); +- +-int ZEXPORT inflateReset(z_streamp strm) +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- strm->total_in = strm->total_out = state->total = 0; +- strm->msg = Z_NULL; +- strm->adler = 1; /* to support ill-conceived Java test suite */ +- state->mode = HEAD; +- state->last = 0; +- state->havedict = 0; +- state->dmax = 32768U; +- state->head = Z_NULL; +- state->wsize = 0; +- state->whave = 0; +- state->write = 0; +- state->hold = 0; +- state->bits = 0; +- state->lencode = state->distcode = state->next = state->codes; +- Tracev((stderr, "inflate: reset\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflatePrime(z_streamp strm, int bits, int value) +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR; +- value &= (1L << bits) - 1; +- state->hold += value << state->bits; +- state->bits += bits; +- return Z_OK; +-} +- +-int ZEXPORT inflateInit2_(z_streamp strm, int windowBits, const char *version, +- int stream_size) +-{ +- struct inflate_state FAR *state; +- +- if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || +- stream_size != (int)(sizeof(z_stream))) +- return Z_VERSION_ERROR; +- if (strm == Z_NULL) return Z_STREAM_ERROR; +- strm->msg = Z_NULL; /* in case we return an error */ +- if (strm->zalloc == (alloc_func)0) { +- strm->zalloc = zcalloc; +- strm->opaque = (voidpf)0; +- } +- if (strm->zfree == (free_func)0) strm->zfree = zcfree; +- state = (struct inflate_state FAR *) +- ZALLOC(strm, 1, sizeof(struct inflate_state)); +- if (state == Z_NULL) return Z_MEM_ERROR; +- Tracev((stderr, "inflate: allocated\n")); +- strm->state = (struct internal_state FAR *)state; +- if (windowBits < 0) { +- state->wrap = 0; +- windowBits = -windowBits; +- } +- else { +- state->wrap = (windowBits >> 4) + 1; +-#ifdef GUNZIP +- if (windowBits < 48) windowBits &= 15; +-#endif +- } +- if (windowBits < 8 || windowBits > 15) { +- ZFREE(strm, state); +- strm->state = Z_NULL; +- return Z_STREAM_ERROR; +- } +- state->wbits = (unsigned)windowBits; +- state->window = Z_NULL; +- return inflateReset(strm); +-} +- +-int ZEXPORT inflateInit_(z_streamp strm, const char *version, int stream_size) +-{ +- return inflateInit2_(strm, DEF_WBITS, version, stream_size); +-} +- +-/* +- Return state with length and distance decoding tables and index sizes set to +- fixed code decoding. Normally this returns fixed tables from inffixed.h. +- If BUILDFIXED is defined, then instead this routine builds the tables the +- first time it's called, and returns those tables the first time and +- thereafter. This reduces the size of the code by about 2K bytes, in +- exchange for a little execution time. However, BUILDFIXED should not be +- used for threaded applications, since the rewriting of the tables and virgin +- may not be thread-safe. +- */ +-local void fixedtables(struct inflate_state FAR *state) +-{ +-#ifdef BUILDFIXED +- static int virgin = 1; +- static code *lenfix, *distfix; +- static code fixed[544]; +- +- /* build fixed huffman tables if first call (may not be thread safe) */ +- if (virgin) { +- unsigned sym, bits; +- static code *next; +- +- /* literal/length table */ +- sym = 0; +- while (sym < 144) state->lens[sym++] = 8; +- while (sym < 256) state->lens[sym++] = 9; +- while (sym < 280) state->lens[sym++] = 7; +- while (sym < 288) state->lens[sym++] = 8; +- next = fixed; +- lenfix = next; +- bits = 9; +- inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); +- +- /* distance table */ +- sym = 0; +- while (sym < 32) state->lens[sym++] = 5; +- distfix = next; +- bits = 5; +- inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); +- +- /* do this just once */ +- virgin = 0; +- } +-#else /* !BUILDFIXED */ +-# include "inffixed.h" +-#endif /* BUILDFIXED */ +- state->lencode = lenfix; +- state->lenbits = 9; +- state->distcode = distfix; +- state->distbits = 5; +-} +- +-#ifdef MAKEFIXED +-#include +- +-/* +- Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also +- defines BUILDFIXED, so the tables are built on the fly. makefixed() writes +- those tables to stdout, which would be piped to inffixed.h. A small program +- can simply call makefixed to do this: +- +- void makefixed(void); +- +- int main(void) +- { +- makefixed(); +- return 0; +- } +- +- Then that can be linked with zlib built with MAKEFIXED defined and run: +- +- a.out > inffixed.h +- */ +-void makefixed() +-{ +- unsigned low, size; +- struct inflate_state state; +- +- fixedtables(&state); +- puts(" /* inffixed.h -- table for decoding fixed codes"); +- puts(" * Generated automatically by makefixed()."); +- puts(" */"); +- puts(""); +- puts(" /* WARNING: this file should *not* be used by applications."); +- puts(" It is part of the implementation of this library and is"); +- puts(" subject to change. Applications should only use zlib.h."); +- puts(" */"); +- puts(""); +- size = 1U << 9; +- printf(" static const code lenfix[%u] = {", size); +- low = 0; +- for (;;) { +- if ((low % 7) == 0) printf("\n "); +- printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits, +- state.lencode[low].val); +- if (++low == size) break; +- putchar(','); +- } +- puts("\n };"); +- size = 1U << 5; +- printf("\n static const code distfix[%u] = {", size); +- low = 0; +- for (;;) { +- if ((low % 6) == 0) printf("\n "); +- printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, +- state.distcode[low].val); +- if (++low == size) break; +- putchar(','); +- } +- puts("\n };"); +-} +-#endif /* MAKEFIXED */ +- +-/* +- Update the window with the last wsize (normally 32K) bytes written before +- returning. If window does not exist yet, create it. This is only called +- when a window is already in use, or when output has been written during this +- inflate call, but the end of the deflate stream has not been reached yet. +- It is also called to create a window for dictionary data when a dictionary +- is loaded. +- +- Providing output buffers larger than 32K to inflate() should provide a speed +- advantage, since only the last 32K of output is copied to the sliding window +- upon return from inflate(), and since all distances after the first 32K of +- output will fall in the output data, making match copies simpler and faster. +- The advantage may be dependent on the size of the processor's data caches. +- */ +-local int updatewindow(z_streamp strm, unsigned out) +-{ +- struct inflate_state FAR *state; +- unsigned copy, dist; +- +- state = (struct inflate_state FAR *)strm->state; +- +- /* if it hasn't been done already, allocate space for the window */ +- if (state->window == Z_NULL) { +- state->window = (unsigned char FAR *) +- ZALLOC(strm, 1U << state->wbits, +- sizeof(unsigned char)); +- if (state->window == Z_NULL) return 1; +- } +- +- /* if window not in use yet, initialize */ +- if (state->wsize == 0) { +- state->wsize = 1U << state->wbits; +- state->write = 0; +- state->whave = 0; +- } +- +- /* copy state->wsize or less output bytes into the circular window */ +- copy = out - strm->avail_out; +- if (copy >= state->wsize) { +- zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); +- state->write = 0; +- state->whave = state->wsize; +- } +- else { +- dist = state->wsize - state->write; +- if (dist > copy) dist = copy; +- zmemcpy(state->window + state->write, strm->next_out - copy, dist); +- copy -= dist; +- if (copy) { +- zmemcpy(state->window, strm->next_out - copy, copy); +- state->write = copy; +- state->whave = state->wsize; +- } +- else { +- state->write += dist; +- if (state->write == state->wsize) state->write = 0; +- if (state->whave < state->wsize) state->whave += dist; +- } +- } +- return 0; +-} +- +-/* Macros for inflate(): */ +- +-/* check function to use adler32() for zlib or crc32() for gzip */ +-#ifdef GUNZIP +-# define UPDATE(check, buf, len) \ +- (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) +-#else +-# define UPDATE(check, buf, len) adler32(check, buf, len) +-#endif +- +-/* check macros for header crc */ +-#ifdef GUNZIP +-# define CRC2(check, word) \ +- do { \ +- hbuf[0] = (unsigned char)(word); \ +- hbuf[1] = (unsigned char)((word) >> 8); \ +- check = crc32(check, hbuf, 2); \ +- } while (0) +- +-# define CRC4(check, word) \ +- do { \ +- hbuf[0] = (unsigned char)(word); \ +- hbuf[1] = (unsigned char)((word) >> 8); \ +- hbuf[2] = (unsigned char)((word) >> 16); \ +- hbuf[3] = (unsigned char)((word) >> 24); \ +- check = crc32(check, hbuf, 4); \ +- } while (0) +-#endif +- +-/* Load registers with state in inflate() for speed */ +-#define LOAD() \ +- do { \ +- put = strm->next_out; \ +- left = strm->avail_out; \ +- next = strm->next_in; \ +- have = strm->avail_in; \ +- hold = state->hold; \ +- bits = state->bits; \ +- } while (0) +- +-/* Restore state from registers in inflate() */ +-#define RESTORE() \ +- do { \ +- strm->next_out = put; \ +- strm->avail_out = left; \ +- strm->next_in = next; \ +- strm->avail_in = have; \ +- state->hold = hold; \ +- state->bits = bits; \ +- } while (0) +- +-/* Clear the input bit accumulator */ +-#define INITBITS() \ +- do { \ +- hold = 0; \ +- bits = 0; \ +- } while (0) +- +-/* Get a byte of input into the bit accumulator, or return from inflate() +- if there is no input available. */ +-#define PULLBYTE() \ +- do { \ +- if (have == 0) goto inf_leave; \ +- have--; \ +- hold += (unsigned long)(*next++) << bits; \ +- bits += 8; \ +- } while (0) +- +-/* Assure that there are at least n bits in the bit accumulator. If there is +- not enough available input to do that, then return from inflate(). */ +-#define NEEDBITS(n) \ +- do { \ +- while (bits < (unsigned)(n)) \ +- PULLBYTE(); \ +- } while (0) +- +-/* Return the low n bits of the bit accumulator (n < 16) */ +-#define BITS(n) \ +- ((unsigned)hold & ((1U << (n)) - 1)) +- +-/* Remove n bits from the bit accumulator */ +-#define DROPBITS(n) \ +- do { \ +- hold >>= (n); \ +- bits -= (unsigned)(n); \ +- } while (0) +- +-/* Remove zero to seven bits as needed to go to a byte boundary */ +-#define BYTEBITS() \ +- do { \ +- hold >>= bits & 7; \ +- bits -= bits & 7; \ +- } while (0) +- +-/* Reverse the bytes in a 32-bit value */ +-#define REVERSE(q) \ +- ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ +- (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) +- +-/* +- inflate() uses a state machine to process as much input data and generate as +- much output data as possible before returning. The state machine is +- structured roughly as follows: +- +- for (;;) switch (state) { +- ... +- case STATEn: +- if (not enough input data or output space to make progress) +- return; +- ... make progress ... +- state = STATEm; +- break; +- ... +- } +- +- so when inflate() is called again, the same case is attempted again, and +- if the appropriate resources are provided, the machine proceeds to the +- next state. The NEEDBITS() macro is usually the way the state evaluates +- whether it can proceed or should return. NEEDBITS() does the return if +- the requested bits are not available. The typical use of the BITS macros +- is: +- +- NEEDBITS(n); +- ... do something with BITS(n) ... +- DROPBITS(n); +- +- where NEEDBITS(n) either returns from inflate() if there isn't enough +- input left to load n bits into the accumulator, or it continues. BITS(n) +- gives the low n bits in the accumulator. When done, DROPBITS(n) drops +- the low n bits off the accumulator. INITBITS() clears the accumulator +- and sets the number of available bits to zero. BYTEBITS() discards just +- enough bits to put the accumulator on a byte boundary. After BYTEBITS() +- and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. +- +- NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return +- if there is no input available. The decoding of variable length codes uses +- PULLBYTE() directly in order to pull just enough bytes to decode the next +- code, and no more. +- +- Some states loop until they get enough input, making sure that enough +- state information is maintained to continue the loop where it left off +- if NEEDBITS() returns in the loop. For example, want, need, and keep +- would all have to actually be part of the saved state in case NEEDBITS() +- returns: +- +- case STATEw: +- while (want < need) { +- NEEDBITS(n); +- keep[want++] = BITS(n); +- DROPBITS(n); +- } +- state = STATEx; +- case STATEx: +- +- As shown above, if the next state is also the next case, then the break +- is omitted. +- +- A state may also return if there is not enough output space available to +- complete that state. Those states are copying stored data, writing a +- literal byte, and copying a matching string. +- +- When returning, a "goto inf_leave" is used to update the total counters, +- update the check value, and determine whether any progress has been made +- during that inflate() call in order to return the proper return code. +- Progress is defined as a change in either strm->avail_in or strm->avail_out. +- When there is a window, goto inf_leave will update the window with the last +- output written. If a goto inf_leave occurs in the middle of decompression +- and there is no window currently, goto inf_leave will create one and copy +- output to the window for the next call of inflate(). +- +- In this implementation, the flush parameter of inflate() only affects the +- return code (per zlib.h). inflate() always writes as much as possible to +- strm->next_out, given the space available and the provided input--the effect +- documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers +- the allocation of and copying into a sliding window until necessary, which +- provides the effect documented in zlib.h for Z_FINISH when the entire input +- stream available. So the only thing the flush parameter actually does is: +- when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it +- will return Z_BUF_ERROR if it has not reached the end of the stream. +- */ +- +-int ZEXPORT inflate(z_streamp strm, int flush) +-{ +- struct inflate_state FAR *state; +- unsigned char FAR *next; /* next input */ +- unsigned char FAR *put; /* next output */ +- unsigned have, left; /* available input and output */ +- unsigned long hold; /* bit buffer */ +- unsigned bits; /* bits in bit buffer */ +- unsigned in, out; /* save starting available input and output */ +- unsigned copy; /* number of stored or match bytes to copy */ +- unsigned char FAR *from; /* where to copy match bytes from */ +- code This; /* current decoding table entry */ +- code last; /* parent table entry */ +- unsigned len; /* length to copy for repeats, bits to drop */ +- int ret; /* return code */ +-#ifdef GUNZIP +- unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ +-#endif +- static const unsigned short order[19] = /* permutation of code lengths */ +- {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; +- +- if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL || +- (strm->next_in == Z_NULL && strm->avail_in != 0)) +- return Z_STREAM_ERROR; +- +- state = (struct inflate_state FAR *)strm->state; +- if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ +- LOAD(); +- in = have; +- out = left; +- ret = Z_OK; +- for (;;) +- switch (state->mode) { +- case HEAD: +- if (state->wrap == 0) { +- state->mode = TYPEDO; +- break; +- } +- NEEDBITS(16); +-#ifdef GUNZIP +- if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ +- state->check = crc32(0L, Z_NULL, 0); +- CRC2(state->check, hold); +- INITBITS(); +- state->mode = FLAGS; +- break; +- } +- state->flags = 0; /* expect zlib header */ +- if (state->head != Z_NULL) +- state->head->done = -1; +- if (!(state->wrap & 1) || /* check if zlib header allowed */ +-#else +- if ( +-#endif +- ((BITS(8) << 8) + (hold >> 8)) % 31) { +- strm->msg = (char *)"incorrect header check"; +- state->mode = BAD; +- break; +- } +- if (BITS(4) != Z_DEFLATED) { +- strm->msg = (char *)"unknown compression method"; +- state->mode = BAD; +- break; +- } +- DROPBITS(4); +- len = BITS(4) + 8; +- if (len > state->wbits) { +- strm->msg = (char *)"invalid window size"; +- state->mode = BAD; +- break; +- } +- state->dmax = 1U << len; +- Tracev((stderr, "inflate: zlib header ok\n")); +- strm->adler = state->check = adler32(0L, Z_NULL, 0); +- state->mode = hold & 0x200 ? DICTID : TYPE; +- INITBITS(); +- break; +-#ifdef GUNZIP +- case FLAGS: +- NEEDBITS(16); +- state->flags = (int)(hold); +- if ((state->flags & 0xff) != Z_DEFLATED) { +- strm->msg = (char *)"unknown compression method"; +- state->mode = BAD; +- break; +- } +- if (state->flags & 0xe000) { +- strm->msg = (char *)"unknown header flags set"; +- state->mode = BAD; +- break; +- } +- if (state->head != Z_NULL) +- state->head->text = (int)((hold >> 8) & 1); +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- state->mode = TIME; +- case TIME: +- NEEDBITS(32); +- if (state->head != Z_NULL) +- state->head->time = hold; +- if (state->flags & 0x0200) CRC4(state->check, hold); +- INITBITS(); +- state->mode = OS; +- case OS: +- NEEDBITS(16); +- if (state->head != Z_NULL) { +- state->head->xflags = (int)(hold & 0xff); +- state->head->os = (int)(hold >> 8); +- } +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- state->mode = EXLEN; +- case EXLEN: +- if (state->flags & 0x0400) { +- NEEDBITS(16); +- state->length = (unsigned)(hold); +- if (state->head != Z_NULL) +- state->head->extra_len = (unsigned)hold; +- if (state->flags & 0x0200) CRC2(state->check, hold); +- INITBITS(); +- } +- else if (state->head != Z_NULL) +- state->head->extra = Z_NULL; +- state->mode = EXTRA; +- case EXTRA: +- if (state->flags & 0x0400) { +- copy = state->length; +- if (copy > have) copy = have; +- if (copy) { +- if (state->head != Z_NULL && +- state->head->extra != Z_NULL) { +- len = state->head->extra_len - state->length; +- zmemcpy(state->head->extra + len, next, +- len + copy > state->head->extra_max ? +- state->head->extra_max - len : copy); +- } +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- state->length -= copy; +- } +- if (state->length) goto inf_leave; +- } +- state->length = 0; +- state->mode = NAME; +- case NAME: +- if (state->flags & 0x0800) { +- if (have == 0) goto inf_leave; +- copy = 0; +- do { +- len = (unsigned)(next[copy++]); +- if (state->head != Z_NULL && +- state->head->name != Z_NULL && +- state->length < state->head->name_max) +- state->head->name[state->length++] = len; +- } while (len && copy < have); +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- if (len) goto inf_leave; +- } +- else if (state->head != Z_NULL) +- state->head->name = Z_NULL; +- state->length = 0; +- state->mode = COMMENT; +- case COMMENT: +- if (state->flags & 0x1000) { +- if (have == 0) goto inf_leave; +- copy = 0; +- do { +- len = (unsigned)(next[copy++]); +- if (state->head != Z_NULL && +- state->head->comment != Z_NULL && +- state->length < state->head->comm_max) +- state->head->comment[state->length++] = len; +- } while (len && copy < have); +- if (state->flags & 0x0200) +- state->check = crc32(state->check, next, copy); +- have -= copy; +- next += copy; +- if (len) goto inf_leave; +- } +- else if (state->head != Z_NULL) +- state->head->comment = Z_NULL; +- state->mode = HCRC; +- case HCRC: +- if (state->flags & 0x0200) { +- NEEDBITS(16); +- if (hold != (state->check & 0xffff)) { +- strm->msg = (char *)"header crc mismatch"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- } +- if (state->head != Z_NULL) { +- state->head->hcrc = (int)((state->flags >> 9) & 1); +- state->head->done = 1; +- } +- strm->adler = state->check = crc32(0L, Z_NULL, 0); +- state->mode = TYPE; +- break; +-#endif +- case DICTID: +- NEEDBITS(32); +- strm->adler = state->check = REVERSE(hold); +- INITBITS(); +- state->mode = DICT; +- case DICT: +- if (state->havedict == 0) { +- RESTORE(); +- return Z_NEED_DICT; +- } +- strm->adler = state->check = adler32(0L, Z_NULL, 0); +- state->mode = TYPE; +- case TYPE: +- if (flush == Z_BLOCK) goto inf_leave; +- case TYPEDO: +- if (state->last) { +- BYTEBITS(); +- state->mode = CHECK; +- break; +- } +- NEEDBITS(3); +- state->last = BITS(1); +- DROPBITS(1); +- switch (BITS(2)) { +- case 0: /* stored block */ +- Tracev((stderr, "inflate: stored block%s\n", +- state->last ? " (last)" : "")); +- state->mode = STORED; +- break; +- case 1: /* fixed block */ +- fixedtables(state); +- Tracev((stderr, "inflate: fixed codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = LEN; /* decode codes */ +- break; +- case 2: /* dynamic block */ +- Tracev((stderr, "inflate: dynamic codes block%s\n", +- state->last ? " (last)" : "")); +- state->mode = TABLE; +- break; +- case 3: +- strm->msg = (char *)"invalid block type"; +- state->mode = BAD; +- } +- DROPBITS(2); +- break; +- case STORED: +- BYTEBITS(); /* go to byte boundary */ +- NEEDBITS(32); +- if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { +- strm->msg = (char *)"invalid stored block lengths"; +- state->mode = BAD; +- break; +- } +- state->length = (unsigned)hold & 0xffff; +- Tracev((stderr, "inflate: stored length %u\n", +- state->length)); +- INITBITS(); +- state->mode = COPY; +- case COPY: +- copy = state->length; +- if (copy) { +- if (copy > have) copy = have; +- if (copy > left) copy = left; +- if (copy == 0) goto inf_leave; +- zmemcpy(put, next, copy); +- have -= copy; +- next += copy; +- left -= copy; +- put += copy; +- state->length -= copy; +- break; +- } +- Tracev((stderr, "inflate: stored end\n")); +- state->mode = TYPE; +- break; +- case TABLE: +- NEEDBITS(14); +- state->nlen = BITS(5) + 257; +- DROPBITS(5); +- state->ndist = BITS(5) + 1; +- DROPBITS(5); +- state->ncode = BITS(4) + 4; +- DROPBITS(4); +-#ifndef PKZIP_BUG_WORKAROUND +- if (state->nlen > 286 || state->ndist > 30) { +- strm->msg = (char *)"too many length or distance symbols"; +- state->mode = BAD; +- break; +- } +-#endif +- Tracev((stderr, "inflate: table sizes ok\n")); +- state->have = 0; +- state->mode = LENLENS; +- case LENLENS: +- while (state->have < state->ncode) { +- NEEDBITS(3); +- state->lens[order[state->have++]] = (unsigned short)BITS(3); +- DROPBITS(3); +- } +- while (state->have < 19) +- state->lens[order[state->have++]] = 0; +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 7; +- ret = inflate_table(CODES, state->lens, 19, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid code lengths set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: code lengths ok\n")); +- state->have = 0; +- state->mode = CODELENS; +- case CODELENS: +- while (state->have < state->nlen + state->ndist) { +- for (;;) { +- This = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if (This.val < 16) { +- NEEDBITS(This.bits); +- DROPBITS(This.bits); +- state->lens[state->have++] = This.val; +- } +- else { +- if (This.val == 16) { +- NEEDBITS(This.bits + 2); +- DROPBITS(This.bits); +- if (state->have == 0) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- len = state->lens[state->have - 1]; +- copy = 3 + BITS(2); +- DROPBITS(2); +- } +- else if (This.val == 17) { +- NEEDBITS(This.bits + 3); +- DROPBITS(This.bits); +- len = 0; +- copy = 3 + BITS(3); +- DROPBITS(3); +- } +- else { +- NEEDBITS(This.bits + 7); +- DROPBITS(This.bits); +- len = 0; +- copy = 11 + BITS(7); +- DROPBITS(7); +- } +- if (state->have + copy > state->nlen + state->ndist) { +- strm->msg = (char *)"invalid bit length repeat"; +- state->mode = BAD; +- break; +- } +- while (copy--) +- state->lens[state->have++] = (unsigned short)len; +- } +- } +- +- /* handle error breaks in while */ +- if (state->mode == BAD) break; +- +- /* build code tables */ +- state->next = state->codes; +- state->lencode = (code const FAR *)(state->next); +- state->lenbits = 9; +- ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), +- &(state->lenbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid literal/lengths set"; +- state->mode = BAD; +- break; +- } +- state->distcode = (code const FAR *)(state->next); +- state->distbits = 6; +- ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, +- &(state->next), &(state->distbits), state->work); +- if (ret) { +- strm->msg = (char *)"invalid distances set"; +- state->mode = BAD; +- break; +- } +- Tracev((stderr, "inflate: codes ok\n")); +- state->mode = LEN; +- case LEN: +- if (have >= 6 && left >= 258) { +- RESTORE(); +- inflate_fast(strm, out); +- LOAD(); +- break; +- } +- for (;;) { +- This = state->lencode[BITS(state->lenbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if (This.op && (This.op & 0xf0) == 0) { +- last = This; +- for (;;) { +- This = state->lencode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + This.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(This.bits); +- state->length = (unsigned)This.val; +- if ((int)(This.op) == 0) { +- Tracevv((stderr, This.val >= 0x20 && This.val < 0x7f ? +- "inflate: literal '%c'\n" : +- "inflate: literal 0x%02x\n", This.val)); +- state->mode = LIT; +- break; +- } +- if (This.op & 32) { +- Tracevv((stderr, "inflate: end of block\n")); +- state->mode = TYPE; +- break; +- } +- if (This.op & 64) { +- strm->msg = (char *)"invalid literal/length code"; +- state->mode = BAD; +- break; +- } +- state->extra = (unsigned)(This.op) & 15; +- state->mode = LENEXT; +- case LENEXT: +- if (state->extra) { +- NEEDBITS(state->extra); +- state->length += BITS(state->extra); +- DROPBITS(state->extra); +- } +- Tracevv((stderr, "inflate: length %u\n", state->length)); +- state->mode = DIST; +- case DIST: +- for (;;) { +- This = state->distcode[BITS(state->distbits)]; +- if ((unsigned)(This.bits) <= bits) break; +- PULLBYTE(); +- } +- if ((This.op & 0xf0) == 0) { +- last = This; +- for (;;) { +- This = state->distcode[last.val + +- (BITS(last.bits + last.op) >> last.bits)]; +- if ((unsigned)(last.bits + This.bits) <= bits) break; +- PULLBYTE(); +- } +- DROPBITS(last.bits); +- } +- DROPBITS(This.bits); +- if (This.op & 64) { +- strm->msg = (char *)"invalid distance code"; +- state->mode = BAD; +- break; +- } +- state->offset = (unsigned)This.val; +- state->extra = (unsigned)(This.op) & 15; +- state->mode = DISTEXT; +- case DISTEXT: +- if (state->extra) { +- NEEDBITS(state->extra); +- state->offset += BITS(state->extra); +- DROPBITS(state->extra); +- } +-#ifdef INFLATE_STRICT +- if (state->offset > state->dmax) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +-#endif +- if (state->offset > state->whave + out - left) { +- strm->msg = (char *)"invalid distance too far back"; +- state->mode = BAD; +- break; +- } +- Tracevv((stderr, "inflate: distance %u\n", state->offset)); +- state->mode = MATCH; +- case MATCH: +- if (left == 0) goto inf_leave; +- copy = out - left; +- if (state->offset > copy) { /* copy from window */ +- copy = state->offset - copy; +- if (copy > state->write) { +- copy -= state->write; +- from = state->window + (state->wsize - copy); +- } +- else +- from = state->window + (state->write - copy); +- if (copy > state->length) copy = state->length; +- } +- else { /* copy from output */ +- from = put - state->offset; +- copy = state->length; +- } +- if (copy > left) copy = left; +- left -= copy; +- state->length -= copy; +- do { +- *put++ = *from++; +- } while (--copy); +- if (state->length == 0) state->mode = LEN; +- break; +- case LIT: +- if (left == 0) goto inf_leave; +- *put++ = (unsigned char)(state->length); +- left--; +- state->mode = LEN; +- break; +- case CHECK: +- if (state->wrap) { +- NEEDBITS(32); +- out -= left; +- strm->total_out += out; +- state->total += out; +- if (out) +- strm->adler = state->check = +- UPDATE(state->check, put - out, out); +- out = left; +- if (( +-#ifdef GUNZIP +- state->flags ? hold : +-#endif +- REVERSE(hold)) != state->check) { +- strm->msg = (char *)"incorrect data check"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- Tracev((stderr, "inflate: check matches trailer\n")); +- } +-#ifdef GUNZIP +- state->mode = LENGTH; +- case LENGTH: +- if (state->wrap && state->flags) { +- NEEDBITS(32); +- if (hold != (state->total & 0xffffffffUL)) { +- strm->msg = (char *)"incorrect length check"; +- state->mode = BAD; +- break; +- } +- INITBITS(); +- Tracev((stderr, "inflate: length matches trailer\n")); +- } +-#endif +- state->mode = DONE; +- case DONE: +- ret = Z_STREAM_END; +- goto inf_leave; +- case BAD: +- ret = Z_DATA_ERROR; +- goto inf_leave; +- case MEM: +- return Z_MEM_ERROR; +- case SYNC: +- default: +- return Z_STREAM_ERROR; +- } +- +- /* +- Return from inflate(), updating the total counts and the check value. +- If there was no progress during the inflate() call, return a buffer +- error. Call updatewindow() to create and/or update the window state. +- Note: a memory error from inflate() is non-recoverable. +- */ +- inf_leave: +- RESTORE(); +- if (state->wsize || (state->mode < CHECK && out != strm->avail_out)) +- if (updatewindow(strm, out)) { +- state->mode = MEM; +- return Z_MEM_ERROR; +- } +- in -= strm->avail_in; +- out -= strm->avail_out; +- strm->total_in += in; +- strm->total_out += out; +- state->total += out; +- if (state->wrap && out) +- strm->adler = state->check = +- UPDATE(state->check, strm->next_out - out, out); +- strm->data_type = state->bits + (state->last ? 64 : 0) + +- (state->mode == TYPE ? 128 : 0); +- if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) +- ret = Z_BUF_ERROR; +- return ret; +-} +- +-int ZEXPORT inflateEnd(z_streamp strm) +-{ +- struct inflate_state FAR *state; +- if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (state->window != Z_NULL) ZFREE(strm, state->window); +- ZFREE(strm, strm->state); +- strm->state = Z_NULL; +- Tracev((stderr, "inflate: end\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflateSetDictionary(z_streamp strm, const Bytef *dictionary, uInt dictLength) +-{ +- struct inflate_state FAR *state; +- unsigned long id; +- +- /* check state */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (state->wrap != 0 && state->mode != DICT) +- return Z_STREAM_ERROR; +- +- /* check for correct dictionary id */ +- if (state->mode == DICT) { +- id = adler32(0L, Z_NULL, 0); +- id = adler32(id, dictionary, dictLength); +- if (id != state->check) +- return Z_DATA_ERROR; +- } +- +- /* copy dictionary to window */ +- if (updatewindow(strm, strm->avail_out)) { +- state->mode = MEM; +- return Z_MEM_ERROR; +- } +- if (dictLength > state->wsize) { +- zmemcpy(state->window, dictionary + dictLength - state->wsize, +- state->wsize); +- state->whave = state->wsize; +- } +- else { +- zmemcpy(state->window + state->wsize - dictLength, dictionary, +- dictLength); +- state->whave = dictLength; +- } +- state->havedict = 1; +- Tracev((stderr, "inflate: dictionary set\n")); +- return Z_OK; +-} +- +-int ZEXPORT inflateGetHeader(z_streamp strm, gz_headerp head) +-{ +- struct inflate_state FAR *state; +- +- /* check state */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; +- +- /* save header structure */ +- state->head = head; +- head->done = 0; +- return Z_OK; +-} +- +-/* +- Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found +- or when out of input. When called, *have is the number of pattern bytes +- found in order so far, in 0..3. On return *have is updated to the new +- state. If on return *have equals four, then the pattern was found and the +- return value is how many bytes were read including the last byte of the +- pattern. If *have is less than four, then the pattern has not been found +- yet and the return value is len. In the latter case, syncsearch() can be +- called again with more data and the *have state. *have is initialized to +- zero for the first call. +- */ +-local unsigned syncsearch(unsigned FAR *have, unsigned char FAR *buf, unsigned len) +-{ +- unsigned got; +- unsigned next; +- +- got = *have; +- next = 0; +- while (next < len && got < 4) { +- if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) +- got++; +- else if (buf[next]) +- got = 0; +- else +- got = 4 - got; +- next++; +- } +- *have = got; +- return next; +-} +- +-int ZEXPORT inflateSync(z_streamp strm) +-{ +- unsigned len; /* number of bytes to look at or looked at */ +- unsigned long in, out; /* temporary to save total_in and total_out */ +- unsigned char buf[4]; /* to restore bit buffer to byte string */ +- struct inflate_state FAR *state; +- +- /* check parameters */ +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; +- +- /* if first time, start search in bit buffer */ +- if (state->mode != SYNC) { +- state->mode = SYNC; +- state->hold <<= state->bits & 7; +- state->bits -= state->bits & 7; +- len = 0; +- while (state->bits >= 8) { +- buf[len++] = (unsigned char)(state->hold); +- state->hold >>= 8; +- state->bits -= 8; +- } +- state->have = 0; +- syncsearch(&(state->have), buf, len); +- } +- +- /* search available input */ +- len = syncsearch(&(state->have), strm->next_in, strm->avail_in); +- strm->avail_in -= len; +- strm->next_in += len; +- strm->total_in += len; +- +- /* return no joy or set up to restart inflate() on a new block */ +- if (state->have != 4) return Z_DATA_ERROR; +- in = strm->total_in; out = strm->total_out; +- inflateReset(strm); +- strm->total_in = in; strm->total_out = out; +- state->mode = TYPE; +- return Z_OK; +-} +- +-/* +- Returns true if inflate is currently at the end of a block generated by +- Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP +- implementation to provide an additional safety check. PPP uses +- Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored +- block. When decompressing, PPP checks that at the end of input packet, +- inflate is waiting for these length bytes. +- */ +-int ZEXPORT inflateSyncPoint(z_streamp strm) +-{ +- struct inflate_state FAR *state; +- +- if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)strm->state; +- return state->mode == STORED && state->bits == 0; +-} +- +-int ZEXPORT inflateCopy(z_streamp dest, z_streamp source) +-{ +- struct inflate_state FAR *state; +- struct inflate_state FAR *copy; +- unsigned char FAR *window; +- unsigned wsize; +- +- /* check input */ +- if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL || +- source->zalloc == (alloc_func)0 || source->zfree == (free_func)0) +- return Z_STREAM_ERROR; +- state = (struct inflate_state FAR *)source->state; +- +- /* allocate space */ +- copy = (struct inflate_state FAR *) +- ZALLOC(source, 1, sizeof(struct inflate_state)); +- if (copy == Z_NULL) return Z_MEM_ERROR; +- window = Z_NULL; +- if (state->window != Z_NULL) { +- window = (unsigned char FAR *) +- ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); +- if (window == Z_NULL) { +- ZFREE(source, copy); +- return Z_MEM_ERROR; +- } +- } +- +- /* copy state */ +- zmemcpy(dest, source, sizeof(z_stream)); +- zmemcpy(copy, state, sizeof(struct inflate_state)); +- if (state->lencode >= state->codes && +- state->lencode <= state->codes + ENOUGH - 1) { +- copy->lencode = copy->codes + (state->lencode - state->codes); +- copy->distcode = copy->codes + (state->distcode - state->codes); +- } +- copy->next = copy->codes + (state->next - state->codes); +- if (window != Z_NULL) { +- wsize = 1U << state->wbits; +- zmemcpy(window, state->window, wsize); +- } +- copy->window = window; +- dest->state = (struct internal_state FAR *)copy; +- return Z_OK; +-} +diff -ruN seqinr.orig/src/inflate.h seqinr/src/inflate.h +--- seqinr.orig/src/inflate.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inflate.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,115 +0,0 @@ +-/* inflate.h -- internal inflate state definition +- * Copyright (C) 1995-2004 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* define NO_GZIP when compiling if you want to disable gzip header and +- trailer decoding by inflate(). NO_GZIP would be used to avoid linking in +- the crc code when it is not needed. For shared libraries, gzip decoding +- should be left enabled. */ +-#ifndef NO_GZIP +-# define GUNZIP +-#endif +- +-/* Possible inflate modes between inflate() calls */ +-typedef enum { +- HEAD, /* i: waiting for magic header */ +- FLAGS, /* i: waiting for method and flags (gzip) */ +- TIME, /* i: waiting for modification time (gzip) */ +- OS, /* i: waiting for extra flags and operating system (gzip) */ +- EXLEN, /* i: waiting for extra length (gzip) */ +- EXTRA, /* i: waiting for extra bytes (gzip) */ +- NAME, /* i: waiting for end of file name (gzip) */ +- COMMENT, /* i: waiting for end of comment (gzip) */ +- HCRC, /* i: waiting for header crc (gzip) */ +- DICTID, /* i: waiting for dictionary check value */ +- DICT, /* waiting for inflateSetDictionary() call */ +- TYPE, /* i: waiting for type bits, including last-flag bit */ +- TYPEDO, /* i: same, but skip check to exit inflate on new block */ +- STORED, /* i: waiting for stored size (length and complement) */ +- COPY, /* i/o: waiting for input or output to copy stored block */ +- TABLE, /* i: waiting for dynamic block table lengths */ +- LENLENS, /* i: waiting for code length code lengths */ +- CODELENS, /* i: waiting for length/lit and distance code lengths */ +- LEN, /* i: waiting for length/lit code */ +- LENEXT, /* i: waiting for length extra bits */ +- DIST, /* i: waiting for distance code */ +- DISTEXT, /* i: waiting for distance extra bits */ +- MATCH, /* o: waiting for output space to copy string */ +- LIT, /* o: waiting for output space to write literal */ +- CHECK, /* i: waiting for 32-bit check value */ +- LENGTH, /* i: waiting for 32-bit length (gzip) */ +- DONE, /* finished check, done -- remain here until reset */ +- BAD, /* got a data error -- remain here until reset */ +- MEM, /* got an inflate() memory error -- remain here until reset */ +- SYNC /* looking for synchronization bytes to restart inflate() */ +-} inflate_mode; +- +-/* +- State transitions between above modes - +- +- (most modes can go to the BAD or MEM mode -- not shown for clarity) +- +- Process header: +- HEAD -> (gzip) or (zlib) +- (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME +- NAME -> COMMENT -> HCRC -> TYPE +- (zlib) -> DICTID or TYPE +- DICTID -> DICT -> TYPE +- Read deflate blocks: +- TYPE -> STORED or TABLE or LEN or CHECK +- STORED -> COPY -> TYPE +- TABLE -> LENLENS -> CODELENS -> LEN +- Read deflate codes: +- LEN -> LENEXT or LIT or TYPE +- LENEXT -> DIST -> DISTEXT -> MATCH -> LEN +- LIT -> LEN +- Process trailer: +- CHECK -> LENGTH -> DONE +- */ +- +-/* state maintained between inflate() calls. Approximately 7K bytes. */ +-struct inflate_state { +- inflate_mode mode; /* current inflate mode */ +- int last; /* true if processing last block */ +- int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ +- int havedict; /* true if dictionary provided */ +- int flags; /* gzip header method and flags (0 if zlib) */ +- unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ +- unsigned long check; /* protected copy of check value */ +- unsigned long total; /* protected copy of output count */ +- gz_headerp head; /* where to save gzip header information */ +- /* sliding window */ +- unsigned wbits; /* log base 2 of requested window size */ +- unsigned wsize; /* window size or zero if not using window */ +- unsigned whave; /* valid bytes in the window */ +- unsigned write; /* window write index */ +- unsigned char FAR *window; /* allocated sliding window, if needed */ +- /* bit accumulator */ +- unsigned long hold; /* input bit accumulator */ +- unsigned bits; /* number of bits in "in" */ +- /* for string and stored block copying */ +- unsigned length; /* literal or length of data to copy */ +- unsigned offset; /* distance back to copy string from */ +- /* for table and code decoding */ +- unsigned extra; /* extra bits needed */ +- /* fixed and dynamic code tables */ +- code const FAR *lencode; /* starting table for length/literal codes */ +- code const FAR *distcode; /* starting table for distance codes */ +- unsigned lenbits; /* index bits for lencode */ +- unsigned distbits; /* index bits for distcode */ +- /* dynamic table building */ +- unsigned ncode; /* number of code length code lengths */ +- unsigned nlen; /* number of length code lengths */ +- unsigned ndist; /* number of distance code lengths */ +- unsigned have; /* number of code lengths in lens[] */ +- code FAR *next; /* next available space in codes[] */ +- unsigned short lens[320]; /* temporary storage for code lengths */ +- unsigned short work[288]; /* work area for code table building */ +- code codes[ENOUGH]; /* space for code tables */ +-}; +diff -ruN seqinr.orig/src/inftrees.c seqinr/src/inftrees.c +--- seqinr.orig/src/inftrees.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inftrees.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,333 +0,0 @@ +-/* inftrees.c -- generate Huffman trees for efficient decoding +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-#include "zutil.h" +-#include "inftrees.h" +- +-#define MAXBITS 15 +- +-const char inflate_copyright[] = +- " inflate 1.2.3 Copyright 1995-2005 Mark Adler "; +-/* +- If you use the zlib library in a product, an acknowledgment is welcome +- in the documentation of your product. If for some reason you cannot +- include such an acknowledgment, I would appreciate that you keep this +- copyright string in the executable of your product. +- */ +- +-/* +- Build a set of tables to decode the provided canonical Huffman code. +- The code lengths are lens[0..codes-1]. The result starts at *table, +- whose indices are 0..2^bits-1. work is a writable array of at least +- lens shorts, which is used as a work area. type is the type of code +- to be generated, CODES, LENS, or DISTS. On return, zero is success, +- -1 is an invalid code, and +1 means that ENOUGH isn't enough. table +- on return points to the next available entry's address. bits is the +- requested root table index bits, and on return it is the actual root +- table index bits. It will differ if the request is greater than the +- longest code or if it is less than the shortest code. +- */ +-int inflate_table(codetype type, unsigned short FAR *lens, unsigned codes, +- code FAR * FAR * table, unsigned FAR *bits, +- unsigned short FAR *work) +-/* +-codetype type; +-unsigned short FAR *lens; +-unsigned codes; +-code FAR * FAR *table; +-unsigned FAR *bits; +-unsigned short FAR *work; +-*/ +-{ +- unsigned len; /* a code's length in bits */ +- unsigned sym; /* index of code symbols */ +- unsigned min, max; /* minimum and maximum code lengths */ +- unsigned root; /* number of index bits for root table */ +- unsigned curr; /* number of index bits for current table */ +- unsigned drop; /* code bits to drop for sub-table */ +- int left; /* number of prefix codes available */ +- unsigned used; /* code entries in table used */ +- unsigned huff; /* Huffman code */ +- unsigned incr; /* for incrementing code, index */ +- unsigned fill; /* index for replicating entries */ +- unsigned low; /* low bits for current root entry */ +- unsigned mask; /* mask for low root bits */ +- code This; /* table entry for duplication */ +- code FAR *next; /* next available space in table */ +- const unsigned short FAR *base; /* base value table to use */ +- const unsigned short FAR *extra; /* extra bits table to use */ +- int end; /* use base and extra for symbol > end */ +- unsigned short count[MAXBITS+1]; /* number of codes of each length */ +- unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ +- static const unsigned short lbase[31] = { /* Length codes 257..285 base */ +- 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, +- 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; +- static const unsigned short lext[31] = { /* Length codes 257..285 extra */ +- 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, +- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 201, 196}; +- static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ +- 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, +- 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, +- 8193, 12289, 16385, 24577, 0, 0}; +- static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ +- 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, +- 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, +- 28, 28, 29, 29, 64, 64}; +- +- /* +- Process a set of code lengths to create a canonical Huffman code. The +- code lengths are lens[0..codes-1]. Each length corresponds to the +- symbols 0..codes-1. The Huffman code is generated by first sorting the +- symbols by length from short to long, and retaining the symbol order +- for codes with equal lengths. Then the code starts with all zero bits +- for the first code of the shortest length, and the codes are integer +- increments for the same length, and zeros are appended as the length +- increases. For the deflate format, these bits are stored backwards +- from their more natural integer increment ordering, and so when the +- decoding tables are built in the large loop below, the integer codes +- are incremented backwards. +- +- This routine assumes, but does not check, that all of the entries in +- lens[] are in the range 0..MAXBITS. The caller must assure this. +- 1..MAXBITS is interpreted as that code length. zero means that that +- symbol does not occur in this code. +- +- The codes are sorted by computing a count of codes for each length, +- creating from that a table of starting indices for each length in the +- sorted table, and then entering the symbols in order in the sorted +- table. The sorted table is work[], with that space being provided by +- the caller. +- +- The length counts are used for other purposes as well, i.e. finding +- the minimum and maximum length codes, determining if there are any +- codes at all, checking for a valid set of lengths, and looking ahead +- at length counts to determine sub-table sizes when building the +- decoding tables. +- */ +- +- /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ +- for (len = 0; len <= MAXBITS; len++) +- count[len] = 0; +- for (sym = 0; sym < codes; sym++) +- count[lens[sym]]++; +- +- /* bound code lengths, force root to be within code lengths */ +- root = *bits; +- for (max = MAXBITS; max >= 1; max--) +- if (count[max] != 0) break; +- if (root > max) root = max; +- if (max == 0) { /* no symbols to code at all */ +- This.op = (unsigned char)64; /* invalid code marker */ +- This.bits = (unsigned char)1; +- This.val = (unsigned short)0; +- *(*table)++ = This; /* make a table to force an error */ +- *(*table)++ = This; +- *bits = 1; +- return 0; /* no symbols, but wait for decoding to report error */ +- } +- for (min = 1; min <= MAXBITS; min++) +- if (count[min] != 0) break; +- if (root < min) root = min; +- +- /* check for an over-subscribed or incomplete set of lengths */ +- left = 1; +- for (len = 1; len <= MAXBITS; len++) { +- left <<= 1; +- left -= count[len]; +- if (left < 0) return -1; /* over-subscribed */ +- } +- if (left > 0 && (type == CODES || max != 1)) +- return -1; /* incomplete set */ +- +- /* generate offsets into symbol table for each length for sorting */ +- offs[1] = 0; +- for (len = 1; len < MAXBITS; len++) +- offs[len + 1] = offs[len] + count[len]; +- +- /* sort symbols by length, by symbol order within each length */ +- for (sym = 0; sym < codes; sym++) +- if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; +- +- /* +- Create and fill in decoding tables. In this loop, the table being +- filled is at next and has curr index bits. The code being used is huff +- with length len. That code is converted to an index by dropping drop +- bits off of the bottom. For codes where len is less than drop + curr, +- those top drop + curr - len bits are incremented through all values to +- fill the table with replicated entries. +- +- root is the number of index bits for the root table. When len exceeds +- root, sub-tables are created pointed to by the root entry with an index +- of the low root bits of huff. This is saved in low to check for when a +- new sub-table should be started. drop is zero when the root table is +- being filled, and drop is root when sub-tables are being filled. +- +- When a new sub-table is needed, it is necessary to look ahead in the +- code lengths to determine what size sub-table is needed. The length +- counts are used for this, and so count[] is decremented as codes are +- entered in the tables. +- +- used keeps track of how many table entries have been allocated from the +- provided *table space. It is checked when a LENS table is being made +- against the space in *table, ENOUGH, minus the maximum space needed by +- the worst case distance code, MAXD. This should never happen, but the +- sufficiency of ENOUGH has not been proven exhaustively, hence the check. +- This assumes that when type == LENS, bits == 9. +- +- sym increments through all symbols, and the loop terminates when +- all codes of length max, i.e. all codes, have been processed. This +- routine permits incomplete codes, so another loop after this one fills +- in the rest of the decoding tables with invalid code markers. +- */ +- +- /* set up for code type */ +- switch (type) { +- case CODES: +- base = extra = work; /* dummy value--not used */ +- end = 19; +- break; +- case LENS: +- base = lbase; +- base -= 257; +- extra = lext; +- extra -= 257; +- end = 256; +- break; +- default: /* DISTS */ +- base = dbase; +- extra = dext; +- end = -1; +- } +- +- /* initialize state for loop */ +- huff = 0; /* starting code */ +- sym = 0; /* starting code symbol */ +- len = min; /* starting code length */ +- next = *table; /* current table to fill in */ +- curr = root; /* current table index bits */ +- drop = 0; /* current bits to drop from code for index */ +- low = (unsigned)(-1); /* trigger new sub-table when len > root */ +- used = 1U << root; /* use root table entries */ +- mask = used - 1; /* mask for comparing low */ +- +- /* check available table space */ +- if (type == LENS && used >= ENOUGH - MAXD) +- return 1; +- +- /* process all codes and make table entries */ +- for (;;) { +- /* create table entry */ +- This.bits = (unsigned char)(len - drop); +- if ((int)(work[sym]) < end) { +- This.op = (unsigned char)0; +- This.val = work[sym]; +- } +- else if ((int)(work[sym]) > end) { +- This.op = (unsigned char)(extra[work[sym]]); +- This.val = base[work[sym]]; +- } +- else { +- This.op = (unsigned char)(32 + 64); /* end of block */ +- This.val = 0; +- } +- +- /* replicate for those indices with low len bits equal to huff */ +- incr = 1U << (len - drop); +- fill = 1U << curr; +- min = fill; /* save offset to next table */ +- do { +- fill -= incr; +- next[(huff >> drop) + fill] = This; +- } while (fill != 0); +- +- /* backwards increment the len-bit code huff */ +- incr = 1U << (len - 1); +- while (huff & incr) +- incr >>= 1; +- if (incr != 0) { +- huff &= incr - 1; +- huff += incr; +- } +- else +- huff = 0; +- +- /* go to next symbol, update count, len */ +- sym++; +- if (--(count[len]) == 0) { +- if (len == max) break; +- len = lens[work[sym]]; +- } +- +- /* create new sub-table if needed */ +- if (len > root && (huff & mask) != low) { +- /* if first time, transition to sub-tables */ +- if (drop == 0) +- drop = root; +- +- /* increment past last table */ +- next += min; /* here min is 1 << curr */ +- +- /* determine length of next table */ +- curr = len - drop; +- left = (int)(1 << curr); +- while (curr + drop < max) { +- left -= count[curr + drop]; +- if (left <= 0) break; +- curr++; +- left <<= 1; +- } +- +- /* check for enough space */ +- used += 1U << curr; +- if (type == LENS && used >= ENOUGH - MAXD) +- return 1; +- +- /* point entry in root table to sub-table */ +- low = huff & mask; +- (*table)[low].op = (unsigned char)curr; +- (*table)[low].bits = (unsigned char)root; +- (*table)[low].val = (unsigned short)(next - *table); +- } +- } +- +- /* +- Fill in rest of table for incomplete codes. This loop is similar to the +- loop above in incrementing huff for table indices. It is assumed that +- len is equal to curr + drop, so there is no loop needed to increment +- through high index bits. When the current sub-table is filled, the loop +- drops back to the root table to fill in any remaining entries there. +- */ +- This.op = (unsigned char)64; /* invalid code marker */ +- This.bits = (unsigned char)(len - drop); +- This.val = (unsigned short)0; +- while (huff != 0) { +- /* when done with sub-table, drop back to root table */ +- if (drop != 0 && (huff & mask) != low) { +- drop = 0; +- len = root; +- next = *table; +- This.bits = (unsigned char)len; +- } +- +- /* put invalid code marker in table */ +- next[huff >> drop] = This; +- +- /* backwards increment the len-bit code huff */ +- incr = 1U << (len - 1); +- while (huff & incr) +- incr >>= 1; +- if (incr != 0) { +- huff &= incr - 1; +- huff += incr; +- } +- else +- huff = 0; +- } +- +- /* set return parameters */ +- *table += used; +- *bits = root; +- return 0; +-} +diff -ruN seqinr.orig/src/inftrees.h seqinr/src/inftrees.h +--- seqinr.orig/src/inftrees.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/inftrees.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,55 +0,0 @@ +-/* inftrees.h -- header to use inftrees.c +- * Copyright (C) 1995-2005 Mark Adler +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* Structure for decoding tables. Each entry provides either the +- information needed to do the operation requested by the code that +- indexed that table entry, or it provides a pointer to another +- table that indexes more bits of the code. op indicates whether +- the entry is a pointer to another table, a literal, a length or +- distance, an end-of-block, or an invalid code. For a table +- pointer, the low four bits of op is the number of index bits of +- that table. For a length or distance, the low four bits of op +- is the number of extra bits to get after the code. bits is +- the number of bits in this code or part of the code to drop off +- of the bit buffer. val is the actual byte to output in the case +- of a literal, the base length or distance, or the offset from +- the current table to the next table. Each entry is four bytes. */ +-typedef struct { +- unsigned char op; /* operation, extra bits, table bits */ +- unsigned char bits; /* bits in this part of the code */ +- unsigned short val; /* offset in table or code value */ +-} code; +- +-/* op values as set by inflate_table(): +- 00000000 - literal +- 0000tttt - table link, tttt != 0 is the number of table index bits +- 0001eeee - length or distance, eeee is the number of extra bits +- 01100000 - end of block +- 01000000 - invalid code +- */ +- +-/* Maximum size of dynamic tree. The maximum found in a long but non- +- exhaustive search was 1444 code structures (852 for length/literals +- and 592 for distances, the latter actually the result of an +- exhaustive search). The true maximum is not known, but the value +- below is more than safe. */ +-#define ENOUGH 2048 +-#define MAXD 592 +- +-/* Type of code to build for inftable() */ +-typedef enum { +- CODES, +- LENS, +- DISTS +-} codetype; +- +-extern int inflate_table OF((codetype type, unsigned short FAR *lens, +- unsigned codes, code FAR * FAR *table, +- unsigned FAR *bits, unsigned short FAR *work)); +diff -ruN seqinr.orig/src/Makevars seqinr/src/Makevars +--- seqinr.orig/src/Makevars 2007-04-19 14:23:37.000000000 +0200 ++++ seqinr/src/Makevars 2009-05-17 21:38:04.000000000 +0200 +@@ -1 +1,2 @@ + PKG_CFLAGS = -DUSE_TYPE_CHECKING_STRICT ++PKG_LIBS=-lz +diff -ruN seqinr.orig/src/trees.c seqinr/src/trees.c +--- seqinr.orig/src/trees.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/trees.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1249 +0,0 @@ +-/* trees.c -- output deflated data using Huffman coding +- * Copyright (C) 1995-2005 Jean-loup Gailly +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* +- * ALGORITHM +- * +- * The "deflation" process uses several Huffman trees. The more +- * common source values are represented by shorter bit sequences. +- * +- * Each code tree is stored in a compressed form which is itself +- * a Huffman encoding of the lengths of all the code strings (in +- * ascending order by source values). The actual code strings are +- * reconstructed from the lengths in the inflate process, as described +- * in the deflate specification. +- * +- * REFERENCES +- * +- * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". +- * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc +- * +- * Storer, James A. +- * Data Compression: Methods and Theory, pp. 49-50. +- * Computer Science Press, 1988. ISBN 0-7167-8156-5. +- * +- * Sedgewick, R. +- * Algorithms, p290. +- * Addison-Wesley, 1983. ISBN 0-201-06672-6. +- */ +- +-/* @(#) $Id: trees.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ +- +-/* #define GEN_TREES_H */ +- +-#include "deflate.h" +- +-#ifdef DEBUG +-# include +-#endif +- +-/* =========================================================================== +- * Constants +- */ +- +-#define MAX_BL_BITS 7 +-/* Bit length codes must not exceed MAX_BL_BITS bits */ +- +-#define END_BLOCK 256 +-/* end of block literal code */ +- +-#define REP_3_6 16 +-/* repeat previous bit length 3-6 times (2 bits of repeat count) */ +- +-#define REPZ_3_10 17 +-/* repeat a zero length 3-10 times (3 bits of repeat count) */ +- +-#define REPZ_11_138 18 +-/* repeat a zero length 11-138 times (7 bits of repeat count) */ +- +-local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ +- = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; +- +-local const int extra_dbits[D_CODES] /* extra bits for each distance code */ +- = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; +- +-local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ +- = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; +- +-local const uch bl_order[BL_CODES] +- = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; +-/* The lengths of the bit length codes are sent in order of decreasing +- * probability, to avoid transmitting the lengths for unused bit length codes. +- */ +- +-#define Buf_size (8 * 2*sizeof(char)) +-/* Number of bits used within bi_buf. (bi_buf might be implemented on +- * more than 16 bits on some systems.) +- */ +- +-/* =========================================================================== +- * Local data. These are initialized only once. +- */ +- +-#define DIST_CODE_LEN 512 /* see definition of array dist_code below */ +- +-#if defined(GEN_TREES_H) || !defined(STDC) +-/* non ANSI compilers may not accept trees.h */ +- +-local ct_data static_ltree[L_CODES+2]; +-/* The static literal tree. Since the bit lengths are imposed, there is no +- * need for the L_CODES extra codes used during heap construction. However +- * The codes 286 and 287 are needed to build a canonical tree (see _tr_init +- * below). +- */ +- +-local ct_data static_dtree[D_CODES]; +-/* The static distance tree. (Actually a trivial tree since all codes use +- * 5 bits.) +- */ +- +-uch _dist_code[DIST_CODE_LEN]; +-/* Distance codes. The first 256 values correspond to the distances +- * 3 .. 258, the last 256 values correspond to the top 8 bits of +- * the 15 bit distances. +- */ +- +-uch _length_code[MAX_MATCH-MIN_MATCH+1]; +-/* length code for each normalized match length (0 == MIN_MATCH) */ +- +-local int base_length[LENGTH_CODES]; +-/* First normalized length for each code (0 = MIN_MATCH) */ +- +-local int base_dist[D_CODES]; +-/* First normalized distance for each code (0 = distance of 1) */ +- +-#else +-# include "trees.h" +-#endif /* GEN_TREES_H */ +- +-struct static_tree_desc_s { +- const ct_data *static_tree; /* static tree or NULL */ +- const intf *extra_bits; /* extra bits for each code or NULL */ +- int extra_base; /* base index for extra_bits */ +- int elems; /* max number of elements in the tree */ +- int max_length; /* max bit length for the codes */ +-}; +- +-local static_tree_desc static_l_desc = +-{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; +- +-local static_tree_desc static_d_desc = +-{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; +- +-local static_tree_desc static_bl_desc = +-{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; +- +-/* =========================================================================== +- * Local (static) routines in this file. +- */ +- +-local void tr_static_init OF((void)); +-local void init_block OF((deflate_state *s)); +-local void pqdownheap OF((deflate_state *s, ct_data *tree, int k)); +-local void gen_bitlen OF((deflate_state *s, tree_desc *desc)); +-local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count)); +-local void build_tree OF((deflate_state *s, tree_desc *desc)); +-local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code)); +-local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); +-local int build_bl_tree OF((deflate_state *s)); +-local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, +- int blcodes)); +-local void compress_block OF((deflate_state *s, ct_data *ltree, +- ct_data *dtree)); +-local void set_data_type OF((deflate_state *s)); +-local unsigned bi_reverse OF((unsigned value, int length)); +-local void bi_windup OF((deflate_state *s)); +-local void bi_flush OF((deflate_state *s)); +-local void copy_block OF((deflate_state *s, charf *buf, unsigned len, +- int header)); +- +-#ifdef GEN_TREES_H +-local void gen_trees_header OF((void)); +-#endif +- +-#ifndef DEBUG +-# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) +- /* Send a code of the given tree. c and tree must not have side effects */ +- +-#else /* DEBUG */ +-# define send_code(s, c, tree) \ +- { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ +- send_bits(s, tree[c].Code, tree[c].Len); } +-#endif +- +-/* =========================================================================== +- * Output a short LSB first on the stream. +- * IN assertion: there is enough room in pendingBuf. +- */ +-#define put_short(s, w) { \ +- put_byte(s, (uch)((w) & 0xff)); \ +- put_byte(s, (uch)((ush)(w) >> 8)); \ +-} +- +-/* =========================================================================== +- * Send a value on a given number of bits. +- * IN assertion: length <= 16 and value fits in length bits. +- */ +-#ifdef DEBUG +-local void send_bits OF((deflate_state *s, int value, int length)); +- +-local void send_bits(s, value, length) +- deflate_state *s; +- int value; /* value to send */ +- int length; /* number of bits */ +-{ +- Tracevv((stderr," l %2d v %4x ", length, value)); +- Assert(length > 0 && length <= 15, "invalid length"); +- s->bits_sent += (ulg)length; +- +- /* If not enough room in bi_buf, use (valid) bits from bi_buf and +- * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) +- * unused bits in value. +- */ +- if (s->bi_valid > (int)Buf_size - length) { +- s->bi_buf |= (value << s->bi_valid); +- put_short(s, s->bi_buf); +- s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); +- s->bi_valid += length - Buf_size; +- } else { +- s->bi_buf |= value << s->bi_valid; +- s->bi_valid += length; +- } +-} +-#else /* !DEBUG */ +- +-#define send_bits(s, value, length) \ +-{ int len = length;\ +- if (s->bi_valid > (int)Buf_size - len) {\ +- int val = value;\ +- s->bi_buf |= (val << s->bi_valid);\ +- put_short(s, s->bi_buf);\ +- s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ +- s->bi_valid += len - Buf_size;\ +- } else {\ +- s->bi_buf |= (value) << s->bi_valid;\ +- s->bi_valid += len;\ +- }\ +-} +-#endif /* DEBUG */ +- +- +-/* the arguments must not have side effects */ +- +-/* =========================================================================== +- * Initialize the various 'constant' tables. +- */ +-local void tr_static_init() +-{ +-#if defined(GEN_TREES_H) || !defined(STDC) +- static int static_init_done = 0; +- int n; /* iterates over tree elements */ +- int bits; /* bit counter */ +- int length; /* length value */ +- int code; /* code value */ +- int dist; /* distance index */ +- ush bl_count[MAX_BITS+1]; +- /* number of codes at each bit length for an optimal tree */ +- +- if (static_init_done) return; +- +- /* For some embedded targets, global variables are not initialized: */ +- static_l_desc.static_tree = static_ltree; +- static_l_desc.extra_bits = extra_lbits; +- static_d_desc.static_tree = static_dtree; +- static_d_desc.extra_bits = extra_dbits; +- static_bl_desc.extra_bits = extra_blbits; +- +- /* Initialize the mapping length (0..255) -> length code (0..28) */ +- length = 0; +- for (code = 0; code < LENGTH_CODES-1; code++) { +- base_length[code] = length; +- for (n = 0; n < (1< dist code (0..29) */ +- dist = 0; +- for (code = 0 ; code < 16; code++) { +- base_dist[code] = dist; +- for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ +- for ( ; code < D_CODES; code++) { +- base_dist[code] = dist << 7; +- for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { +- _dist_code[256 + dist++] = (uch)code; +- } +- } +- Assert (dist == 256, "tr_static_init: 256+dist != 512"); +- +- /* Construct the codes of the static literal tree */ +- for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; +- n = 0; +- while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; +- while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; +- while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; +- while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; +- /* Codes 286 and 287 do not exist, but we must include them in the +- * tree construction to get a canonical Huffman tree (longest code +- * all ones) +- */ +- gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); +- +- /* The static distance tree is trivial: */ +- for (n = 0; n < D_CODES; n++) { +- static_dtree[n].Len = 5; +- static_dtree[n].Code = bi_reverse((unsigned)n, 5); +- } +- static_init_done = 1; +- +-# ifdef GEN_TREES_H +- gen_trees_header(); +-# endif +-#endif /* defined(GEN_TREES_H) || !defined(STDC) */ +-} +- +-/* =========================================================================== +- * Genererate the file trees.h describing the static trees. +- */ +-#ifdef GEN_TREES_H +-# ifndef DEBUG +-# include +-# endif +- +-# define SEPARATOR(i, last, width) \ +- ((i) == (last)? "\n};\n\n" : \ +- ((i) % (width) == (width)-1 ? ",\n" : ", ")) +- +-void gen_trees_header() +-{ +- FILE *header = fopen("trees.h", "w"); +- int i; +- +- Assert (header != NULL, "Can't open trees.h"); +- fprintf(header, +- "/* header created automatically with -DGEN_TREES_H */\n\n"); +- +- fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); +- for (i = 0; i < L_CODES+2; i++) { +- fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, +- static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); +- } +- +- fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); +- for (i = 0; i < D_CODES; i++) { +- fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, +- static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); +- } +- +- fprintf(header, "const uch _dist_code[DIST_CODE_LEN] = {\n"); +- for (i = 0; i < DIST_CODE_LEN; i++) { +- fprintf(header, "%2u%s", _dist_code[i], +- SEPARATOR(i, DIST_CODE_LEN-1, 20)); +- } +- +- fprintf(header, "const uch _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); +- for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { +- fprintf(header, "%2u%s", _length_code[i], +- SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); +- } +- +- fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); +- for (i = 0; i < LENGTH_CODES; i++) { +- fprintf(header, "%1u%s", base_length[i], +- SEPARATOR(i, LENGTH_CODES-1, 20)); +- } +- +- fprintf(header, "local const int base_dist[D_CODES] = {\n"); +- for (i = 0; i < D_CODES; i++) { +- fprintf(header, "%5u%s", base_dist[i], +- SEPARATOR(i, D_CODES-1, 10)); +- } +- +- fclose(header); +-} +-#endif /* GEN_TREES_H */ +- +-/* =========================================================================== +- * Initialize the tree data structures for a new zlib stream. +- */ +-void _tr_init(deflate_state *s) +-/* +- deflate_state *s; +-*/ +-{ +- tr_static_init(); +- +- s->l_desc.dyn_tree = s->dyn_ltree; +- s->l_desc.stat_desc = &static_l_desc; +- +- s->d_desc.dyn_tree = s->dyn_dtree; +- s->d_desc.stat_desc = &static_d_desc; +- +- s->bl_desc.dyn_tree = s->bl_tree; +- s->bl_desc.stat_desc = &static_bl_desc; +- +- s->bi_buf = 0; +- s->bi_valid = 0; +- s->last_eob_len = 8; /* enough lookahead for inflate */ +-#ifdef DEBUG +- s->compressed_len = 0L; +- s->bits_sent = 0L; +-#endif +- +- /* Initialize the first block of the first file: */ +- init_block(s); +-} +- +-/* =========================================================================== +- * Initialize a new block. +- */ +-local void init_block(deflate_state *s) +-/* deflate_state *s;*/ +-{ +- int n; /* iterates over tree elements */ +- +- /* Initialize the trees. */ +- for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; +- for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; +- for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; +- +- s->dyn_ltree[END_BLOCK].Freq = 1; +- s->opt_len = s->static_len = 0L; +- s->last_lit = s->matches = 0; +-} +- +-#define SMALLEST 1 +-/* Index within the heap array of least frequent node in the Huffman tree */ +- +- +-/* =========================================================================== +- * Remove the smallest element from the heap and recreate the heap with +- * one less element. Updates heap and heap_len. +- */ +-#define pqremove(s, tree, top) \ +-{\ +- top = s->heap[SMALLEST]; \ +- s->heap[SMALLEST] = s->heap[s->heap_len--]; \ +- pqdownheap(s, tree, SMALLEST); \ +-} +- +-/* =========================================================================== +- * Compares to subtrees, using the tree depth as tie breaker when +- * the subtrees have equal frequency. This minimizes the worst case length. +- */ +-#define smaller(tree, n, m, depth) \ +- (tree[n].Freq < tree[m].Freq || \ +- (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) +- +-/* =========================================================================== +- * Restore the heap property by moving down the tree starting at node k, +- * exchanging a node with the smallest of its two sons if necessary, stopping +- * when the heap property is re-established (each father smaller than its +- * two sons). +- */ +-local void pqdownheap(deflate_state *s, ct_data *tree, int k) +-#if 0 +- deflate_state *s; +- ct_data *tree; /* the tree to restore */ +- int k; /* node to move down */ +-#endif +-{ +- int v = s->heap[k]; +- int j = k << 1; /* left son of k */ +- while (j <= s->heap_len) { +- /* Set j to the smallest of the two sons: */ +- if (j < s->heap_len && +- smaller(tree, s->heap[j+1], s->heap[j], s->depth)) { +- j++; +- } +- /* Exit if v is smaller than both sons */ +- if (smaller(tree, v, s->heap[j], s->depth)) break; +- +- /* Exchange v with the smallest son */ +- s->heap[k] = s->heap[j]; k = j; +- +- /* And continue down the tree, setting j to the left son of k */ +- j <<= 1; +- } +- s->heap[k] = v; +-} +- +-/* =========================================================================== +- * Compute the optimal bit lengths for a tree and update the total bit length +- * for the current block. +- * IN assertion: the fields freq and dad are set, heap[heap_max] and +- * above are the tree nodes sorted by increasing frequency. +- * OUT assertions: the field len is set to the optimal bit length, the +- * array bl_count contains the frequencies for each bit length. +- * The length opt_len is updated; static_len is also updated if stree is +- * not null. +- */ +-local void gen_bitlen(deflate_state *s, tree_desc *desc) +-#if 0 +- deflate_state *s; +- tree_desc *desc; /* the tree descriptor */ +-#endif +-{ +- ct_data *tree = desc->dyn_tree; +- int max_code = desc->max_code; +- const ct_data *stree = desc->stat_desc->static_tree; +- const intf *extra = desc->stat_desc->extra_bits; +- int base = desc->stat_desc->extra_base; +- int max_length = desc->stat_desc->max_length; +- int h; /* heap index */ +- int n, m; /* iterate over the tree elements */ +- int bits; /* bit length */ +- int xbits; /* extra bits */ +- ush f; /* frequency */ +- int overflow = 0; /* number of elements with bit length too large */ +- +- for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; +- +- /* In a first pass, compute the optimal bit lengths (which may +- * overflow in the case of the bit length tree). +- */ +- tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ +- +- for (h = s->heap_max+1; h < HEAP_SIZE; h++) { +- n = s->heap[h]; +- bits = tree[tree[n].Dad].Len + 1; +- if (bits > max_length) bits = max_length, overflow++; +- tree[n].Len = (ush)bits; +- /* We overwrite tree[n].Dad which is no longer needed */ +- +- if (n > max_code) continue; /* not a leaf node */ +- +- s->bl_count[bits]++; +- xbits = 0; +- if (n >= base) xbits = extra[n-base]; +- f = tree[n].Freq; +- s->opt_len += (ulg)f * (bits + xbits); +- if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits); +- } +- if (overflow == 0) return; +- +- Trace((stderr,"\nbit length overflow\n")); +- /* This happens for example on obj2 and pic of the Calgary corpus */ +- +- /* Find the first bit length which could increase: */ +- do { +- bits = max_length-1; +- while (s->bl_count[bits] == 0) bits--; +- s->bl_count[bits]--; /* move one leaf down the tree */ +- s->bl_count[bits+1] += 2; /* move one overflow item as its brother */ +- s->bl_count[max_length]--; +- /* The brother of the overflow item also moves one step up, +- * but this does not affect bl_count[max_length] +- */ +- overflow -= 2; +- } while (overflow > 0); +- +- /* Now recompute all bit lengths, scanning in increasing frequency. +- * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all +- * lengths instead of fixing only the wrong ones. This idea is taken +- * from 'ar' written by Haruhiko Okumura.) +- */ +- for (bits = max_length; bits != 0; bits--) { +- n = s->bl_count[bits]; +- while (n != 0) { +- m = s->heap[--h]; +- if (m > max_code) continue; +- if ((unsigned) tree[m].Len != (unsigned) bits) { +- Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); +- s->opt_len += ((long)bits - (long)tree[m].Len) +- *(long)tree[m].Freq; +- tree[m].Len = (ush)bits; +- } +- n--; +- } +- } +-} +- +-/* =========================================================================== +- * Generate the codes for a given tree and bit counts (which need not be +- * optimal). +- * IN assertion: the array bl_count contains the bit length statistics for +- * the given tree and the field len is set for all tree elements. +- * OUT assertion: the field code is set for all tree elements of non +- * zero code length. +- */ +-local void gen_codes (ct_data *tree, int max_code, ushf *bl_count) +-#if 0 +- ct_data *tree; /* the tree to decorate */ +- int max_code; /* largest code with non zero frequency */ +- ushf *bl_count; /* number of codes at each bit length */ +-#endif +-{ +- ush next_code[MAX_BITS+1]; /* next code value for each bit length */ +- ush code = 0; /* running code value */ +- int bits; /* bit index */ +- int n; /* code index */ +- +- /* The distribution counts are first used to generate the code values +- * without bit reversal. +- */ +- for (bits = 1; bits <= MAX_BITS; bits++) { +- next_code[bits] = code = (code + bl_count[bits-1]) << 1; +- } +- /* Check that the bit counts in bl_count are consistent. The last code +- * must be all ones. +- */ +- Assert (code + bl_count[MAX_BITS]-1 == (1<dyn_tree; +- const ct_data *stree = desc->stat_desc->static_tree; +- int elems = desc->stat_desc->elems; +- int n, m; /* iterate over heap elements */ +- int max_code = -1; /* largest code with non zero frequency */ +- int node; /* new node being created */ +- +- /* Construct the initial heap, with least frequent element in +- * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. +- * heap[0] is not used. +- */ +- s->heap_len = 0, s->heap_max = HEAP_SIZE; +- +- for (n = 0; n < elems; n++) { +- if (tree[n].Freq != 0) { +- s->heap[++(s->heap_len)] = max_code = n; +- s->depth[n] = 0; +- } else { +- tree[n].Len = 0; +- } +- } +- +- /* The pkzip format requires that at least one distance code exists, +- * and that at least one bit should be sent even if there is only one +- * possible code. So to avoid special checks later on we force at least +- * two codes of non zero frequency. +- */ +- while (s->heap_len < 2) { +- node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); +- tree[node].Freq = 1; +- s->depth[node] = 0; +- s->opt_len--; if (stree) s->static_len -= stree[node].Len; +- /* node is 0 or 1 so it does not have extra bits */ +- } +- desc->max_code = max_code; +- +- /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, +- * establish sub-heaps of increasing lengths: +- */ +- for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); +- +- /* Construct the Huffman tree by repeatedly combining the least two +- * frequent nodes. +- */ +- node = elems; /* next internal node of the tree */ +- do { +- pqremove(s, tree, n); /* n = node of least frequency */ +- m = s->heap[SMALLEST]; /* m = node of next least frequency */ +- +- s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ +- s->heap[--(s->heap_max)] = m; +- +- /* Create a new node father of n and m */ +- tree[node].Freq = tree[n].Freq + tree[m].Freq; +- s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? +- s->depth[n] : s->depth[m]) + 1); +- tree[n].Dad = tree[m].Dad = (ush)node; +-#ifdef DUMP_BL_TREE +- if (tree == s->bl_tree) { +- fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", +- node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); +- } +-#endif +- /* and insert the new node in the heap */ +- s->heap[SMALLEST] = node++; +- pqdownheap(s, tree, SMALLEST); +- +- } while (s->heap_len >= 2); +- +- s->heap[--(s->heap_max)] = s->heap[SMALLEST]; +- +- /* At this point, the fields freq and dad are set. We can now +- * generate the bit lengths. +- */ +- gen_bitlen(s, (tree_desc *)desc); +- +- /* The field len is now set, we can generate the bit codes */ +- gen_codes ((ct_data *)tree, max_code, s->bl_count); +-} +- +-/* =========================================================================== +- * Scan a literal or distance tree to determine the frequencies of the codes +- * in the bit length tree. +- */ +-local void scan_tree (deflate_state *s, ct_data *tree, int max_code) +-#if 0 +- deflate_state *s; +- ct_data *tree; /* the tree to be scanned */ +- int max_code; /* and its largest code of non zero frequency */ +-#endif +-{ +- int n; /* iterates over all tree elements */ +- int prevlen = -1; /* last emitted length */ +- int curlen; /* length of current code */ +- int nextlen = tree[0].Len; /* length of next code */ +- int count = 0; /* repeat count of the current code */ +- int max_count = 7; /* max repeat count */ +- int min_count = 4; /* min repeat count */ +- +- if (nextlen == 0) max_count = 138, min_count = 3; +- tree[max_code+1].Len = (ush)0xffff; /* guard */ +- +- for (n = 0; n <= max_code; n++) { +- curlen = nextlen; nextlen = tree[n+1].Len; +- if (++count < max_count && curlen == nextlen) { +- continue; +- } else if (count < min_count) { +- s->bl_tree[curlen].Freq += count; +- } else if (curlen != 0) { +- if (curlen != prevlen) s->bl_tree[curlen].Freq++; +- s->bl_tree[REP_3_6].Freq++; +- } else if (count <= 10) { +- s->bl_tree[REPZ_3_10].Freq++; +- } else { +- s->bl_tree[REPZ_11_138].Freq++; +- } +- count = 0; prevlen = curlen; +- if (nextlen == 0) { +- max_count = 138, min_count = 3; +- } else if (curlen == nextlen) { +- max_count = 6, min_count = 3; +- } else { +- max_count = 7, min_count = 4; +- } +- } +-} +- +-/* =========================================================================== +- * Send a literal or distance tree in compressed form, using the codes in +- * bl_tree. +- */ +-local void send_tree (deflate_state *s, ct_data *tree, int max_code) +-#if 0 +- deflate_state *s; +- ct_data *tree; /* the tree to be scanned */ +- int max_code; /* and its largest code of non zero frequency */ +-#endif +-{ +- int n; /* iterates over all tree elements */ +- int prevlen = -1; /* last emitted length */ +- int curlen; /* length of current code */ +- int nextlen = tree[0].Len; /* length of next code */ +- int count = 0; /* repeat count of the current code */ +- int max_count = 7; /* max repeat count */ +- int min_count = 4; /* min repeat count */ +- +- /* tree[max_code+1].Len = -1; */ /* guard already set */ +- if (nextlen == 0) max_count = 138, min_count = 3; +- +- for (n = 0; n <= max_code; n++) { +- curlen = nextlen; nextlen = tree[n+1].Len; +- if (++count < max_count && curlen == nextlen) { +- continue; +- } else if (count < min_count) { +- do { send_code(s, curlen, s->bl_tree); } while (--count != 0); +- +- } else if (curlen != 0) { +- if (curlen != prevlen) { +- send_code(s, curlen, s->bl_tree); count--; +- } +- Assert(count >= 3 && count <= 6, " 3_6?"); +- send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2); +- +- } else if (count <= 10) { +- send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3); +- +- } else { +- send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7); +- } +- count = 0; prevlen = curlen; +- if (nextlen == 0) { +- max_count = 138, min_count = 3; +- } else if (curlen == nextlen) { +- max_count = 6, min_count = 3; +- } else { +- max_count = 7, min_count = 4; +- } +- } +-} +- +-/* =========================================================================== +- * Construct the Huffman tree for the bit lengths and return the index in +- * bl_order of the last bit length code to send. +- */ +-local int build_bl_tree(deflate_state *s) +-#if 0 +- deflate_state *s; +-#endif +-{ +- int max_blindex; /* index of last bit length code of non zero freq */ +- +- /* Determine the bit length frequencies for literal and distance trees */ +- scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); +- scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); +- +- /* Build the bit length tree: */ +- build_tree(s, (tree_desc *)(&(s->bl_desc))); +- /* opt_len now includes the length of the tree representations, except +- * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. +- */ +- +- /* Determine the number of bit length codes to send. The pkzip format +- * requires that at least 4 bit length codes be sent. (appnote.txt says +- * 3 but the actual value used is 4.) +- */ +- for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { +- if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; +- } +- /* Update opt_len to include the bit length tree and counts */ +- s->opt_len += 3*(max_blindex+1) + 5+5+4; +- Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", +- s->opt_len, s->static_len)); +- +- return max_blindex; +-} +- +-/* =========================================================================== +- * Send the header for a block using dynamic Huffman trees: the counts, the +- * lengths of the bit length codes, the literal tree and the distance tree. +- * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. +- */ +-local void send_all_trees(deflate_state *s, int lcodes, int dcodes, int blcodes) +-#if 0 +- deflate_state *s; +- int lcodes, dcodes, blcodes; /* number of codes for each tree */ +-#endif +-{ +- int rank; /* index in bl_order */ +- +- Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); +- Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, +- "too many codes"); +- Tracev((stderr, "\nbl counts: ")); +- send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */ +- send_bits(s, dcodes-1, 5); +- send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */ +- for (rank = 0; rank < blcodes; rank++) { +- Tracev((stderr, "\nbl code %2d ", bl_order[rank])); +- send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); +- } +- Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); +- +- send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */ +- Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); +- +- send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */ +- Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); +-} +- +-/* =========================================================================== +- * Send a stored block +- */ +-void _tr_stored_block(deflate_state *s, charf *buf, ulg stored_len, int eof) +-#if 0 +- deflate_state *s; +- charf *buf; /* input block */ +- ulg stored_len; /* length of input block */ +- int eof; /* true if this is the last block for a file */ +-#endif +-{ +- send_bits(s, (STORED_BLOCK<<1)+eof, 3); /* send block type */ +-#ifdef DEBUG +- s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; +- s->compressed_len += (stored_len + 4) << 3; +-#endif +- copy_block(s, buf, (unsigned)stored_len, 1); /* with header */ +-} +- +-/* =========================================================================== +- * Send one empty static block to give enough lookahead for inflate. +- * This takes 10 bits, of which 7 may remain in the bit buffer. +- * The current inflate code requires 9 bits of lookahead. If the +- * last two codes for the previous block (real code plus EOB) were coded +- * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode +- * the last real code. In this case we send two empty static blocks instead +- * of one. (There are no problems if the previous block is stored or fixed.) +- * To simplify the code, we assume the worst case of last real code encoded +- * on one bit only. +- */ +-void _tr_align(deflate_state *s) +-/* deflate_state *s; */ +-{ +- send_bits(s, STATIC_TREES<<1, 3); +- send_code(s, END_BLOCK, static_ltree); +-#ifdef DEBUG +- s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ +-#endif +- bi_flush(s); +- /* Of the 10 bits for the empty block, we have already sent +- * (10 - bi_valid) bits. The lookahead for the last real code (before +- * the EOB of the previous block) was thus at least one plus the length +- * of the EOB plus what we have just sent of the empty static block. +- */ +- if (1 + s->last_eob_len + 10 - s->bi_valid < 9) { +- send_bits(s, STATIC_TREES<<1, 3); +- send_code(s, END_BLOCK, static_ltree); +-#ifdef DEBUG +- s->compressed_len += 10L; +-#endif +- bi_flush(s); +- } +- s->last_eob_len = 7; +-} +- +-/* =========================================================================== +- * Determine the best encoding for the current block: dynamic trees, static +- * trees or store, and output the encoded block to the zip file. +- */ +-void _tr_flush_block(deflate_state *s, charf *buf, ulg stored_len, int eof) +-#if 0 +- deflate_state *s; +- charf *buf; /* input block, or NULL if too old */ +- ulg stored_len; /* length of input block */ +- int eof; /* true if this is the last block for a file */ +-#endif +-{ +- ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ +- int max_blindex = 0; /* index of last bit length code of non zero freq */ +- +- /* Build the Huffman trees unless a stored block is forced */ +- if (s->level > 0) { +- +- /* Check if the file is binary or text */ +- if (stored_len > 0 && s->strm->data_type == Z_UNKNOWN) +- set_data_type(s); +- +- /* Construct the literal and distance trees */ +- build_tree(s, (tree_desc *)(&(s->l_desc))); +- Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, +- s->static_len)); +- +- build_tree(s, (tree_desc *)(&(s->d_desc))); +- Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, +- s->static_len)); +- /* At this point, opt_len and static_len are the total bit lengths of +- * the compressed block data, excluding the tree representations. +- */ +- +- /* Build the bit length tree for the above two trees, and get the index +- * in bl_order of the last bit length code to send. +- */ +- max_blindex = build_bl_tree(s); +- +- /* Determine the best encoding. Compute the block lengths in bytes. */ +- opt_lenb = (s->opt_len+3+7)>>3; +- static_lenb = (s->static_len+3+7)>>3; +- +- Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", +- opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, +- s->last_lit)); +- +- if (static_lenb <= opt_lenb) opt_lenb = static_lenb; +- +- } else { +- Assert(buf != (char*)0, "lost buf"); +- opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ +- } +- +-#ifdef FORCE_STORED +- if (buf != (char*)0) { /* force stored block */ +-#else +- if (stored_len+4 <= opt_lenb && buf != (char*)0) { +- /* 4: two words for the lengths */ +-#endif +- /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. +- * Otherwise we can't have processed more than WSIZE input bytes since +- * the last block flush, because compression would have been +- * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to +- * transform a block into a stored block. +- */ +- _tr_stored_block(s, buf, stored_len, eof); +- +-#ifdef FORCE_STATIC +- } else if (static_lenb >= 0) { /* force static trees */ +-#else +- } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { +-#endif +- send_bits(s, (STATIC_TREES<<1)+eof, 3); +- compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); +-#ifdef DEBUG +- s->compressed_len += 3 + s->static_len; +-#endif +- } else { +- send_bits(s, (DYN_TREES<<1)+eof, 3); +- send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, +- max_blindex+1); +- compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); +-#ifdef DEBUG +- s->compressed_len += 3 + s->opt_len; +-#endif +- } +- Assert (s->compressed_len == s->bits_sent, "bad compressed size"); +- /* The above check is made mod 2^32, for files larger than 512 MB +- * and uLong implemented on 32 bits. +- */ +- init_block(s); +- +- if (eof) { +- bi_windup(s); +-#ifdef DEBUG +- s->compressed_len += 7; /* align on byte boundary */ +-#endif +- } +- Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3, +- s->compressed_len-7*eof)); +-} +- +-/* =========================================================================== +- * Save the match info and tally the frequency counts. Return true if +- * the current block must be flushed. +- */ +-int _tr_tally (deflate_state *s, unsigned dist, unsigned lc) +-#if 0 +- deflate_state *s; +- unsigned dist; /* distance of matched string */ +- unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ +-#endif +-{ +- s->d_buf[s->last_lit] = (ush)dist; +- s->l_buf[s->last_lit++] = (uch)lc; +- if (dist == 0) { +- /* lc is the unmatched char */ +- s->dyn_ltree[lc].Freq++; +- } else { +- s->matches++; +- /* Here, lc is the match length - MIN_MATCH */ +- dist--; /* dist = match distance - 1 */ +- Assert((ush)dist < (ush)MAX_DIST(s) && +- (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && +- (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); +- +- s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++; +- s->dyn_dtree[d_code(dist)].Freq++; +- } +- +-#ifdef TRUNCATE_BLOCK +- /* Try to guess if it is profitable to stop the current block here */ +- if ((s->last_lit & 0x1fff) == 0 && s->level > 2) { +- /* Compute an upper bound for the compressed length */ +- ulg out_length = (ulg)s->last_lit*8L; +- ulg in_length = (ulg)((long)s->strstart - s->block_start); +- int dcode; +- for (dcode = 0; dcode < D_CODES; dcode++) { +- out_length += (ulg)s->dyn_dtree[dcode].Freq * +- (5L+extra_dbits[dcode]); +- } +- out_length >>= 3; +- Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ", +- s->last_lit, in_length, out_length, +- 100L - out_length*100L/in_length)); +- if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1; +- } +-#endif +- return (s->last_lit == s->lit_bufsize-1); +- /* We avoid equality with lit_bufsize because of wraparound at 64K +- * on 16 bit machines and because stored blocks are restricted to +- * 64K-1 bytes. +- */ +-} +- +-/* =========================================================================== +- * Send the block data compressed using the given Huffman trees +- */ +-local void compress_block(deflate_state *s, ct_data *ltree, ct_data *dtree) +-#if 0 +- deflate_state *s; +- ct_data *ltree; /* literal tree */ +- ct_data *dtree; /* distance tree */ +-#endif +-{ +- unsigned dist; /* distance of matched string */ +- int lc; /* match length or unmatched char (if dist == 0) */ +- unsigned lx = 0; /* running index in l_buf */ +- unsigned code; /* the code to send */ +- int extra; /* number of extra bits to send */ +- +- if (s->last_lit != 0) do { +- dist = s->d_buf[lx]; +- lc = s->l_buf[lx++]; +- if (dist == 0) { +- send_code(s, lc, ltree); /* send a literal byte */ +- Tracecv(isgraph(lc), (stderr," '%c' ", lc)); +- } else { +- /* Here, lc is the match length - MIN_MATCH */ +- code = _length_code[lc]; +- send_code(s, code+LITERALS+1, ltree); /* send the length code */ +- extra = extra_lbits[code]; +- if (extra != 0) { +- lc -= base_length[code]; +- send_bits(s, lc, extra); /* send the extra length bits */ +- } +- dist--; /* dist is now the match distance - 1 */ +- code = d_code(dist); +- Assert (code < D_CODES, "bad d_code"); +- +- send_code(s, code, dtree); /* send the distance code */ +- extra = extra_dbits[code]; +- if (extra != 0) { +- dist -= base_dist[code]; +- send_bits(s, dist, extra); /* send the extra distance bits */ +- } +- } /* literal or match pair ? */ +- +- /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */ +- Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx, +- "pendingBuf overflow"); +- +- } while (lx < s->last_lit); +- +- send_code(s, END_BLOCK, ltree); +- s->last_eob_len = ltree[END_BLOCK].Len; +-} +- +-/* =========================================================================== +- * Set the data type to BINARY or TEXT, using a crude approximation: +- * set it to Z_TEXT if all symbols are either printable characters (33 to 255) +- * or white spaces (9 to 13, or 32); or set it to Z_BINARY otherwise. +- * IN assertion: the fields Freq of dyn_ltree are set. +- */ +-local void set_data_type(deflate_state *s) +-/* deflate_state *s; */ +-{ +- int n; +- +- for (n = 0; n < 9; n++) +- if (s->dyn_ltree[n].Freq != 0) +- break; +- if (n == 9) +- for (n = 14; n < 32; n++) +- if (s->dyn_ltree[n].Freq != 0) +- break; +- s->strm->data_type = (n == 32) ? Z_TEXT : Z_BINARY; +-} +- +-/* =========================================================================== +- * Reverse the first len bits of a code, using straightforward code (a faster +- * method would use a table) +- * IN assertion: 1 <= len <= 15 +- */ +-local unsigned bi_reverse(unsigned code, int len) +-#if 0 +- unsigned code; /* the value to invert */ +- int len; /* its bit length */ +-#endif +-{ +- register unsigned res = 0; +- do { +- res |= code & 1; +- code >>= 1, res <<= 1; +- } while (--len > 0); +- return res >> 1; +-} +- +-/* =========================================================================== +- * Flush the bit buffer, keeping at most 7 bits in it. +- */ +-local void bi_flush(deflate_state *s) +-/* deflate_state *s; */ +-{ +- if (s->bi_valid == 16) { +- put_short(s, s->bi_buf); +- s->bi_buf = 0; +- s->bi_valid = 0; +- } else if (s->bi_valid >= 8) { +- put_byte(s, (Byte)s->bi_buf); +- s->bi_buf >>= 8; +- s->bi_valid -= 8; +- } +-} +- +-/* =========================================================================== +- * Flush the bit buffer and align the output on a byte boundary +- */ +-local void bi_windup(deflate_state *s) +-/* deflate_state *s; */ +-{ +- if (s->bi_valid > 8) { +- put_short(s, s->bi_buf); +- } else if (s->bi_valid > 0) { +- put_byte(s, (Byte)s->bi_buf); +- } +- s->bi_buf = 0; +- s->bi_valid = 0; +-#ifdef DEBUG +- s->bits_sent = (s->bits_sent+7) & ~7; +-#endif +-} +- +-/* =========================================================================== +- * Copy a stored block, storing first the length and its +- * one's complement if requested. +- */ +-local void copy_block(deflate_state *s, charf *buf, unsigned len, int header) +-#if 0 +- deflate_state *s; +- charf *buf; /* the input data */ +- unsigned len; /* its length */ +- int header; /* true if block header must be written */ +-#endif +-{ +- bi_windup(s); /* align on byte boundary */ +- s->last_eob_len = 8; /* enough lookahead for inflate */ +- +- if (header) { +- put_short(s, (ush)len); +- put_short(s, (ush)~len); +-#ifdef DEBUG +- s->bits_sent += 2*16; +-#endif +- } +-#ifdef DEBUG +- s->bits_sent += (ulg)len<<3; +-#endif +- while (len--) { +- put_byte(s, *buf++); +- } +-} +diff -ruN seqinr.orig/src/trees.h seqinr/src/trees.h +--- seqinr.orig/src/trees.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/trees.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,128 +0,0 @@ +-/* header created automatically with -DGEN_TREES_H */ +- +-local const ct_data static_ltree[L_CODES+2] = { +-{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, +-{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, +-{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, +-{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, +-{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, +-{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, +-{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, +-{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, +-{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, +-{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, +-{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, +-{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, +-{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, +-{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, +-{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, +-{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, +-{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, +-{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, +-{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, +-{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, +-{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, +-{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, +-{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, +-{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, +-{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, +-{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, +-{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, +-{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, +-{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, +-{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, +-{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, +-{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, +-{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, +-{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, +-{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, +-{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, +-{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, +-{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, +-{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, +-{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, +-{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, +-{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, +-{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, +-{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, +-{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, +-{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, +-{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, +-{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, +-{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, +-{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, +-{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, +-{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, +-{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, +-{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, +-{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, +-{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, +-{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, +-{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} +-}; +- +-local const ct_data static_dtree[D_CODES] = { +-{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, +-{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, +-{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, +-{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, +-{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, +-{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} +-}; +- +-const uch _dist_code[DIST_CODE_LEN] = { +- 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, +- 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, +-10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, +-11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, +-12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, +-13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, +-13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +-14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +-15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, +-18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, +-23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +-28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +-29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 +-}; +- +-const uch _length_code[MAX_MATCH-MIN_MATCH+1]= { +- 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, +-13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, +-17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, +-19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, +-21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, +-22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, +-23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +-25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +-25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +-26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +-27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 +-}; +- +-local const int base_length[LENGTH_CODES] = { +-0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, +-64, 80, 96, 112, 128, 160, 192, 224, 0 +-}; +- +-local const int base_dist[D_CODES] = { +- 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, +- 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, +- 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 +-}; +- +diff -ruN seqinr.orig/src/uncompr.c seqinr/src/uncompr.c +--- seqinr.orig/src/uncompr.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/uncompr.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,63 +0,0 @@ +-/* uncompr.c -- decompress a memory buffer +- * Copyright (C) 1995-2003 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id: uncompr.c,v 1.1.2.1 2007-04-19 09:40:18 penel Exp $ */ +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-/* =========================================================================== +- Decompresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be large enough to hold the +- entire uncompressed data. (The size of the uncompressed data must have +- been saved previously by the compressor and transmitted to the decompressor +- by some mechanism outside the scope of this compression library.) +- Upon exit, destLen is the actual size of the compressed buffer. +- This function can be used to decompress a whole file at once if the +- input file is mmap'ed. +- +- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer, or Z_DATA_ERROR if the input data was corrupted. +-*/ +-int ZEXPORT uncompress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) +-/* +- Bytef *dest; +- uLongf *destLen; +- const Bytef *source; +- uLong sourceLen; +-*/ +-{ +- z_stream stream; +- int err; +- +- stream.next_in = (Bytef*)source; +- stream.avail_in = (uInt)sourceLen; +- /* Check for source > 64K on 16-bit machine: */ +- if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +- +- stream.next_out = dest; +- stream.avail_out = (uInt)*destLen; +- if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; +- +- stream.zalloc = (alloc_func)0; +- stream.zfree = (free_func)0; +- +- err = inflateInit(&stream); +- if (err != Z_OK) return err; +- +- err = inflate(&stream, Z_FINISH); +- if (err != Z_STREAM_END) { +- inflateEnd(&stream); +- if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) +- return Z_DATA_ERROR; +- return err; +- } +- *destLen = stream.total_out; +- +- err = inflateEnd(&stream); +- return err; +-} +diff -ruN seqinr.orig/src/zconf.h seqinr/src/zconf.h +--- seqinr.orig/src/zconf.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/zconf.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,335 +0,0 @@ +-/* zconf.h -- configuration of the zlib compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id: zconf.h,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ +- +-#ifndef ZCONF_H +-#define ZCONF_H +- +-#ifdef HAVE_CONFIG_H +-#include +-#endif +-/* +- * If you *really* need a unique prefix for all types and library functions, +- * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. +- */ +-#ifdef Z_PREFIX +-# define deflateInit_ z_deflateInit_ +-# define deflate z_deflate +-# define deflateEnd z_deflateEnd +-# define inflateInit_ z_inflateInit_ +-# define inflate z_inflate +-# define inflateEnd z_inflateEnd +-# define deflateInit2_ z_deflateInit2_ +-# define deflateSetDictionary z_deflateSetDictionary +-# define deflateCopy z_deflateCopy +-# define deflateReset z_deflateReset +-# define deflateParams z_deflateParams +-# define deflateBound z_deflateBound +-# define deflatePrime z_deflatePrime +-# define inflateInit2_ z_inflateInit2_ +-# define inflateSetDictionary z_inflateSetDictionary +-# define inflateSync z_inflateSync +-# define inflateSyncPoint z_inflateSyncPoint +-# define inflateCopy z_inflateCopy +-# define inflateReset z_inflateReset +-# define inflateBack z_inflateBack +-# define inflateBackEnd z_inflateBackEnd +-# define compress z_compress +-# define compress2 z_compress2 +-# define compressBound z_compressBound +-# define uncompress z_uncompress +-# define adler32 z_adler32 +-# define crc32 z_crc32 +-# define get_crc_table z_get_crc_table +-# define zError z_zError +- +-# define alloc_func z_alloc_func +-# define free_func z_free_func +-# define in_func z_in_func +-# define out_func z_out_func +-# define Byte z_Byte +-# define uInt z_uInt +-# define uLong z_uLong +-# define Bytef z_Bytef +-# define charf z_charf +-# define intf z_intf +-# define uIntf z_uIntf +-# define uLongf z_uLongf +-# define voidpf z_voidpf +-# define voidp z_voidp +-#endif +- +-#if defined(__MSDOS__) && !defined(MSDOS) +-# define MSDOS +-#endif +-#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) +-# define OS2 +-#endif +-#if defined(_WINDOWS) && !defined(WINDOWS) +-# define WINDOWS +-#endif +-#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) +-# ifndef WIN32 +-# define WIN32 +-# endif +-#endif +-#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) +-# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) +-# ifndef SYS16BIT +-# define SYS16BIT +-# endif +-# endif +-#endif +- +-/* +- * Compile with -DMAXSEG_64K if the alloc function cannot allocate more +- * than 64k bytes at a time (needed on systems with 16-bit int). +- */ +-#ifdef SYS16BIT +-# define MAXSEG_64K +-#endif +-#ifdef MSDOS +-# define UNALIGNED_OK +-#endif +- +-#ifdef __STDC_VERSION__ +-# ifndef STDC +-# define STDC +-# endif +-# if __STDC_VERSION__ >= 199901L +-# ifndef STDC99 +-# define STDC99 +-# endif +-# endif +-#endif +-#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) +-# define STDC +-#endif +-#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) +-# define STDC +-#endif +- +-#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ +-# define STDC +-#endif +- +-#ifndef STDC +-# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ +-# define const /* note: need a more gentle solution here */ +-# endif +-#endif +- +-/* Some Mac compilers merge all .h files incorrectly: */ +-#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) +-# define NO_DUMMY_DECL +-#endif +- +-/* Maximum value for memLevel in deflateInit2 */ +-#ifndef MAX_MEM_LEVEL +-# ifdef MAXSEG_64K +-# define MAX_MEM_LEVEL 8 +-# else +-# define MAX_MEM_LEVEL 9 +-# endif +-#endif +- +-/* Maximum value for windowBits in deflateInit2 and inflateInit2. +- * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files +- * created by gzip. (Files created by minigzip can still be extracted by +- * gzip.) +- */ +-#ifndef MAX_WBITS +-# define MAX_WBITS 15 /* 32K LZ77 window */ +-#endif +- +-/* The memory requirements for deflate are (in bytes): +- (1 << (windowBits+2)) + (1 << (memLevel+9)) +- that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) +- plus a few kilobytes for small objects. For example, if you want to reduce +- the default memory requirements from 256K to 128K, compile with +- make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" +- Of course this will generally degrade compression (there's no free lunch). +- +- The memory requirements for inflate are (in bytes) 1 << windowBits +- that is, 32K for windowBits=15 (default value) plus a few kilobytes +- for small objects. +-*/ +- +- /* Type declarations */ +- +-#ifndef OF /* function prototypes */ +-# ifdef STDC +-# define OF(args) args +-# else +-# define OF(args) () +-# endif +-#endif +- +-/* The following definitions for FAR are needed only for MSDOS mixed +- * model programming (small or medium model with some far allocations). +- * This was tested only with MSC; for other MSDOS compilers you may have +- * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, +- * just define FAR to be empty. +- */ +-#ifdef SYS16BIT +-# if defined(M_I86SM) || defined(M_I86MM) +- /* MSC small or medium model */ +-# define SMALL_MEDIUM +-# ifdef _MSC_VER +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-# if (defined(__SMALL__) || defined(__MEDIUM__)) +- /* Turbo C small or medium model */ +-# define SMALL_MEDIUM +-# ifdef __BORLANDC__ +-# define FAR _far +-# else +-# define FAR far +-# endif +-# endif +-#endif +- +-#if defined(WINDOWS) || defined(WIN32) +- /* If building or using zlib as a DLL, define ZLIB_DLL. +- * This is not mandatory, but it offers a little performance increase. +- */ +-# ifdef ZLIB_DLL +-# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) +-# ifdef ZLIB_INTERNAL +-# define ZEXTERN extern __declspec(dllexport) +-# else +-# define ZEXTERN extern __declspec(dllimport) +-# endif +-# endif +-# endif /* ZLIB_DLL */ +- /* If building or using zlib with the WINAPI/WINAPIV calling convention, +- * define ZLIB_WINAPI. +- * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. +- */ +-# ifdef ZLIB_WINAPI +-# ifdef FAR +-# undef FAR +-# endif +-# include +- /* No need for _export, use ZLIB.DEF instead. */ +- /* For complete Windows compatibility, use WINAPI, not __stdcall. */ +-# define ZEXPORT WINAPI +-# ifdef WIN32 +-# define ZEXPORTVA WINAPIV +-# else +-# define ZEXPORTVA FAR CDECL +-# endif +-# endif +-#endif +- +-#if defined (__BEOS__) +-# ifdef ZLIB_DLL +-# ifdef ZLIB_INTERNAL +-# define ZEXPORT __declspec(dllexport) +-# define ZEXPORTVA __declspec(dllexport) +-# else +-# define ZEXPORT __declspec(dllimport) +-# define ZEXPORTVA __declspec(dllimport) +-# endif +-# endif +-#endif +- +-#ifndef ZEXTERN +-# define ZEXTERN extern +-#endif +-#ifndef ZEXPORT +-# define ZEXPORT +-#endif +-#ifndef ZEXPORTVA +-# define ZEXPORTVA +-#endif +- +-#ifndef FAR +-# define FAR +-#endif +- +-#if !defined(__MACTYPES__) +-typedef unsigned char Byte; /* 8 bits */ +-#endif +-typedef unsigned int uInt; /* 16 bits or more */ +-typedef unsigned long uLong; /* 32 bits or more */ +- +-#ifdef SMALL_MEDIUM +- /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ +-# define Bytef Byte FAR +-#else +- typedef Byte FAR Bytef; +-#endif +-typedef char FAR charf; +-typedef int FAR intf; +-typedef uInt FAR uIntf; +-typedef uLong FAR uLongf; +- +-#ifdef STDC +- typedef void const *voidpc; +- typedef void FAR *voidpf; +- typedef void *voidp; +-#else +- typedef Byte const *voidpc; +- typedef Byte FAR *voidpf; +- typedef Byte *voidp; +-#endif +- +-#ifdef HAVE_UNISTD_H /* HAVE_UNISTD_H -- this line is updated by ./configure */ +-# include /* for off_t */ +-# include /* for SEEK_* and off_t */ +-# ifdef VMS +-# include /* for off_t */ +-# endif +-# define z_off_t off_t +-#endif +-#ifndef SEEK_SET +-# define SEEK_SET 0 /* Seek from beginning of file. */ +-# define SEEK_CUR 1 /* Seek from current position. */ +-# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ +-#endif +-#ifndef z_off_t +-# define z_off_t long +-#endif +- +-#if defined(__OS400__) +-# define NO_vsnprintf +-#endif +- +-#if defined(__MVS__) +-# define NO_vsnprintf +-# ifdef FAR +-# undef FAR +-# endif +-#endif +- +-/* MVS linker does not support external names larger than 8 bytes */ +-#if defined(__MVS__) +-# pragma map(deflateInit_,"DEIN") +-# pragma map(deflateInit2_,"DEIN2") +-# pragma map(deflateEnd,"DEEND") +-# pragma map(deflateBound,"DEBND") +-# pragma map(inflateInit_,"ININ") +-# pragma map(inflateInit2_,"ININ2") +-# pragma map(inflateEnd,"INEND") +-# pragma map(inflateSync,"INSY") +-# pragma map(inflateSetDictionary,"INSEDI") +-# pragma map(compressBound,"CMBND") +-# pragma map(inflate_table,"INTABL") +-# pragma map(inflate_fast,"INFA") +-# pragma map(inflate_copyright,"INCOPY") +-#endif +- +-#endif /* ZCONF_H */ +diff -ruN seqinr.orig/src/zlib.h seqinr/src/zlib.h +--- seqinr.orig/src/zlib.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/zlib.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,1357 +0,0 @@ +-/* zlib.h -- interface of the 'zlib' general purpose compression library +- version 1.2.3, July 18th, 2005 +- +- Copyright (C) 1995-2005 Jean-loup Gailly and Mark Adler +- +- This software is provided 'as-is', without any express or implied +- warranty. In no event will the authors be held liable for any damages +- arising from the use of this software. +- +- Permission is granted to anyone to use this software for any purpose, +- including commercial applications, and to alter it and redistribute it +- freely, subject to the following restrictions: +- +- 1. The origin of this software must not be misrepresented; you must not +- claim that you wrote the original software. If you use this software +- in a product, an acknowledgment in the product documentation would be +- appreciated but is not required. +- 2. Altered source versions must be plainly marked as such, and must not be +- misrepresented as being the original software. +- 3. This notice may not be removed or altered from any source distribution. +- +- Jean-loup Gailly Mark Adler +- jloup@gzip.org madler@alumni.caltech.edu +- +- +- The data format used by the zlib library is described by RFCs (Request for +- Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt +- (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). +-*/ +- +-#ifndef ZLIB_H +-#define ZLIB_H +- +-#include "zconf.h" +- +-#ifdef __cplusplus +-extern "C" { +-#endif +- +-#define ZLIB_VERSION "1.2.3" +-#define ZLIB_VERNUM 0x1230 +- +-/* +- The 'zlib' compression library provides in-memory compression and +- decompression functions, including integrity checks of the uncompressed +- data. This version of the library supports only one compression method +- (deflation) but other algorithms will be added later and will have the same +- stream interface. +- +- Compression can be done in a single step if the buffers are large +- enough (for example if an input file is mmap'ed), or can be done by +- repeated calls of the compression function. In the latter case, the +- application must provide more input and/or consume the output +- (providing more output space) before each call. +- +- The compressed data format used by default by the in-memory functions is +- the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped +- around a deflate stream, which is itself documented in RFC 1951. +- +- The library also supports reading and writing files in gzip (.gz) format +- with an interface similar to that of stdio using the functions that start +- with "gz". The gzip format is different from the zlib format. gzip is a +- gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. +- +- This library can optionally read and write gzip streams in memory as well. +- +- The zlib format was designed to be compact and fast for use in memory +- and on communications channels. The gzip format was designed for single- +- file compression on file systems, has a larger header than zlib to maintain +- directory information, and uses a different, slower check method than zlib. +- +- The library does not install any signal handler. The decoder checks +- the consistency of the compressed data, so the library should never +- crash even in case of corrupted input. +-*/ +- +-typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); +-typedef void (*free_func) OF((voidpf opaque, voidpf address)); +- +-struct internal_state; +- +-typedef struct z_stream_s { +- Bytef *next_in; /* next input byte */ +- uInt avail_in; /* number of bytes available at next_in */ +- uLong total_in; /* total nb of input bytes read so far */ +- +- Bytef *next_out; /* next output byte should be put there */ +- uInt avail_out; /* remaining free space at next_out */ +- uLong total_out; /* total nb of bytes output so far */ +- +- char *msg; /* last error message, NULL if no error */ +- struct internal_state FAR *state; /* not visible by applications */ +- +- alloc_func zalloc; /* used to allocate the internal state */ +- free_func zfree; /* used to free the internal state */ +- voidpf opaque; /* private data object passed to zalloc and zfree */ +- +- int data_type; /* best guess about the data type: binary or text */ +- uLong adler; /* adler32 value of the uncompressed data */ +- uLong reserved; /* reserved for future use */ +-} z_stream; +- +-typedef z_stream FAR *z_streamp; +- +-/* +- gzip header information passed to and from zlib routines. See RFC 1952 +- for more details on the meanings of these fields. +-*/ +-typedef struct gz_header_s { +- int text; /* true if compressed data believed to be text */ +- uLong time; /* modification time */ +- int xflags; /* extra flags (not used when writing a gzip file) */ +- int os; /* operating system */ +- Bytef *extra; /* pointer to extra field or Z_NULL if none */ +- uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ +- uInt extra_max; /* space at extra (only when reading header) */ +- Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ +- uInt name_max; /* space at name (only when reading header) */ +- Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ +- uInt comm_max; /* space at comment (only when reading header) */ +- int hcrc; /* true if there was or will be a header crc */ +- int done; /* true when done reading gzip header (not used +- when writing a gzip file) */ +-} gz_header; +- +-typedef gz_header FAR *gz_headerp; +- +-/* +- 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 +- has dropped to zero. The application must initialize zalloc, zfree and +- opaque before calling the init function. All other fields are set by the +- compression library and must not be updated by the application. +- +- The opaque value provided by the application will be passed as the first +- parameter for calls of zalloc and zfree. This can be useful for custom +- memory management. The compression library attaches no meaning to the +- opaque value. +- +- zalloc must return Z_NULL if there is not enough memory for the object. +- If zlib is used in a multi-threaded application, zalloc and zfree must be +- thread safe. +- +- On 16-bit systems, the functions zalloc and zfree must be able to allocate +- exactly 65536 bytes, but will not be required to allocate more than this +- if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, +- pointers returned by zalloc for objects of exactly 65536 bytes *must* +- have their offset normalized to zero. The default allocation function +- provided by this library ensures this (see zutil.c). To reduce memory +- requirements and avoid any allocation of 64K objects, at the expense of +- compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). +- +- The fields total_in and total_out can be used for statistics or +- progress reports. After compression, total_in holds the total size of +- the uncompressed data and may be saved for use in the decompressor +- (particularly if the decompressor wants to decompress everything in +- a single step). +-*/ +- +- /* constants */ +- +-#define Z_NO_FLUSH 0 +-#define Z_PARTIAL_FLUSH 1 /* will be removed, use Z_SYNC_FLUSH instead */ +-#define Z_SYNC_FLUSH 2 +-#define Z_FULL_FLUSH 3 +-#define Z_FINISH 4 +-#define Z_BLOCK 5 +-/* Allowed flush values; see deflate() and inflate() below for details */ +- +-#define Z_OK 0 +-#define Z_STREAM_END 1 +-#define Z_NEED_DICT 2 +-#define Z_ERRNO (-1) +-#define Z_STREAM_ERROR (-2) +-#define Z_DATA_ERROR (-3) +-#define Z_MEM_ERROR (-4) +-#define Z_BUF_ERROR (-5) +-#define Z_VERSION_ERROR (-6) +-/* Return codes for the compression/decompression functions. Negative +- * values are errors, positive values are used for special but normal events. +- */ +- +-#define Z_NO_COMPRESSION 0 +-#define Z_BEST_SPEED 1 +-#define Z_BEST_COMPRESSION 9 +-#define Z_DEFAULT_COMPRESSION (-1) +-/* compression levels */ +- +-#define Z_FILTERED 1 +-#define Z_HUFFMAN_ONLY 2 +-#define Z_RLE 3 +-#define Z_FIXED 4 +-#define Z_DEFAULT_STRATEGY 0 +-/* compression strategy; see deflateInit2() below for details */ +- +-#define Z_BINARY 0 +-#define Z_TEXT 1 +-#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ +-#define Z_UNKNOWN 2 +-/* Possible values of the data_type field (though see inflate()) */ +- +-#define Z_DEFLATED 8 +-/* The deflate compression method (the only one supported in this version) */ +- +-#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ +- +-#define zlib_version zlibVersion() +-/* for compatibility with versions < 1.0.2 */ +- +- /* basic functions */ +- +-ZEXTERN const char * ZEXPORT zlibVersion OF((void)); +-/* The application can compare zlibVersion and ZLIB_VERSION for consistency. +- If the first character differs, the library code actually used is +- not compatible with the zlib.h header file used by the application. +- This check is automatically made by deflateInit and inflateInit. +- */ +- +-/* +-ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); +- +- Initializes the internal stream state for compression. The fields +- zalloc, zfree and opaque must be initialized before by the caller. +- If zalloc and zfree are set to Z_NULL, deflateInit updates them to +- use default allocation functions. +- +- The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: +- 1 gives best speed, 9 gives best compression, 0 gives no compression at +- all (the input data is simply copied a block at a time). +- Z_DEFAULT_COMPRESSION requests a default compromise between speed and +- compression (currently equivalent to level 6). +- +- deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if level is not a valid compression level, +- Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible +- with the version assumed by the caller (ZLIB_VERSION). +- msg is set to null if there is no error message. deflateInit does not +- perform any compression: this will be done by deflate(). +-*/ +- +- +-ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); +-/* +- deflate compresses as much data as possible, and stops when the input +- buffer becomes empty or the output buffer becomes full. It may introduce some +- output latency (reading input without producing any output) except when +- forced to flush. +- +- The detailed semantics are as follows. deflate performs one or both of the +- following actions: +- +- - Compress more input starting at next_in and update next_in and avail_in +- accordingly. If not all input can be processed (because there is not +- enough room in the output buffer), next_in and avail_in are updated and +- processing will resume at this point for the next call of deflate(). +- +- - Provide more output starting at next_out and update next_out and avail_out +- accordingly. This action is forced if the parameter flush is non zero. +- Forcing flush frequently degrades the compression ratio, so this parameter +- should be set only when necessary (in interactive applications). +- Some output may be provided even if flush is not set. +- +- Before the call of deflate(), the application should ensure that at least +- one of the actions is possible, by providing more input and/or consuming +- more output, and updating avail_in or avail_out accordingly; avail_out +- should never be zero before the call. The application can consume the +- compressed output when it wants, for example when the output buffer is full +- (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK +- and with zero avail_out, it must be called again after making room in the +- output buffer because there might be more output pending. +- +- Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to +- decide how much data to accumualte before producing output, in order to +- maximize compression. +- +- If the parameter flush is set to Z_SYNC_FLUSH, all pending output is +- flushed to the output buffer and the output is aligned on a byte boundary, so +- that the decompressor can get all input data available so far. (In particular +- avail_in is zero after the call if enough output space has been provided +- before the call.) Flushing may degrade compression for some compression +- algorithms and so it should be used only when necessary. +- +- If flush is set to Z_FULL_FLUSH, all output is flushed as with +- Z_SYNC_FLUSH, and the compression state is reset so that decompression can +- restart from this point if previous compressed data has been damaged or if +- random access is desired. Using Z_FULL_FLUSH too often can seriously degrade +- compression. +- +- If deflate returns with avail_out == 0, this function must be called again +- with the same value of the flush parameter and more output space (updated +- avail_out), until the flush is complete (deflate returns with non-zero +- avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that +- avail_out is greater than six to avoid repeated flush markers due to +- avail_out == 0 on return. +- +- If the parameter flush is set to Z_FINISH, pending input is processed, +- pending output is flushed and deflate returns with Z_STREAM_END if there +- was enough output space; if deflate returns with Z_OK, this function must be +- called again with Z_FINISH and more output space (updated avail_out) but no +- more input data, until it returns with Z_STREAM_END or an error. After +- deflate has returned Z_STREAM_END, the only possible operations on the +- stream are deflateReset or deflateEnd. +- +- Z_FINISH can be used immediately after deflateInit if all the compression +- is to be done in a single step. In this case, avail_out must be at least +- the value returned by deflateBound (see below). If deflate does not return +- Z_STREAM_END, then it must be called again as described above. +- +- deflate() sets strm->adler to the adler32 checksum of all input read +- so far (that is, total_in bytes). +- +- deflate() may update strm->data_type if it can make a good guess about +- the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered +- binary. This field is only for information purposes and does not affect +- the compression algorithm in any manner. +- +- deflate() returns Z_OK if some progress has been made (more input +- processed or more output produced), Z_STREAM_END if all input has been +- consumed and all output has been produced (only when flush is set to +- Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example +- if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible +- (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not +- fatal, and deflate() can be called again with more input and more output +- space to continue compressing. +-*/ +- +- +-ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); +-/* +- All dynamically allocated data structures for this stream are freed. +- This function discards any unprocessed input and does not flush any +- pending output. +- +- deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the +- stream state was inconsistent, Z_DATA_ERROR if the stream was freed +- prematurely (some input or output was discarded). In the error case, +- msg may be set but then points to a static string (which must not be +- deallocated). +-*/ +- +- +-/* +-ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); +- +- Initializes the internal stream state for decompression. The fields +- next_in, avail_in, zalloc, zfree and opaque must be initialized before by +- the caller. If next_in is not Z_NULL and avail_in is large enough (the exact +- value depends on the compression method), inflateInit determines the +- compression method from the zlib header and allocates all data structures +- accordingly; otherwise the allocation will be deferred to the first call of +- inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to +- use default allocation functions. +- +- inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_VERSION_ERROR if the zlib library version is incompatible with the +- version assumed by the caller. msg is set to null if there is no error +- message. inflateInit does not perform any decompression apart from reading +- the zlib header if present: this will be done by inflate(). (So next_in and +- avail_in may be modified, but next_out and avail_out are unchanged.) +-*/ +- +- +-ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); +-/* +- inflate decompresses as much data as possible, and stops when the input +- buffer becomes empty or the output buffer becomes full. It may introduce +- some output latency (reading input without producing any output) except when +- forced to flush. +- +- The detailed semantics are as follows. inflate performs one or both of the +- following actions: +- +- - Decompress more input starting at next_in and update next_in and avail_in +- accordingly. If not all input can be processed (because there is not +- enough room in the output buffer), next_in is updated and processing +- will resume at this point for the next call of inflate(). +- +- - Provide more output starting at next_out and update next_out and avail_out +- accordingly. inflate() provides as much output as possible, until there +- is no more input data or no more space in the output buffer (see below +- about the flush parameter). +- +- Before the call of inflate(), the application should ensure that at least +- one of the actions is possible, by providing more input and/or consuming +- more output, and updating the next_* and avail_* values accordingly. +- The application can consume the uncompressed output when it wants, for +- example when the output buffer is full (avail_out == 0), or after each +- call of inflate(). If inflate returns Z_OK and with zero avail_out, it +- must be called again after making room in the output buffer because there +- might be more output pending. +- +- The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, +- Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much +- output as possible to the output buffer. Z_BLOCK requests that inflate() stop +- if and when it gets to the next deflate block boundary. When decoding the +- zlib or gzip format, this will cause inflate() to return immediately after +- the header and before the first block. When doing a raw inflate, inflate() +- will go ahead and process the first block, and will return when it gets to +- the end of that block, or when it runs out of data. +- +- The Z_BLOCK option assists in appending to or combining deflate streams. +- Also to assist in this, on return inflate() will set strm->data_type to the +- number of unused bits in the last byte taken from strm->next_in, plus 64 +- if inflate() is currently decoding the last block in the deflate stream, +- plus 128 if inflate() returned immediately after decoding an end-of-block +- code or decoding the complete header up to just before the first byte of the +- deflate stream. The end-of-block will not be indicated until all of the +- uncompressed data from that block has been written to strm->next_out. The +- number of unused bits may in general be greater than seven, except when +- bit 7 of data_type is set, in which case the number of unused bits will be +- less than eight. +- +- inflate() should normally be called until it returns Z_STREAM_END or an +- error. However if all decompression is to be performed in a single step +- (a single call of inflate), the parameter flush should be set to +- Z_FINISH. In this case all pending input is processed and all pending +- output is flushed; avail_out must be large enough to hold all the +- uncompressed data. (The size of the uncompressed data may have been saved +- by the compressor for this purpose.) The next operation on this stream must +- be inflateEnd to deallocate the decompression state. The use of Z_FINISH +- is never required, but can be used to inform inflate that a faster approach +- may be used for the single inflate() call. +- +- In this implementation, inflate() always flushes as much output as +- possible to the output buffer, and always uses the faster approach on the +- first call. So the only effect of the flush parameter in this implementation +- is on the return value of inflate(), as noted below, or when it returns early +- because Z_BLOCK is used. +- +- If a preset dictionary is needed after this call (see inflateSetDictionary +- below), inflate sets strm->adler to the adler32 checksum of the 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() checks that its computed adler32 +- checksum is equal to that saved by the compressor and returns Z_STREAM_END +- only if the checksum is correct. +- +- inflate() will decompress and check either zlib-wrapped or gzip-wrapped +- deflate data. The header type is detected automatically. Any information +- contained in the gzip header is not retained, so applications that need that +- information should instead use raw inflate, see inflateInit2() below, or +- inflateBack() and perform their own processing of the gzip header and +- trailer. +- +- inflate() returns Z_OK if some progress has been made (more input processed +- or more output produced), Z_STREAM_END if the end of the compressed data has +- been reached and all uncompressed output has been produced, Z_NEED_DICT if a +- preset dictionary is needed at this point, Z_DATA_ERROR if the input data was +- corrupted (input stream not conforming to the zlib format or incorrect check +- value), Z_STREAM_ERROR if the stream structure was inconsistent (for example +- if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, +- Z_BUF_ERROR if no progress is possible or if there was not enough room in the +- output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and +- inflate() can be called again with more input and more output space to +- continue decompressing. If Z_DATA_ERROR is returned, the application may then +- call inflateSync() to look for a good compression block if a partial recovery +- of the data is desired. +-*/ +- +- +-ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); +-/* +- All dynamically allocated data structures for this stream are freed. +- This function discards any unprocessed input and does not flush any +- pending output. +- +- inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state +- was inconsistent. In the error case, msg may be set but then points to a +- static string (which must not be deallocated). +-*/ +- +- /* Advanced functions */ +- +-/* +- The following functions are needed only in some special applications. +-*/ +- +-/* +-ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, +- int level, +- int method, +- int windowBits, +- int memLevel, +- int strategy)); +- +- This is another version of deflateInit with more compression options. The +- fields next_in, zalloc, zfree and opaque must be initialized before by +- the caller. +- +- The method parameter is the compression method. It must be Z_DEFLATED in +- this version of the library. +- +- The windowBits parameter is the base two logarithm of the window size +- (the size of the history buffer). It should be in the range 8..15 for this +- version of the library. Larger values of this parameter result in better +- compression at the expense of memory usage. The default value is 15 if +- deflateInit is used instead. +- +- windowBits can also be -8..-15 for raw deflate. In this case, -windowBits +- determines the window size. deflate() will then generate raw deflate data +- with no zlib header or trailer, and will not compute an adler32 check value. +- +- windowBits can also be greater than 15 for optional gzip encoding. Add +- 16 to windowBits to write a simple gzip header and trailer around the +- compressed data instead of a zlib wrapper. The gzip header will have no +- file name, no extra data, no comment, no modification time (set to zero), +- no header crc, and the operating system will be set to 255 (unknown). If a +- gzip stream is being written, strm->adler is a crc32 instead of an adler32. +- +- The memLevel parameter specifies how much memory should be allocated +- for the internal compression state. memLevel=1 uses minimum memory but +- is slow and reduces compression ratio; memLevel=9 uses maximum memory +- for optimal speed. The default value is 8. See zconf.h for total memory +- usage as a function of windowBits and memLevel. +- +- The strategy parameter is used to tune the compression algorithm. Use the +- value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a +- filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no +- string match), or Z_RLE to limit match distances to one (run-length +- encoding). Filtered data consists mostly of small values with a somewhat +- random distribution. In this case, the compression algorithm is tuned to +- compress them better. The effect of Z_FILTERED is to force more Huffman +- coding and less string matching; it is somewhat intermediate between +- Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as +- Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy +- parameter only affects the compression ratio but not the correctness of the +- compressed output even if it is not set appropriately. Z_FIXED prevents the +- use of dynamic Huffman codes, allowing for a simpler decoder for special +- applications. +- +- deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid +- method). msg is set to null if there is no error message. deflateInit2 does +- not perform any compression: this will be done by deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, +- const Bytef *dictionary, +- uInt dictLength)); +-/* +- Initializes the compression dictionary from the given byte sequence +- without producing any compressed output. This function must be called +- immediately after deflateInit, deflateInit2 or deflateReset, before any +- call of deflate. The compressor and decompressor must use exactly the same +- dictionary (see inflateSetDictionary). +- +- The dictionary should consist of strings (byte sequences) that are likely +- to be encountered later in the data to be compressed, with the most commonly +- used strings preferably put towards the end of the dictionary. Using a +- dictionary is most useful when the data to be compressed is short and can be +- predicted with good accuracy; the data can then be compressed better than +- with the default empty dictionary. +- +- Depending on the size of the compression data structures selected by +- deflateInit or deflateInit2, a part of the dictionary may in effect be +- discarded, for example if the dictionary is larger than the window size in +- deflate or deflate2. Thus the strings most likely to be useful should be +- put at the end of the dictionary, not at the front. In addition, the +- current implementation of deflate will use at most the window size minus +- 262 bytes of the provided dictionary. +- +- Upon return of this function, strm->adler is set to the adler32 value +- of the dictionary; the decompressor may later use this value to determine +- which dictionary has been used by the compressor. (The adler32 value +- applies to the whole dictionary even if only a subset of the dictionary is +- actually used by the compressor.) If a raw deflate was requested, then the +- adler32 value is not computed and strm->adler is not set. +- +- deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a +- parameter is invalid (such as NULL dictionary) or the stream state is +- inconsistent (for example if deflate has already been called for this stream +- or if the compression method is bsort). deflateSetDictionary does not +- perform any compression: this will be done by deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, +- z_streamp source)); +-/* +- Sets the destination stream as a complete copy of the source stream. +- +- This function can be useful when several compression strategies will be +- tried, for example when there are several ways of pre-processing the input +- data with a filter. The streams that will be discarded should then be freed +- by calling deflateEnd. Note that deflateCopy duplicates the internal +- compression state which can be quite large, so this strategy is slow and +- can consume lots of memory. +- +- deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent +- (such as zalloc being NULL). msg is left unchanged in both source and +- destination. +-*/ +- +-ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); +-/* +- This function is equivalent to deflateEnd followed by deflateInit, +- but does not free and reallocate all the internal compression state. +- The stream will keep the same compression level and any other attributes +- that may have been set by deflateInit2. +- +- deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent (such as zalloc or state being NULL). +-*/ +- +-ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, +- int level, +- int strategy)); +-/* +- Dynamically update the compression level and compression strategy. The +- interpretation of level and strategy is as in deflateInit2. This can be +- used to switch between compression and straight copy of the input data, or +- to switch to a different kind of input data requiring a different +- strategy. If the compression level is changed, the input available so far +- is compressed with the old level (and may be flushed); the new level will +- take effect only at the next call of deflate(). +- +- Before the call of deflateParams, the stream state must be set as for +- a call of deflate(), since the currently available input may have to +- be compressed and flushed. In particular, strm->avail_out must be non-zero. +- +- deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source +- stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR +- if strm->avail_out was zero. +-*/ +- +-ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, +- int good_length, +- int max_lazy, +- int nice_length, +- int max_chain)); +-/* +- Fine tune deflate's internal compression parameters. This should only be +- used by someone who understands the algorithm used by zlib's deflate for +- searching for the best matching string, and even then only by the most +- fanatic optimizer trying to squeeze out the last compressed bit for their +- specific input data. Read the deflate.c source code for the meaning of the +- max_lazy, good_length, nice_length, and max_chain parameters. +- +- deflateTune() can be called after deflateInit() or deflateInit2(), and +- returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. +- */ +- +-ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, +- uLong sourceLen)); +-/* +- deflateBound() returns an upper bound on the compressed size after +- deflation of sourceLen bytes. It must be called after deflateInit() +- or deflateInit2(). This would be used to allocate an output buffer +- for deflation in a single pass, and so would be called before deflate(). +-*/ +- +-ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, +- int bits, +- int value)); +-/* +- deflatePrime() inserts bits in the deflate output stream. The intent +- is that this function is used to start off the deflate output with the +- bits leftover from a previous deflate stream when appending to it. As such, +- this function can only be used for raw deflate, and must be used before the +- first deflate() call after a deflateInit2() or deflateReset(). bits must be +- less than or equal to 16, and that many of the least significant bits of +- value will be inserted in the output. +- +- deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, +- gz_headerp head)); +-/* +- deflateSetHeader() provides gzip header information for when a gzip +- stream is requested by deflateInit2(). deflateSetHeader() may be called +- after deflateInit2() or deflateReset() and before the first call of +- deflate(). The text, time, os, extra field, name, and comment information +- in the provided gz_header structure are written to the gzip header (xflag is +- ignored -- the extra flags are set according to the compression level). The +- caller must assure that, if not Z_NULL, name and comment are terminated with +- a zero byte, and that if extra is not Z_NULL, that extra_len bytes are +- available there. If hcrc is true, a gzip header crc is included. Note that +- the current versions of the command-line version of gzip (up through version +- 1.3.x) do not support header crc's, and will report that it is a "multi-part +- gzip file" and give up. +- +- If deflateSetHeader is not used, the default gzip header has text false, +- the time set to zero, and os set to 255, with no extra, name, or comment +- fields. The gzip header is returned to the default state by deflateReset(). +- +- deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-/* +-ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, +- int windowBits)); +- +- This is another version of inflateInit with an extra parameter. The +- fields next_in, avail_in, zalloc, zfree and opaque must be initialized +- before by the caller. +- +- The windowBits parameter is the base two logarithm of the maximum window +- size (the size of the history buffer). It should be in the range 8..15 for +- this version of the library. The default value is 15 if inflateInit is used +- instead. windowBits must be greater than or equal to the windowBits value +- provided to deflateInit2() while compressing, or it must be equal to 15 if +- deflateInit2() was not used. If a compressed stream with a larger window +- size is given as input, inflate() will return with the error code +- Z_DATA_ERROR instead of trying to allocate a larger window. +- +- windowBits can also be -8..-15 for raw inflate. In this case, -windowBits +- determines the window size. inflate() will then process raw deflate data, +- not looking for a zlib or gzip header, not generating a check value, and not +- looking for any check values for comparison at the end of the stream. This +- is for use with other formats that use the deflate compressed data format +- such as zip. Those formats provide their own check values. If a custom +- format is developed using the raw deflate format for compressed data, it is +- recommended that a check value such as an adler32 or a crc32 be applied to +- the uncompressed data as is done in the zlib, gzip, and zip formats. For +- most applications, the zlib format should be used as is. Note that comments +- above on the use in deflateInit2() applies to the magnitude of windowBits. +- +- windowBits can also be greater than 15 for optional gzip decoding. Add +- 32 to windowBits to enable zlib and gzip decoding with automatic header +- detection, or add 16 to decode only the gzip format (the zlib format will +- return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is +- a crc32 instead of an adler32. +- +- inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). msg +- is set to null if there is no error message. inflateInit2 does not perform +- any decompression apart from reading the zlib header if present: this will +- be done by inflate(). (So next_in and avail_in may be modified, but next_out +- and avail_out are unchanged.) +-*/ +- +-ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, +- const Bytef *dictionary, +- uInt dictLength)); +-/* +- Initializes the decompression dictionary from the given uncompressed byte +- sequence. This function must be called immediately after a call of inflate, +- if that call returned Z_NEED_DICT. The dictionary chosen by the compressor +- can be determined from the adler32 value returned by that call of inflate. +- The compressor and decompressor must use exactly the same dictionary (see +- deflateSetDictionary). For raw inflate, this function can be called +- immediately after inflateInit2() or inflateReset() and before any call of +- inflate() to set the dictionary. The application must insure that the +- dictionary that was used for compression is provided. +- +- inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a +- parameter is invalid (such as NULL dictionary) or the stream state is +- inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the +- expected one (incorrect adler32 value). inflateSetDictionary does not +- perform any decompression: this will be done by subsequent calls of +- inflate(). +-*/ +- +-ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); +-/* +- Skips invalid compressed data until a full flush point (see above the +- description of deflate with Z_FULL_FLUSH) can be found, or until all +- available input is skipped. No output is provided. +- +- inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR +- if no more input was provided, Z_DATA_ERROR if no flush point has been found, +- or Z_STREAM_ERROR if the stream structure was inconsistent. In the success +- case, the application may save the current current value of total_in which +- indicates where valid compressed data was found. In the error case, the +- application may repeatedly call inflateSync, providing more input each time, +- until success or end of the input data. +-*/ +- +-ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, +- z_streamp source)); +-/* +- Sets the destination stream as a complete copy of the source stream. +- +- This function can be useful when randomly accessing a large stream. The +- first pass through the stream can periodically record the inflate state, +- allowing restarting inflate at those points when randomly accessing the +- stream. +- +- inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_STREAM_ERROR if the source stream state was inconsistent +- (such as zalloc being NULL). msg is left unchanged in both source and +- destination. +-*/ +- +-ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); +-/* +- This function is equivalent to inflateEnd followed by inflateInit, +- but does not free and reallocate all the internal decompression state. +- The stream will keep attributes that may have been set by inflateInit2. +- +- inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent (such as zalloc or state being NULL). +-*/ +- +-ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, +- int bits, +- int value)); +-/* +- This function inserts bits in the inflate input stream. The intent is +- that this function is used to start inflating at a bit position in the +- middle of a byte. The provided bits will be used before any bytes are used +- from next_in. This function should only be used with raw inflate, and +- should be used before the first inflate() call after inflateInit2() or +- inflateReset(). bits must be less than or equal to 16, and that many of the +- least significant bits of value will be inserted in the input. +- +- inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, +- gz_headerp head)); +-/* +- inflateGetHeader() requests that gzip header information be stored in the +- provided gz_header structure. inflateGetHeader() may be called after +- inflateInit2() or inflateReset(), and before the first call of inflate(). +- As inflate() processes the gzip stream, head->done is zero until the header +- is completed, at which time head->done is set to one. If a zlib stream is +- being decoded, then head->done is set to -1 to indicate that there will be +- no gzip header information forthcoming. Note that Z_BLOCK can be used to +- force inflate() to return immediately after header processing is complete +- and before any actual data is decompressed. +- +- The text, time, xflags, and os fields are filled in with the gzip header +- contents. hcrc is set to true if there is a header CRC. (The header CRC +- was valid if done is set to one.) If extra is not Z_NULL, then extra_max +- contains the maximum number of bytes to write to extra. Once done is true, +- extra_len contains the actual extra field length, and extra contains the +- extra field, or that field truncated if extra_max is less than extra_len. +- If name is not Z_NULL, then up to name_max characters are written there, +- terminated with a zero unless the length is greater than name_max. If +- comment is not Z_NULL, then up to comm_max characters are written there, +- terminated with a zero unless the length is greater than comm_max. When +- any of extra, name, or comment are not Z_NULL and the respective field is +- not present in the header, then that field is set to Z_NULL to signal its +- absence. This allows the use of deflateSetHeader() with the returned +- structure to duplicate the header. However if those fields are set to +- allocated memory, then the application will need to save those pointers +- elsewhere so that they can be eventually freed. +- +- If inflateGetHeader is not used, then the header information is simply +- discarded. The header is always checked for validity, including the header +- CRC if present. inflateReset() will reset the process to discard the header +- information. The application would need to call inflateGetHeader() again to +- retrieve the header from the next gzip stream. +- +- inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source +- stream state was inconsistent. +-*/ +- +-/* +-ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, +- unsigned char FAR *window)); +- +- Initialize the internal stream state for decompression using inflateBack() +- calls. The fields zalloc, zfree and opaque in strm must be initialized +- before the call. If zalloc and zfree are Z_NULL, then the default library- +- derived memory allocation routines are used. windowBits is the base two +- logarithm of the window size, in the range 8..15. window is a caller +- supplied buffer of that size. Except for special applications where it is +- assured that deflate was used with small window sizes, windowBits must be 15 +- and a 32K byte window must be supplied to be able to decompress general +- deflate streams. +- +- See inflateBack() for the usage of these routines. +- +- inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of +- the paramaters are invalid, Z_MEM_ERROR if the internal state could not +- be allocated, or Z_VERSION_ERROR if the version of the library does not +- match the version of the header file. +-*/ +- +-typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); +-typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); +- +-ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, +- in_func in, void FAR *in_desc, +- out_func out, void FAR *out_desc)); +-/* +- inflateBack() does a raw inflate with a single call using a call-back +- interface for input and output. This is more efficient than inflate() for +- file i/o applications in that it avoids copying between the output and the +- sliding window by simply making the window itself the output buffer. This +- function trusts the application to not change the output buffer passed by +- the output function, at least until inflateBack() returns. +- +- inflateBackInit() must be called first to allocate the internal state +- and to initialize the state with the user-provided window buffer. +- inflateBack() may then be used multiple times to inflate a complete, raw +- deflate stream with each call. inflateBackEnd() is then called to free +- the allocated state. +- +- A raw deflate stream is one with no zlib or gzip header or trailer. +- This routine would normally be used in a utility that reads zip or gzip +- files and writes out uncompressed files. The utility would decode the +- header and process the trailer on its own, hence this routine expects +- only the raw deflate stream to decompress. This is different from the +- normal behavior of inflate(), which expects either a zlib or gzip header and +- trailer around the deflate stream. +- +- inflateBack() uses two subroutines supplied by the caller that are then +- called by inflateBack() for input and output. inflateBack() calls those +- routines until it reads a complete deflate stream and writes out all of the +- uncompressed data, or until it encounters an error. The function's +- parameters and return types are defined above in the in_func and out_func +- typedefs. inflateBack() will call in(in_desc, &buf) which should return the +- number of bytes of provided input, and a pointer to that input in buf. If +- there is no input available, in() must return zero--buf is ignored in that +- case--and inflateBack() will return a buffer error. inflateBack() will call +- out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() +- should return zero on success, or non-zero on failure. If out() returns +- non-zero, inflateBack() will return with an error. Neither in() nor out() +- are permitted to change the contents of the window provided to +- inflateBackInit(), which is also the buffer that out() uses to write from. +- The length written by out() will be at most the window size. Any non-zero +- amount of input may be provided by in(). +- +- For convenience, inflateBack() can be provided input on the first call by +- setting strm->next_in and strm->avail_in. If that input is exhausted, then +- in() will be called. Therefore strm->next_in must be initialized before +- calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called +- immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in +- must also be initialized, and then if strm->avail_in is not zero, input will +- initially be taken from strm->next_in[0 .. strm->avail_in - 1]. +- +- The in_desc and out_desc parameters of inflateBack() is passed as the +- first parameter of in() and out() respectively when they are called. These +- descriptors can be optionally used to pass any information that the caller- +- supplied in() and out() functions need to do their job. +- +- On return, inflateBack() will set strm->next_in and strm->avail_in to +- pass back any unused input that was provided by the last in() call. The +- return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR +- if in() or out() returned an error, Z_DATA_ERROR if there was a format +- error in the deflate stream (in which case strm->msg is set to indicate the +- nature of the error), or Z_STREAM_ERROR if the stream was not properly +- initialized. In the case of Z_BUF_ERROR, an input or output error can be +- distinguished using strm->next_in which will be Z_NULL only if in() returned +- an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to +- out() returning non-zero. (in() will always be called before out(), so +- strm->next_in is assured to be defined if out() returns non-zero.) Note +- that inflateBack() cannot return Z_OK. +-*/ +- +-ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); +-/* +- All memory allocated by inflateBackInit() is freed. +- +- inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream +- state was inconsistent. +-*/ +- +-ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); +-/* Return flags indicating compile-time options. +- +- Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: +- 1.0: size of uInt +- 3.2: size of uLong +- 5.4: size of voidpf (pointer) +- 7.6: size of z_off_t +- +- Compiler, assembler, and debug options: +- 8: DEBUG +- 9: ASMV or ASMINF -- use ASM code +- 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention +- 11: 0 (reserved) +- +- One-time table building (smaller code, but not thread-safe if true): +- 12: BUILDFIXED -- build static block decoding tables when needed +- 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed +- 14,15: 0 (reserved) +- +- Library content (indicates missing functionality): +- 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking +- deflate code when not needed) +- 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect +- and decode gzip streams (to avoid linking crc code) +- 18-19: 0 (reserved) +- +- Operation variations (changes in library functionality): +- 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate +- 21: FASTEST -- deflate algorithm with only one, lowest compression level +- 22,23: 0 (reserved) +- +- The sprintf variant used by gzprintf (zero is best): +- 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format +- 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! +- 26: 0 = returns value, 1 = void -- 1 means inferred string length returned +- +- Remainder: +- 27-31: 0 (reserved) +- */ +- +- +- /* utility functions */ +- +-/* +- The following utility functions are implemented on top of the +- basic stream-oriented functions. To simplify the interface, some +- default options are assumed (compression level and memory usage, +- standard memory allocation functions). The source code of these +- utility functions can easily be modified if you need special options. +-*/ +- +-ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen)); +-/* +- Compresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be at least the value returned +- by compressBound(sourceLen). Upon exit, destLen is the actual size of the +- compressed buffer. +- This function can be used to compress a whole file at once if the +- input file is mmap'ed. +- compress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer. +-*/ +- +-ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen, +- int level)); +-/* +- Compresses the source buffer into the destination buffer. The level +- parameter has the same meaning as in deflateInit. sourceLen is the byte +- length of the source buffer. Upon entry, destLen is the total size of the +- destination buffer, which must be at least the value returned by +- compressBound(sourceLen). Upon exit, destLen is the actual size of the +- compressed buffer. +- +- compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough +- memory, Z_BUF_ERROR if there was not enough room in the output buffer, +- Z_STREAM_ERROR if the level parameter is invalid. +-*/ +- +-ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); +-/* +- compressBound() returns an upper bound on the compressed size after +- compress() or compress2() on sourceLen bytes. It would be used before +- a compress() or compress2() call to allocate the destination buffer. +-*/ +- +-ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, +- const Bytef *source, uLong sourceLen)); +-/* +- Decompresses the source buffer into the destination buffer. sourceLen is +- the byte length of the source buffer. Upon entry, destLen is the total +- size of the destination buffer, which must be large enough to hold the +- entire uncompressed data. (The size of the uncompressed data must have +- been saved previously by the compressor and transmitted to the decompressor +- by some mechanism outside the scope of this compression library.) +- Upon exit, destLen is the actual size of the compressed buffer. +- This function can be used to decompress a whole file at once if the +- input file is mmap'ed. +- +- uncompress returns Z_OK if success, Z_MEM_ERROR if there was not +- enough memory, Z_BUF_ERROR if there was not enough room in the output +- buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. +-*/ +- +- +-typedef voidp gzFile; +- +-ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); +-/* +- Opens a gzip (.gz) file for reading or writing. The mode parameter +- is as in fopen ("rb" or "wb") but can also include a compression level +- ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for +- Huffman only compression as in "wb1h", or 'R' for run-length encoding +- as in "wb1R". (See the description of deflateInit2 for more information +- about the strategy parameter.) +- +- gzopen can be used to read a file which is not in gzip format; in this +- case gzread will directly read from the file without decompression. +- +- gzopen returns NULL if the file could not be opened or if there was +- insufficient memory to allocate the (de)compression state; errno +- can be checked to distinguish the two cases (if errno is zero, the +- zlib error is Z_MEM_ERROR). */ +- +-ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); +-/* +- gzdopen() associates a gzFile with the file descriptor fd. File +- descriptors are obtained from calls like open, dup, creat, pipe or +- fileno (in the file has been previously opened with fopen). +- The mode parameter is as in gzopen. +- The next call of gzclose on the returned gzFile will also close the +- file descriptor fd, just like fclose(fdopen(fd), mode) closes the file +- descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). +- gzdopen returns NULL if there was insufficient memory to allocate +- the (de)compression state. +-*/ +- +-ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); +-/* +- Dynamically update the compression level or strategy. See the description +- of deflateInit2 for the meaning of these parameters. +- gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not +- opened for writing. +-*/ +- +-ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); +-/* +- Reads the given number of uncompressed bytes from the compressed file. +- If the input file was not in gzip format, gzread copies the given number +- of bytes into the buffer. +- gzread returns the number of uncompressed bytes actually read (0 for +- end of file, -1 for error). */ +- +-ZEXTERN int ZEXPORT gzwrite OF((gzFile file, +- voidpc buf, unsigned len)); +-/* +- Writes the given number of uncompressed bytes into the compressed file. +- gzwrite returns the number of uncompressed bytes actually written +- (0 in case of error). +-*/ +- +-ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); +-/* +- Converts, formats, and writes the args to the compressed file under +- control of the format string, as in fprintf. gzprintf returns the number of +- uncompressed bytes actually written (0 in case of error). The number of +- uncompressed bytes written is limited to 4095. The caller should assure that +- this limit is not exceeded. If it is exceeded, then gzprintf() will return +- return an error (0) with nothing written. In this case, there may also be a +- buffer overflow with unpredictable consequences, which is possible only if +- zlib was compiled with the insecure functions sprintf() or vsprintf() +- because the secure snprintf() or vsnprintf() functions were not available. +-*/ +- +-ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); +-/* +- Writes the given null-terminated string to the compressed file, excluding +- the terminating null character. +- gzputs returns the number of characters written, or -1 in case of error. +-*/ +- +-ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); +-/* +- Reads bytes from the compressed file until len-1 characters are read, or +- a newline character is read and transferred to buf, or an end-of-file +- condition is encountered. The string is then terminated with a null +- character. +- gzgets returns buf, or Z_NULL in case of error. +-*/ +- +-ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); +-/* +- Writes c, converted to an unsigned char, into the compressed file. +- gzputc returns the value that was written, or -1 in case of error. +-*/ +- +-ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); +-/* +- Reads one byte from the compressed file. gzgetc returns this byte +- or -1 in case of end of file or error. +-*/ +- +-ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); +-/* +- Push one character back onto the stream to be read again later. +- Only one character of push-back is allowed. gzungetc() returns the +- character pushed, or -1 on failure. gzungetc() will fail if a +- character has been pushed but not read yet, or if c is -1. The pushed +- character will be discarded if the stream is repositioned with gzseek() +- or gzrewind(). +-*/ +- +-ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); +-/* +- Flushes all pending output into the compressed file. The parameter +- flush is as in the deflate() function. The return value is the zlib +- error number (see function gzerror below). gzflush returns Z_OK if +- the flush parameter is Z_FINISH and all output could be flushed. +- gzflush should be called only when strictly necessary because it can +- degrade compression. +-*/ +- +-ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, +- z_off_t offset, int whence)); +-/* +- Sets the starting position for the next gzread or gzwrite on the +- given compressed file. The offset represents a number of bytes in the +- uncompressed data stream. The whence parameter is defined as in lseek(2); +- the value SEEK_END is not supported. +- If the file is opened for reading, this function is emulated but can be +- extremely slow. If the file is opened for writing, only forward seeks are +- supported; gzseek then compresses a sequence of zeroes up to the new +- starting position. +- +- gzseek returns the resulting offset location as measured in bytes from +- the beginning of the uncompressed stream, or -1 in case of error, in +- particular if the file is opened for writing and the new starting position +- would be before the current position. +-*/ +- +-ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); +-/* +- Rewinds the given file. This function is supported only for reading. +- +- gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) +-*/ +- +-ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); +-/* +- Returns the starting position for the next gzread or gzwrite on the +- given compressed file. This position represents a number of bytes in the +- uncompressed data stream. +- +- gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +-*/ +- +-ZEXTERN int ZEXPORT gzeof OF((gzFile file)); +-/* +- Returns 1 when EOF has previously been detected reading the given +- input stream, otherwise zero. +-*/ +- +-ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); +-/* +- Returns 1 if file is being read directly without decompression, otherwise +- zero. +-*/ +- +-ZEXTERN int ZEXPORT gzclose OF((gzFile file)); +-/* +- Flushes all pending output if necessary, closes the compressed file +- and deallocates all the (de)compression state. The return value is the zlib +- error number (see function gzerror below). +-*/ +- +-ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); +-/* +- Returns the error message for the last error which occurred on the +- given compressed file. errnum is set to zlib error number. If an +- error occurred in the file system and not in the compression library, +- errnum is set to Z_ERRNO and the application may consult errno +- to get the exact error code. +-*/ +- +-ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); +-/* +- Clears the error and end-of-file flags for file. This is analogous to the +- clearerr() function in stdio. This is useful for continuing to read a gzip +- file that is being written concurrently. +-*/ +- +- /* checksum functions */ +- +-/* +- These functions are not related to compression but are exported +- anyway because they might be useful in applications using the +- compression library. +-*/ +- +-ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); +-/* +- Update a running Adler-32 checksum with the bytes buf[0..len-1] and +- return the updated checksum. If buf is NULL, this function returns +- the required initial value for the checksum. +- An Adler-32 checksum is almost as reliable as a CRC32 but can be computed +- much faster. Usage example: +- +- uLong adler = adler32(0L, Z_NULL, 0); +- +- while (read_buffer(buffer, length) != EOF) { +- adler = adler32(adler, buffer, length); +- } +- if (adler != original_adler) error(); +-*/ +- +-ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, +- z_off_t len2)); +-/* +- Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 +- and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for +- each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of +- seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. +-*/ +- +-ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); +-/* +- Update a running CRC-32 with the bytes buf[0..len-1] and return the +- updated CRC-32. If buf is NULL, this function returns the required initial +- value for the 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: +- +- uLong crc = crc32(0L, Z_NULL, 0); +- +- while (read_buffer(buffer, length) != EOF) { +- crc = crc32(crc, buffer, length); +- } +- if (crc != original_crc) error(); +-*/ +- +-ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); +- +-/* +- Combine two CRC-32 check values into one. For two sequences of bytes, +- seq1 and seq2 with lengths len1 and len2, CRC-32 check values were +- calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 +- check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and +- len2. +-*/ +- +- +- /* various hacks, don't look :) */ +- +-/* deflateInit and inflateInit are macros to allow checking the zlib version +- * and the compiler's view of z_stream: +- */ +-ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, +- int windowBits, int memLevel, +- int strategy, const char *version, +- int stream_size)); +-ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, +- const char *version, int stream_size)); +-ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, +- unsigned char FAR *window, +- const char *version, +- int stream_size)); +-#define deflateInit(strm, level) \ +- deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateInit(strm) \ +- inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) +-#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ +- deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ +- (strategy), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateInit2(strm, windowBits) \ +- inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) +-#define inflateBackInit(strm, windowBits, window) \ +- inflateBackInit_((strm), (windowBits), (window), \ +- ZLIB_VERSION, sizeof(z_stream)) +- +- +-#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) +- struct internal_state {int dummy;}; /* hack for buggy compilers */ +-#endif +- +-ZEXTERN const char * ZEXPORT zError OF((int)); +-ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); +-ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); +- +-#ifdef __cplusplus +-} +-#endif +- +-#endif /* ZLIB_H */ +diff -ruN seqinr.orig/src/zsockr.c seqinr/src/zsockr.c +--- seqinr.orig/src/zsockr.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/zsockr.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,169 +0,0 @@ +-/* functions to handle zlib-compressed data read from socket +-*/ +-#ifndef WIN32 +-#ifdef _WIN32 +-#define WIN32 1 +-#endif +-#endif +-#ifndef WIN32 +-#include "zlib.h" +-#include +-#include +-#include +-#include +-#ifdef WIN32 +-#include +-#else +-#include +-#endif +- +- +-/* included functions */ +-void *prepare_sock_gz_r(int sockr); +-int z_getc_R(void *v); +-char *z_gets(void *v, char *line, size_t len); +-char *z_read_sock(void *v); +-int close_sock_gz_r(void *v); +- +- +- +-#define ZBSIZE 100000 +-typedef struct { +- z_stream stream; +- char z_buffer[ZBSIZE]; /* compressed input buffer */ +- char text_buffer[4 * ZBSIZE]; /* decompressed buffer */ +- char *pos, *endbuf; +-#ifdef WIN32 +- SOCKET fd; +-#else +- int fd; +-#endif +- } sock_gz_r; +- +- +- +-void *prepare_sock_gz_r(int sockr) +-{ +-int err; +-sock_gz_r *big; +-static sock_gz_r s_big; +- +-big = &s_big; +-if(big == NULL) return NULL; +-big->stream.next_in = Z_NULL; +-big->stream.avail_in = 0; +-big->stream.avail_out = 0; +-big->stream.zalloc = Z_NULL; +-big->stream.zfree = Z_NULL; +-big->stream.opaque = NULL; +-big->pos = big->text_buffer; +-big->endbuf = big->pos; +-#ifdef WIN32 +-big->fd = (SOCKET)sockr; +-#else +-big->fd = sockr; +-#endif +-err = inflateInit(&big->stream); +-return err == Z_OK ? (void *)big : NULL; +-} +- +- +-int z_getc_R(void *v) +-{ +-int q, lu; +-sock_gz_r *big = (sock_gz_r *)v; +-z_streamp zs; +-#ifndef WIN32 +-int err; +-fd_set readfds; +-#endif +- +-if(big->pos < big->endbuf) { +- return *(big->pos++); +- } +-zs = &(big->stream); +-zs->next_out = (Bytef *)big->text_buffer; +-zs->avail_out = sizeof(big->text_buffer); +-big->pos = (char *)zs->next_out; +-do { +- if(zs->avail_in == 0) { +-#ifdef WIN32 +- do +- lu = recv( big->fd , big->z_buffer, ZBSIZE, 0 ); +- while (lu <=0); +-#else +- FD_ZERO(&readfds); +- FD_SET(big->fd, &readfds); +- err = select(big->fd + 1, &readfds, NULL, NULL, NULL); +- if(err > 0 ) { +- lu = read( big->fd , big->z_buffer, ZBSIZE ); +- } +- else lu = -1; +-#endif +- if(lu == -1) return EOF; +- zs->next_in = (Bytef *)big->z_buffer; +- zs->avail_in = lu; +- } +- q = inflate(zs, Z_NO_FLUSH); +- if(q == Z_STREAM_END) break; +- if(q != Z_OK) { +- break; +- } +- } +-while ( (char *)zs->next_out == big->pos); +-big->endbuf = (char *)zs->next_out; +-if(big->pos < big->endbuf) return *(big->pos++); +-else +- return EOF; +-} +- +- +-char *z_gets(void *v, char *line, size_t len) +-{ +-int c; +-char *p; +- +-p = line; +-while(len > 1) { +- c = z_getc_R( v ); +- if(c == EOF) { +- if(p == line) return NULL; +- break; +- } +- *(p++) = c; +- if(c == '\n') break; +- len--; +- } +-*p = 0; +-return line; +-} +- +- +-char *z_read_sock(void *v) +-{ +-static char line[500]; +-char *p; +-int l; +- +-p = z_gets(v, line, sizeof(line)); +-if(p == NULL) return NULL; +-l = strlen(line); +-if(l > 0 && line[l-1] == '\n') line[l-1] = 0; +-return line; +-} +- +- +-int close_sock_gz_r(void *v) +-{ +-sock_gz_r *big = (sock_gz_r *)v; +-int val; +- +-val = inflateEnd(&(big->stream)); +-return val; +-} +-#else +-void *prepare_sock_gz_r(int sockr) { +-return 0; +-} +-#endif +- +diff -ruN seqinr.orig/src/zutil.c seqinr/src/zutil.c +--- seqinr.orig/src/zutil.c 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/zutil.c 1970-01-01 01:00:00.000000000 +0100 +@@ -1,322 +0,0 @@ +-/* zutil.c -- target dependent utility functions for the compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* @(#) $Id: zutil.c,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ +- +-#include "zutil.h" +- +-#ifndef NO_DUMMY_DECL +-struct internal_state {int dummy;}; /* for buggy compilers */ +-#endif +- +-const char * const z_errmsg[10] = { +-"need dictionary", /* Z_NEED_DICT 2 */ +-"stream end", /* Z_STREAM_END 1 */ +-"", /* Z_OK 0 */ +-"file error", /* Z_ERRNO (-1) */ +-"stream error", /* Z_STREAM_ERROR (-2) */ +-"data error", /* Z_DATA_ERROR (-3) */ +-"insufficient memory", /* Z_MEM_ERROR (-4) */ +-"buffer error", /* Z_BUF_ERROR (-5) */ +-"incompatible version",/* Z_VERSION_ERROR (-6) */ +-""}; +- +- +-const char * ZEXPORT zlibVersion() +-{ +- return ZLIB_VERSION; +-} +- +-uLong ZEXPORT zlibCompileFlags() +-{ +- uLong flags; +- +- flags = 0; +- switch (sizeof(uInt)) { +- case 2: break; +- case 4: flags += 1; break; +- case 8: flags += 2; break; +- default: flags += 3; +- } +- switch (sizeof(uLong)) { +- case 2: break; +- case 4: flags += 1 << 2; break; +- case 8: flags += 2 << 2; break; +- default: flags += 3 << 2; +- } +- switch (sizeof(voidpf)) { +- case 2: break; +- case 4: flags += 1 << 4; break; +- case 8: flags += 2 << 4; break; +- default: flags += 3 << 4; +- } +- switch (sizeof(z_off_t)) { +- case 2: break; +- case 4: flags += 1 << 6; break; +- case 8: flags += 2 << 6; break; +- default: flags += 3 << 6; +- } +-#ifdef DEBUG +- flags += 1 << 8; +-#endif +-#if defined(ASMV) || defined(ASMINF) +- flags += 1 << 9; +-#endif +-#ifdef ZLIB_WINAPI +- flags += 1 << 10; +-#endif +-#ifdef BUILDFIXED +- flags += 1 << 12; +-#endif +-#ifdef DYNAMIC_CRC_TABLE +- flags += 1 << 13; +-#endif +-#ifdef NO_GZCOMPRESS +- flags += 1L << 16; +-#endif +-#ifdef NO_GZIP +- flags += 1L << 17; +-#endif +-#ifdef PKZIP_BUG_WORKAROUND +- flags += 1L << 20; +-#endif +-#ifdef FASTEST +- flags += 1L << 21; +-#endif +-#ifdef STDC +-# ifdef NO_vsnprintf +- flags += 1L << 25; +-# ifdef HAS_vsprintf_void +- flags += 1L << 26; +-# endif +-# else +-# ifdef HAS_vsnprintf_void +- flags += 1L << 26; +-# endif +-# endif +-#else +- flags += 1L << 24; +-# ifdef NO_snprintf +- flags += 1L << 25; +-# ifdef HAS_sprintf_void +- flags += 1L << 26; +-# endif +-# else +-# ifdef HAS_snprintf_void +- flags += 1L << 26; +-# endif +-# endif +-#endif +- return flags; +-} +- +-#ifdef DEBUG +- +-# ifndef verbose +-# define verbose 0 +-# endif +-int z_verbose = verbose; +- +-void z_error (m) +- char *m; +-{ +- fprintf(stderr, "%s\n", m); +- exit(1); +-} +-#endif +- +-/* exported to allow conversion of error code to string for compress() and +- * uncompress() +- */ +-const char * ZEXPORT zError(int err) +-/* int err; */ +-{ +- return ERR_MSG(err); +-} +- +-#if defined(_WIN32_WCE) +- /* The Microsoft C Run-Time Library for Windows CE doesn't have +- * errno. We define it as a global variable to simplify porting. +- * Its value is always 0 and should not be used. +- */ +- int errno = 0; +-#endif +- +-#ifndef HAVE_MEMCPY +- +-void zmemcpy(dest, source, len) +- Bytef* dest; +- const Bytef* source; +- uInt len; +-{ +- if (len == 0) return; +- do { +- *dest++ = *source++; /* ??? to be unrolled */ +- } while (--len != 0); +-} +- +-int zmemcmp(s1, s2, len) +- const Bytef* s1; +- const Bytef* s2; +- uInt len; +-{ +- uInt j; +- +- for (j = 0; j < len; j++) { +- if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1; +- } +- return 0; +-} +- +-void zmemzero(dest, len) +- Bytef* dest; +- uInt len; +-{ +- if (len == 0) return; +- do { +- *dest++ = 0; /* ??? to be unrolled */ +- } while (--len != 0); +-} +-#endif +- +- +-#ifdef SYS16BIT +- +-#ifdef __TURBOC__ +-/* Turbo C in 16-bit mode */ +- +-# define MY_ZCALLOC +- +-/* Turbo C malloc() does not allow dynamic allocation of 64K bytes +- * and farmalloc(64K) returns a pointer with an offset of 8, so we +- * must fix the pointer. Warning: the pointer must be put back to its +- * original form in order to free it, use zcfree(). +- */ +- +-#define MAX_PTR 10 +-/* 10*64K = 640K */ +- +-local int next_ptr = 0; +- +-typedef struct ptr_table_s { +- voidpf org_ptr; +- voidpf new_ptr; +-} ptr_table; +- +-local ptr_table table[MAX_PTR]; +-/* This table is used to remember the original form of pointers +- * to large buffers (64K). Such pointers are normalized with a zero offset. +- * Since MSDOS is not a preemptive multitasking OS, this table is not +- * protected from concurrent access. This hack doesn't work anyway on +- * a protected system like OS/2. Use Microsoft C instead. +- */ +- +-voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +-{ +- voidpf buf = opaque; /* just to make some compilers happy */ +- ulg bsize = (ulg)items*size; +- +- /* If we allocate less than 65520 bytes, we assume that farmalloc +- * will return a usable pointer which doesn't have to be normalized. +- */ +- if (bsize < 65520L) { +- buf = farmalloc(bsize); +- if (*(ush*)&buf != 0) return buf; +- } else { +- buf = farmalloc(bsize + 16L); +- } +- if (buf == NULL || next_ptr >= MAX_PTR) return NULL; +- table[next_ptr].org_ptr = buf; +- +- /* Normalize the pointer to seg:0 */ +- *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4; +- *(ush*)&buf = 0; +- table[next_ptr++].new_ptr = buf; +- return buf; +-} +- +-void zcfree (voidpf opaque, voidpf ptr) +-{ +- int n; +- if (*(ush*)&ptr != 0) { /* object < 64K */ +- farfree(ptr); +- return; +- } +- /* Find the original pointer */ +- for (n = 0; n < next_ptr; n++) { +- if (ptr != table[n].new_ptr) continue; +- +- farfree(table[n].org_ptr); +- while (++n < next_ptr) { +- table[n-1] = table[n]; +- } +- next_ptr--; +- return; +- } +- ptr = opaque; /* just to make some compilers happy */ +- Assert(0, "zcfree: ptr not found"); +-} +- +-#endif /* __TURBOC__ */ +- +- +-#ifdef M_I86 +-/* Microsoft C in 16-bit mode */ +- +-# define MY_ZCALLOC +- +-#if (!defined(_MSC_VER) || (_MSC_VER <= 600)) +-# define _halloc halloc +-# define _hfree hfree +-#endif +- +-voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +-{ +- if (opaque) opaque = 0; /* to make compiler happy */ +- return _halloc((long)items, size); +-} +- +-void zcfree (voidpf opaque, voidpf ptr) +-{ +- if (opaque) opaque = 0; /* to make compiler happy */ +- _hfree(ptr); +-} +- +-#endif /* M_I86 */ +- +-#endif /* SYS16BIT */ +- +- +-#ifndef MY_ZCALLOC /* Any system without a special alloc function */ +- +-#ifndef STDC +-extern voidp malloc OF((uInt size)); +-extern voidp calloc OF((uInt items, uInt size)); +-extern void free OF((voidpf ptr)); +-#endif +- +-voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +-/* +- voidpf opaque; +- unsigned items; +- unsigned size; +-*/ +-{ +- if (opaque) items += size - size; /* make compiler happy */ +- return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) : +- (voidpf)calloc(items, size); +-} +- +-void zcfree (voidpf opaque, voidpf ptr) +-/* +- voidpf opaque; +- voidpf ptr; +-*/ +-{ +- free(ptr); +- if (opaque) return; /* make compiler happy */ +-} +- +-#endif /* MY_ZCALLOC */ +diff -ruN seqinr.orig/src/zutil.h seqinr/src/zutil.h +--- seqinr.orig/src/zutil.h 2007-04-19 11:40:19.000000000 +0200 ++++ seqinr/src/zutil.h 1970-01-01 01:00:00.000000000 +0100 +@@ -1,269 +0,0 @@ +-/* zutil.h -- internal interface and configuration of the compression library +- * Copyright (C) 1995-2005 Jean-loup Gailly. +- * For conditions of distribution and use, see copyright notice in zlib.h +- */ +- +-/* WARNING: this file should *not* be used by applications. It is +- part of the implementation of the compression library and is +- subject to change. Applications should only use zlib.h. +- */ +- +-/* @(#) $Id: zutil.h,v 1.1.2.1 2007-04-19 09:40:19 penel Exp $ */ +- +-#ifndef ZUTIL_H +-#define ZUTIL_H +- +-#define ZLIB_INTERNAL +-#include "zlib.h" +- +-#ifdef STDC +-# ifndef _WIN32_WCE +-# include +-# endif +-# include +-# include +-#endif +-#ifdef NO_ERRNO_H +-# ifdef _WIN32_WCE +- /* The Microsoft C Run-Time Library for Windows CE doesn't have +- * errno. We define it as a global variable to simplify porting. +- * Its value is always 0 and should not be used. We rename it to +- * avoid conflict with other libraries that use the same workaround. +- */ +-# define errno z_errno +-# endif +- extern int errno; +-#else +-# ifndef _WIN32_WCE +-# include +-# endif +-#endif +- +-#ifndef local +-# define local static +-#endif +-/* compile with -Dlocal if your debugger can't find static symbols */ +- +-typedef unsigned char uch; +-typedef uch FAR uchf; +-typedef unsigned short ush; +-typedef ush FAR ushf; +-typedef unsigned long ulg; +- +-extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ +-/* (size given to avoid silly warnings with Visual C++) */ +- +-#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] +- +-#define ERR_RETURN(strm,err) \ +- return (strm->msg = (char*)ERR_MSG(err), (err)) +-/* To be used only when the state is known to be valid */ +- +- /* common constants */ +- +-#ifndef DEF_WBITS +-# define DEF_WBITS MAX_WBITS +-#endif +-/* default windowBits for decompression. MAX_WBITS is for compression only */ +- +-#if MAX_MEM_LEVEL >= 8 +-# define DEF_MEM_LEVEL 8 +-#else +-# define DEF_MEM_LEVEL MAX_MEM_LEVEL +-#endif +-/* default memLevel */ +- +-#define STORED_BLOCK 0 +-#define STATIC_TREES 1 +-#define DYN_TREES 2 +-/* The three kinds of block type */ +- +-#define MIN_MATCH 3 +-#define MAX_MATCH 258 +-/* The minimum and maximum match lengths */ +- +-#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ +- +- /* target dependencies */ +- +-#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) +-# define OS_CODE 0x00 +-# if defined(__TURBOC__) || defined(__BORLANDC__) +-# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) +- /* Allow compilation with ANSI keywords only enabled */ +- void _Cdecl farfree( void *block ); +- void *_Cdecl farmalloc( unsigned long nbytes ); +-# else +-# include +-# endif +-# else /* MSC or DJGPP */ +-# include +-# endif +-#endif +- +-#ifdef AMIGA +-# define OS_CODE 0x01 +-#endif +- +-#if defined(VAXC) || defined(VMS) +-# define OS_CODE 0x02 +-# define F_OPEN(name, mode) \ +- fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") +-#endif +- +-#if defined(ATARI) || defined(atarist) +-# define OS_CODE 0x05 +-#endif +- +-#ifdef OS2 +-# define OS_CODE 0x06 +-# ifdef M_I86 +- #include +-# endif +-#endif +- +-#if defined(MACOS) || defined(TARGET_OS_MAC) +-# define OS_CODE 0x07 +-# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os +-# include /* for fdopen */ +-# else +-# ifndef fdopen +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-# endif +-# endif +-#endif +- +-#ifdef TOPS20 +-# define OS_CODE 0x0a +-#endif +- +-#ifdef WIN32 +-# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ +-# define OS_CODE 0x0b +-# endif +-#endif +- +-#ifdef __50SERIES /* Prime/PRIMOS */ +-# define OS_CODE 0x0f +-#endif +- +-#if defined(_BEOS_) || defined(RISCOS) +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-#endif +- +-#if (defined(_MSC_VER) && (_MSC_VER > 600)) +-# if defined(_WIN32_WCE) +-# define fdopen(fd,mode) NULL /* No fdopen() */ +-# ifndef _PTRDIFF_T_DEFINED +- typedef int ptrdiff_t; +-# define _PTRDIFF_T_DEFINED +-# endif +-# else +-# define fdopen(fd,type) _fdopen(fd,type) +-# endif +-#endif +- +- /* common defaults */ +- +-#ifndef OS_CODE +-# define OS_CODE 0x03 /* assume Unix */ +-#endif +- +-#ifndef F_OPEN +-# define F_OPEN(name, mode) fopen((name), (mode)) +-#endif +- +- /* functions */ +- +-#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) +-# ifndef HAVE_VSNPRINTF +-# define HAVE_VSNPRINTF +-# endif +-#endif +-#if defined(__CYGWIN__) +-# ifndef HAVE_VSNPRINTF +-# define HAVE_VSNPRINTF +-# endif +-#endif +-#ifndef HAVE_VSNPRINTF +-# ifdef MSDOS +- /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), +- but for now we just assume it doesn't. */ +-# define NO_vsnprintf +-# endif +-# ifdef __TURBOC__ +-# define NO_vsnprintf +-# endif +-# ifdef WIN32 +- /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +-# if !defined(vsnprintf) && !defined(NO_vsnprintf) +-# define vsnprintf _vsnprintf +-# endif +-# endif +-# ifdef __SASC +-# define NO_vsnprintf +-# endif +-#endif +-#ifdef VMS +-# define NO_vsnprintf +-#endif +- +-#if defined(pyr) +-# define NO_MEMCPY +-#endif +-#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) +- /* Use our own functions for small and medium model with MSC <= 5.0. +- * You may have to use the same strategy for Borland C (untested). +- * The __SC__ check is for Symantec. +- */ +-# define NO_MEMCPY +-#endif +-#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) +-# define HAVE_MEMCPY +-#endif +-#ifdef HAVE_MEMCPY +-# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ +-# define zmemcpy _fmemcpy +-# define zmemcmp _fmemcmp +-# define zmemzero(dest, len) _fmemset(dest, 0, len) +-# else +-# define zmemcpy memcpy +-# define zmemcmp memcmp +-# define zmemzero(dest, len) memset(dest, 0, len) +-# endif +-#else +- extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); +- extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); +- extern void zmemzero OF((Bytef* dest, uInt len)); +-#endif +- +-/* Diagnostic functions */ +-#ifdef DEBUG +-# include +- extern int z_verbose; +- extern void z_error OF((char *m)); +-# define Assert(cond,msg) {if(!(cond)) z_error(msg);} +-# define Trace(x) {if (z_verbose>=0) fprintf x ;} +-# define Tracev(x) {if (z_verbose>0) fprintf x ;} +-# define Tracevv(x) {if (z_verbose>1) fprintf x ;} +-# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} +-# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} +-#else +-# define Assert(cond,msg) +-# define Trace(x) +-# define Tracev(x) +-# define Tracevv(x) +-# define Tracec(c,x) +-# define Tracecv(c,x) +-#endif +- +- +-voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); +-void zcfree OF((voidpf opaque, voidpf ptr)); +- +-#define ZALLOC(strm, items, size) \ +- (*((strm)->zalloc))((strm)->opaque, (items), (size)) +-#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) +-#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} +- +-#endif /* ZUTIL_H */ diff --git a/branch/split_build/inst/etc/patches/svSocket/00list b/branch/split_build/inst/etc/patches/svSocket/00list new file mode 100644 index 0000000..b0adfd9 --- /dev/null +++ b/branch/split_build/inst/etc/patches/svSocket/00list @@ -0,0 +1 @@ +01_SimpleClient.patch diff --git a/branch/split_build/inst/etc/patches/svSocket/01_SimpleClient.patch b/branch/split_build/inst/etc/patches/svSocket/01_SimpleClient.patch new file mode 100644 index 0000000..786ba3d --- /dev/null +++ b/branch/split_build/inst/etc/patches/svSocket/01_SimpleClient.patch @@ -0,0 +1,17 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 01_SimpleClient.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: Correct tclsh path + +@DPATCH@ + +diff -ru svSocket.orig/inst/etc/SimpleClient.Tcl svSocket/inst/etc/SimpleClient.Tcl +--- svSocket.orig/inst/etc/SimpleClient.Tcl 2007-12-31 10:42:05.000000000 +0100 ++++ svSocket/inst/etc/SimpleClient.Tcl 2009-05-18 04:23:04.000000000 +0200 +@@ -1,4 +1,4 @@ +-#!/usr/local/bin/tclsh8.4 ++#!/usr/bin/tclsh8.4 + # Open a terminal and issue + # $ tclsh SimpleClient.tcl + # when the R socket server is running diff --git a/branch/split_build/inst/etc/sys/debian-amd64/dput.cf b/branch/split_build/inst/etc/sys/debian-amd64/dput.cf new file mode 100644 index 0000000..4439493 --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-amd64/dput.cf @@ -0,0 +1,7 @@ +[local] +method = local +incoming = /etc/cran2deb/archive/debian-amd64/mini-dinstall/incoming +allow_non-us_software = 1 +run_dinstall = 0 +run_lintian = 1 +allow_unsigned_uploads = 1 diff --git a/branch/split_build/inst/etc/sys/debian-amd64/mini-dinstall.conf b/branch/split_build/inst/etc/sys/debian-amd64/mini-dinstall.conf new file mode 100644 index 0000000..9cb44c2 --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-amd64/mini-dinstall.conf @@ -0,0 +1,13 @@ +[DEFAULT] +architectures = all, i386, amd64 +use_dnotify = 1 +verify_sigs = 0 +mail_on_success = 0 +archive_style = simple-subdir +mail_log_level = NONE +archivedir = /etc/cran2deb/archive/debian-amd64 +logfile = /dev/null +incoming_permissions=770 + +[testing] + diff --git a/branch/split_build/inst/etc/sys/debian-amd64/pbuilderrc b/branch/split_build/inst/etc/sys/debian-amd64/pbuilderrc new file mode 100644 index 0000000..6479499 --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-amd64/pbuilderrc @@ -0,0 +1,12 @@ +BASETGZ=/var/cache/pbuilder/base-cran2deb-debian-amd64.tgz +HOOKDIR=/etc/cran2deb/hook +BUILDRESULT=/var/cache/cran2deb/results/debian-amd64 +EXTRAPACKAGES='debhelper r-base-dev cdbs r-base-core lintian xvfb xauth xfonts-base' +REMOVEPACKAGES='lilo libldap-2.4-2 libopencdk10 libsasl2-2' +# don't actually need aptitude, but pbuilder insists... +#REMOVEPACKAGES+='aptitude libcwidget3 libept0 libncursesw5 libsigc++-2.0-0c2a libxapian15' +DISTRIBUTION=testing +OTHERMIRROR='deb http://localhost/cran2deb/debian-amd64 testing/$(ARCH)/ | deb http://localhost/cran2deb/debian-amd64 testing/all/ | deb http://statmath.wu-wien.ac.at/AASC/debian/ testing main' +MIRRORSITE='http://ftp.at.debian.org/debian/' +APTCACHE='' +PBUILDERSATISFYDEPENDSCMD='/usr/lib/pbuilder/pbuilder-satisfydepends-classic' diff --git a/branch/split_build/inst/etc/sys/debian-i386/dput.cf b/branch/split_build/inst/etc/sys/debian-i386/dput.cf new file mode 100644 index 0000000..722ece3 --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-i386/dput.cf @@ -0,0 +1,7 @@ +[local] +method = local +incoming = /etc/cran2deb/archive/debian-i386/mini-dinstall/incoming +allow_non-us_software = 1 +run_dinstall = 0 +run_lintian = 1 +allow_unsigned_uploads = 1 diff --git a/branch/split_build/inst/etc/sys/debian-i386/mini-dinstall.conf b/branch/split_build/inst/etc/sys/debian-i386/mini-dinstall.conf new file mode 100644 index 0000000..45bab22 --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-i386/mini-dinstall.conf @@ -0,0 +1,13 @@ +[DEFAULT] +architectures = all, i386 +use_dnotify = 1 +verify_sigs = 0 +mail_on_success = 0 +archive_style = simple-subdir +mail_log_level = NONE +archivedir = /etc/cran2deb/archive/debian-i386 +logfile = /dev/null +incoming_permissions=770 + +[testing] + diff --git a/branch/split_build/inst/etc/sys/debian-i386/pbuilderrc b/branch/split_build/inst/etc/sys/debian-i386/pbuilderrc new file mode 100644 index 0000000..e3b5f5e --- /dev/null +++ b/branch/split_build/inst/etc/sys/debian-i386/pbuilderrc @@ -0,0 +1,13 @@ +BASETGZ=/var/cache/pbuilder/base-cran2deb-debian-i386.tgz +HOOKDIR=/etc/cran2deb/hook +BUILDRESULT=/var/cache/cran2deb/results/debian-i386 +EXTRAPACKAGES='debhelper r-base-dev cdbs r-base-core lintian xvfb xauth xfonts-base' +REMOVEPACKAGES='lilo libldap-2.4-2 libopencdk10 libsasl2-2' +# don't actually need aptitude, but pbuilder insists... +#REMOVEPACKAGES+='aptitude libcwidget3 libept0 libncursesw5 libsigc++-2.0-0c2a libxapian15' +DISTRIBUTION=testing +OTHERMIRROR='deb http://localhost/cran2deb/debian-i386 testing/$(ARCH)/ | deb http://localhost/cran2deb/debian-i386 testing/all/ | deb http://statmath.wu-wien.ac.at/AASC/debian/ testing main' +MIRRORSITE='http://ftp.at.debian.org/debian/' +APTCACHE='' +PBUILDERSATISFYDEPENDSCMD='/usr/lib/pbuilder/pbuilder-satisfydepends-classic' +DEBOOTSTRAPOPTS='--arch=i386'