3 files changed, 470 insertions, 11 deletions

diff --git a/lang/sbcl/Makefile b/lang/sbcl/Makefile
index b03a250667b5..d68df96e90c4 100644
--- a/lang/sbcl/Makefile
+++ b/lang/sbcl/Makefile
@@ -7,6 +7,7 @@
 
 PORTNAME=	sbcl
 PORTVERSION=	1.0
+PORTREVISION=	1
 CATEGORIES=	lang lisp
 MASTER_SITES=	${MASTER_SITE_SOURCEFORGE}
 MASTER_SITE_SUBDIR=	sbcl
@@ -23,7 +24,7 @@ USE_GMAKE=	yes
 
 EXTRACT_AFTER_ARGS=	| ${TAR} -xf - --exclude */CVS/*
 
-# Can currently only bootstrap using cmucl, which is i386-only
+# SBCL is a native code compiler: it must be ported per architecture.
 ONLY_FOR_ARCHS=	i386 amd64
 
 MAN1=		sbcl.1
@@ -56,10 +57,6 @@ BUILD_DEPENDS+=	${LOCALBASE}/lib32/compat/libc.so.4:${PORTSDIR}/misc/compat4x
 BROKEN=		Does not compile on 4.x with threading
 .endif
 
-.if defined(WITH_THREADS) && ${ARCH} == amd64
-BROKEN=		Does not compile on AMD64 with threading
-.endif
-
 .if ${ARCH} == i386
 PLIST_SUB+=	I386_ONLY=""
 .else
@@ -93,11 +90,6 @@ test:	build
 	(cd ${WRKSRC}/tests && ${SH} run-tests.sh)
 
 pre-everything::
-.if ${ARCH} == amd64
-	@${ECHO_MSG} "====>"
-	@${ECHO_MSG} "====> WARNING: AMD64 support is experimental."
-	@${ECHO_MSG} "====>"
-.else
 .if !defined(WITH_THREADS) && ${OSVERSION} >= 600000
 	@${ECHO_MSG} "====>"
 	@${ECHO_MSG} "====> To enable experimental threading support, define WITH_THREADS."
@@ -107,6 +99,5 @@ pre-everything::
 	@${ECHO_MSG} "====> WARNING: Current threading support is very unstable on FreeBSD 5.x."
 	@${ECHO_MSG} "====>"
 .endif
-.endif
 
 .include <bsd.port.post.mk>
diff --git a/lang/sbcl/files/patch-freebsd-amd64 b/lang/sbcl/files/patch-freebsd-amd64
index 29a626c18b07..58c25cc17381 100644
--- a/lang/sbcl/files/patch-freebsd-amd64
+++ b/lang/sbcl/files/patch-freebsd-amd64
@@ -557,3 +557,101 @@
 +#endif
 +
 +#endif /* _X86_64_BSD_OS_H */
+--- src/runtime/x86-64-arch.c	Thu Nov 30 19:20:11 2006 +0900
++++ src/runtime/x86-64-arch.c	Sun Dec 03 02:26:51 2006 +0900
+@@ -308,6 +308,56 @@ sigill_handler(int signal, siginfo_t *si
+     lose("fake_foreign_function_call fell through");
+ }
+ 
++#ifdef X86_64_SIGFPE_FIXUP
++#define MXCSR_IE (0x01)         /* Invalid Operation */
++#define MXCSR_DE (0x02)         /* Denormal */
++#define MXCSR_ZE (0x04)         /* Devide-by-Zero */
++#define MXCSR_OE (0x08)         /* Overflow */
++#define MXCSR_UE (0x10)         /* Underflow */
++#define MXCSR_PE (0x20)         /* Precision */
++
++static inline int
++mxcsr_to_code(unsigned int mxcsr)
++{
++    /* Extract unmasked exception bits. */
++    mxcsr &= ~(mxcsr >> 7) & 0x3F;
++
++    /* This order is defined at "Intel 64 and IA-32 Architectures
++     * Software Developerfs Manual" Volume 1: "Basic Architecture",
++     * 4.9.2 "Floating-Point Exception Priority". */
++    if (mxcsr & MXCSR_IE)
++        return FPE_FLTINV;
++    else if (mxcsr & MXCSR_ZE)
++        return FPE_FLTDIV;
++    else if (mxcsr & MXCSR_DE)
++        return FPE_FLTUND;
++    else if (mxcsr & MXCSR_OE)
++        return FPE_FLTOVF;
++    else if (mxcsr & MXCSR_UE)
++        return FPE_FLTUND;
++    else if (mxcsr & MXCSR_PE)
++        return FPE_FLTRES;
++
++    return 0;
++}
++
++static void
++sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context)
++{
++    os_context_t *context = arch_os_get_context(&void_context);
++    unsigned int *mxcsr = arch_os_context_mxcsr_addr(context);
++
++    if (siginfo->si_code == 0) { /* XMM exception */
++        siginfo->si_code = mxcsr_to_code(*mxcsr);
++
++        /* Clear sticky exception flag. */
++        *mxcsr &= ~0x3F;
++    }
++
++    interrupt_handle_now(signal, siginfo, context);
++}
++#endif
++
+ void
+ arch_install_interrupt_handlers()
+ {
+@@ -325,6 +375,9 @@ arch_install_interrupt_handlers()
+      * why.. -- WHN 2001-06-07 */
+     undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
+     undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler);
++#ifdef X86_64_SIGFPE_FIXUP
++    undoably_install_low_level_interrupt_handler(SIGFPE, sigfpe_handler);
++#endif
+ 
+     SHOW("returning from arch_install_interrupt_handlers()");
+ }
+--- src/runtime/x86-64-bsd-os.h	Thu Nov 30 19:20:11 2006 +0900
++++ src/runtime/x86-64-bsd-os.h	Sun Dec 03 02:26:51 2006 +0900
+@@ -2,8 +2,7 @@
+ #define _X86_64_BSD_OS_H
+ 
+ #ifdef LISP_FEATURE_FREEBSD
+-#include <machine/segments.h>
+-#include <machine/cpufunc.h>
++#include <machine/fpu.h>
+ #endif
+ 
+ typedef register_t os_context_register_t;
+@@ -29,6 +28,16 @@ static inline os_context_t *arch_os_get_
+ #if defined LISP_FEATURE_FREEBSD
+ #define RESTORE_FP_CONTROL_FROM_CONTEXT
+ void os_restore_fp_control(os_context_t *context);
++
++/* FreeBSD does not setup si_code on XMM exception. */
++#define X86_64_SIGFPE_FIXUP
++
++static inline unsigned int *
++arch_os_context_mxcsr_addr(os_context_t *context)
++{
++    struct envxmm *ex = (struct envxmm *)(&context->uc_mcontext.mc_fpstate);
++    return &ex->en_mxcsr;
++}
+ #endif
+ 
+ #endif /* _X86_64_BSD_OS_H */
diff --git a/lang/sbcl/files/patch-futex b/lang/sbcl/files/patch-futex
new file mode 100644
index 000000000000..9533a5ba0e6c
--- /dev/null
+++ b/lang/sbcl/files/patch-futex
@@ -0,0 +1,370 @@
+--- make-config.sh	Thu Nov 30 02:36:43 2006 +0000
++++ make-config.sh	Sat Dec 09 13:57:31 2006 +0900
+@@ -191,8 +191,9 @@ case "$sbcl_os" in
+             freebsd)
+                 printf ' :elf' >> $ltf
+                 printf ' :freebsd' >> $ltf
++                printf ' :sb-pthread-futex' >> $ltf
+                 if [ $sbcl_arch = "x86" ]; then
+-                    printf ' :sb-lutex :restore-tls-segment-register-from-tls' >> $ltf
++                    printf ' :restore-tls-segment-register-from-tls' >> $ltf
+                 fi
+                 link_or_copy Config.$sbcl_arch-freebsd Config
+                 ;;
+--- src/runtime/GNUmakefile	Thu Nov 30 02:36:43 2006 +0000
++++ src/runtime/GNUmakefile	Sat Dec 09 13:58:56 2006 +0900
+@@ -40,7 +40,8 @@ include Config
+ 
+ COMMON_SRC = alloc.c backtrace.c breakpoint.c coreparse.c \
+ 	dynbind.c gc-common.c globals.c interr.c interrupt.c largefile.c \
+-	monitor.c os-common.c parse.c print.c purify.c pthread-lutex.c \
++	monitor.c os-common.c parse.c print.c purify.c \
++	pthread-futex.c pthread-lutex.c \
+ 	regnames.c run-program.c runtime.c save.c search.c \
+ 	thread.c time.c util.c validate.c vars.c wrap.c	
+ 
+--- src/runtime/linux-os.c	Thu Nov 30 02:36:43 2006 +0000
++++ src/runtime/linux-os.c	Sat Dec 09 13:56:27 2006 +0900
+@@ -62,7 +62,7 @@ int personality (unsigned long);
+ 
+ size_t os_vm_page_size;
+ 
+-#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX)
++#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX) && !defined(LISP_FEATURE_SB_PTHREAD_FUTEX)
+ #include <sys/syscall.h>
+ #include <unistd.h>
+ #include <errno.h>
+@@ -145,7 +145,7 @@ os_init(char *argv[], char *envp[])
+ {
+     /* Conduct various version checks: do we have enough mmap(), is
+      * this a sparc running 2.2, can we do threads? */
+-#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX)
++#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX) && !defined(LISP_FEATURE_SB_PTHREAD_FUTEX)
+     int *futex=0;
+ #endif
+     struct utsname name;
+@@ -171,7 +171,7 @@ os_init(char *argv[], char *envp[])
+ #endif
+     }
+ #ifdef LISP_FEATURE_SB_THREAD
+-#if !defined(LISP_FEATURE_SB_LUTEX)
++#if !defined(LISP_FEATURE_SB_LUTEX) && !defined(LISP_FEATURE_SB_PTHREAD_FUTEX)
+     futex_wait(futex,-1);
+     if(errno==ENOSYS) {
+        lose("This version of SBCL is compiled with threading support, but your kernel\n"
+--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
++++ src/runtime/pthread-futex.c	Sat Dec 09 13:56:27 2006 +0900
+@@ -0,0 +1,313 @@
++/* An approximation of Linux futexes implemented using pthread mutexes
++ * and pthread condition variables.
++ */
++
++/*
++ * This software is part of the SBCL system. See the README file for
++ * more information.
++ *
++ * The software is in the public domain and is provided with
++ * absolutely no warranty. See the COPYING and CREDITS files for more
++ * information.
++ */
++
++#include "sbcl.h"
++
++#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_PTHREAD_FUTEX)
++
++#include <errno.h>
++#include <pthread.h>
++#include <stdlib.h>
++
++#include "runtime.h"
++#include "arch.h"
++#include "target-arch-os.h"
++#include "os.h"
++
++#define FUTEX_WAIT_NSEC (10000000) /* 10 msec */
++
++#if 1
++# define futex_assert(ex)                                              \
++do {                                                                   \
++    if (!(ex)) futex_abort();                                          \
++} while (0)
++# define futex_assert_verbose(ex, fmt, ...)                            \
++do {                                                                   \
++    if (!(ex)) {                                                       \
++        fprintf(stderr, fmt, ## __VA_ARGS__);                          \
++        futex_abort();                                                 \
++    }                                                                  \
++} while (0)
++#else
++# define futex_assert(ex)
++# define futex_assert_verbose(ex, fmt, ...)
++#endif
++
++#define futex_abort()                                                  \
++  lose("Futex assertion failure, file \"%s\", line %d\n", __FILE__, __LINE__)
++
++struct futex {
++    struct futex *prev;
++    struct futex *next;
++    int *lock_word;
++    pthread_mutex_t mutex;
++    pthread_cond_t cond;
++    int count;
++};
++
++static pthread_mutex_t futex_lock = PTHREAD_MUTEX_INITIALIZER;
++
++static struct futex *futex_head = NULL;
++static struct futex *futex_free_head = NULL;
++
++static struct futex *
++futex_add(struct futex *head, struct futex *futex)
++{
++    futex->prev = NULL;
++    futex->next = head;
++    if (head != NULL)
++        head->prev = futex;
++    head = futex;
++
++    return head;
++}
++
++static struct futex *
++futex_delete(struct futex *head, struct futex *futex)
++{
++    if (head == futex)
++        head = futex->next;
++    if (futex->prev != NULL)
++        futex->prev->next = futex->next;
++    if (futex->next != NULL)
++        futex->next->prev = futex->prev;
++
++    return head;
++}
++
++static struct futex *
++futex_find(struct futex *head, int *lock_word)
++{
++    struct futex *futex;
++
++    for (futex = head; futex != NULL; futex = futex->next) {
++        if (futex->lock_word == lock_word)
++            break;
++    }
++
++    return futex;
++}
++
++static struct futex *
++futex_get(int *lock_word)
++{
++    int ret;
++    struct futex *futex;
++
++    ret = pthread_mutex_lock(&futex_lock);
++    futex_assert(ret == 0);
++
++    futex = futex_find(futex_head, lock_word);
++
++    if (futex != NULL)
++        futex->count++;
++
++    ret = pthread_mutex_unlock(&futex_lock);
++    futex_assert(ret == 0);
++
++    if (futex != NULL) {
++        ret = pthread_mutex_lock(&futex->mutex);
++        futex_assert(ret == 0);
++    }
++
++    return futex;
++}
++
++static struct futex *
++futex_allocate(int *lock_word)
++{
++    int ret;
++    struct futex *futex;
++
++    ret = pthread_mutex_lock(&futex_lock);
++    futex_assert(ret == 0);
++
++    futex = futex_free_head;
++
++    if (futex != NULL)
++        futex_free_head = futex_delete(futex_free_head, futex);
++
++    ret = pthread_mutex_unlock(&futex_lock);
++    futex_assert(ret == 0);
++
++    if (futex == NULL) {
++        futex = malloc(sizeof(struct futex));
++        futex_assert(futex != NULL);
++
++        ret = pthread_mutex_init(&futex->mutex, NULL);
++        futex_assert(ret == 0);
++
++        ret = pthread_cond_init(&futex->cond, NULL);
++        futex_assert(ret == 0);
++    }
++
++    futex->lock_word = lock_word;
++    futex->count = 1;
++
++    /* Lock mutex before register to avoid race conditions. */
++    ret = pthread_mutex_lock(&futex->mutex);
++    futex_assert(ret == 0);
++
++    ret = pthread_mutex_lock(&futex_lock);
++    futex_assert(ret == 0);
++
++    futex_head = futex_add(futex_head, futex);
++
++    ret = pthread_mutex_unlock(&futex_lock);
++    futex_assert(ret == 0);
++
++    return futex;
++}
++
++static void
++futex_cleanup(void *p)
++{
++    struct futex *futex = (struct futex *)p;
++    int ret, count;
++ 
++    ret = pthread_mutex_lock(&futex_lock);
++    futex_assert(ret == 0);
++
++    count = --futex->count;
++    if (count <= 0) {
++        futex_head = futex_delete(futex_head, futex);
++        futex_free_head = futex_add(futex_free_head, futex);
++    }
++
++    ret = pthread_mutex_unlock(&futex_lock);
++    futex_assert(ret == 0);
++
++    ret = pthread_mutex_unlock(&futex->mutex);
++    futex_assert(ret == 0);
++}
++
++static int
++futex_relative_to_abs(struct timespec *tp, int relative)
++{
++    int ret;
++    struct timeval tv;
++
++    ret = gettimeofday(&tv, NULL);
++    if (ret != 0)
++        return ret;
++    tp->tv_sec = tv.tv_sec + (tv.tv_usec * 1000 + relative) / 1000000000;
++    tp->tv_nsec = (tv.tv_usec * 1000 + relative) % 1000000000;
++    return 0;
++}
++
++int
++futex_wait(int *lock_word, int oldval)
++{
++    int ret, result;
++    struct futex *futex;
++    sigset_t oldset, newset;
++
++    sigemptyset(&newset);
++    sigaddset_deferrable(&newset);
++
++again:
++    pthread_sigmask(SIG_BLOCK, &newset, &oldset);
++
++    futex = futex_get(lock_word);
++
++    if (futex == NULL)
++        futex = futex_allocate(lock_word);
++
++    pthread_cleanup_push(futex_cleanup, futex);
++
++    /* Compare lock_word after the lock is aquired to avoid race
++     * conditions. */
++    if (*(volatile int *)lock_word != oldval) {
++        result = EWOULDBLOCK;
++        goto done;
++    }
++
++    /* It's not possible to unwind frames across pthread_cond_wait(3). */
++    for (;;) {
++        int i;
++        sigset_t pendset;
++        struct timespec abstime;
++
++        ret = futex_relative_to_abs(&abstime, FUTEX_WAIT_NSEC);
++        futex_assert(ret == 0);
++
++        result = pthread_cond_timedwait(&futex->cond, &futex->mutex,
++                                        &abstime);
++        futex_assert(result == 0 || result == ETIMEDOUT);
++
++        if (result != ETIMEDOUT)
++            break;
++
++        /* futex system call of Linux returns with EINTR errno when
++         * it's interrupted by signals.  Check pending signals here to
++         * emulate this behaviour. */
++        sigpending(&pendset);
++        for (i = 1; i < NSIG; i++) {
++            if (sigismember(&pendset, i) && sigismember(&newset, i)) {
++                result = EINTR;
++                goto done;
++            }
++        }
++    }
++done:
++    ; /* Null statement is required between label and pthread_cleanup_pop. */
++    pthread_cleanup_pop(1);
++    pthread_sigmask(SIG_SETMASK, &oldset, NULL);
++
++    /* futex_wake() in linux-os.c loops when futex system call returns
++     * EINTR.  */
++    if (result == EINTR) {
++        sched_yield();
++        goto again;
++    }
++
++    return result;
++}
++
++int
++futex_wake(int *lock_word, int n)
++{
++    int ret;
++    struct futex *futex;
++    sigset_t newset, oldset;
++
++    sigemptyset(&newset);
++    sigaddset_deferrable(&newset);
++
++    pthread_sigmask(SIG_BLOCK, &newset, &oldset);
++
++    futex = futex_get(lock_word);
++
++    if (futex != NULL) {
++        pthread_cleanup_push(futex_cleanup, futex);
++
++        /* The lisp-side code passes N=2**29-1 for a broadcast. */
++        if (n >= ((1 << 29) - 1)) {
++            /* CONDITION-BROADCAST */
++            ret = pthread_cond_broadcast(&futex->cond);
++            futex_assert(ret == 0);
++        } else {
++            while (n-- > 0) {
++                ret = pthread_cond_signal(&futex->cond);
++                futex_assert(ret == 0);
++            }
++        }
++
++        pthread_cleanup_pop(1);
++    }
++
++    pthread_sigmask(SIG_SETMASK, &oldset, NULL);
++
++    return 0;
++}
++#endif