From: Christophe Rhodes Date: Sat, 16 Aug 2003 21:46:30 +0000 (+0000) Subject: 0.8.2.34: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b7cfa0e5e726c2037ba2c6cb32406ff7e9764dd2;p=sbcl.git 0.8.2.34: Merge patch from Brian Mastenbrook for better dlfoo handling on Darwin (plus more-likely cpp options, add boilerplate) ... reindent to 4 spaces; ASSQ patch from observation by PFD sbcl-devel 2003-08-16 ... (NOT (NULL PAIR)) plus explanatory comment; Pragmatism: since not all lisps implement arrays with NIL specialized-array-element-type, our cross-compiler version needs to be more robust. Symptoms: building sbcl/ppc from openmcl loses in cold-init; sbcl/sparc from sbcl-0.7.x hangs in cross-compiler compilation of STRING ... since we don't need any (ARRAY NIL)s to cross-compile SBCL, the answer to SIMPLE-ARRAY-NIL-P for constant-folding purposes in the cross-compiler is always NIL. --- diff --git a/contrib/asdf-install/.cvsignore b/contrib/asdf-install/.cvsignore new file mode 100644 index 0000000..1f7006e --- /dev/null +++ b/contrib/asdf-install/.cvsignore @@ -0,0 +1,2 @@ +asdf-install +test-passed diff --git a/contrib/sb-simple-streams/simple-streams.lisp b/contrib/sb-simple-streams/simple-streams.lisp index 31db6dd..4caf28a 100644 --- a/contrib/sb-simple-streams/simple-streams.lisp +++ b/contrib/sb-simple-streams/simple-streams.lisp @@ -278,7 +278,7 @@ ;; Handle encapsulated stream. FIXME: perhaps handle ;; sbcl-vintage ansi-stream type in write-octets too? (stream (write-octets fd buffer start end blocking)) - (t (error "Don't know how to handle output handle &A" fd)))))) + (t (error "Don't know how to handle output handle ~A" fd)))))) ;;; diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index a0fe12d..e2fb124 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -122,7 +122,9 @@ ;;; These functions are needed for constant-folding. (defun sb!kernel:simple-array-nil-p (object) - (typep object '(simple-array nil))) + (when (typep object 'array) + (aver (not (null (array-element-type object))))) + nil) (defun sb!kernel:%negate (number) (- number)) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index c5cf3b2..7435069 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -288,7 +288,12 @@ ;; just define ASSQ explicitly in terms of more primitive ;; operations: (dolist (pair alist) - (when (and pair (eq (car pair) item)) + ;; though it may look more natural to write this as + ;; (AND PAIR (EQ (CAR PAIR) ITEM)) + ;; the temptation to do so should be resisted, as pointed out by PFD + ;; sbcl-devel 2003-08-16, as NIL elements are rare in association + ;; lists. -- CSR, 2003-08-16 + (when (and (eq (car pair) item) (not (null pair))) (return pair)))) ;;; like (DELETE .. :TEST #'EQ): diff --git a/src/runtime/Config.ppc-darwin b/src/runtime/Config.ppc-darwin index 7f66fd4..a208c5d 100644 --- a/src/runtime/Config.ppc-darwin +++ b/src/runtime/Config.ppc-darwin @@ -1,19 +1,17 @@ # -*- makefile -*- -CFLAGS = -ggdb -Wall -O3 -traditional-cpp -OS_SRC = bsd-os.c os-common.c ppc-darwin-os.c -OS_LIBS = -lSystem -lc -lm /sw/lib/libdl.a +CFLAGS = -DDARWIN -Dppc -g -Wall -O3 -no-cpp-precomp +OS_SRC = bsd-os.c os-common.c ppc-darwin-os.c ppc-darwin-dlshim.c +OS_LIBS = -lSystem -lc -lm + +# Avoid the dreaded gcc 3.3 prerelease tarpit of death! +CC = gcc3 ASSEM_SRC = ppc-assem.S ldso-stubs.S ARCH_SRC = ppc-arch.c -CPP = cpp -traditional-cpp +CPP = cpp -no-cpp-precomp -# Until sbcl-0.6.7.3, we used "OS_LINK_FLAGS=-static" here, which -# worked fine for most things, but LOAD-FOREIGN & friends require -# dlopen() etc., which in turn depend on dynamic linking of the -# runtime. -OS_LINK_FLAGS = -dynamic -L/sw/lib +OS_LINK_FLAGS = -dynamic -L$(HOME)/local/lib -L/sw/lib -L/opt/local/lib -L/usr/local/lib GC_SRC= cheneygc.c -CFLAGS=-DDARWIN -Dppc -g -traditional-cpp diff --git a/src/runtime/ldso-stubs.S b/src/runtime/ldso-stubs.S index 5e3a86c..73ef19f 100644 --- a/src/runtime/ldso-stubs.S +++ b/src/runtime/ldso-stubs.S @@ -123,10 +123,12 @@ ldso_stub__ ## fct: ; \ LDSO_STUBIFY(connect) LDSO_STUBIFY(cosh) LDSO_STUBIFY(creat) +#ifndef LISP_FEATURE_DARWIN LDSO_STUBIFY(dlclose) LDSO_STUBIFY(dlerror) LDSO_STUBIFY(dlopen) LDSO_STUBIFY(dlsym) +#endif LDSO_STUBIFY(dup) LDSO_STUBIFY(dup2) LDSO_STUBIFY(execve) diff --git a/src/runtime/ppc-darwin-dlshim.c b/src/runtime/ppc-darwin-dlshim.c new file mode 100644 index 0000000..9187ef2 --- /dev/null +++ b/src/runtime/ppc-darwin-dlshim.c @@ -0,0 +1,190 @@ +/* + * These functions emulate a small subset of the dlopen / dlsym + * functionality under Darwin's Mach-O dyld system. + */ + +/* + * 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 + +/* Darwin does not define the standard ELF + * dlopen/dlclose/dlsym/dlerror interface to shared libraries, so this + * is an attempt at a minimal wrapper to allow SBCL to work without + * external dependency on pogma's dlcompat library. + */ + +/* For now, there is no RTLD_GLOBAL emulation either. */ + +static char dl_self; /* I'm going to abuse this */ + +#define RTLD_LAZY 1 +#define RTLD_NOW 2 +#define RTLD_GLOBAL 0x100 + +static int callback_count; +static struct mach_header* last_header; + +void dlshim_image_callback(struct mach_header* ptr, unsigned long phooey) +{ + callback_count++; + last_header = ptr; +} + +int lib_path_count(void) +{ + char* libpath; + int i; + int count; + libpath = getenv("DYLD_LIBRARY_PATH"); + count = 1; + if (libpath) { + for (i = 0; libpath[i] != '\0'; i++) { + if (libpath[i] == ':') count++; + } + } + return count; +} + +const char* lib_path_prefixify(int index, const char* filename) +{ + static char* retbuf = NULL; + int fi, li, i, count; + char* libpath; + if (!retbuf) { + retbuf = (char*) malloc(1024*sizeof(char)); + } + count = 0; + fi = 0; + li = -1; + libpath = getenv("DYLD_LIBRARY_PATH"); + if (libpath) { + i = 0; + while (count != index && libpath[i] != '\0') { + if (libpath[i] == ':') count++; + i++; + } + fi = i; + while (libpath[i] != '\0' && libpath[i] != ':') { + i++; + } + li = i - 1; + } + if (li - fi > 0) { + if (li - fi + 1 > 1022 - strlen(filename)) { + retbuf = (char*) realloc(retbuf, (li - fi + 3 + strlen(filename))*sizeof(char)); + } + memcpy(retbuf, libpath + fi, (li - fi + 1)*sizeof(char)); + retbuf[li - fi + 1] = '/'; + memcpy(retbuf + li - fi + 2, filename, strlen(filename) + 1); + return retbuf; + } else { + return filename; + } +} + +void* dlopen(const char* filename, int flags) +{ + static char has_callback = 0; + if (!has_callback) { + _dyld_register_func_for_add_image(dlshim_image_callback); + } + if (!filename) { + return &dl_self; + } else { + struct mach_header* img = NULL; + if (!img) img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR); + if (!img) img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR | NSADDIMAGE_OPTION_WITH_SEARCHING); + if (!img) { + NSObjectFileImage fileImage; + callback_count = 0; + last_header = NULL; + if (NSCreateObjectFileImageFromFile(filename, &fileImage) == NSObjectFileImageSuccess) { + NSLinkModule(fileImage, filename, NSLINKMODULE_OPTION_BINDNOW | ((flags & RTLD_GLOBAL)?NSLINKMODULE_OPTION_PRIVATE:0) | NSLINKMODULE_OPTION_RETURN_ON_ERROR); + if (callback_count && last_header) img = last_header; + } + } + if (!img) { + NSObjectFileImage fileImage; + int i, maxi; + char* prefixfilename; + maxi = lib_path_count(); + for (i = 0; i < maxi && !img; i++) { + prefixfilename = lib_path_prefixify(i, filename); + callback_count = 0; + last_header = NULL; + if (NSCreateObjectFileImageFromFile(prefixfilename, &fileImage) == NSObjectFileImageSuccess) { + NSLinkModule(fileImage, filename, NSLINKMODULE_OPTION_BINDNOW | ((flags & RTLD_GLOBAL)?NSLINKMODULE_OPTION_PRIVATE:0) | NSLINKMODULE_OPTION_RETURN_ON_ERROR); + if (callback_count && last_header) img = last_header; + } + } + } + if (img) { + if (flags & RTLD_NOW) { + NSLookupSymbolInImage(img, "", NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_FULLY | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); + } + if (NSIsSymbolNameDefinedInImage(img, "__init")) { + NSSymbol* initsymbol; + void (*initfunc) (void); + initsymbol = NSLookupSymbolInImage(img, "__init", 0); + initfunc = NSAddressOfSymbol(initsymbol); + initfunc(); + } + } + return img; + } +} + +const char* dlerror() +{ + static char* errbuf = NULL; + NSLinkEditErrors a; + int b; + char *c, *d; + NSLinkEditError(&a, &b, &c, &d); + if (!errbuf) { + errbuf = (char*) malloc(256*sizeof(char)); + } + snprintf(errbuf, 255, "%s in %s: %d %d", c, d, a, b); + return errbuf; +} + +void* dlsym(void* handle, char* symbol) +{ + if (handle == &dl_self) { + if (NSIsSymbolNameDefined(symbol)) { + NSSymbol* retsym; + retsym = NSLookupAndBindSymbol(symbol); + return NSAddressOfSymbol(retsym); + } else { + return NULL; + } + } else { + if (NSIsSymbolNameDefinedInImage(handle, symbol)) { + NSSymbol* retsym; + retsym = NSLookupSymbolInImage(handle, symbol, 0); + return NSAddressOfSymbol(retsym); + } else { + return NULL; + } + } +} + +int dlclose(void *handle) +{ + /* dlclose is not implemented, and never will be for dylibs. + * return -1 to signal an error; it's not used by SBCL anyhow */ + return -1; +} diff --git a/src/runtime/ppc-darwin-os.c b/src/runtime/ppc-darwin-os.c index 8e16094..ba1060f 100644 --- a/src/runtime/ppc-darwin-os.c +++ b/src/runtime/ppc-darwin-os.c @@ -1,3 +1,20 @@ +/* + * This is the PowerPC/Darwin incarnation of arch-dependent + * OS-dependent routines. See also "bsdos.c". + */ + +/* + * 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 "globals.h" #include #include diff --git a/tests/assertoid.lisp b/tests/assertoid.lisp index f50270b..0e76532 100644 --- a/tests/assertoid.lisp +++ b/tests/assertoid.lisp @@ -89,7 +89,7 @@ (flet ((frob (evaloid) (let ((result (funcall evaloid expr))) (unless (funcall eval-expected-lambda result) - (error "failed assertoid" expr)))) + (error "failed assertoid ~S" expr)))) (compile-as-evaloid (optimizations) (lambda (expr) (funcall (compile nil diff --git a/version.lisp-expr b/version.lisp-expr index c5dae56..21da096 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.2.33" +"0.8.2.34"