1 ;;;; -*- Mode: ANSI-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: Feb 2002
10 ;;;; $Id: compress.cl,v 1.8 2002/03/17 17:33:30 kevin Exp $
12 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; UFFI users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
21 (unless (uffi:load-foreign-library "/usr/lib/libz.so"
23 :supporting-libraries '("c"))
24 (warn "Unable to load zlib"))
26 (uffi:def-function ("compress" c-compress)
27 ((dest (* :unsigned-char))
34 (defun compress (source)
35 "Returns two values: array of bytes containing the compressed data
36 and the numbe of compressed bytes"
37 (let* ((sourcelen (length source))
38 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
39 (dest (uffi:allocate-foreign-string destsize :unsigned t))
40 (destlen (uffi:allocate-foreign-object :long)))
41 (setf (uffi:deref-pointer destlen :long) destsize)
42 (uffi:with-cstring (source-native source)
43 (let ((result (c-compress dest destlen source-native sourcelen))
44 (newdestlen (uffi:deref-pointer destlen :long)))
47 (values (uffi:convert-from-foreign-string
50 :null-terminated-p nil)
52 (error "zlib error, code ~D" result))
54 (uffi:free-foreign-object destlen)
55 (uffi:free-foreign-object dest)))))))
60 (flet ((print-results (str)
61 (multiple-value-bind (compressed len) (compress str)
62 (format t "~&(compress ~S) => ~S,~D" str compressed len))))
64 (print-results "test")
65 (print-results "test2")))