diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr
index 60161d4..63e671f 100644
--- a/base-target-features.lisp-expr
+++ b/base-target-features.lisp-expr
@@ -304,6 +304,9 @@
  ;; foreign code that uses a 32-bit off_t.
  ; :largefile
 
+ ;; GC can be made aware of regions of the foreign heap.
+ ; :sb-foreign-allocation
+
  ;;
  ;; miscellaneous notes on other things which could have special significance
  ;; in the *FEATURES* list
diff --git a/src/runtime/Config.ppc-darwin b/src/runtime/Config.ppc-darwin
index fc94e87..3399d19 100644
--- a/src/runtime/Config.ppc-darwin
+++ b/src/runtime/Config.ppc-darwin
@@ -23,6 +23,9 @@ CPPFLAGS += -no-cpp-precomp
 
 ifdef LISP_FEATURE_GENCGC
   GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    GC_SRC += foreign-allocation.c
+endif
 else
   GC_SRC = cheneygc.c
 endif
diff --git a/src/runtime/Config.ppc-linux b/src/runtime/Config.ppc-linux
index d2fe76c..3b947ec 100644
--- a/src/runtime/Config.ppc-linux
+++ b/src/runtime/Config.ppc-linux
@@ -21,6 +21,9 @@ OS_LIBS = -ldl
 
 ifdef LISP_FEATURE_GENCGC
   GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    GC_SRC += foreign-allocation.c
+endif
 else
   GC_SRC = cheneygc.c
 endif
diff --git a/src/runtime/Config.ppc-netbsd b/src/runtime/Config.ppc-netbsd
index 07f668e..84d6b2b 100644
--- a/src/runtime/Config.ppc-netbsd
+++ b/src/runtime/Config.ppc-netbsd
@@ -19,6 +19,9 @@ OS_SRC = bsd-os.c undefineds.c ppc-bsd-os.c
 OS_LIBS = # -ldl
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-64-bsd b/src/runtime/Config.x86-64-bsd
index 5a2d294..1bf1bdb 100644
--- a/src/runtime/Config.x86-64-bsd
+++ b/src/runtime/Config.x86-64-bsd
@@ -19,6 +19,9 @@ OS_LIBS = # -ldl
 CFLAGS += -fno-omit-frame-pointer
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-64-darwin b/src/runtime/Config.x86-64-darwin
index e6fffb9..6aa9675 100644
--- a/src/runtime/Config.x86-64-darwin
+++ b/src/runtime/Config.x86-64-darwin
@@ -25,6 +25,9 @@ LINKFLAGS += -arch x86_64 -dynamic -twolevel_namespace -bind_at_load -pagezero_s
 CFLAGS += -arch x86_64 -fno-omit-frame-pointer -pagezero_size 0x100000
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-64-sunos b/src/runtime/Config.x86-64-sunos
index 8441cef..b5ad543 100644
--- a/src/runtime/Config.x86-64-sunos
+++ b/src/runtime/Config.x86-64-sunos
@@ -16,7 +16,10 @@ ARCH_SRC = x86-64-arch.c
 OS_SRC = sunos-os.c x86-64-sunos-os.c os-common.c
 OS_LIBS= -ldl -lsocket -lnsl -lrt
 
-GC_SRC= gencgc.c
+GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-bsd b/src/runtime/Config.x86-bsd
index 685fdbc..7a1077e 100644
--- a/src/runtime/Config.x86-bsd
+++ b/src/runtime/Config.x86-bsd
@@ -17,6 +17,9 @@ OS_SRC = bsd-os.c x86-bsd-os.c
 OS_LIBS = # -ldl
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-darwin b/src/runtime/Config.x86-darwin
index ff19612..03e5cac 100644
--- a/src/runtime/Config.x86-darwin
+++ b/src/runtime/Config.x86-darwin
@@ -25,6 +25,9 @@ ARCH_SRC = x86-arch.c
 CPPFLAGS += -no-cpp-precomp
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 .PHONY: after-grovel-headers
 
diff --git a/src/runtime/Config.x86-linux b/src/runtime/Config.x86-linux
index d64a779..8fbf1a5 100644
--- a/src/runtime/Config.x86-linux
+++ b/src/runtime/Config.x86-linux
@@ -39,6 +39,9 @@ ifdef LISP_FEATURE_SB_THREAD
 endif
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-sunos b/src/runtime/Config.x86-sunos
index 2e58b51..6818985 100644
--- a/src/runtime/Config.x86-sunos
+++ b/src/runtime/Config.x86-sunos
@@ -12,6 +12,9 @@ OS_SRC = sunos-os.c x86-sunos-os.c os-common.c
 OS_LIBS= -ldl -lsocket -lnsl -lrt
 
 GC_SRC= gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/Config.x86-win32 b/src/runtime/Config.x86-win32
index 2eac98b..638026f 100644
--- a/src/runtime/Config.x86-win32
+++ b/src/runtime/Config.x86-win32
@@ -29,6 +29,9 @@ OS_LINK_FLAGS = -Wl,--export-dynamic,-mno-cygwin
 OS_LIBS = -mno-cygwin
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 CFLAGS =  -g -Wall -O3 -mno-cygwin
 ASFLAGS = $(CFLAGS)
diff --git a/src/runtime/Config.x86_64-linux b/src/runtime/Config.x86_64-linux
index e1efb79..48d08e9 100644
--- a/src/runtime/Config.x86_64-linux
+++ b/src/runtime/Config.x86_64-linux
@@ -41,6 +41,9 @@ endif
 CFLAGS += -fno-omit-frame-pointer
 
 GC_SRC = gencgc.c
+ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+  GC_SRC += foreign-allocation.c
+endif
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
diff --git a/src/runtime/foreign-allocation.c b/src/runtime/foreign-allocation.c
new file mode 100644
index 0000000..d77ad6f
--- /dev/null
+++ b/src/runtime/foreign-allocation.c
@@ -0,0 +1,521 @@
+/* Support for either scavenged or mark/sweep and scavenged regions
+ * in the foreign heap.
+ *
+ * Scavenged-only regions are easy: they are treated as additional
+ * roots and otherwise managed manually.
+ *
+ * Otherwise, a weak generational mark/sweep model is used:
+ * GCed regions are either dead, adult or teenaged.
+ *
+ * Dead regions are only waiting to be deallocated; their contents
+ * are completely ignored and may contain wild pointers. Outside GCs,
+ * these regions are in the dead_allocations list.
+ *
+ * Adult regions may be pointed to by random places in the heap;
+ * they can only be GCed on full collections. These regions are in
+ * the live_allocations list.
+ *
+ * Teenaged regions are only pointed to by roots; they are GCed
+ * at every collection (until they pass majority). These regions are
+ * in the maybe_live_allocations list.
+ *
+ * A region is only in limbo during GC. Once the GC is done, any
+ * region still in limbo is dead. During GC, they are only found in
+ * maybe_live_allocations.
+ *
+ * The first step of any GC is to scavenge (scan in our case) the roots.
+ * Teenaged regions are demoted in limbo. When scanning roots, regions
+ * in limbo become teenagers. When we're done scanning roots, these reborn
+ * regions are scavenged, but remain on the white list: they could still
+ * pass majority.
+ *
+ * When scanning the general heap, teenaged or in-limbo regions become
+ * adults. Since teenaged regions have already been scavenged, only
+ * those in limbo are put on a to-scavenge list (newly_live_regions).
+ *
+ * While scavenging the new_space, we also scavenge newly_live_regions,
+ * before splicing it into live_regions.
+ *
+ * When we're done GCing, any region in maybe_live that's still in limbo
+ * is dead, while teenaged regions remain there.
+ *
+ * On full GCs, everything is a rejuvenated as in limbo.
+ *
+ * In the actual implementation, pointers into foreign allocations aren't
+ * followed immediately.  Instead, they are accumulated in a buffer, and
+ * that buffer is processed from time to time.
+ */
+
+#include <stdlib.h>
+#include "sbcl.h"
+#include "runtime.h"
+#include "gc-internal.h"
+#include "genesis/sap.h"
+#include "gencgc-internal.h"
+#include "foreign-allocation.h"
+
+#ifdef LISP_FEATURE_SB_THREAD
+pthread_mutex_t foreign_allocation_lock = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+struct foreign_allocation * always_live_allocations = 0;
+// to sweep
+struct foreign_allocation * dead_allocations = 0;
+// white: if partial GC, filled with limbo and teens
+//         if full GC, filled with everything.
+struct foreign_allocation * maybe_live_allocations = 0;
+// grey
+struct foreign_allocation * newly_live_allocations = 0;
+// black
+struct foreign_allocation * live_allocations = 0;
+
+// mask of all the type of objects found in maybe_live
+int all_type_masks = 0;
+unsigned scanning_roots_p = 0;
+
+void enqueue_allocation (struct foreign_allocation ** queue,
+                         struct foreign_allocation * allocation)
+{
+    gc_assert(!allocation->prev);
+    gc_assert(!allocation->next);
+
+    if (!*queue) {
+        allocation->prev = allocation->next = allocation;
+        *queue = allocation;
+        return;
+    }
+
+    allocation->next = (*queue)->next;
+    allocation->next->prev = allocation;
+
+    (*queue)->next = allocation;
+    allocation->prev = *queue;
+}
+
+void dequeue_allocation (struct foreign_allocation ** queue,
+                         struct foreign_allocation * allocation)
+{
+    if (allocation->prev == allocation) {
+        gc_assert(allocation->next == allocation);
+        *queue = 0;
+    } else {
+        allocation->next->prev = allocation->prev;
+        allocation->prev->next = allocation->next;
+    }
+
+    allocation->next = allocation->prev = 0;
+}
+
+void splice_allocations (struct foreign_allocation ** dest,
+                         struct foreign_allocation * queue)
+{
+    if (!queue) return;
+
+    if (!*dest) {
+        *dest = queue;
+        return;
+    }
+
+    struct foreign_allocation
+        * first_queue = queue,
+        * last_queue  = queue->prev,
+        * first_dest  = *dest,
+        * last_dest   = (*dest)->prev;
+
+    last_dest->next    = first_queue;
+    first_queue->prev  = last_dest;
+
+    last_queue->next   = first_dest;
+    first_dest->prev   = last_queue;
+}
+
+struct foreign_allocation * pop_allocation (struct foreign_allocation ** queue)
+{
+    if (!*queue)
+        return 0;
+
+    struct foreign_allocation * ret = *queue;
+    dequeue_allocation (queue, ret);
+    return ret;
+}
+
+void register_always_live_allocation (struct foreign_allocation * allocation)
+{
+    allocation->state = -1;
+
+    enqueue_allocation(&always_live_allocations, allocation);
+}
+
+void retire_always_live_allocation (struct foreign_allocation * allocation)
+{
+    gc_assert(-1 == allocation->state);
+
+    dequeue_allocation(&always_live_allocations, allocation);
+}
+
+void register_gced_allocation (struct foreign_allocation * allocation)
+{
+    allocation->state = 1;
+    enqueue_allocation(&maybe_live_allocations, allocation);
+}
+
+void retire_gced_allocation (struct foreign_allocation * allocation)
+{
+    struct foreign_allocation ** queue;
+
+    switch (allocation->state) {
+    case 0: queue = &dead_allocations;
+        break;
+    case 1: queue = &maybe_live_allocations;
+        break;
+    case 2: queue = &live_allocations;
+        break;
+    default:
+        lose("Bad allocation state (%i) for GCed allocation %p",
+             allocation->state, allocation);
+        return;
+    }
+
+    dequeue_allocation(queue, allocation);
+}
+
+struct foreign_ref {
+    lispobj * ptr;
+};
+unsigned long foreign_pointer_count = 0;
+unsigned long foreign_pointer_size = 0;
+struct foreign_ref * foreign_pointer_vector = 0;
+
+void (*enqueue_lisp_pointer)(lispobj *) = 0;
+
+void enqueue_random_pointer (lispobj * ptr)
+{
+    if (!maybe_live_allocations) return;
+    if (ptr < maybe_live_allocations->start) return;
+    if (ptr >= maybe_live_allocations->prev->end) return;
+
+    if (foreign_pointer_count >= foreign_pointer_size)
+        process_foreign_pointers();
+
+    foreign_pointer_vector[foreign_pointer_count].ptr = ptr;
+    foreign_pointer_count++;
+}
+
+void enqueue_sap_pointer (void * ptr)
+{
+    gc_assert(!scanning_roots_p);
+    if (!maybe_live_allocations) return;
+    if ((lispobj*) ptr < maybe_live_allocations->start) return;
+    if ((lispobj*) ptr >= maybe_live_allocations->prev->end) return;
+
+    if (foreign_pointer_count >= foreign_pointer_size)
+        process_foreign_pointers();
+
+    foreign_pointer_vector[foreign_pointer_count].ptr
+        = (lispobj*) (((lispobj)ptr) & (~1UL));
+    foreign_pointer_count++;
+}
+
+lispobj (*default_trans_sap)(lispobj obj) = 0;
+
+static lispobj
+trans_sap(lispobj object)
+{
+    gc_assert(is_lisp_pointer(object));
+    enqueue_sap_pointer(((struct sap *)native_pointer(object))->pointer);
+
+    return copy_unboxed_object(object, 2);
+}
+
+static int cmp_foreign_pointers (const void * a, const void * b)
+{
+    const struct foreign_ref * x = a;
+    const struct foreign_ref * y = b;
+
+    if (x->ptr < y->ptr)
+        return -1;
+    if (x->ptr == y->ptr)
+        return 0;
+    return 1;
+}
+
+static void sort_foreign_pointers ()
+{
+    qsort(foreign_pointer_vector,
+          foreign_pointer_count, sizeof(struct foreign_ref),
+          cmp_foreign_pointers);
+}
+
+void process_foreign_pointers ()
+{
+    struct foreign_allocation * alloc;
+    unsigned i;
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+    lispobj * search_ptr;
+#endif
+    struct foreign_ref foreign;
+
+    if (!maybe_live_allocations)
+        goto done;
+    if (!foreign_pointer_count)
+        goto done;
+
+    sort_foreign_pointers();
+
+    alloc = maybe_live_allocations;
+    search_ptr = alloc->start;
+    i = 0;
+    foreign = foreign_pointer_vector[0];
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+#define NEXT_ALLOC                                              \
+    do {                                                        \
+        alloc = alloc->next;                                    \
+        search_ptr = alloc->start;                              \
+        if (alloc == maybe_live_allocations) goto done;         \
+    } while (0)
+#else
+#define NEXT_ALLOC                                              \
+    do {                                                        \
+        alloc = alloc->next;                                    \
+        if (alloc == maybe_live_allocations) goto done;         \
+    } while (0)
+#endif
+
+#define NEXT_FOREIGN                                    \
+    do {                                                \
+        if (++i >= foreign_pointer_count) goto done;    \
+        foreign = foreign_pointer_vector[i];            \
+    } while (0)
+
+    while (maybe_live_allocations) {
+        int live_p = 0;
+        while (!((alloc->start <= foreign.ptr)
+                 && (foreign.ptr < alloc->end))) {
+            while (!(foreign.ptr < alloc->end))
+                NEXT_ALLOC;
+
+            while (!(foreign.ptr >= alloc->start))
+                NEXT_FOREIGN;
+        }
+
+        if (alloc->type & 1) { // any pointer counts!
+            // SAP's low bit is cleared, so either it's a preserved pointer
+            // (and we're scanning roots), or it's not a lisp pointer.
+            if (scanning_roots_p || !is_lisp_pointer((lispobj)foreign.ptr)) {
+                live_p = 1;
+                goto next;
+            }
+        }
+
+        if (alloc->type & 4) { // pointer to head counts
+            if (scanning_roots_p) { // we're scanning roots, it's preserved
+                if (alloc->start == foreign.ptr) {
+                    live_p = 1;
+                    goto next;
+                }
+            } else if (!is_lisp_pointer((lispobj)foreign.ptr)) {
+                // otherwise low bit cleared on SAP addresses
+                lispobj start = (lispobj)alloc->start & (~1UL);
+                if (start == (lispobj)foreign.ptr) {
+                    live_p = 1;
+                    goto next;
+                }
+            }
+        }
+
+        if (!(alloc->type & 2)) goto next;
+
+        /* Lisp-like heap: */
+        if (!(is_lisp_pointer((lispobj)foreign.ptr)||scanning_roots_p))
+            goto next;
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+        lispobj * enclosing
+            = gc_search_space(search_ptr, alloc->end-search_ptr, foreign.ptr);
+        if (!enclosing)
+            goto next;
+        search_ptr = enclosing;
+
+        if (!looks_like_valid_lisp_pointer_p(foreign.ptr, enclosing))
+            goto next;
+#endif
+
+        live_p = 1;
+        next:
+        if (live_p) {
+            if (scanning_roots_p) {
+                alloc->state = 1;
+            } else {
+                struct foreign_allocation * next = alloc->next;
+                dequeue_allocation(&maybe_live_allocations, alloc);
+                enqueue_allocation((1 == alloc->state)
+                                   ? &live_allocations
+                                   : &newly_live_allocations,
+                                   alloc);
+                alloc->state = 2;
+                alloc = next;
+                search_ptr = alloc->start;
+            }
+        }
+        NEXT_FOREIGN;
+    }
+
+#undef NEXT_FOREIGN
+#undef NEXT_ALLOC
+    done:
+    foreign_pointer_count = 0;
+}
+
+static int cmp_foreign_allocation_ptr (const void * a, const void * b)
+{
+    const struct foreign_allocation * x = a;
+    const struct foreign_allocation * y = b;
+
+    if (x->start < y->start)
+        return -1;
+
+    if (x->start == y->start)
+        return 0;
+
+    return 1;
+}
+
+static void sort_gced_allocations ()
+{
+    struct foreign_allocation * ptr;
+    unsigned count = 0, size = 1024, i;
+    struct foreign_allocation ** vec;
+    all_type_masks = 0;
+    if (!maybe_live_allocations)
+        return;
+    /* Blit the list to a vector */
+    vec = successful_malloc(size*sizeof(struct foreign_allocation *));
+
+    ptr = maybe_live_allocations;
+    do {
+        if (count >= size) {
+            vec = realloc(vec, sizeof(struct foreign_allocation *) * size * 2);
+            gc_assert(vec);
+            size *= 2;
+        }
+
+        ptr->state = 0;
+        vec[count++] = ptr;
+        all_type_masks |= ptr->type;
+    } while ((ptr = ptr->next) != maybe_live_allocations);
+
+    /* sort the vector */
+    qsort(vec,
+          count, sizeof(struct foreign_allocation *),
+          cmp_foreign_allocation_ptr);
+
+    gc_assert(count);
+    /* And blit the sorted vector back to the list */
+    for (i = 0; i < count-1; i++) {
+        vec[i]->next = vec[i+1];
+        vec[i+1]->prev = vec[i];
+    }
+
+    vec[count-1]->next = vec[0];
+    vec[0]->prev = vec[count-1];
+
+    maybe_live_allocations = vec[0];
+
+    free(vec);
+}
+
+void prepare_foreign_allocations_for_gc (int full_gc_p)
+{
+    default_trans_sap = transother[SAP_WIDETAG];
+    newly_live_allocations = 0;
+    foreign_pointer_count = 0;
+    foreign_pointer_size = 1024*1024;
+    foreign_pointer_vector = realloc(foreign_pointer_vector,
+                                     1024*1024*sizeof(lispobj *));
+    scanning_roots_p = 1;
+    if (full_gc_p) {
+        splice_allocations(&maybe_live_allocations, live_allocations);
+        live_allocations = 0;
+    }
+
+    sort_gced_allocations();
+    if (all_type_masks&(1|4))
+        transother[SAP_WIDETAG] = trans_sap;
+
+    enqueue_lisp_pointer
+        = (all_type_masks&2)
+        ? enqueue_random_pointer
+        : 0;
+}
+
+void scavenge_foreign_allocations (struct foreign_allocation * allocations)
+{
+    struct foreign_allocation * ptr;
+    if (!allocations) return;
+
+    ptr = allocations;
+    do {
+        if (!(ptr->type & 8)) continue;
+        scavenge(ptr->start, ptr->end - ptr->start);
+        gc_assert(!from_space_p(*ptr->start));
+        ptr = ptr->next;
+    } while ((ptr = ptr->next) != allocations);
+}
+
+/* execute once all the roots have been scavenged */
+void scavenge_teenaged_alloc ()
+{
+    struct foreign_allocation * ptr;
+    process_foreign_pointers();
+
+    if (!scanning_roots_p) return;
+
+    scanning_roots_p = 0;
+
+    if (!maybe_live_allocations) return;
+
+    ptr = maybe_live_allocations;
+    do {
+        if ((1 == ptr->state) && (ptr->type & 8))
+            scavenge(ptr->start, ptr->end-ptr->start);
+    } while ((ptr = ptr->next) != maybe_live_allocations);
+}
+
+void mark_foreign_alloc ()
+{
+    gc_assert(!scanning_roots_p);
+    while (foreign_pointer_count || newly_live_allocations) {
+        process_foreign_pointers();
+        if (newly_live_allocations) {
+            scavenge_foreign_allocations(newly_live_allocations);
+            splice_allocations(&live_allocations, newly_live_allocations);
+            newly_live_allocations = 0;
+        }
+    }
+}
+
+void sweep_allocations ()
+{
+    struct foreign_allocation * ptr = maybe_live_allocations;
+
+    transother[SAP_WIDETAG] = default_trans_sap;
+    enqueue_lisp_pointer = 0;
+    gc_assert(0 == newly_live_allocations);
+    gc_assert(0 == foreign_pointer_count);
+
+    if (!maybe_live_allocations) return;
+
+    do {
+        if (0 == ptr->state) {
+            struct foreign_allocation * next = ptr->next;
+            dequeue_allocation(&maybe_live_allocations, ptr);
+            enqueue_allocation(&dead_allocations, ptr);
+            if (!maybe_live_allocations) break;
+            ptr = next;
+        } else {
+            gc_assert(1 == ptr->state);
+            ptr = ptr->next;
+        }
+    } while (ptr != maybe_live_allocations);
+}
+
diff --git a/src/runtime/foreign-allocation.h b/src/runtime/foreign-allocation.h
new file mode 100644
index 0000000..5b77828
--- /dev/null
+++ b/src/runtime/foreign-allocation.h
@@ -0,0 +1,69 @@
+#ifndef __FOREIGN_ALLOCATION_H__
+#define __FOREIGN_ALLOCATION_H__
+#include "runtime.h"
+
+/* Foreign allocation region descriptors. The interface only
+ * manipulates pointers; feel free to "subclass".
+ **/
+struct foreign_allocation {
+    struct foreign_allocation * prev;
+    struct foreign_allocation * next;
+    lispobj * start;
+    lispobj * end;
+    /* bitmask:
+     * bit  |  meaning if set
+     *  0   |   any SAP/raw pointer counts
+     *  1   |   lisp heap-like
+     *  2   |   SAP/raw pointers to head count
+     *  3   |   scavenged region
+     */
+    int type;
+    int state;
+    /* 0 : dead or in limbo
+     * 1 : teenager (live, but only from direct roots)
+     * 2 : adult (live, from heap)
+     * -1 : always live
+     */
+};
+
+
+/* Foreign allocation region interface.
+ */
+void register_always_live_allocation (struct foreign_allocation * allocation);
+void retire_always_live_allocation (struct foreign_allocation * allocation);
+void register_gced_allocation (struct foreign_allocation * allocation);
+void retire_gced_allocation (struct foreign_allocation * allocation);
+
+
+extern struct foreign_allocation * always_live_allocations;
+extern struct foreign_allocation * dead_allocations;
+extern struct foreign_allocation * maybe_live_allocations;
+extern struct foreign_allocation * live_allocations;
+
+void enqueue_allocation (struct foreign_allocation ** queue,
+                         struct foreign_allocation * allocation);
+void dequeue_allocation (struct foreign_allocation ** queue,
+                         struct foreign_allocation * allocation);
+void splice_allocations (struct foreign_allocation ** dest,
+                         struct foreign_allocation * queue);
+struct foreign_allocation *
+pop_allocation (struct foreign_allocation ** queue);
+
+
+/* Interface for the GC.
+ */
+extern unsigned scanning_roots_p;
+
+extern void (*enqueue_lisp_pointer)(lispobj *);
+void enqueue_random_pointer (lispobj * ptr);
+void enqueue_sap_pointer (void * ptr);
+
+// should that be public?
+void process_foreign_pointers ();
+
+void prepare_foreign_allocations_for_gc (int full_gc_p);
+void scavenge_foreign_allocations (struct foreign_allocation * allocations);
+void scavenge_teenaged_alloc ();
+void mark_foreign_alloc ();
+void sweep_allocations ();
+#endif
diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index a9f69b6..7df6dc3 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -44,6 +44,10 @@
 #include "genesis/hash-table.h"
 #include "gc-internal.h"
 
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+#include "foreign-allocation.h"
+#endif
+
 #ifdef LISP_FEATURE_SPARC
 #define LONG_FLOAT_SIZE 4
 #else
@@ -171,6 +175,10 @@ scavenge(lispobj *start, long n_words)
                 /* It points somewhere other than oldspace. Leave it
                  * alone. */
                 n_words_scavenged = 1;
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+                if (enqueue_lisp_pointer)
+                        enqueue_lisp_pointer((lispobj*)object);
+#endif
             }
         }
 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
diff --git a/src/runtime/gencgc-internal.h b/src/runtime/gencgc-internal.h
index cdaa456..c568fb9 100644
--- a/src/runtime/gencgc-internal.h
+++ b/src/runtime/gencgc-internal.h
@@ -113,6 +113,9 @@ void gc_set_region_empty(struct alloc_region *region);
 /*
  * predicates
  */
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+int looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr);
+#endif
 
 static inline boolean
 space_matches_p(lispobj obj, generation_index_t space)
diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 5bd67c8..d8cad2d 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -56,6 +56,10 @@
 #include "pthread-lutex.h"
 #endif
 
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+#include "foreign-allocation.h"
+#endif
+
 /* forward declarations */
 page_index_t  gc_find_freeish_pages(long *restart_page_ptr, long nbytes,
                                     int page_type_flag);
@@ -2226,7 +2230,7 @@ search_dynamic_space(void *pointer)
  * pointer is the pointer to validate, and start_addr is the address
  * of the enclosing object.
  */
-static int
+int
 looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
 {
     if (!is_lisp_pointer((lispobj)pointer)) {
@@ -2713,9 +2717,17 @@ preserve_pointer(void *addr)
     page_index_t i;
     unsigned int region_allocation;
 
+    /* points to foreign heap... */
+    if (addr_page_index == -1) {
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+        if (scanning_roots_p)
+            enqueue_random_pointer(addr);
+#endif
+        return;
+    }
+
     /* quick check 1: Address is quite likely to have been invalid. */
-    if ((addr_page_index == -1)
-        || page_free_p(addr_page_index)
+    if (page_free_p(addr_page_index)
         || (page_table[addr_page_index].bytes_used == 0)
         || (page_table[addr_page_index].gen != from_space)
         /* Skip if already marked dont_move. */
@@ -3139,6 +3151,14 @@ scavenge_newspace_generation(generation_index_t generation)
      * http://www.haible.de/bruno/papers/cs/weak/WeakDatastructures-writeup.html
      * see "Implementation 2". */
     scav_weak_hash_tables();
+    /* Similar with marked foreign allocations.  However, since the algorithm
+     * works better when batched, only process them if we might otherwise stop
+     * GCing.
+     */
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    if (!new_areas_index)
+            mark_foreign_alloc();
+#endif
 
     /* Flush the current regions updating the tables. */
     gc_alloc_update_all_page_tables();
@@ -3189,6 +3209,10 @@ scavenge_newspace_generation(generation_index_t generation)
             record_new_objects = 2;
 
             scav_weak_hash_tables();
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+            if (!new_areas_index)
+                    mark_foreign_alloc();
+#endif
 
             /* Flush the current regions updating the tables. */
             gc_alloc_update_all_page_tables();
@@ -3205,6 +3229,10 @@ scavenge_newspace_generation(generation_index_t generation)
             }
 
             scav_weak_hash_tables();
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+            if (!new_areas_index)
+                    mark_foreign_alloc();
+#endif
 
             /* Flush the current regions updating the tables. */
             gc_alloc_update_all_page_tables();
@@ -4169,6 +4197,15 @@ garbage_collect_generation(generation_index_t generation, int raise)
     }
     scavenge( (lispobj *) STATIC_SPACE_START, static_space_size);
 
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    /* Scavenge the manually managed and known live foreign alloc regions. */
+    scavenge_foreign_allocations(always_live_allocations);
+    scavenge_foreign_allocations(live_allocations);
+
+    /* Done scavenging roots... scavenge teenagers */
+    scavenge_teenaged_alloc();
+#endif
+
     /* All generations but the generation being GCed need to be
      * scavenged. The new_space generation needs special handling as
      * objects may be moved in - it is handled separately below. */
@@ -4339,6 +4376,10 @@ collect_garbage(generation_index_t last_gen)
         last_gen = 0;
     }
 
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    prepare_foreign_allocations_for_gc(HIGHEST_NORMAL_GENERATION+1 == last_gen);
+#endif
+
     /* Flush the alloc regions updating the tables. */
     gc_alloc_update_all_page_tables();
 
@@ -4451,6 +4492,10 @@ collect_garbage(generation_index_t last_gen)
         high_water_mark = 0;
     }
 
+#ifdef LISP_FEATURE_SB_FOREIGN_ALLOCATION
+    sweep_allocations();
+#endif
+
     gc_active_p = 0;
 
     SHOW("returning from collect_garbage");