/usr/share/common-lisp/source/cl-acl-compat/clisp/acl-excl.lisp is in cl-acl-compat 1.2.42+cvs.2010.02.08-dfsg-1.
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 | ;;;;
;;;; ACL-COMPAT - EXCL
;;;;
;;;; Implementation-specific parts of acl-compat.excl (see
;;;; acl-excl-common.lisp)
(in-package :acl-compat.excl)
(defun fixnump (x)
(sys::fixnump x))
(defun stream-input-fn (stream)
stream)
(defun filesys-type (file-or-directory-name)
;; Taken from clocc's port library, with thanks to Sam Steingold
(if (values
(ignore-errors
(#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
file-or-directory-name)))
:directory
(if (probe-file file-or-directory-name)
:file
nil)))
(defmacro atomically (&body forms)
;; No multiprocessing here, move along...
`(progn ,@forms))
(defun unix-signal (signal pid)
(declare (ignore signal pid))
(error "clisp unix-signal not implemented yet."))
(defmacro without-package-locks (&body forms)
`(ext:without-package-lock ,(list-all-packages) ,@forms))
(defun fixnump (x)
(sys::fixnump x))
(defun string-to-octets (string &key (null-terminate t) (start 0)
end mb-vector make-mb-vector?
(external-format :default))
"This function returns a lisp-usb8-vector and the number of bytes copied."
(declare (ignore external-format))
;; The end parameter is different in ACL's lambda list, but this
;; variant lets us give an argument :end nil explicitly, and the
;; right thing will happen
(unless end (setf end (length string)))
(let* ((number-of-octets (if null-terminate (1+ (- end start))
(- end start)))
(mb-vector (cond
((and mb-vector (>= (length mb-vector) number-of-octets))
mb-vector)
((or (not mb-vector) make-mb-vector?)
(make-array (list number-of-octets)
:element-type '(unsigned-byte 8)
:initial-element 0))
(t (error "Was given a vector of length ~A, ~
but needed at least length ~A."
(length mb-vector) number-of-octets)))))
(declare (type (simple-array (unsigned-byte 8) (*)) mb-vector))
(loop for from-index from start below end
for to-index upfrom 0
do (progn
(setf (aref mb-vector to-index)
(char-code (aref string from-index)))))
(when null-terminate
(setf (aref mb-vector (1- number-of-octets)) 0))
(values mb-vector number-of-octets)))
|