/usr/lib/clisp-2.49.60+/gdbm/gdbm.lisp is in clisp-module-gdbm 1:2.49.20170913-4build1.
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 | ;; Module for GDBM / CLISP
;; <http://www.gnu.org/gdbm/>
;; Copyright (C) 2007 Masayuki Onjo <onjo@lispuser.net>
;; Copyright (C) 2007-2008 Sam Steingold <sds@gnu.org>
;; Released under GNU GPL2
(defpackage #:gdbm
(:documentation
"GDBM - The GNU database manager - <http://www.gnu.org/software/gdbm/>")
(:use #:lisp)
(:export #:gdbm #:gdbm-p #:gdbm-error #:gdbm-version
#:gdbm-path #:gdbm-default-key-type #:gdbm-default-value-type
#:gdbm-error-message #:gdbm-error-code
#:gdbm-open #:gdbm-open-p #:gdbm-close #:do-db #:with-open-db
#:gdbm-store #:gdbm-fetch #:gdbm-delete #:gdbm-exists
#:gdbm-firstkey #:gdbm-nextkey #:gdbm-file-size
#:gdbm-reorganize #:gdbm-sync #:gdbm-setopt))
(in-package "GDBM")
(pushnew :gdbm *features*)
(provide "gdbm")
(pushnew "GDBM" custom:*system-package-list* :test #'string=)
(setf (documentation (find-package "GDBM") 'sys::impnotes) "gdbm")
;; keep this definition in sync with check_gdbm in gdbm.c
(defstruct (gdbm (:constructor make-gdbm (dbf path key-type value-type)))
dbf
path
key-type
value-type)
(defun gdbm-open-p (gdbm) (not (null (gdbm-dbf gdbm))))
(define-condition gdbm-error (simple-error)
((code :reader gdbm-error-code :initarg :code)
(message :reader gdbm-error-message :initarg :message))
(:report (lambda (condition stream)
(princ (gdbm-error-message condition) stream))))
(defmacro do-db ((key-var gdbm &rest options) &body body)
"Iterate over the GDBM keys in LOOP."
(let ((db (gensym "DO-DB")))
`(loop :with ,db = ,gdbm
:for ,key-var = (gdbm:gdbm-firstkey ,db ,@options)
:then (gdbm:gdbm-nextkey ,db ,key-var ,@options)
:while ,key-var ,@body)))
(defmacro with-open-db ((db filename &rest options) &body body)
"Open a GDBM database, execute BODY, ensure that the DB is closed."
(multiple-value-bind (body-rest declarations) (system::parse-body body)
`(let ((,db (gdbm-open ,filename ,@options)))
(declare (read-only ,db) ,@declarations)
(unwind-protect (multiple-value-prog1 (progn ,@body-rest)
(when ,db (gdbm-close ,db)))
(when ,db (gdbm-close ,db))))))
|