From a18f0a95bc9a457e4d2d00c702b746f29c2662b1 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 17 Apr 2001 14:43:42 +0000 Subject: [PATCH] 0.6.11.40: added code to support coming changes in (probably) 0.6.11.41.. ..moving Unix opendir/readdir/closedir iteration down to the C level, so that all structure layouts and whatnot can be read directly from #include files, so that directory operations become inherently portable (or at least as much as C/Unix ever is:-) and work on OpenBSD ..replacing old *UNIX-ERROR* cruft with STRERROR and SIMPLE-PERROR GET-ERRNO belongs in SB-C-CALL, it's not Unix-specific. --- make.sh | 1 - package-data-list.lisp-expr | 18 ++++++- src/code/filesys.lisp | 43 ++++++++++++----- src/code/misc-aliens.lisp | 8 +++ src/code/run-program.lisp | 8 +-- src/code/target-extensions.lisp | 19 ++++++++ src/code/target-pathname.lisp | 22 ++++----- src/code/unix.lisp | 52 +++++++++++--------- src/compiler/aliencomp.lisp | 2 + src/runtime/GNUmakefile | 2 +- src/runtime/ldso-stubs.S | 2 +- src/runtime/util.c | 88 +++++++++++++++++++++++++++++++++ src/runtime/util.h | 40 +++++++++++++++ src/runtime/wrap.c | 102 +++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- wc.sh | 3 +- 16 files changed, 351 insertions(+), 61 deletions(-) create mode 100644 src/runtime/util.c create mode 100644 src/runtime/util.h create mode 100644 src/runtime/wrap.c diff --git a/make.sh b/make.sh index ea3c12c..3fe2511 100755 --- a/make.sh +++ b/make.sh @@ -2,7 +2,6 @@ # "When we build software, it's a good idea to have a reliable method # for getting an executable from it. We want any two reconstructions - # starting from the same source to end up in the same result. That's # just a basic intellectual premise." # -- Christian Queinnec, in _Lisp In Small Pieces_, p. 313 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 662458a..e7053a5 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -134,6 +134,14 @@ #s(sb-cold:package-data :name "SB!C" :doc "private: implementation of the compiler" + ;; (It seems strange to have the compiler USE SB-ALIEN-INTERNALS, + ;; but the point seems to be to be able to express things like + ;; SB-C:DEFTRANSFORM SB-ALIEN-INTERNALS:MAKE-LOCAL-ALIEN without + ;; having to use a bunch of package prefixes, by putting them + ;; in the SB-C package. Maybe it'd be tidier to define an SB-ALIEN-COMP + ;; package for this? But it seems like a fairly low priority.) + ;; (Probably the same considerations also explain why BIGNUM is + ;;in the USE list.) :use ("CL" "SB!ALIEN-INTERNALS" "SB!ALIEN" "SB!BIGNUM" #!+sb-dyncount "SB-DYNCOUNT" "SB!EXT" "SB!INT" "SB!KERNEL" "SB!ASSEM" "SB!SYS") @@ -295,7 +303,7 @@ :doc "public: some types used with ALIENs" :use ("CL" "SB!SYS" "SB!ALIEN-INTERNALS" "SB!ALIEN" "SB!INT" "SB!EXT") :reexport ("FLOAT" "CHAR") - :export ("C-STRING" "DOUBLE" "INT" "LONG" + :export ("C-STRING" "DOUBLE" "GET-ERRNO" "INT" "LONG" "SHORT" "UNSIGNED-CHAR" "UNSIGNED-INT" "UNSIGNED-LONG" "UNSIGNED-SHORT" "VOID")) @@ -734,6 +742,9 @@ retained, possibly temporariliy, because it might be used internally." ;; used for FORMAT tilde paren "MAKE-CASE-FROB-STREAM" + ;; helpers for C library calls + "STRERROR" "SIMPLE-PERROR" + ;; debuggers' little helpers #!+sb-show "*/SHOW*" #!+sb-show "HEXSTR" @@ -751,6 +762,9 @@ retained, possibly temporariliy, because it might be used internally." ;; need it: "*EOF-OBJECT*" + ;; alien interface utilities + "C-STRINGS->STRING-LIST" + ;; misc. utilities used internally "LEGAL-FUNCTION-NAME-P" "FUNCTION-NAME-BLOCK-NAME" @@ -1458,7 +1472,7 @@ no guarantees of interface stability." "DADDR-T" "DEV-T" "DIRECT" "EXECGRP" "EXECOTH" "EXECOWN" "F-DUPFD" "F-GETFD" "F-GETFL" "F-GETOWN" "F-SETFD" "F-SETFL" "F-SETOWN" "FAPPEND" "FASYNC" "FCREAT" "FEXCL" "FIONREAD" "FNDELAY" "FTRUNC" - "F_OK" "GET-UNIX-ERROR-MSG" "GET-ERRNO" "GID-T" + "F_OK" "GET-UNIX-ERROR-MSG" "GID-T" "INO-T" "UNIX-SETITIMER" "UNIX-GETITIMER" "KBDCGET" "KBDCRESET" "KBDCRST" "KBDCSET" "KBDCSSTD" "KBDGCLICK" "KBDSCLICK" "KBDSGET" "L_INCR" "L_SET" diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 540fe55..cf3cdab 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -415,7 +415,7 @@ (let* ((pathname-directory (%pathname-directory pathname)) (defaults-directory (%pathname-directory defaults)) (prefix-len (length defaults-directory)) - (result-dir + (result-directory (cond ((and (> prefix-len 1) (>= (length pathname-directory) prefix-len) (compare-component (subseq pathname-directory @@ -430,7 +430,7 @@ (t ;; We are a relative directory. So we lose. (lose))))) - (strings (unparse-unix-directory-list result-dir))) + (strings (unparse-unix-directory-list result-directory))) (let* ((pathname-version (%pathname-version pathname)) (version-needed (and pathname-version (not (eq pathname-version :newest)))) @@ -487,6 +487,25 @@ ;;;; wildcard matching stuff +;;; Return a list of all the Lispy filenames (not including e.g. the +;;; Unix magic "." and "..") in the directory named by DIRECTORY-NAME. +(defun directory-lispy-filenames (directory-name) + (with-alien ((adlf (* c-string) + (alien-funcall (extern-alien + "alloc_directory_lispy_filenames" + (function (* c-string) c-string)) + directory-name))) + (if (null-alien adlf) + (error 'simple-file-error + :pathname directory-name + :format-control "~@" + :format-arguments (list directory-name (strerror))) + (unwind-protect + (c-strings->string-list adlf) + (alien-funcall (extern-alien "free_directory_lispy_filenames" + (function void (* c-string))) + adlf))))) + (/show0 "filesys.lisp 498") ;;; FIXME: could maybe be EVAL-WHEN (COMPILE EVAL) @@ -548,16 +567,16 @@ ,@body)))) (do-directory-entries ((name directory) &body body) `(let ((dir (sb!unix:open-dir ,directory))) - (when dir - (unwind-protect - (loop - (let ((,name (sb!unix:read-dir dir))) - (cond ((null ,name) - (return)) - ((string= ,name ".")) - ((string= ,name "..")) - (t - ,@body)))) + (when dir + (unwind-protect + (loop + (let ((,name (sb!unix:read-dir dir))) + (cond ((null ,name) + (return)) + ((string= ,name ".")) + ((string= ,name "..")) + (t + ,@body)))) (sb!unix:close-dir dir)))))) (if tail (let ((piece (car tail))) diff --git a/src/code/misc-aliens.lisp b/src/code/misc-aliens.lisp index bcebb22..3fe8cdf 100644 --- a/src/code/misc-aliens.lisp +++ b/src/code/misc-aliens.lisp @@ -16,3 +16,11 @@ (dest (* char)) (src (* char)) (n unsigned-int)) + +(def-alien-routine ("os_get_errno" get-errno) integer) +(setf (fdocumentation 'get-errno 'function) + "Return the value of the C library pseudo-variable named \"errno\".") + +;;; Decode errno into a string. +(defun strerror (&optional (errno (get-errno))) + (alien-funcall (extern-alien "strerror" (function c-string int)) errno)) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 8ae7caa..550d872 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -49,13 +49,7 @@ (defun posix-environ () "Return the Unix environment (\"man environ\") as a list of SIMPLE-STRINGs." - (let ((reversed-result nil)) - (dotimes (i most-positive-fixnum (error "can't happen")) - (declare (type index i)) - (let ((env-item (deref environ i))) - (if env-item - (push env-item reversed-result) - (return (nreverse reversed-result))))))) + (c-strings->string-list environ)) ;;; Convert as best we can from a SBCL representation of a Unix ;;; environment to a CMU CL representation. diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp index 2daa462..fe2bbfc 100644 --- a/src/code/target-extensions.lisp +++ b/src/code/target-extensions.lisp @@ -44,3 +44,22 @@ (cond ((not (whitespace-char-p char)) (unread-char char stream) (return t))))) + +;;;; helpers for C library calls + +;;; Signal a SIMPLE-CONDITION/ERROR condition associated with an ANSI C +;;; errno problem, arranging for the condition's print representation +;;; to be similar to the ANSI C perror(3) style. +(defun simple-perror (prefix-string + &key + (errno (get-errno)) + (simple-error 'simple-error) + other-condition-args) + (declare (type symbol simple-error)) + (aver (subtypep simple-error 'simple-condition)) + (aver (subtypep simple-error 'error)) + (apply #'error + simple-error + :format-control "~@<~A: ~2I~_~A~:>" + :format-arguments (list prefix-string (strerror errno)) + other-condition-args)) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 5b6aa9f..0ef34ff 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -1489,30 +1489,30 @@ a host-structure or string." ;;; Unparse a logical pathname string. (defun unparse-enough-namestring (pathname defaults) - (let* ((path-dir (pathname-directory pathname)) - (def-dir (pathname-directory defaults)) - (enough-dir + (let* ((path-directory (pathname-directory pathname)) + (def-directory (pathname-directory defaults)) + (enough-directory ;; Go down the directory lists to see what matches. What's ;; left is what we want, more or less. - (cond ((and (eq (first path-dir) (first def-dir)) - (eq (first path-dir) :absolute)) + (cond ((and (eq (first path-directory) (first def-directory)) + (eq (first path-directory) :absolute)) ;; Both paths are :ABSOLUTE, so find where the ;; common parts end and return what's left - (do* ((p (rest path-dir) (rest p)) - (d (rest def-dir) (rest d))) + (do* ((p (rest path-directory) (rest p)) + (d (rest def-directory) (rest d))) ((or (endp p) (endp d) (not (equal (first p) (first d)))) `(:relative ,@p)))) (t ;; At least one path is :RELATIVE, so just return the ;; original path. If the original path is :RELATIVE, - ;; then that's the right one. If PATH-DIR is + ;; then that's the right one. If PATH-DIRECTORY is ;; :ABSOLUTE, we want to return that except when - ;; DEF-DIR is :ABSOLUTE, as handled above. so return + ;; DEF-DIRECTORY is :ABSOLUTE, as handled above. so return ;; the original directory. - path-dir)))) + path-directory)))) (make-pathname :host (pathname-host pathname) - :directory enough-dir + :directory enough-directory :name (pathname-name pathname) :type (pathname-type pathname) :version (pathname-version pathname)))) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 950a823..94a991b 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -27,7 +27,7 @@ (/show0 "unix.lisp 21") -;;;; common machine-independent structures +;;;; common machine-independent stuff (eval-when (:compile-toplevel :execute) @@ -52,6 +52,8 @@ ) ; EVAL-WHEN +;;; FIXME: Couldn't all the *UNIX-ERRORS*/*COMPILER-UNIX-ERRORS* cruft +;;; be replaced by POSIX strerror(3)? (defvar *unix-errors*) (/show0 "unix.lisp 52") @@ -61,6 +63,18 @@ (prog1 (when name `(defconstant ,name ,cur)) (setf cur (funcall inc cur 1))))) `(progn ,@(mapcar #'defform names)))) + +;;; Given a C-level zero-terminated array of C strings, return a +;;; corresponding Lisp-level list of SIMPLE-STRINGs. +(defun c-strings->string-list (c-strings) + (declare (type (alien (* c-string)) c-strings)) + (let ((reversed-result nil)) + (dotimes (i most-positive-fixnum (error "argh! can't happen")) + (declare (type index i)) + (let ((c-string (deref c-strings i))) + (if c-string + (push c-string reversed-result) + (return (nreverse reversed-result))))))) ;;;; Lisp types used by syscalls @@ -74,9 +88,6 @@ ;;;; system calls -(def-alien-routine ("os_get_errno" get-errno) integer - "Return the value of the C library pseudo-variable named \"errno\".") - (/show0 "unix.lisp 74") (defun get-unix-error-msg (&optional (error-number (get-errno))) @@ -126,10 +137,9 @@ ;;; from stdio.h +;;; Rename the file with string NAME1 to the string NAME2. NIL and an +;;; error code is returned if an error occurs. (defun unix-rename (name1 name2) - #!+sb-doc - "Unix-rename renames the file with string NAME1 to the string - NAME2. NIL and an error code is returned if an error occurs." (declare (type unix-pathname name1 name2)) (void-syscall ("rename" c-string c-string) name1 name2)) @@ -195,6 +205,8 @@ ;;;; direntry.h +(/show0 "unix.lisp 304") + (def-alien-type nil (struct direct (d-ino long); inode number of entry @@ -202,23 +214,19 @@ (d-reclen unsigned-short) ; length of this record (d_type unsigned-char) (d-name (array char 256)))) ; name must be no longer than this -(/show0 "unix.lisp 289") - -;;;; dirent.h -;;; operations on Unix directories +;;;; dirent.h ;;;; FIXME: It might be really nice to implement these in C, so that ;;;; we don't need to do horrible things like hand-copying the ;;;; direntry struct slot types into an alien struct. + ;;; FIXME: DIRECTORY is an external symbol of package CL, so we should ;;; use some other name for this low-level implementation type. (defstruct (directory (:copier nil)) name (dir-struct (required-argument) :type system-area-pointer)) -(/show0 "unix.lisp 304") - (def!method print-object ((dir directory) stream) (print-unreadable-object (dir stream :type t) (prin1 (directory-name dir) stream))) @@ -504,14 +512,13 @@ (addr (deref ptr offset))) len)) +;;; Set up a unix-piping mechanism consisting of +;;; an input pipe and an output pipe. Return two +;;; values: if no error occurred the first value is the pipe +;;; to be read from and the second is can be written to. If +;;; an error occurred the first value is NIL and the second +;;; the unix error code. (defun unix-pipe () - #!+sb-doc - "Unix-pipe sets up a unix-piping mechanism consisting of - an input pipe and an output pipe. Unix-Pipe returns two - values: if no error occurred the first value is the pipe - to be read from and the second is can be written to. If - an error occurred the first value is NIL and the second - the unix error code." (with-alien ((fds (array int 2))) (syscall ("pipe" (* int)) (values (deref fds 0) (deref fds 1)) @@ -1077,7 +1084,7 @@ ;;; And now for something completely different ... (emit-unix-errors) -;;;; support routines for dealing with unix pathnames +;;;; support routines for dealing with Unix pathnames (defun unix-file-kind (name &optional check-for-links) #!+sb-doc @@ -1103,9 +1110,8 @@ (concatenate 'simple-string dir "/" name) name)))) +;;; Return the pathname with all symbolic links resolved. (defun unix-resolve-links (pathname) - #!+sb-doc - "Returns the pathname with all symbolic links resolved." (declare (simple-string pathname)) (let ((len (length pathname)) (pending pathname)) diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index eb86005..7c2fbc0 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -485,6 +485,8 @@ (deftransform %sap-alien ((sap type) * * :important t) (give-up-ir1-transform + ;; FIXME: The hardcoded newline here causes more-than-usually + ;; screwed-up formatting of the optimization note output. "could not optimize away %SAP-ALIEN: forced to do runtime ~@ allocation of alien-value structure")) diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index 7b8159c..91f0816 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -44,7 +44,7 @@ SRCS = alloc.c backtrace.c breakpoint.c coreparse.c \ dynbind.c globals.c interr.c interrupt.c \ monitor.c parse.c print.c purify.c \ regnames.c run-program.c runtime.c save.c search.c \ - time.c validate.c vars.c \ + time.c util.c validate.c vars.c wrap.c \ ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC} OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(patsubst %.s,%.o,$(SRCS)))) diff --git a/src/runtime/ldso-stubs.S b/src/runtime/ldso-stubs.S index 772bd15..101eaf5 100644 --- a/src/runtime/ldso-stubs.S +++ b/src/runtime/ldso-stubs.S @@ -119,6 +119,7 @@ ldso_stub__ ## fct: ; \ LDSO_STUBIFY(sinh) LDSO_STUBIFY(socket) LDSO_STUBIFY(stat) + LDSO_STUBIFY(strerror) LDSO_STUBIFY(symlink) LDSO_STUBIFY(sync) LDSO_STUBIFY(tanh) @@ -780,7 +781,6 @@ ldso_stub__ ## fct: ; \ /* LDSO_STUBIFY(strcpy) */ /* LDSO_STUBIFY(strcspn) */ /* LDSO_STUBIFY(strdup) */ -/* LDSO_STUBIFY(strerror) */ /* LDSO_STUBIFY(strfry) */ /* LDSO_STUBIFY(strftime) */ /* LDSO_STUBIFY(strlen) */ diff --git a/src/runtime/util.c b/src/runtime/util.c new file mode 100644 index 0000000..7568d5c --- /dev/null +++ b/src/runtime/util.c @@ -0,0 +1,88 @@ +/* + * miscellaneous utilities + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include +#include "util.h" + +/* + * voidacc stuff + * + * The interface is documented in the header file. + * + * Note that we never end up needing to explicitly set errno, not even + * for malloc failure, because Unix98 guarantees errno=ENOMEM for us + * automatically in that case. + */ + +int +voidacc_ctor(struct voidacc *va) +{ + va->n_used = 1; /* We begin with 1 entry already for zero termination. */ + va->n_avail = 4; /* arbitrary initial value */ + va->result = (void**)calloc(sizeof(void*), va->n_avail); + return va->result ? 0 : (-1); +} + +int +voidacc_acc(struct voidacc *va, void* x) +{ + /* Ensure that we have enough space, or die. */ + if (va->n_used >= va->n_avail) { /* if we've run out of space */ + /* We need to allocate more space. */ + int new_n_avail = 1 + 2 * va->n_avail; + void** new_result = (void**)calloc(sizeof(void*), new_n_avail); + int i; + if (!new_result) { + return 1; + } + /* Copy old result into new space. */ + for (i = va->n_used; --i >= 0; ) { + new_result[i] = va->result[i]; + } + free(va->result); + va->result = new_result; + va->n_avail = new_n_avail; + } + + /* If we get to this point, we have enough space to store x. + * + * Note that since we cleverly counted the 0 as part of the space + * used, now we need to subtract one to get the correct offset to + * write into.:-| */ + va->result[va->n_used++ - 1] = x; + return 0; +} + +void** +voidacc_give_away_result(struct voidacc *va) +{ + /* (We could do realloc(3) here to try to shrink the result down + * to minimum size, but that's not really needed for the the + * directory-iteration application this was originally written + * for, so for now we just do the simplest thing which could + * possibly work.) */ + void **result_tmp = va->result; + va->result = 0; + return result_tmp; +} + +void +voidacc_dtor(struct voidacc *va) +{ + /* if result has been allocated and hasn't been given away */ + if (va->result) { + free(voidacc_give_away_result(va)); + } +} diff --git a/src/runtime/util.h b/src/runtime/util.h new file mode 100644 index 0000000..73728ab --- /dev/null +++ b/src/runtime/util.h @@ -0,0 +1,40 @@ +/* + * miscellaneous utilities + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +/* + * a utility to accumulate a zero-terminated array of void* values + * + * (Ah, lovely C, makes it such a delight to accumulate a collection + * whose length isn't known in advance.. but it's probably more fun + * than trying to teach the SBCL debugger to walk g++ stack frames, not to + * mention dealing with g++'s lovely in-which-file-do-templates-expand + * issues; or than trying to use Lisp for all accumulation and having to + * hassle about FFIing all the details of opendir/readdir/closedir + * and so forth.) + * + * We more or less simulate C++-style ctors and dtors. + */ +typedef struct +voidacc { /* the accumulator itself, to be treated as an opaque data type */ +/*private:*/ + void **result; + int n_avail; + int n_used; +} voidacc; +int voidacc_ctor(voidacc*); /* the ctor, returning 0 for success */ +int voidacc_acc(voidacc*, void*); /* Accumulate an element into result, + * returning 0 for success. */ +void** voidacc_give_away_result(voidacc*); /* giving away ownership */ +void voidacc_dtor(voidacc*); /* the dtor */ diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c new file mode 100644 index 0000000..fee9df9 --- /dev/null +++ b/src/runtime/wrap.c @@ -0,0 +1,102 @@ +/* + * wrappers around low-level operations to provide a simpler interface + * to the operations that Lisp needs + * + * The functions in this file are typically called directly from Lisp. + * Thus, when their signature changes, they don't need updates in a .h + * file somewhere, but they do need updates in the Lisp code. FIXME: + * It would be nice to enforce this at compile time. It mighn't even + * be all that hard: make the cross-compiler versions of DEF-ALIEN-FOO + * macros accumulate strings in a list which then gets written out at + * the end of sbcl2.h at the end of cross-compilation, then rerun + * 'make' in src/runtime/ using the new sbcl2.h as sbcl.h (and make + * sure that all the files in src/runtime/ include sbcl.h). */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include +#include +#include + +#include "util.h" + +/* + * stuff needed by CL:DIRECTORY and other Lisp directory operations + */ + +/* Unix directory operations think of "." and ".." as filenames, but + * Lisp directory operations do not. */ +int +is_lispy_filename(const char *filename) +{ + return strcmp(filename, ".") && strcmp(filename, ".."); +} + +/* Return a zero-terminated array of strings holding the Lispy filenames + * (i.e. excluding the Unix magic "." and "..") in the named directory. */ +char** +alloc_directory_lispy_filenames(const char *directory_name) +{ + DIR *dir_ptr; + char **result = 0; + + if (dir_ptr = opendir(directory_name)) { /* if opendir success */ + + struct voidacc va; + + if (0 == voidacc_ctor(&va)) { /* if voidacc_ctor success */ + struct dirent *dirent_ptr; + + while (dirent_ptr = readdir(dir_ptr)) { /* until end of data */ + char* original_name = dirent_ptr->d_name; + if (is_lispy_filename(original_name)) { + /* strdup(3) is in Linux and *BSD. If you port + * somewhere else that doesn't have it, it's easy + * to reimplement. */ + char* dup_name = strdup(original_name); + if (!dup_name) { /* if strdup failure */ + goto dtors; + } + if (voidacc_acc(&va, dup_name)) { /* if acc failure */ + goto dtors; + } + } + } + result = (char**)voidacc_give_away_result(&va); + } + + dtors: + voidacc_dtor(&va); + /* ignoring closedir(3) return code, since what could we do? + * + * "Never ask questions you don't want to know the answer to." + * -- William Irving Zumwalt (Rich Cook, _The Wizardry Quested_) */ + closedir(dir_ptr); + } + + return result; +} + +/* Free a result returned by alloc_directory_lispy_filenames. */ +void +free_directory_lispy_filenames(char** directory_lispy_filenames) +{ + char** p; + + /* Free the strings. */ + for (p = directory_lispy_filenames; *p; ++p) { + free(*p); + } + + /* Free the table of strings. */ + free(directory_lispy_filenames); +} diff --git a/version.lisp-expr b/version.lisp-expr index 6095a98..c4a7b0a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.11.39" +"0.6.11.40" diff --git a/wc.sh b/wc.sh index cfafe39..1cc99c7 100755 --- a/wc.sh +++ b/wc.sh @@ -21,5 +21,4 @@ find . -name "*.[ch]" -print | xargs egrep -s '^[ ]*[^ /*]' | wc -l # * doesn't catch #if 0 convention for commenting out blocks # * doesn't catch stale source files which are no longer used -# There are assembler source lines, too, but there seem to be less than -# 1000 for each machine type. (Hardly worth considering!:-) +echo "(ignoring .sh, .S, etc.)" -- 1.7.10.4