1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: UFFI Example file for zlib compression
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
12 ;;;; $Id: compress.cl,v 1.6 2002/03/10 20:01:55 kevin Exp $
14 ;;;; This file is part of UFFI.
16 ;;;; UFFI is free software; you can redistribute it and/or modify
17 ;;;; it under the terms of the GNU General Public License (version 2) as
18 ;;;; published by the Free Software Foundation.
20 ;;;; UFFI is distributed in the hope that it will be useful,
21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;;;; GNU General Public License for more details.
25 ;;;; You should have received a copy of the GNU General Public License
26 ;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
27 ;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 ;;;; *************************************************************************
32 (unless (uffi:load-foreign-library "/usr/lib/libz.so"
34 :supporting-libraries '("c"))
35 (warn "Unable to load zlib"))
37 (uffi:def-function ("compress" c-compress)
38 ((dest (* :unsigned-char))
45 (defun compress (source)
46 "Returns two values: array of bytes containing the compressed data
47 and the numbe of compressed bytes"
48 (let* ((sourcelen (length source))
49 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
50 (dest (uffi:allocate-foreign-string destsize :unsigned t))
51 (destlen (uffi:allocate-foreign-object :long)))
52 (setf (uffi:deref-pointer destlen :long) destsize)
53 (uffi:with-cstring (source-native source)
54 (let ((result (c-compress dest destlen source-native sourcelen))
55 (newdestlen (uffi:deref-pointer destlen :long)))
58 (values (uffi:convert-from-foreign-string
61 :null-terminated-p nil)
63 (error "zlib error, code ~D" result))
65 (uffi:free-foreign-object destlen)
66 (uffi:free-foreign-object dest)))))))
71 (flet ((print-results (str)
72 (multiple-value-bind (compressed len) (compress str)
73 (format t "~&(compress ~S) => ~S,~D" str compressed len))))
75 (print-results "test")
76 (print-results "test2")))