/usr/lib/clisp-2.49/zlib/zlib.lisp is in clisp-module-zlib 1:2.49-9ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | ;;; zlib interface
;;; <http://www.gzip.org/zlib>, <http://www.zlib.org>
;;;
;;; Copyright (C) 2004 by Joerg Hoehle
;;; Copyright (C) 2004-2008 by Sam Steingold
;;; This is Free Software, covered by the GNU GPL (v2)
;;; See http://www.gnu.org/copyleft/gpl.html
(defpackage "ZLIB" (:use "CL" "EXT" "FFI"))
(in-package "ZLIB")
(export '(compress uncompress compress-bound error-string z-version
zerror zerror-caller zerror-errno))
(setf (documentation (find-package "ZLIB") 'sys::impnotes) "zlib")
;;; types and constants
;;; foreign function definitions
(default-foreign-language :stdc)
(c-lines "#include <zlib.h>~%")
(def-call-out z-version (:name "zlibVersion")
(:arguments) (:return-type c-string))
(def-call-out compress-bound (:name "compressBound")
(:arguments (sourceLen ulong)) (:return-type ulong))
(def-call-out error-string (:name "zError")
(:arguments (errno int)) (:return-type c-string))
(def-call-out %compress (:name "compress2")
(:arguments (dest c-pointer :in)
(destlen (c-ptr ulong) :in-out)
(source (c-array-ptr uint8))
(sourcelen ulong)
(level int))
(:return-type int))
(def-call-out %uncompress (:name "uncompress")
(:arguments (dest c-pointer :in)
(destlen (c-ptr ulong) :in-out)
(source (c-array-ptr uint8))
(sourcelen ulong))
(:return-type int))
;;; errors
(define-condition zerror (error)
(($errno :type integer :reader zerror-errno :initarg :errno)
($caller :type (or symbol (cons (eql setf) (cons symbol null)))
:reader zerror-caller :initarg :caller))
(:documentation "an error in a ZLIB library call")
(:report (lambda (ze out)
(let ((err (zerror-errno ze)))
(format out "~S/~D: ~A" (zerror-caller ze) err
(error-string err))))))
;;; wrappers
(defun compress (source &key (level -1))
"Compress the byte vector SOURCE into a new byte vector."
(let* ((sourcelen (length source))
(destlen (compress-bound sourcelen)))
(with-c-var (dest `(c-array uint8 ,destlen))
(multiple-value-bind (errno actual)
(%compress (c-var-address dest) destlen source sourcelen level)
(if (zerop errno)
;; CAST not usable because of different size...
(offset dest 0 `(c-array uint8 ,actual))
(error 'zerror :caller 'compress :errno errno))))))
(defun uncompress (source destlen)
"Uncompress the byte vector SOURCE into a new byte vector of length DESTLEN."
(let* ((sourcelen (length source)))
(with-c-var (dest `(c-array uint8 ,destlen))
(multiple-value-bind (errno actual)
(%uncompress (c-var-address dest) destlen source sourcelen)
(if (zerop errno)
;; CAST not usable because of different size...
(offset dest 0 `(c-array uint8 ,actual))
(error 'zerror :caller 'uncompress :errno errno))))))
(pushnew :zlib *features*)
(provide "zlib")
(pushnew "ZLIB" custom:*system-package-list* :test #'string=)
|