move to new sharing structure

This commit is contained in:
Vitor Santos Costa 2011-02-09 13:10:20 +00:00
parent 0ad02c3ee1
commit b00ed6508e
12 changed files with 127 additions and 1964 deletions

63
packages/Dialect.defs.in Normal file
View File

@ -0,0 +1,63 @@
################################################################
# Shared makefile for packages.
################################################################
# This file must provide the following macros:
#
# * PLLIBDIR
# Base directory holding the Prolog library. Some packages
# may create subdirectories.
# * SOLIBDIR
# Directory holding shared objects/DLLs for the target architecture.
# * PKGDOCDIR
# Directory for storing the documentation. Packages typically
# create subdirectories
# * PKGEXDIR
# Directory where a package stores example code. Packages typically
# create subdirectories
# * SO
# Extension used for shared objects. E.g., .so, .dylib, .dll, ...
PLBASE=@prefix@
PLARCH=@ARCH@
PLINCL=$(PLBASE)/include
PLLIBDIR=$(PLBASE)/share/Yap
SOLIBDIR=$(PLLIBDIR)
PKGDOCDIR=$(PLBASE)/share/doc/packages
PKGEXDIR=$(PLBASE)/share/doc/packages/examples
#
# YAP internal stuff
#
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
BINDIR = $(EROOTDIR)/bin
LIBDIR=@libdir@
YAPLIBDIR=@libdir@/Yap
SHAREDIR=$(ROOTDIR)/share/Yap
abs_top_builddir=@abs_top_builddir@
PL=@INSTALL_ENV@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss
CC=@CC@
LD=@SHLIB_LD@
SO=@SOT@
COFLAGS=$(YAP_EXTRAS) $(DEFS) -D_YAP_NOT_INSTALLED_=1 -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@
CWFLAGS=
CMFLAGS=@SHLIB_CFLAGS@
CIFLAGS=
CFLAGS=$(COFLAGS) $(CWFLAGS) $(CMFLAGS) $(CIFLAGS) $(PKGCFLAGS) @DEFS@
LDSOFLAGS=@LDFLAGS@ @EXTRA_LIBS_FOR_SWIDLLS@
LDFLAGS=$(PKGLDFLAGS)
MKINDEX=$(PL) -f none -g make -t halt
PUBLICPL=swipl
PLTOTEX=$(PUBLICPL) -q -s pltotex.pl -g pltotex --
#
# find out how to generate .o files from $(scrdir)
#
%.o: $(srcdir)/%.c
$(CC) -c $(CFLAGS) $< -o $@

64
packages/Makefile.defs.in Normal file
View File

@ -0,0 +1,64 @@
################################################################
# Share Prolog-independent bits of the package makefiles.
################################################################
.SUFFIXES: .tex .dvi .doc .pl
# This is to have a simple 'make' build `all' instead of the local
# targets.
top: all
prefix=@prefix@
exec_prefix=@exec_prefix@
srcdir=@abs_srcdir@/$(PACKAGE)
bindir=@bindir@
libdir=@libdir@
mandir=@mandir@
SHELL=@SHELL@
INSTALL=@INSTALL@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_SCRIPT=@INSTALL_SCRIPT@
################################################################
# Documentation
################################################################
LATEX=latex
RUNTEX=../../man/runtex
DOC2TEX=../../man/doc2tex
TEX=$(DOC).tex $(SUBTEX)
DVI=$(DOC).dvi
PDF=$(DOC).pdf
HTML=$(DOC).html
ifneq ($(DOC),)
doc: pdf html
pdf: $(PDF)
html: $(HTML)
else
doc::
echo "No documentation provided"
pdf::
echo "No documentation provided"
html::
echo "No documentation provided"
endif
$(HTML): $(TEX)
latex2html $(DOC)
mv html/index.html $@
$(PDF): $(TEX)
../../man/runtex --pdf $(DOC)
$(TEX): $(DOC2TEX)
.doc.tex:
$(DOC2TEX) $*.doc > $*.tex
# Get the Prolog dialect specific part of the Makefiles
include ../Dialect.defs

View File

@ -1,60 +0,0 @@
[Jul 21 2009]
* MODIFIED: Make initialization/1 ISO compliant
This patch is a modest cleanup to the implementation of '$load_file'/3
from init.pl and provides an ISO compatible implementation of
initialization/1. This executes the argument goal *after* loading the
file rather than when encountering the directive. Often this makes no
difference, but notably load_foreign_library/1 is an exception.
Therefore we added use_foreign_library/1,2 that act as a directive and
provides proper integration with saved-states automatically. Loading
code using initialization(load_foreign_library(...)) will load the
library immediately and issue a warning.
See initialization/1,2 for details and further hints for dealing with
possible compatibility problems.
[Mar 19 2009]
* CLEANUP: Removed all trailing whitespace from all source-files. This avoids many GIT (merge) warnings.
[Nov 4 2008]
* FIXED: Copy encoding parameters from parent stream.
[Sep 11 2008]
* PORT: Add AC_PREREQ to configure.h for systems that auto-select autoconf
versions. After tip by Ulrich Neumerkel.
[Aug 11 2008]
* INSTALL: Remove all configure files from the git repository
[Jan 23 2008]
* PORT: Bug#346: Allow overriding COFLAGS and CWFLAGS in package
configuration. Keri Harris.
Jul 28, 2007
* FIXED: Bug#300: memory loss when returning the stream fails. Keri Harris.
May 2, 2007
* FIXED: Compress (deflate) large amounts of data. Added test to ztest.pl.
Matt Lilley.
Apr 26, 2007
* FIXED: Allow passing compressed stream between threads. Matt Lilley.
Apr 23, 2007
* FIXED: Explicit handling of format option in reader.
* FIXED: handling of format(deflate) option.
Jan 1, 2007
* Bug#246: Fixed running tests. Keri Harris.
Dec 21, 2006
* Portability to MacOS

View File

@ -1,181 +0,0 @@
################################################################
# Makefile template for SWI-Prolog CLIB package
#
# This template is used by configure to create Makefile. See
# the file INSTALL for further installation instructions.
#
# License: LGPL
#
# Author: Jan Wielemaker (wielemak@science.uva.nl)
################################################################
.SUFFIXES: .tex .dvi .doc .pl
ifeq (@PROLOG_SYSTEM@,yap)
prefix = @prefix@
exec_prefix = @exec_prefix@
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
abs_top_builddir = @abs_top_builddir@
srcdir=@srcdir@
BINDIR = $(EROOTDIR)/bin
LIBDIR=@libdir@
YAPLIBDIR=@libdir@/Yap
SHAREDIR=$(ROOTDIR)/share/Yap
SHELL=@SHELL@
PL=@INSTALL_ENV@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss
EXDIR=$(YAPLIBDIR)/examples/http
LN_S=@LN_S@
#
#
DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1
CC=@CC@
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@
MKINDEX=true
LIBS=@ZLIBS@
SO=@SO@
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
LD=@DO_SECOND_LD@ @SHLIB_LD@
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@
BINTARGET=$(DESTDIR)$(YAPLIBDIR)
PLTARGET=$(DESTDIR)$(SHAREDIR)
FINAL_BINTARGET=$(YAPLIBDIR)
FINAL_PLTARGET=$(SHAREDIR)
LIBPL= @ZLIB_PLTARGETS@
TARGETS= @ZLIB_TARGETS@
%.o: $(srcdir)/%.c
$(CC) -c $(CFLAGS) $< -o $@
else # SWI
PL=@PL@
PLBASE=@PLBASE@
PLARCH=@PLARCH@
PLINCL=@PLINCL@
PKGDOC=$(PLBASE)/doc/packages
PCEHOME=../xpce
CC=@CC@
COFLAGS=@COFLAGS@
CWFLAGS=@CWFLAGS@
CMFLAGS=@CMFLAGS@
CIFLAGS=
CFLAGS=$(COFLAGS) $(CWFLAGS) $(CMFLAGS) $(CIFLAGS) @DEFS@
LIBS=@LIBS@ @ZLIBS@
DOCTOTEX=$(PCEHOME)/bin/doc2tex
PLTOTEX=$(PCEHOME)/bin/pl2tex
DOC=zlib
TEX=$(DOC).tex
DVI=$(DOC).dvi
PDF=$(DOC).pdf
RUNTEX=../../man/runtex
LD=@LD@
LDFLAGS=@LDSOFLAGS@
LIBPL= @PLTARGETS@
TARGETS= @TARGETS@
endif
INSTALL=@INSTALL@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
INSTALL_DATA=@INSTALL_DATA@
ZOBJ= zlib4pl.o
all: $(TARGETS)
nolib::
@echo "WARNING: Could not find zlib library; skipped"
zlib4pl.@SO@: $(ZOBJ)
$(LD) $(LDFLAGS) -o $@ $(ZOBJ) $(LIBS)
install: $(TARGETS) $(LIBPL)
mkdir -p $(BINTARGET)
for f in $(TARGETS); do \
$(INSTALL_PROGRAM) $$f $(BINTARGET); \
done
mkdir -p $(PLTARGET)
for f in $(LIBPL); do \
$(INSTALL_DATA) $$f $(PLTARGET); \
done
$(PL) -f none -g make -t halt
ln-install::
$(MAKE) INSTALL_DATA="../ln-install" INSTALL_PROGRAM="../ln-install" install
rpm-install: install
html-install::
mkdir -p $(DESTDIR)$(PKGDOC)
$(INSTALL) -m 644 $(DOC).html $(DESTDIR)$(PKGDOC)
pdf-install::
mkdir -p $(DESTDIR)$(PKGDOC)
$(INSTALL) -m 644 $(DOC).pdf $(DESTDIR)$(PKGDOC)
uninstall::
(cd $(PLBASE)/lib/$(PLARCH) && rm -f $(TARGETS))
(cd $(PLBASE)/library && rm -f $(LIBPL))
$(PL) -f none -g make -t halt
################################################################
# Testing
################################################################
check::
$(PL) -q -f $(srcdir)/test_zlib.pl -g test_zlib,halt -t 'halt(1)'
################################################################
# Documentation
################################################################
pdf: $(PDF)
$(DVI): $(TEX)
$(RUNTEX) $(DOC)
$(PDF): $(TEX)
$(RUNTEX) --pdf $(DOC)
html: $(TEX)
latex2html $(DOC)
mv html/index.html $(DOC).html
rm -r html
$(TEX): $(DOCTOTEX)
.doc.tex:
$(DOCTOTEX) $*.doc > $*.tex
.pl.tex:
$(PLTOTEX) $*.pl > $*.tex
################################################################
# Clean
################################################################
clean:
rm -f $(ZOBJ) *~ *.o *% a.out core config.log
distclean: clean
rm -f $(TARGETS) config.cache config.h config.status Makefile
rm -f $(DOC).aux $(DOC).log $(DOC).out $(DOC).toc
rm -rf html
rm -rf autom4te.cache

View File

@ -1,73 +0,0 @@
################################################################
# Build the SWI-Prolog zlib package for MS-Windows
#
# Author: Jan Wielemaker
#
# Use:
# nmake /f Makefile.mak
# nmake /f Makefile.mak install
################################################################
PLHOME=..\..
!include $(PLHOME)\src\rules.mk
CFLAGS=$(CFLAGS) /D__SWI_PROLOG__
!IF "$(MD)" == "WIN64"
ZLIB=ZLIBWAPI
CFLAGS=$(CFLAGS) /DZLIB_WINAPI
!ELSE
ZLIB=ZLIB1
!ENDIF
OBJ= zlib4pl.obj
all: zlib4pl.dll
zlib4pl.dll: $(OBJ)
$(LD) /dll /out:$@ $(LDFLAGS) $(OBJ) $(ZLIB).lib $(PLLIB) $(LIBS)
!IF "$(CFG)" == "rt"
install: idll
!ELSE
install: idll ilib
!ENDIF
################################################################
# Testing
################################################################
check::
################################################################
# Installation
################################################################
idll::
copy "$(EXTRALIBDIR)\$(ZLIB).dll" "$(BINDIR)"
copy zlib4pl.dll "$(BINDIR)"
!IF "$(PDB)" == "true"
copy zlib4pl.pdb "$(BINDIR)"
!ENDIF
ilib::
copy zlib.pl "$(PLBASE)\library"
$(MAKEINDEX)
uninstall::
del "$(BINDIR)\zlib4pl.dll"
del "$(PLBASE)\library\zlib.pl"
$(MAKEINDEX)
html-install::
copy zlib.html "$(PKGDOC)"
xpce-install::
clean::
if exist *.obj del *.obj
if exist *~ del *~
distclean: clean
-DEL *.dll *.lib *.exp *.ilk *.pdb 2>nul

View File

@ -1,96 +0,0 @@
/* config.h.in. Generated from configure.in by autoheader. */
/* Define if building universal (internal helper macro) */
#undef AC_APPLE_UNIVERSAL_BUILD
/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
systems. This function is required for `alloca.c' support on those systems.
*/
#undef CRAY_STACKSEG_END
/* Define to 1 if using `alloca.c'. */
#undef C_ALLOCA
/* Define to 1 if you have `alloca', as a function or macro. */
#undef HAVE_ALLOCA
/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).
*/
#undef HAVE_ALLOCA_H
/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
/* Define to 1 if you have the <stdint.h> header file. */
#undef HAVE_STDINT_H
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H
/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H
/* Define to 1 if you have the <sys/stat.h> header file. */
#undef HAVE_SYS_STAT_H
/* Define to 1 if you have the <sys/types.h> header file. */
#undef HAVE_SYS_TYPES_H
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
/* Define to 1 if you have the <zlib.h> header file. */
#undef HAVE_ZLIB_H
/* Define to 1 if you have the <zutil.h> header file. */
#undef HAVE_ZUTIL_H
/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT
/* Define to the full name of this package. */
#undef PACKAGE_NAME
/* Define to the full name and version of this package. */
#undef PACKAGE_STRING
/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME
/* Define to the home page for this package. */
#undef PACKAGE_URL
/* Define to the version of this package. */
#undef PACKAGE_VERSION
/* If using the C implementation of alloca, define if you know the
direction of stack growth for your system; otherwise it will be
automatically deduced at runtime.
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
#undef STACK_DIRECTION
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
significant byte first (like Motorola and SPARC, unlike Intel). */
#if defined AC_APPLE_UNIVERSAL_BUILD
# if defined __BIG_ENDIAN__
# define WORDS_BIGENDIAN 1
# endif
#else
# ifndef WORDS_BIGENDIAN
# undef WORDS_BIGENDIAN
# endif
#endif
/* Define for multi-thread support */
#undef _REENTRANT

View File

@ -1,33 +0,0 @@
dnl Process this file with autoconf to produce a configure script.
AC_INIT(install-sh)
AC_PREREQ([2.50])
AC_CONFIG_HEADER(config.h)
AC_SUBST(TARGETS)
AC_SUBST(PLTARGETS)
m4_include([../ac_swi_c.m4])
AC_CHECK_HEADERS(zlib.h zutil.h)
AC_CHECK_LIB(z, zlibVersion,
LIBS="$LIBS -lz"
ZLIB=yes,
ZLIB=no)
if test "$ZLIB" = yes; then
TARGETS="zlib4pl.$SO"
PLTARGETS=zlib.pl
else
TARGETS=nolib
cat << EOF
##################################################################
# ERROR: Could not find library zlib (-lz). Dropped library(zlib)
# Library zlib is available from http://www.zlib.net/
# Most Unix/Linux distributions are shipped with binaries. Make
# sure to have the development library installed.
##################################################################
EOF
fi
AC_OUTPUT(Makefile)

View File

@ -1,204 +0,0 @@
:- module(test_zlib,
[ test_zlib/0
]).
:- asserta(user:file_search_path(foreign, '.')).
:- asserta(user:file_search_path(foreign, '../clib')).
:- asserta(user:file_search_path(library, '.')).
:- asserta(user:file_search_path(library, '../plunit')).
:- asserta(user:file_search_path(library, '../clib')).
:- use_module(library(zlib)).
:- use_module(library(plunit)).
:- use_module(library(readutil)).
:- use_module(library(socket)).
:- use_module(library(debug)).
test_zlib :-
run_tests([ zlib
]).
:- begin_tests(zlib).
% gunzip: can we read a file compressed with gzip
test(gunzip,
[ setup(shell('gzip < test_zlib.pl > plunit-tmp.gz')),
cleanup(delete_file('plunit-tmp.gz'))
]) :-
gzopen('plunit-tmp.gz', read, ZIn),
call_cleanup(read_stream_to_codes(ZIn, Codes0), close(ZIn)),
this_read_file_to_codes('test_zlib.pl', Codes1),
Codes0 == Codes1.
% gzip: Can gunzip read our compressed file
test(gzip,
[ cleanup(delete_file('plunit-tmp.gz'))
]) :-
this_read_file_to_codes('test_zlib.pl', Codes),
gzopen('plunit-tmp.gz', write, ZOut),
format(ZOut, '~s', [Codes]),
close(ZOut),
this_read_file_to_codes(pipe('gunzip < plunit-tmp.gz'), Codes1),
Codes == Codes1.
% deflate: test read/write of deflate format
test(deflate,
[ cleanup(delete_file('plunit-tmp.z'))
]) :-
this_read_file_to_codes('test_zlib.pl', Codes),
system:swi_open('plunit-tmp.z', write, Out),
zopen(Out, ZOut, []),
format(ZOut, '~s', [Codes]),
close(ZOut),
system:swi_open('plunit-tmp.z', read, In),
zopen(In, ZIn, []),
read_stream_to_codes(ZIn, Codes1),
close(ZIn),
Codes == Codes1.
% zstream: test compressed stream flushing and processing
test(zstream, Exit == true) :-
server(Port),
debug(server, 'Server at ~w~n', [Port]),
client(Port),
thread_join(server, Exit).
server(Port) :-
tcp_socket(S),
tcp_bind(S, Port),
tcp_listen(S, 5),
tcp_open_socket(S, AcceptFd, _),
thread_create(process(AcceptFd), _, [alias(server)]).
process(AcceptFd) :-
tcp_accept(AcceptFd, S2, _Peer),
tcp_open_socket(S2, ZIn, ZOut),
zopen(ZIn, In, []),
zopen(ZOut, Out, []),
loop(In, Out),
read(In, X),
assertion(X==end_of_file),
close(In), close(Out).
loop(In, Out) :-
read(In, Term),
debug(server, 'Read ~w', [Term]),
( Term == quit
-> true
; format(Out, '~q.~n', [Term]),
flush_output(Out),
debug(server, 'Replied', [Term]),
loop(In, Out)
).
client(Port) :-
integer(Port), !,
client(localhost:Port).
client(Address) :-
tcp_socket(S),
tcp_connect(S, Address),
tcp_open_socket(S, ZIn, ZOut),
zopen(ZIn, In, []),
zopen(ZOut, Out, []),
process_client(In, Out),
close(Out),
read(In, X),
assertion(X==end_of_file),
close(In).
process_client(In, Out) :-
forall(between(0, 50, X),
( format(Out, '~q.~n', [X]),
flush_output(Out),
read(In, Term),
%put(user_error, .),
( X == Term
-> true
; format('Wrong reply~n'),
fail
)
)),
format(Out, 'quit.~n', []).
/*******************************
* BIG DATA *
*******************************/
test(big) :-
forall(between(1, 5, I),
( Max is 10**I,
big(_, Max))).
big(Port, N):-
tcp_socket(SockFd),
tcp_setopt(SockFd, reuseaddr),
tcp_bind(SockFd, Port),
tcp_listen(SockFd, 5),
thread_create(client_test(Port, N), Client, []),
tcp_accept(SockFd, ClientFd, _Peer),
tcp_open_socket(ClientFd, InStream, OutStream),
zopen(OutStream, ZOut, [close_parent(false), format(deflate)]),
send_data(1, N, ZOut),
close(InStream),
character_count(ZOut, RawCnt),
close(ZOut),
character_count(OutStream, CompressedCnt),
debug(zlib, 'compressed ~d into ~d bytes~n',
[RawCnt, CompressedCnt]),
close(OutStream),
tcp_close_socket(SockFd),
thread_join(Client, Status),
assertion(Status == true).
send_data(I, N, ZOut) :-
I =< N, !,
format(ZOut, '~d.~n', [I]),
I2 is I + 1,
send_data(I2, N, ZOut).
send_data(_, _, _).
client_test(Port, N) :-
tcp_socket(SockFd),
tcp_connect(SockFd, localhost:Port),
tcp_open_socket(SockFd, In, Out),
zopen(In, ZIn, [format(deflate)]),
get_data(ZIn, N),
close(ZIn),
close(Out).
get_data(ZIn, _) :-
debugging(data), !,
between(0, inf, X),
get_byte(ZIn, C),
( C == -1
-> !,
format('EOF at ~w~n', [X])
; put_byte(C),
fail
).
get_data(ZIn, N) :-
between(1, inf, X),
read(ZIn, Term),
( Term == end_of_file
-> !,
assertion(X =:= N + 1)
; assertion(Term == X),
fail
).
:- end_tests(zlib).
/*******************************
* UTIL *
*******************************/
this_read_file_to_codes(File, Codes) :-
system:swi_open(File, read, In),
call_cleanup(read_stream_to_codes(In, Codes), close(In)).

View File

@ -1,163 +0,0 @@
\documentclass[11pt]{article}
\usepackage{times}
\usepackage{pl}
\usepackage{html}
\sloppy
\makeindex
\onefile
\htmloutput{html} % Output directory
\htmlmainfile{index} % Main document file
\bodycolor{white} % Page colour
\begin{document}
\title{SWI-Prolog binding to zlib}
\author{Jan Wielemaker \\
HCS, \\
University of Amsterdam \\
The Netherlands \\
E-mail: \email{wielemak@science.uva.nl}}
\maketitle
\begin{abstract}
The library \pllib{zlib} provides a binding to the
\url[zlib]{http://www.zlib.net/} general purpose compression library.
The prolog library aims as seamlessly reading and writing files
compatible to the \program{gzip} program as well as compressed (network)
communication.
\end{abstract}
\pagebreak
\tableofcontents
\vfill
\vfill
\newpage
\section{Zlib and compression}
Zlib is a widespread library implementing the RFC1950 (zlib wrapper),
RFC1951 (deflate stream) and RFC1952 (gzip wrapper) compression
standards. The SWI-Prolog binding is a foreign library that creates a
compressed stream as a wrapper around a normal stream. Implemented this
way, it can perform a wide variety of tasks:
\begin{itemize}
\item Read/write gzip compatible files
\item Setup standard compressed stream communication
\item Realise in-memory compression or decompression
\item Deal with streams holding embedded compressed objects
\end{itemize}
The core predicate of the library is zopen/3. The remainder of the
functionality of \pllib{zlib} is defined in Prolog and can be used as a
starting point for other high-level primitives. See also \file{ztest.pl}
providing test and demo code. This file is part of the source
distribution.
Part of the functionality of this library can also be realised using
the pipe interface and the \program{gzip} program. For example, a
gziped file can also be opened in Prolog using the code below.
\begin{code}
...
open(pipe('gunzip < file.gz'), read, In),
...
\end{code}
The advantage of this library for such tasks is enhanced platform
independence and reduced time to open a file. Platform independence is
improved as we do not have to worry about availability of the
\program{gunzip} utility and we do not have to worry about shell and
filename quoting issues. While the above works well on most modern Unix
systems, it only works with special precautions on Windows.%
\footnote{Install gunzip, deal with Windows path-names, the
windows shell and quoting.}
The library becomes really valuable if we consider compressed network
communication. Here we get the stream from tcp_open_socket/3. The
library provides efficient creation of a compressed stream, as well as
support for flushing output through the standard Prolog flush_output/1
call.
\section{Predicate reference}
\begin{description}
\predicate{zopen}{3}{+Stream, -ZStream, +Options}
Creates \arg{ZStream}, providing compressed access to \arg{Stream}. If
an input stream is wrapped, it recognises a gzip or deflate header.
If an output stream is enabled, \arg{Options} define the desired wrapper
and compression level. Defined options on output streams are:
\begin{description}
\termitem{format}{+Format}
Either \const{deflate} (default) or \const{gzip}. The \const{deflate}
envelope is simple and short and is typically used for compressed
(network) communication. The \const{gzip} envelope is compatible to
the \program{gzip} program and intended to read/write compressed files.
\termitem{level}{+Level}
Number between 0 and 9, specifying the compression level, Higher levels
use more resources. Default is 6, generally believed to be a good
compromise between speed, memory requirement and compression.
\end{description}
Generic options are:
\begin{description}
\termitem{close_parent}{Bool}
If \const{true} (default), closing the compressed stream also closes
(and thus invalidates) the wrapped stream. If \const{false}, the wrapped
stream is \emph{not} closed. This can be used to read/write a compressed
ndata block as partial input/output on a stream.
\end{description}
\predicate{gzopen}{3}{+File, +Mode, -Stream}
Same as \exam{gzopen}{File, Mode, Stream, []}.
\predicate{gzopen}{4}{+File, +Mode, -Stream, +Options}
Open \program{gzip} compatible \arg{File} for reading or writing.
\end{description}
\section{Interaction with Prolog stream predicates}
Using flush_output/1 on a compressed stream causes a
\const{Z_SYNC_FLUSH} on the stream. Using close/1 on a compressed
stream causes a \const{Z_FINISH} on the stream. If the stream uses
the \const{gzip} format, a \program{gzip} compatible footer is
written to the stream. If \const{close_parent} is set (default)
the underlying stream is closed too. Otherwise it remains open
and the user can continue communication in non-compressed format
or reopen the stream for compression using zopen/3.
\section{Installation}
\subsection{Unix systems}
Installation on Unix system uses the commonly found {\em configure},
{\em make} and {\em make install} sequence. SWI-Prolog should be
installed before building this package. If SWI-Prolog is not installed
as \program{pl}, the environment variable \env{PL} must be set to the
name of the SWI-Prolog executable. Installation is now accomplished
using:
\begin{code}
% ./configure
% make
% make install
\end{code}
This installs the foreign libraries in \file{$PLBASE/lib/$PLARCH} and
the Prolog library files in \file{$PLBASE/library}, where
\file{$PLBASE} refers to the SWI-Prolog `home-directory'.
\printindex
\end{document}

View File

@ -1,88 +0,0 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2006, University of Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(zlib,
[ zopen/3, % +Stream, -ZStream, +Option
gzopen/3, % +File, +Mode, -Stream
gzopen/4 % +File, +Mode, -Stream, +Options
]).
:- use_module(library(shlib)).
:- use_module(library(error)).
:- expects_dialect(swi).
:- assert(system:swi_io).
/** <module> Zlib wrapper for SWI-Prolog
Read/write compressed data based on the zlib library.
@author Jan Wielemaker
@see http://www.zlib.net/
@see http://www.swi-prolog.org/packages/zlib.html
*/
:- use_foreign_library(foreign(zlib4pl)).
%% gzopen(+File, +Mode, -Stream) is det.
%% gzopen(+File, +Mode, -Stream, +Options) is det.
%
% Open a file compatible with the gzip program. Note that if a
% file is opened in =append= mode, a second gzip image will be
% added to the end of the file.
%
% @tbd Later versions may actually append to an existing
% compressed file.
gzopen(File, Mode, Stream) :-
gzopen(File, Mode, Stream, []).
gzopen(File, Mode, Stream, Options) :-
must_be(oneof([read,write,append]), Mode),
zoptions(Options, ZOptions, OpenOptions),
open(File, Mode, Stream0, OpenOptions),
zopen(Stream0, Stream,
[ format(gzip),
close_parent(true)
| ZOptions
]).
zoptions([], [], []).
zoptions([H|T], [H|TZ], TO) :-
zoption(H), !,
zoptions(T, TZ, TO).
zoptions([H|T], TZ, [H|TO]) :-
zoptions(T, TZ, TO).
zoption(format(_)).
zoption(level(_)).
:- retract(system:swi_io).

View File

@ -1,797 +0,0 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 2006, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define O_DEBUG 1
#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <time.h>
#include <zlib.h>
/* Some distributions do not include this ... */
#ifdef HAVE_ZUTIL_H
#include <zutil.h>
#else
#include "zutil.h"
#endif
static functor_t FUNCTOR_error2; /* error(Formal, Context) */
static functor_t FUNCTOR_type_error2; /* type_error(Term, Expected) */
static functor_t FUNCTOR_domain_error2; /* domain_error(Term, Expected) */
static atom_t ATOM_format; /* format(Format) */
static atom_t ATOM_level; /* level(Int) */
static atom_t ATOM_close_parent; /* close_parent(Bool) */
static atom_t ATOM_gzip;
static atom_t ATOM_deflate;
static int debuglevel = 0;
#ifdef O_DEBUG
#define DEBUG(n, g) if ( debuglevel >= n ) g
#else
#define DEBUG(n, g) (void)0
#endif
/*******************************
* ERRORS *
*******************************/
static int
type_error(term_t actual, const char *expected)
{ term_t ex;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_CHARS, expected,
PL_TERM, actual,
PL_VARIABLE) )
return PL_raise_exception(ex);
return FALSE;
}
static int
domain_error(term_t actual, const char *domain)
{ term_t ex;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_CHARS, domain,
PL_TERM, actual,
PL_VARIABLE) )
return PL_raise_exception(ex);
return FALSE;
}
static int
instantiation_error()
{ term_t ex;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR, FUNCTOR_error2,
PL_CHARS, "instantiation_error",
PL_VARIABLE) )
return PL_raise_exception(ex);
return FALSE;
}
static int
get_atom_ex(term_t t, atom_t *a)
{ if ( PL_get_atom(t, a) )
return TRUE;
return type_error(t, "atom");
}
static int
get_int_ex(term_t t, int *i)
{ if ( PL_get_integer(t, i) )
return TRUE;
return type_error(t, "integer");
}
static int
get_bool_ex(term_t t, int *i)
{ if ( PL_get_bool(t, i) )
return TRUE;
return type_error(t, "boolean");
}
/*******************************
* TYPES *
*******************************/
#define BUFSIZE SIO_BUFSIZE /* raw I/O buffer */
typedef enum
{ F_UNKNOWN = 0,
F_GZIP, /* gzip output */
F_GZIP_CRC, /* end of gzip output */
F_DEFLATE /* zlib data */
} zformat;
typedef struct z_context
{ IOSTREAM *stream; /* Original stream */
IOSTREAM *zstream; /* Compressed stream (I'm handle of) */
int close_parent; /* close parent on close */
int initialized; /* did inflateInit()? */
zformat format; /* current format */
uLong crc; /* CRC check */
z_stream zstate; /* Zlib state */
} z_context;
static z_context*
alloc_zcontext(IOSTREAM *s)
{ z_context *ctx = PL_malloc(sizeof(*ctx));
memset(ctx, 0, sizeof(*ctx));
ctx->stream = s;
ctx->close_parent = TRUE;
return ctx;
}
static void
free_zcontext(z_context *ctx)
{ if ( ctx->stream->upstream )
Sset_filter(ctx->stream, NULL);
else
PL_release_stream(ctx->stream);
PL_free(ctx);
}
/*******************************
* GZIP HEADER *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Code based on gzio.c from the zlib source distribution.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int 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 */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
gz_skip_header() parses the gzip file-header. return
* If ok: pointer to first byte following header
* If not a gzip file: NULL
* If still ok, but incomplete: GZHDR_SHORT
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define HDR_SHORT ((Bytef*)-1) /* Header is incomplete */
#define SKIP_STRING \
{ while ( *in && avail > 0 ) \
in++, avail--; \
if ( avail > 0 ) \
in++, avail--; \
}
static Bytef *
gz_skip_header(z_context *ctx, Bytef *in, int avail)
{ int method; /* method byte */
int flags; /* flags byte */
int len;
if ( avail < 10 ) /* 2-byte magic, method, flags, */
return HDR_SHORT; /* time, xflags and OS code */
if ( in[0] != gz_magic[0] &&
in[1] != gz_magic[1] )
return NULL;
in += 2;
method = *in++;
flags = *in++;
if ( method != Z_DEFLATED || (flags & RESERVED ) != 0)
return NULL;
in += 6; /* Discard time, xflags and OS code */
avail -= 10;
if ((flags & EXTRA_FIELD) != 0)
{ /* skip the extra field */
len = *in++;
len += (*in++)<<8;
len &= 0xffff;
if ( avail > len )
{ in += len;
avail -= len;
} else
{ return HDR_SHORT;
}
}
if ((flags & ORIG_NAME) != 0)
{ /* skip the original file name */
SKIP_STRING
}
if ((flags & COMMENT) != 0)
{ /* skip the .gz file comment */
SKIP_STRING
}
if ((flags & HEAD_CRC) != 0)
{ /* skip the header crc */
in += 2;
avail -= 2;
}
if ( avail <= 0 )
return HDR_SHORT;
return in;
}
static int
write_ulong_lsb(IOSTREAM *s, unsigned long x)
{ Sputc((x) &0xff, s);
Sputc((x>>8) &0xff, s);
Sputc((x>>16)&0xff, s);
Sputc((x>>24)&0xff, s);
return Sferror(s) ? -1 : 0;
}
static int
write_gzip_header(z_context *ctx)
{ IOSTREAM *s = ctx->stream;
time_t stamp = time(NULL);
Sputc(gz_magic[0], s);
Sputc(gz_magic[1], s);
Sputc(Z_DEFLATED, s); /* method */
Sputc(0, s); /* flags */
write_ulong_lsb(s, (unsigned long)stamp); /* time stamp */
Sputc(0, s); /* xflags */
Sputc(OS_CODE, s); /* OS identifier */
return Sferror(s) ? FALSE : TRUE; /* TBD: Error */
}
static int
write_gzip_footer(z_context *ctx)
{ IOSTREAM *s = ctx->stream;
write_ulong_lsb(s, ctx->crc); /* CRC32 */
write_ulong_lsb(s, ctx->zstate.total_in); /* Total length */
return Sferror(s) ? -1 : 0;
}
static Bytef *
get_ulong_lsb(const Bytef *in, uLong *v)
{ *v = (in[0] |
in[1] << 8 |
in[2] << 16 |
in[3] << 24) & 0xffffffff;
return (Bytef*)in+4;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
0: ok
-1: CRC/size error
-2: not enough data
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
gz_skip_footer(z_context *ctx)
{ if ( ctx->zstate.avail_in >= 8 )
{ uLong crc, size;
Bytef *in = ctx->zstate.next_in;
in = get_ulong_lsb(in, &crc);
in = get_ulong_lsb(in, &size);
ctx->zstate.next_in = in;
ctx->zstate.avail_in -= 8;
if ( crc != ctx->crc )
{ char msg[256];
Ssprintf(msg, "CRC error (%08lx != %08lx)", crc, ctx->crc);
Sseterr(ctx->zstream, SIO_FERR, msg);
return -1;
}
if ( size != ctx->zstate.total_out )
{ char msg[256];
Ssprintf(msg, "Size mismatch (%ld != %ld)", size, ctx->zstate.total_out);
Sseterr(ctx->zstream, SIO_FERR, msg);
return -1;
}
return 0;
}
return -2;
}
/*******************************
* GZ I/O *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
read_more() reads more data into the zstate buffer if deflating cannot
do anything with the available bytes. Note that S__fillbuf() can be
called with data in the buffer. It moves the remaining data to the start
of the stream buffer and tries to read more data into the stream.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
read_more(z_context *ctx)
{ int c;
ctx->stream->bufp = (char*)ctx->zstate.next_in;
ctx->stream->limitp = ctx->stream->bufp + ctx->zstate.avail_in;
if ( (c=S__fillbuf(ctx->stream)) != EOF )
{ Sungetc(c, ctx->stream);
ctx->zstate.next_in = (Bytef*)ctx->stream->bufp;
ctx->zstate.avail_in = (long)(ctx->stream->limitp - ctx->stream->bufp);
ctx->stream->bufp = ctx->stream->limitp;
return 0;
}
return -1;
}
static ssize_t /* inflate */
zread(void *handle, char *buf, size_t size)
{ z_context *ctx = handle;
int flush = Z_SYNC_FLUSH;
int rc;
if ( ctx->zstate.avail_in == 0 )
{ if ( Sfeof(ctx->stream) )
{ flush = Z_FINISH;
} else
{ ctx->zstate.next_in = (Bytef*)ctx->stream->bufp;
ctx->zstate.avail_in = (long)(ctx->stream->limitp - ctx->stream->bufp);
ctx->stream->bufp = ctx->stream->limitp; /* empty buffer */
}
}
DEBUG(1, Sdprintf("Processing %d bytes\n", ctx->zstate.avail_in));
ctx->zstate.next_out = (Bytef*)buf;
ctx->zstate.avail_out = (long)size;
if ( ctx->initialized == FALSE )
{ Bytef *p;
DEBUG(1, Sdprintf("Trying gzip header\n"));
if ( ctx->format == F_DEFLATE )
{ p = NULL;
} else
{ while( (p = gz_skip_header(ctx, ctx->zstate.next_in,
ctx->zstate.avail_in)) == HDR_SHORT )
{ int rc;
if ( (rc=read_more(ctx)) < 0 )
return -1;
}
}
if ( p )
{ long m = (int)(p - ctx->zstate.next_in);
ctx->format = F_GZIP;
DEBUG(1, Sdprintf("Skipped gzip header (%d bytes)\n", m));
ctx->zstate.next_in = p;
ctx->zstate.avail_in -= m;
/* init without header */
switch(inflateInit2(&ctx->zstate, -MAX_WBITS))
{ case Z_OK:
ctx->initialized = TRUE;
ctx->crc = crc32(0L, Z_NULL, 0);
DEBUG(1, Sdprintf("inflateInit2(): Z_OK\n"));
break;
case Z_MEM_ERROR: /* no memory */
case Z_VERSION_ERROR: /* bad library version */
PL_warning("ERROR: TBD");
return -1;
default:
assert(0);
return -1;
}
} else
{ switch(inflateInit(&ctx->zstate))
{ case Z_OK:
ctx->format = F_DEFLATE;
ctx->initialized = TRUE;
DEBUG(1, Sdprintf("inflateInit(): Z_OK\n"));
break;
case Z_MEM_ERROR: /* no memory */
case Z_VERSION_ERROR: /* bad library version */
PL_warning("ERROR: TBD");
return -1;
default:
assert(0);
return -1;
}
}
} else if ( ctx->format == F_GZIP_CRC )
{ int rc;
while( (rc=gz_skip_footer(ctx)) == -2 )
{ int rc2;
if ( (rc2=read_more(ctx)) < 0 )
return -1;
}
if ( rc == 0 )
{ int avail = ctx->zstate.avail_in;
/* copy back unprocessed bytes */
DEBUG(1, Sdprintf("GZIP footer ok; copying %d bytes back\n", avail));
memmove(ctx->stream->buffer, ctx->zstate.next_in, avail);
ctx->stream->bufp = ctx->stream->buffer;
ctx->stream->limitp = ctx->stream->bufp + avail;
return 0; /* EOF */
} else
{ DEBUG(1, Sdprintf("GZIP CRC/length error\n"));
return -1;
}
}
switch((rc=inflate(&ctx->zstate, Z_NO_FLUSH)))
{ case Z_OK:
case Z_STREAM_END:
{ long n = (long)(size - ctx->zstate.avail_out);
if ( ctx->format == F_GZIP && n > 0 )
ctx->crc = crc32(ctx->crc, (Bytef*)buf, n);
if ( rc == Z_STREAM_END )
{ DEBUG(1, Sdprintf("Z_STREAM_END: %d bytes\n", n));
if ( ctx->format == F_GZIP )
ctx->format = F_GZIP_CRC;
} else
{ DEBUG(1, Sdprintf("inflate(): Z_OK: %d bytes\n", n));
}
return n;
}
case Z_NEED_DICT:
DEBUG(1, Sdprintf("Z_NEED_DICT\n"));
break;
case Z_DATA_ERROR:
DEBUG(1, Sdprintf("Z_DATA_ERROR\n"));
break;
case Z_STREAM_ERROR:
DEBUG(1, Sdprintf("Z_STREAM_ERROR\n"));
break;
case Z_MEM_ERROR:
DEBUG(1, Sdprintf("Z_MEM_ERROR\n"));
break;
case Z_BUF_ERROR:
DEBUG(1, Sdprintf("Z_BUF_ERROR\n"));
break;
default:
DEBUG(1, Sdprintf("Inflate error: %d\n", rc));
}
if ( ctx->zstate.msg )
Sdprintf("ERROR: zread(): %s\n", ctx->zstate.msg);
return -1;
}
static ssize_t /* deflate */
zwrite4(void *handle, char *buf, size_t size, int flush)
{ z_context *ctx = handle;
Bytef buffer[SIO_BUFSIZE];
int rc;
int loops = 0;
ctx->zstate.next_in = (Bytef*)buf;
ctx->zstate.avail_in = (long)size;
if ( ctx->format == F_GZIP && size > 0 )
ctx->crc = crc32(ctx->crc, ctx->zstate.next_in, ctx->zstate.avail_in);
DEBUG(1, Sdprintf("Compressing %d bytes\n", ctx->zstate.avail_in));
do
{ loops++;
ctx->zstate.next_out = buffer;
ctx->zstate.avail_out = sizeof(buffer);
switch( (rc = deflate(&ctx->zstate, flush)) )
{ case Z_OK:
case Z_STREAM_END:
{ size_t n = sizeof(buffer) - ctx->zstate.avail_out;
DEBUG(1, Sdprintf("Compressed (%s) to %d bytes; left %d\n",
rc == Z_OK ? "Z_OK" : "Z_STREAM_END",
n, ctx->zstate.avail_in));
if ( Sfwrite(buffer, 1, n, ctx->stream) != n )
return -1;
break;
}
case Z_BUF_ERROR:
DEBUG(1, Sdprintf("zwrite4(): Z_BUF_ERROR\n"));
break;
case Z_STREAM_ERROR:
default:
Sdprintf("ERROR: zwrite(): %s\n", ctx->zstate.msg);
return -1;
}
} while ( ctx->zstate.avail_in > 0 ||
(flush != Z_NO_FLUSH && rc == Z_OK) );
if ( flush != Z_NO_FLUSH && Sflush(ctx->stream) < 0 )
return -1;
return size;
}
static ssize_t /* deflate */
zwrite(void *handle, char *buf, size_t size)
{ return zwrite4(handle, buf, size, Z_NO_FLUSH);
}
static int
zcontrol(void *handle, int op, void *data)
{ z_context *ctx = handle;
switch(op)
{ case SIO_FLUSHOUTPUT:
DEBUG(1, Sdprintf("Flushing output\n"));
return (int)zwrite4(handle, NULL, 0, Z_SYNC_FLUSH);
case SIO_SETENCODING:
return 0; /* allow switching encoding */
default:
if ( ctx->stream->functions->control )
return (*ctx->stream->functions->control)(ctx->stream->handle, op, data);
return -1;
}
}
static int
zclose(void *handle)
{ z_context *ctx = handle;
ssize_t rc;
DEBUG(1, Sdprintf("zclose() ...\n"));
if ( (ctx->stream->flags & SIO_INPUT) )
{ rc = inflateEnd(&ctx->zstate);
} else
{ rc = zwrite4(handle, NULL, 0, Z_FINISH); /* flush */
if ( rc == 0 && ctx->format == F_GZIP )
rc = write_gzip_footer(ctx);
if ( rc == 0 )
rc = deflateEnd(&ctx->zstate);
else
deflateEnd(&ctx->zstate);
}
switch(rc)
{ case Z_OK:
DEBUG(1, Sdprintf("%s(): Z_OK\n",
(ctx->stream->flags & SIO_INPUT) ? "inflateEnd"
: "deflateEnd"));
if ( ctx->close_parent )
{ IOSTREAM *parent = ctx->stream;
free_zcontext(ctx);
return Sclose(parent);
} else
{ free_zcontext(ctx);
return 0;
}
case Z_STREAM_ERROR: /* inconsistent state */
case Z_DATA_ERROR: /* premature end */
default:
if ( ctx->close_parent )
{ IOSTREAM *parent = ctx->stream;
free_zcontext(ctx);
Sclose(parent);
return -1;
}
free_zcontext(ctx);
return -1;
}
}
static IOFUNCTIONS zfunctions =
{ zread,
zwrite,
NULL, /* seek */
zclose,
zcontrol, /* zcontrol */
NULL, /* seek64 */
};
/*******************************
* PROLOG CONNECTION *
*******************************/
#define COPY_FLAGS (SIO_INPUT|SIO_OUTPUT| \
SIO_TEXT| \
SIO_REPXML|SIO_REPPL|\
SIO_RECORDPOS)
static foreign_t
pl_zopen(term_t org, term_t new, term_t options)
{ term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
z_context *ctx;
zformat fmt = F_UNKNOWN;
int level = Z_DEFAULT_COMPRESSION;
IOSTREAM *s, *s2;
int close_parent = TRUE;
while(PL_get_list(tail, head, tail))
{ atom_t name;
int arity;
term_t arg = PL_new_term_ref();
if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
return type_error(head, "option");
_PL_get_arg(1, head, arg);
if ( name == ATOM_format )
{ atom_t a;
if ( !get_atom_ex(arg, &a) )
return FALSE;
if ( a == ATOM_gzip )
fmt = F_GZIP;
else if ( a == ATOM_deflate )
fmt = F_DEFLATE;
else
return domain_error(arg, "compression_format");
} else if ( name == ATOM_level )
{ if ( !get_int_ex(arg, &level) )
return FALSE;
if ( level < 0 || level > 9 )
return domain_error(arg, "compression_level");
} else if ( name == ATOM_close_parent )
{ if ( !get_bool_ex(arg, &close_parent) )
return FALSE;
}
}
if ( !PL_get_nil(tail) )
return type_error(tail, "list");
if ( !PL_get_stream_handle(org, &s) )
return FALSE; /* Error */
ctx = alloc_zcontext(s);
ctx->close_parent = close_parent;
ctx->format = fmt;
if ( (s->flags & SIO_OUTPUT) )
{ int rc;
if ( fmt == F_GZIP )
{ if ( write_gzip_header(ctx) < 0 )
{ free_zcontext(ctx);
return FALSE;
}
rc = deflateInit2(&ctx->zstate, level, Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0);
} else
{ rc = deflateInit(&ctx->zstate, level);
}
if ( rc != Z_OK )
{ free_zcontext(ctx);
return FALSE; /* TBD: Error */
}
}
if ( !(s2 = Snew(ctx,
(s->flags&COPY_FLAGS)|SIO_FBUF,
&zfunctions)) )
{ free_zcontext(ctx); /* no memory */
return FALSE;
}
s2->encoding = s->encoding;
ctx->zstream = s2;
Sset_filter(s, s2);
PL_release_stream(s);
if ( PL_unify_stream(new, s2) )
{ return TRUE;
} else
{ ctx->close_parent = FALSE;
Sclose(s2);
return instantiation_error();
}
}
#ifdef O_DEBUG
static foreign_t
zdebug(term_t level)
{ return PL_get_integer(level, &debuglevel);
}
#endif
/*******************************
* INSTALL *
*******************************/
#define MKFUNCTOR(name, arity) PL_new_functor(PL_new_atom(name), arity)
install_t
install_zlib4pl()
{ FUNCTOR_error2 = MKFUNCTOR("error", 2);
FUNCTOR_type_error2 = MKFUNCTOR("type_error", 2);
FUNCTOR_domain_error2 = MKFUNCTOR("domain_error", 2);
ATOM_format = PL_new_atom("format");
ATOM_level = PL_new_atom("level");
ATOM_close_parent = PL_new_atom("close_parent");
ATOM_gzip = PL_new_atom("gzip");
ATOM_deflate = PL_new_atom("deflate");
PL_register_foreign("zopen", 3, pl_zopen, 0);
#ifdef O_DEBUG
PL_register_foreign("zdebug", 1, zdebug, 0);
#endif
}

View File

@ -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 <stddef.h>
# endif
# include <string.h>
# include <stdlib.h>
#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 <errno.h>
# 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 <alloc.h>
# endif
# else /* MSC or DJGPP */
# include <malloc.h>
# 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 <malloc.h>
# 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 <unix.h> /* 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 <stdio.h>
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 */