examples/compress.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          compress.cl
   6 ;;;; Purpose:       UFFI Example file for zlib compression
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id: compress.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  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 ;;;; *************************************************************************
  18
  19 (in-package :cl-user)
  20
  21 (unless (uffi:load-foreign-library
  22          (uffi:find-foreign-library
  23           "libz"
  24           '("/usr/local/lib/" "/usr/lib/" "/zlib/")
  25           :types '("so" "a" "dylib"))
  26          :module "zlib"
  27          :supporting-libraries '("c"))
  28   (warn "Unable to load zlib"))
  29
  30 (uffi:def-function ("compress" c-compress)
  31     ((dest (* :unsigned-char))
  32      (destlen (* :long))
  33      (source :cstring)
  34      (source-len :long))
  35   :returning :int
  36   :module "zlib")
  37
  38 (defun compress (source)
  39   "Returns two values: array of bytes containing the compressed data
  40  and the numbe of compressed bytes"
  41   (let* ((sourcelen (length source))
  42          (destsize (+ 12 (ceiling (* sourcelen 1.01))))
  43          (dest (uffi:allocate-foreign-string destsize :unsigned t))
  44          (destlen (uffi:allocate-foreign-object :long)))
  45     (setf (uffi:deref-pointer destlen :long) destsize)
  46     (uffi:with-cstring (source-native source)
  47       (let ((result (c-compress dest destlen source-native sourcelen))
  48             (newdestlen (uffi:deref-pointer destlen :long)))
  49         (unwind-protect
  50             (if (zerop result)
  51                 (values (uffi:convert-from-foreign-string
  52                          dest
  53                          :length newdestlen
  54                          :null-terminated-p nil)
  55                         newdestlen)
  56               (error "zlib error, code ~D" result))
  57           (progn
  58             (uffi:free-foreign-object destlen)
  59             (uffi:free-foreign-object dest)))))))
  60
  61
  62 #+examples-uffi
  63 (progn
  64   (flet ((print-results (str)
  65            (multiple-value-bind (compressed len) (compress str)
  66                (format t "~&(compress ~S) => " str)
  67                (dotimes (i len)
  68                  (format t "~X" (char-code (char compressed i))))
  69                (format t ",~D" len))))
  70     (print-results "")
  71     (print-results "test")
  72     (print-results "test2")))
  73
  74 ;; Results of the above on my system:
  75 ;; (compress "") => 789c300001,8
  76 ;; (compress "test") => 789c2b492d2e1045d1c1,12
  77 ;; (compress "test2") => 789c2b492d2e31206501f3,13