From 6295772657ba9bf5e4e0c95d590ab90356c984bc Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 28 Jul 1992 20:16:54 +0000
Subject: [PATCH] Initial revision

---
 lisp/Config.pmax_mach |   12 +
 lisp/GNUmakefile      |   58 ++
 lisp/alloc.c          |  116 +++
 lisp/alloc.h          |   13 +
 lisp/arch.h           |   24 +
 lisp/backtrace.c      |  230 +++++
 lisp/breakpoint.c     |  110 +++
 lisp/breakpoint.h     |   17 +
 lisp/core.h           |   45 +
 lisp/coreparse.c      |  140 ++++
 lisp/dynbind.c        |   68 ++
 lisp/dynbind.h        |   10 +
 lisp/gc.c             | 1859 +++++++++++++++++++++++++++++++++++++++++
 lisp/gc.h             |   22 +
 lisp/globals.c        |   53 ++
 lisp/globals.h        |   62 ++
 lisp/interr.c         |  150 ++++
 lisp/interr.h         |   16 +
 lisp/interrupt.c      |  335 ++++++++
 lisp/interrupt.h      |   44 +
 lisp/lisp.c           |  215 +++++
 lisp/lisp.h           |   43 +
 lisp/lispregs.h       |   25 +
 lisp/mach-os.c        |  182 ++++
 lisp/mach-os.h        |   12 +
 lisp/mips-arch.c      |  286 +++++++
 lisp/mips-assem.S     |  363 ++++++++
 lisp/mips-lispregs.h  |   58 ++
 lisp/mips-validate.h  |   19 +
 lisp/monitor.c        |  480 +++++++++++
 lisp/monitor.h        |    4 +
 lisp/os-common.c      |   91 ++
 lisp/os.h             |   56 ++
 lisp/parse.c          |  361 ++++++++
 lisp/parse.h          |    9 +
 lisp/print.c          |  570 +++++++++++++
 lisp/print.h          |   14 +
 lisp/purify.c         |  752 +++++++++++++++++
 lisp/purify.h         |   10 +
 lisp/regnames.c       |    5 +
 lisp/save.c           |  229 +++++
 lisp/save.h           |   14 +
 lisp/search.c         |   44 +
 lisp/search.h         |   11 +
 lisp/socket.c         |  144 ++++
 lisp/validate.c       |   63 ++
 lisp/validate.h       |   28 +
 lisp/vars.c           |  173 ++++
 lisp/vars.h           |   15 +
 lisp/version.c        |    2 +
 50 files changed, 7662 insertions(+)
 create mode 100644 lisp/Config.pmax_mach
 create mode 100644 lisp/GNUmakefile
 create mode 100644 lisp/alloc.c
 create mode 100644 lisp/alloc.h
 create mode 100644 lisp/arch.h
 create mode 100644 lisp/backtrace.c
 create mode 100644 lisp/breakpoint.c
 create mode 100644 lisp/breakpoint.h
 create mode 100644 lisp/core.h
 create mode 100644 lisp/coreparse.c
 create mode 100644 lisp/dynbind.c
 create mode 100644 lisp/dynbind.h
 create mode 100644 lisp/gc.c
 create mode 100644 lisp/gc.h
 create mode 100644 lisp/globals.c
 create mode 100644 lisp/globals.h
 create mode 100644 lisp/interr.c
 create mode 100644 lisp/interr.h
 create mode 100644 lisp/interrupt.c
 create mode 100644 lisp/interrupt.h
 create mode 100644 lisp/lisp.c
 create mode 100644 lisp/lisp.h
 create mode 100644 lisp/lispregs.h
 create mode 100644 lisp/mach-os.c
 create mode 100644 lisp/mach-os.h
 create mode 100644 lisp/mips-arch.c
 create mode 100644 lisp/mips-assem.S
 create mode 100644 lisp/mips-lispregs.h
 create mode 100644 lisp/mips-validate.h
 create mode 100644 lisp/monitor.c
 create mode 100644 lisp/monitor.h
 create mode 100644 lisp/os-common.c
 create mode 100644 lisp/os.h
 create mode 100644 lisp/parse.c
 create mode 100644 lisp/parse.h
 create mode 100644 lisp/print.c
 create mode 100644 lisp/print.h
 create mode 100644 lisp/purify.c
 create mode 100644 lisp/purify.h
 create mode 100644 lisp/regnames.c
 create mode 100644 lisp/save.c
 create mode 100644 lisp/save.h
 create mode 100644 lisp/search.c
 create mode 100644 lisp/search.h
 create mode 100644 lisp/socket.c
 create mode 100644 lisp/validate.c
 create mode 100644 lisp/validate.h
 create mode 100644 lisp/vars.c
 create mode 100644 lisp/vars.h
 create mode 100644 lisp/version.c

diff --git a/lisp/Config.pmax_mach b/lisp/Config.pmax_mach
new file mode 100644
index 000000000..709a20fff
--- /dev/null
+++ b/lisp/Config.pmax_mach
@@ -0,0 +1,12 @@
+CPPFLAGS = -I. -I/usr/misc/.X11/include
+CC = gcc # -Wall -Wstrict-prototypes -Wmissing-prototypes
+CPP = /usr/cs/lib/cpp
+CFLAGS = -g
+ASFLAGS = -g
+NM = nm -gp
+UNDEFSYMPATTERN = &
+ASSEM_SRC = mips-assem.S
+ARCH_SRC = mips-arch.c
+OS_SRC = mach-os.c
+OS_LINK_FLAGS=
+OS_LIBS=-lmach
diff --git a/lisp/GNUmakefile b/lisp/GNUmakefile
new file mode 100644
index 000000000..b704392ad
--- /dev/null
+++ b/lisp/GNUmakefile
@@ -0,0 +1,58 @@
+# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.1 1992/07/28 20:13:58 wlott Exp $
+
+all: lisp.nm
+
+CC = gcc
+
+include Config
+
+SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c os-common.c \
+	vars.c parse.c interrupt.c search.c validate.c gc.c globals.c \
+	dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \
+	socket.c ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC}
+
+OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(SRCS)))
+
+### Don't look in RCS for the files, because we might not want the latest.
+%: RCS/%,v
+
+lisp.nm: lisp
+	echo -n 'Map file for lisp version ' > ,lisp.nm
+	cat version >> ,lisp.nm
+	$(NM) lisp >> ,lisp.nm
+	mv ,lisp.nm lisp.nm
+
+lisp: ${OBJS} version undefineds
+	echo -n '1 + ' | cat - version | bc > ,version
+	mv ,version version
+	$(CC) ${CFLAGS} -DVERSION=`cat version` -c version.c
+	$(CC) $(CFLAGS) ${OS_LINK_FLAGS} `cat undefineds` -o ,lisp \
+		${OBJS} version.o \
+		${OS_LIBS} -lm
+	mv -f ,lisp lisp
+
+version:
+	echo 0 > version
+
+undefineds: undefineds.src
+	${CPP} undefineds.src | \
+	sed -e '/^#/d' -e '/^[ 	]*$$/d' -e 's/.*/-Xlinker -u -Xlinker ${UNDEFSYMPATTERN}/' | \
+	sort -u > ,undefineds
+	mv ,undefineds undefineds
+
+### Socket.c needs to be compiled with UNIXCONN defined.
+socket.o: socket.c
+	$(COMPILE.c) -DUNIXCONN socket.c
+
+internals.h:
+	@echo "You must run genesis to create internals.h!"
+	@false
+
+clean:
+	rm -f Depends lisp.h undefineds *.o lisp lisp.nm
+
+depend:
+	$(CC) -MM ${CFLAGS} ${CPPFLAGS} ${SRCS} > ,depends
+	mv ,depends Depends
+
+include Depends
diff --git a/lisp/alloc.c b/lisp/alloc.c
new file mode 100644
index 000000000..658541e1d
--- /dev/null
+++ b/lisp/alloc.c
@@ -0,0 +1,116 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.c,v 1.1 1992/07/28 20:14:02 wlott Exp $ */
+
+#include "lisp.h"
+#include "internals.h"
+#include "alloc.h"
+#include "globals.h"
+#include "gc.h"
+
+#ifdef ibmrt
+#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER))
+#define SET_FREE_POINTER(new_value) \
+    (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value)))
+#define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER))
+#define SET_GC_TRIGGER(new_value) \
+    (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value)))
+#else
+#define GET_FREE_POINTER() current_dynamic_space_free_pointer
+#define SET_FREE_POINTER(new_value) \
+    (current_dynamic_space_free_pointer = (new_value))
+#define GET_GC_TRIGGER() current_auto_gc_trigger
+#define SET_GC_TRIGGER(new_value) \
+    clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
+#endif
+
+
+
+/****************************************************************
+Allocation Routines.
+****************************************************************/
+
+static lispobj *alloc(int bytes)
+{
+    lispobj *result;
+
+    /* Round to dual word boundry. */
+    bytes = (bytes + lowtag_Mask) & ~lowtag_Mask;
+
+    result = GET_FREE_POINTER();
+    SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
+
+    if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
+	SET_GC_TRIGGER((char *)GET_FREE_POINTER()
+		       - (char *)current_dynamic_space);
+    }
+
+    return result;
+}
+
+static lispobj *alloc_unboxed(int type, int words)
+{
+    lispobj *result;
+
+    result = alloc((1 + words) * sizeof(lispobj));
+
+    *result = (lispobj) (words << type_Bits) | type;
+
+    return result;
+}
+
+static lispobj alloc_vector(int type, int length, int size)
+{
+    struct vector *result;
+
+    result = (struct vector *)alloc((2 + (length*size + 31) / 32) * sizeof(lispobj));
+
+    result->header = type;
+    result->length = make_fixnum(length);
+
+    return ((lispobj)result)|type_OtherPointer;
+}
+
+lispobj alloc_cons(lispobj car, lispobj cdr)
+{
+    struct cons *ptr = (struct cons *)alloc(sizeof(struct cons));
+
+    ptr->car = car;
+    ptr->cdr = cdr;
+
+    return (lispobj)ptr | type_ListPointer;
+}
+
+lispobj alloc_number(long n)
+{
+    struct bignum *ptr;
+
+    if (-0x20000000 < n && n < 0x20000000)
+        return make_fixnum(n);
+    else {
+        ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1);
+
+        ptr->digits[0] = n;
+
+	return (lispobj) ptr | type_OtherPointer;
+    }
+}
+
+lispobj alloc_string(char *str)
+{
+    int len = strlen(str);
+    lispobj result = alloc_vector(type_SimpleString, len+1, 8);
+    struct vector *vec = (struct vector *)PTR(result);
+
+    vec->length = make_fixnum(len);
+    strcpy((char *)vec->data, str);
+
+    return result;
+}
+
+lispobj alloc_sap(void *ptr)
+{
+    struct sap *sap = (struct sap *)alloc_unboxed(type_Sap, 1);
+
+    sap->pointer = ptr;
+
+    return (lispobj) sap | type_OtherPointer;
+}
diff --git a/lisp/alloc.h b/lisp/alloc.h
new file mode 100644
index 000000000..e4e698271
--- /dev/null
+++ b/lisp/alloc.h
@@ -0,0 +1,13 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.h,v 1.1 1992/07/28 20:14:04 wlott Exp $ */
+
+#ifndef _ALLOC_H_
+#define _ALLOC_H_
+
+#include "lisp.h"
+
+extern lispobj alloc_cons(lispobj car, lispobj cdr);
+extern lispobj alloc_number(long n);
+extern lispobj alloc_string(char *str);
+extern lispobj alloc_sap(void *ptr);
+
+#endif _ALLOC_H_
diff --git a/lisp/arch.h b/lisp/arch.h
new file mode 100644
index 000000000..b4e7f045d
--- /dev/null
+++ b/lisp/arch.h
@@ -0,0 +1,24 @@
+#ifndef __ARCH_H__
+#define __ARCH_H__
+
+#include "os.h"
+#include "signal.h"
+
+extern char *arch_init(void);
+extern void arch_skip_instruction(struct sigcontext *scp);
+extern boolean arch_pseudo_atomic_atomic(struct sigcontext *scp);
+extern void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp);
+extern os_vm_address_t arch_get_bad_addr(struct sigcontext *scp);
+extern unsigned char *arch_internal_error_arguments(struct sigcontext *scp);
+extern unsigned long arch_install_breakpoint(void *pc);
+extern void arch_remove_breakpoint(void *pc, unsigned long orig_inst);
+extern void arch_install_interrupt_handlers(void);
+extern void arch_do_displaced_inst(struct sigcontext *scp,
+				   unsigned long orig_inst);
+extern lispobj funcall0(lispobj function);
+extern lispobj funcall1(lispobj function, lispobj arg0);
+extern lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1);
+extern lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1,
+			lispobj arg2);
+
+#endif /* __ARCH_H__ */
diff --git a/lisp/backtrace.c b/lisp/backtrace.c
new file mode 100644
index 000000000..d9c49c759
--- /dev/null
+++ b/lisp/backtrace.c
@@ -0,0 +1,230 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/backtrace.c,v 1.1 1992/07/28 20:14:10 wlott Exp $
+ *
+ * Simple backtrace facility.  More or less from Rob's lisp version.
+ */
+
+#include <stdio.h>
+#include <signal.h>
+#include "lisp.h"
+#include "internals.h"
+#include "globals.h"
+#include "interrupt.h"
+#include "lispregs.h"
+
+#ifndef i386
+
+/* Sigh ... I know what the call frame looks like and it had
+   better not change. */
+
+struct call_frame {
+	struct call_frame *old_cont;
+	lispobj saved_lra;
+        lispobj code;
+	lispobj other_state[5];
+};
+
+struct call_info {
+    struct call_frame *frame;
+    int interrupted;
+    struct code *code;
+    lispobj lra;
+    int pc; /* Note: this is the trace file offset, not the actual pc. */
+};
+
+#define HEADER_LENGTH(header) ((header)>>8)
+
+static int previous_info(struct call_info *info);
+
+static struct code *
+code_pointer(lispobj object)
+{
+    lispobj *headerp, header;
+    int type, len;
+
+    headerp = (lispobj *) PTR(object);
+    header = *headerp;
+    type = TypeOf(header);
+
+    switch (type) {
+        case type_CodeHeader:
+            break;
+        case type_ReturnPcHeader:
+        case type_FunctionHeader:
+        case type_ClosureFunctionHeader:
+            len = HEADER_LENGTH(header);
+            if (len == 0)
+                headerp = NULL;
+            else
+                headerp -= len;
+            break;
+        default:
+            headerp = NULL;
+    }
+
+    return (struct code *) headerp;
+}
+
+static boolean
+cs_valid_pointer_p(struct call_frame *pointer)
+{
+	return (((char *) control_stack <= (char *) pointer) &&
+		((char *) pointer < (char *) current_control_stack_pointer));
+}
+
+static void
+info_from_lisp_state(struct call_info *info)
+{
+    info->frame = (struct call_frame *)current_control_frame_pointer;
+    info->interrupted = 0;
+    info->code = NULL;
+    info->lra = 0;
+    info->pc = 0;
+
+    previous_info(info);
+}
+
+static void
+info_from_sigcontext(struct call_info *info, struct sigcontext *csp)
+{
+    unsigned long pc;
+
+    info->interrupted = 1;
+    if (LowtagOf(SC_REG(csp, reg_CODE)) == type_FunctionPointer) {
+        /* We tried to call a function, but crapped out before $CODE could be fixed up.  Probably an undefined function. */
+        info->frame = (struct call_frame *)SC_REG(csp, reg_OCFP);
+        info->lra = (lispobj)SC_REG(csp, reg_LRA);
+        info->code = code_pointer(info->lra);
+        pc = (unsigned long)PTR(info->lra);
+    }
+    else {
+        info->frame = (struct call_frame *)SC_REG(csp, reg_CFP);
+        info->code = code_pointer(SC_REG(csp, reg_CODE));
+        info->lra = NIL;
+        pc = SC_PC(csp);
+    }
+    if (info->code != NULL)
+        info->pc = pc - (unsigned long) info->code -
+            (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
+    else
+        info->pc = 0;
+}
+
+static int
+previous_info(struct call_info *info)
+{
+    struct call_frame *this_frame;
+    int free;
+    struct sigcontext *csp;
+
+    if (!cs_valid_pointer_p(info->frame)) {
+        printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame);
+        return 0;
+    }
+
+    this_frame = info->frame;
+    info->lra = this_frame->saved_lra;
+    info->frame = this_frame->old_cont;
+    info->interrupted = 0;
+
+    if (info->frame == NULL || info->frame == this_frame)
+        return 0;
+
+    if (info->lra == NIL) {
+        /* We were interrupted.  Find the correct sigcontext. */
+        free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+        while (free-- > 0) {
+            csp = lisp_interrupt_contexts[free];
+            if ((struct call_frame *)(SC_REG(csp, reg_CFP)) == info->frame) {
+                info_from_sigcontext(info, csp);
+                break;
+            }
+        }
+    }
+    else {
+        info->code = code_pointer(info->lra);
+        if (info->code != NULL)
+            info->pc = (unsigned long)PTR(info->lra) -
+                (unsigned long)info->code -
+                (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
+        else
+            info->pc = 0;
+    }
+
+    return 1;
+}
+
+void
+backtrace(int nframes)
+{
+    struct call_info info;
+	
+    info_from_lisp_state(&info);
+
+    do {
+        printf("<Frame 0x%08x%s, ", (unsigned long) info.frame,
+                info.interrupted ? " [interrupted]" : "");
+        
+        if (info.code != (struct code *) 0) {
+            lispobj function;
+
+            printf("CODE: 0x%08X, ", (unsigned long) info.code | type_OtherPointer);
+
+            function = info.code->entry_points;
+            while (function != NIL) {
+                struct function_header *header;
+                lispobj name;
+
+                header = (struct function_header *) PTR(function);
+                name = header->name;
+
+                if (LowtagOf(name) == type_OtherPointer) {
+                    lispobj *object;
+
+                    object = (lispobj *) PTR(name);
+
+                    if (TypeOf(*object) == type_SymbolHeader) {
+                        struct symbol *symbol;
+
+                        symbol = (struct symbol *) object;
+                        object = (lispobj *) PTR(symbol->name);
+                    }
+                    if (TypeOf(*object) == type_SimpleString) {
+                        struct vector *string;
+
+                        string = (struct vector *) object;
+                        printf("%s, ", (char *) string->data);
+                    } else
+                        printf("(Not simple string???), ");
+                } else
+                    printf("(Not other pointer???), ");
+
+
+                function = header->next;
+            }
+        }
+        else
+            printf("CODE: ???, ");
+
+        if (info.lra != NIL)
+            printf("LRA: 0x%08x, ", (unsigned long)info.lra);
+        else
+            printf("<no LRA>, ");
+
+        if (info.pc)
+            printf("PC: 0x%x>\n", info.pc);
+        else
+            printf("PC: ???>\n");
+
+    } while (--nframes > 0 && previous_info(&info));
+}
+
+#else
+
+void
+backtrace(nframes)
+int nframes;
+{
+    printf("Can't backtrace on the x86.\n");
+}
+
+#endif
diff --git a/lisp/breakpoint.c b/lisp/breakpoint.c
new file mode 100644
index 000000000..c690c7395
--- /dev/null
+++ b/lisp/breakpoint.c
@@ -0,0 +1,110 @@
+#include <stdio.h>
+#include <signal.h>
+
+#include "lisp.h"
+#include "os.h"
+#include "internals.h"
+#include "arch.h"
+#include "lispregs.h"
+#include "globals.h"
+#include "alloc.h"
+#include "breakpoint.h"
+
+#define REAL_LRA_SLOT 0
+#define KNOWN_RETURN_P_SLOT 1
+#define BOGUS_LRA_CONSTANTS 2
+
+static void *compute_pc(lispobj code_obj, int pc_offset)
+{
+    struct code *code;
+
+    code = (struct code *)PTR(code_obj);
+    return (void *)((char *)code + HeaderValue(code->header)*sizeof(lispobj)
+		    + pc_offset);
+}
+
+unsigned long breakpoint_install(lispobj code_obj, int pc_offset)
+{
+    return arch_install_breakpoint(compute_pc(code_obj, pc_offset));
+}
+
+void breakpoint_remove(lispobj code_obj, int pc_offset,
+		       unsigned long orig_inst)
+{
+    arch_remove_breakpoint(compute_pc(code_obj, pc_offset), orig_inst);
+}
+
+void breakpoint_do_displaced_inst(struct sigcontext *scp,
+				  unsigned long orig_inst)
+{
+    arch_do_displaced_inst(scp, orig_inst);
+}
+
+static lispobj find_code(struct sigcontext *scp)
+{
+#ifdef CODE
+    lispobj code = SC_REG(scp, CODE), header;
+
+    if (LowtagOf(code) != type_OtherPointer)
+	return NIL;
+
+    header = *(lispobj *)PTR(code);
+
+    if (TypeOf(header) == type_CodeHeader)
+	return code;
+    else
+	return code - HeaderValue(code)*sizeof(lispobj);
+#else
+    return NIL;
+#endif
+}
+
+static void internal_handle_breakpoint(struct sigcontext *scp, lispobj code)
+{
+    int offset;
+
+    if (code == NIL)
+	offset = 0;
+    else {
+	unsigned long code_start;
+	struct code *codeptr = (struct code *)PTR(code);
+
+	code_start = (unsigned long)codeptr
+	    + HeaderValue(codeptr->header)*sizeof(lispobj);
+	if (SC_PC(scp) < code_start)
+	    offset = 0;
+	else {
+	    offset = SC_PC(scp) - code_start;
+	    if (offset >= codeptr->code_size)
+		offset = 0;
+	}
+    }
+
+    funcall3(SymbolFunction(HANDLE_BREAKPOINT),
+	     make_fixnum(offset),
+	     code,
+	     alloc_sap(scp));
+    scp->sc_mask = sigblock(0);
+}
+
+void handle_breakpoint(int signal, int subcode, struct sigcontext *scp)
+{
+    internal_handle_breakpoint(scp, find_code(scp));
+}
+
+void *handle_function_end_breakpoint(int signal, int subcode,
+				     struct sigcontext *scp)
+{
+    lispobj code = find_code(scp);
+    struct code *codeptr = (struct code *)PTR(code);
+    lispobj lra;
+
+    internal_handle_breakpoint(scp, code);
+
+    lra = codeptr->constants[REAL_LRA_SLOT];
+#ifdef CODE
+    if (codeptr->constants[KNOWN_RETURN_P_SLOT] == NIL)
+	SC_REG(scp, CODE) = lra;
+#endif
+    return (void *)(lra - type_OtherPointer+sizeof(lispobj));
+}
diff --git a/lisp/breakpoint.h b/lisp/breakpoint.h
new file mode 100644
index 000000000..8f45fe841
--- /dev/null
+++ b/lisp/breakpoint.h
@@ -0,0 +1,17 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.h,v 1.1 1992/07/28 20:14:15 wlott Exp $
+ */
+
+#ifndef _BREAKPOINT_H_
+#define _BREAKPOINT_H_
+
+extern unsigned long breakpoint_install(lispobj code_obj, int pc_offset);
+extern void breakpoint_remove(lispobj code_obj, int pc_offset,
+			      unsigned long orig_inst);
+extern void breakpoint_do_displaced_inst(struct sigcontext *scp,
+					 unsigned long orig_inst);
+extern void handle_breakpoint(int signal, int subcode, struct sigcontext *scp);
+extern void *handle_function_end_breakpoint(int signal, int subcode,
+					    struct sigcontext *scp);
+
+#endif
diff --git a/lisp/core.h b/lisp/core.h
new file mode 100644
index 000000000..1010fd038
--- /dev/null
+++ b/lisp/core.h
@@ -0,0 +1,45 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/core.h,v 1.1 1992/07/28 20:14:19 wlott Exp $ */
+
+#ifndef _CORE_H_
+#define _CORE_H_
+
+#include "lisp.h"
+#include "lispregs.h"
+
+#define CORE_PAGESIZE OS_VM_DEFAULT_PAGESIZE
+#define CORE_MAGIC (('C' << 24) | ('O' << 16) | ('R' << 8) | 'E')
+#define CORE_END 3840
+#define CORE_NDIRECTORY 3861
+#define CORE_VALIDATE 3845
+#define CORE_VERSION 3860
+#define CORE_MACHINE_STATE 3862
+
+#define DYNAMIC_SPACE_ID (1)
+#define STATIC_SPACE_ID (2)
+#define READ_ONLY_SPACE_ID (3)
+
+struct ndir_entry {
+	long identifier;
+	long nwords;
+	long data_page;
+	long address;
+	long page_count;
+};
+
+struct machine_state {
+    lispobj *csp;
+    lispobj *cfp;
+    long control_stack_page;
+
+#ifdef reg_BSP
+    lispobj *bsp;
+#endif
+    long binding_stack_page;
+
+    char *nsp;
+    long number_stack_page;
+};
+
+extern boolean load_core_file(char *file);
+
+#endif
diff --git a/lisp/coreparse.c b/lisp/coreparse.c
new file mode 100644
index 000000000..ec98103a5
--- /dev/null
+++ b/lisp/coreparse.c
@@ -0,0 +1,140 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.1 1992/07/28 20:14:21 wlott Exp $ */
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/file.h>
+
+#include "os.h"
+#include "lisp.h"
+#include "globals.h"
+#include "core.h"
+#include "save.h"
+
+extern int version;
+
+static void process_directory(int fd, long *ptr, int count)
+{
+	long id, offset, len;
+	lispobj *free_pointer;
+	os_vm_address_t addr;
+	struct ndir_entry *entry;
+
+	entry = (struct ndir_entry *) ptr;
+
+	while (count-- > 0) {
+		id = entry->identifier;
+		offset = CORE_PAGESIZE * (1 + entry->data_page);
+		addr = (os_vm_address_t) (CORE_PAGESIZE * entry->address);
+		free_pointer = (lispobj *) addr + entry->nwords;
+		len = CORE_PAGESIZE * entry->page_count;
+
+		if (len != 0) {
+		    os_vm_address_t real_addr;
+#ifdef PRINTNOISE
+		    printf("Mapping %d bytes at 0x%x.\n", len, addr);
+#endif
+		    real_addr=os_map(fd, offset, addr, len);
+		    if(real_addr!=addr)
+			fprintf(stderr,
+		  "process_directory: file mapped in wrong place! (0x%08x != 0x%08x)\n",
+				real_addr,
+				addr);
+		}
+
+#if 0
+		printf("Space ID = %d, free pointer = 0x%08x.\n", id, free_pointer);
+#endif
+
+		switch (id) {
+		case DYNAMIC_SPACE_ID:
+                    if (addr != (os_vm_address_t)dynamic_0_space && addr != (os_vm_address_t)dynamic_1_space)
+                        printf("Strange ... dynamic space lossage.\n");
+                    current_dynamic_space = (lispobj *)addr;
+#ifdef ibmrt
+		    SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
+#else
+                    current_dynamic_space_free_pointer = free_pointer;
+#endif
+                    break;
+		case STATIC_SPACE_ID:
+			static_space = (lispobj *) addr;
+			break;
+		case READ_ONLY_SPACE_ID:
+			/* Don't care about read only space */
+			break;
+		default:
+			printf("Strange space ID: %d; ignored.\n", id);
+			break;
+		}
+		entry++;
+	}
+}
+
+boolean load_core_file(char *file)
+{
+    int fd = open(file, O_RDONLY), count;
+    long header[CORE_PAGESIZE / sizeof(long)], val, len, *ptr;
+    boolean restore_state = FALSE;
+
+    if (fd < 0) {
+	    fprintf(stderr, "Could not open file \"%s\".\n", file);
+	    perror("open");
+	    exit(1);
+    }
+
+    count = read(fd, header, CORE_PAGESIZE);
+    if (count < 0) {
+        perror("read");
+        exit(1);
+    }
+    if (count < CORE_PAGESIZE) {
+        fprintf(stderr, "Premature EOF.\n");
+        exit(1);
+    }   
+
+    ptr = header;
+    val = *ptr++;
+
+    if (val != CORE_MAGIC) {
+        fprintf(stderr, "Invalid magic number: 0x%x should have been 0x%x.\n",
+		val, CORE_MAGIC); 
+        exit(1);
+    }
+
+    while (val != CORE_END) {
+        val = *ptr++;
+        len = *ptr++;
+
+        switch (val) {
+            case CORE_END:
+                break;
+
+            case CORE_VERSION:
+                if (*ptr != version) {
+                    fprintf(stderr, "WARNING: ldb version (%d) different from core version (%d).\nYou may lose big.\n", version, *ptr);
+                }
+                break;
+
+            case CORE_VALIDATE:
+		fprintf(stderr, "Validation no longer supported; ignored.\n");
+                break;
+
+            case CORE_NDIRECTORY:
+                process_directory(fd, ptr,
+				  (len-2) / (sizeof(struct ndir_entry) / sizeof(long)));
+                break;
+
+            case CORE_MACHINE_STATE:
+                restore_state = TRUE;
+                load(fd, (struct machine_state *)ptr);
+                break;
+
+            default:
+                printf("Unknown core file entry: %d; skipping.\n", val);
+                break;
+        }
+
+        ptr += len - 2;
+    }
+
+    return restore_state;
+}
diff --git a/lisp/dynbind.c b/lisp/dynbind.c
new file mode 100644
index 000000000..839c1bd7b
--- /dev/null
+++ b/lisp/dynbind.c
@@ -0,0 +1,68 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.c,v 1.1 1992/07/28 20:14:22 wlott Exp $
+ * 
+ * Support for dynamic binding from C.
+ */
+
+#include "lisp.h"
+#include "internals.h"
+#include "globals.h"
+#include "dynbind.h"
+
+#ifdef ibmrt
+#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER))
+#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value))
+#else
+#define GetBSP() ((struct binding *)current_binding_stack_pointer)
+#define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value))
+#endif
+
+void bind_variable(lispobj symbol, lispobj value)
+{
+	lispobj old_value;
+	struct binding *binding;
+
+	old_value = SymbolValue(symbol);
+	binding = GetBSP();
+	SetBSP(binding+1);
+
+	binding->value = old_value;
+	binding->symbol = symbol;
+	SetSymbolValue(symbol, value);
+}
+
+void unbind(void)
+{
+	struct binding *binding;
+	lispobj symbol;
+	
+	binding = GetBSP() - 1;
+		
+	symbol = binding->symbol;
+
+	SetSymbolValue(symbol, binding->value);
+
+	binding->symbol = 0;
+
+	SetBSP(binding);
+}
+
+void unbind_to_here(lispobj *bsp)
+{
+    struct binding *target = (struct binding *)bsp;
+    struct binding *binding = GetBSP();
+    lispobj symbol;
+
+    while (target < binding) {
+	binding--;
+
+	symbol = binding->symbol;
+
+	if (symbol) {
+	    SetSymbolValue(symbol, binding->value);
+	    binding->symbol = 0;
+	}
+
+    }
+    SetBSP(binding);
+}
diff --git a/lisp/dynbind.h b/lisp/dynbind.h
new file mode 100644
index 000000000..ba7e98269
--- /dev/null
+++ b/lisp/dynbind.h
@@ -0,0 +1,10 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.h,v 1.1 1992/07/28 20:14:24 wlott Exp $ */
+
+#ifndef _DYNBIND_H_
+#define _DYNBIND_H_
+
+extern void bind_variable(lispobj symbol, lispobj value);
+extern void unbind(void);
+extern void unbind_to_here(lispobj *bsp);
+
+#endif
diff --git a/lisp/gc.c b/lisp/gc.c
new file mode 100644
index 000000000..fa156d64a
--- /dev/null
+++ b/lisp/gc.c
@@ -0,0 +1,1859 @@
+/*
+ * Stop and Copy GC based on Cheney's algorithm.
+ *
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.1 1992/07/28 20:14:26 wlott Exp $
+ * 
+ * Written by Christopher Hoover.
+ */
+
+#include <stdio.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <signal.h>
+#include "lisp.h"
+#include "internals.h"
+#include "os.h"
+#include "gc.h"
+#include "globals.h"
+#include "interrupt.h"
+#include "validate.h"
+#include "lispregs.h"
+#include "interr.h"
+
+static lispobj *from_space;
+static lispobj *from_space_free_pointer;
+
+static lispobj *new_space;
+static lispobj *new_space_free_pointer;
+
+static int (*scavtab[256])(lispobj *where, lispobj object);
+static lispobj (*transother[256])(lispobj object);
+static int (*sizetab[256])(lispobj *where);
+
+static struct weak_pointer *weak_pointers;
+
+static void scavenge(lispobj *start, long nwords);
+static void scavenge_newspace(void);
+static void scavenge_interrupt_contexts(void);
+static void scan_weak_pointers(void);
+
+#define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
+			__FILE__, __LINE__)
+
+#if 0
+#define gc_assert(ex) do { \
+	if (!(ex)) gc_abort(); \
+} while (0)
+#else
+#define gc_assert(ex)
+#endif
+
+#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
+
+
+/* Predicates */
+
+#if defined(DEBUG_SPACE_PREDICATES)
+
+boolean from_space_p(lispobj object)
+{
+	lispobj *ptr;
+
+	gc_assert(Pointerp(object));
+
+	ptr = (lispobj *) PTR(object);
+
+	return ((from_space <= ptr) &&
+		(ptr < from_space_free_pointer));
+}	    
+
+boolean new_space_p(lispobj object)
+{
+	lispobj *ptr;
+
+	gc_assert(Pointerp(object));
+
+	ptr = (lispobj *) PTR(object);
+		
+	return ((new_space <= ptr) &&
+		(ptr < new_space_free_pointer));
+}	    
+
+#else
+
+#define from_space_p(ptr) \
+	((from_space <= ((lispobj *) ptr)) && \
+	 (((lispobj *) ptr) < from_space_free_pointer))
+
+#define new_space_p(ptr) \
+	((new_space <= ((lispobj *) ptr)) && \
+	 (((lispobj *) ptr) < new_space_free_pointer))
+
+#endif
+
+
+/* Copying Objects */
+
+static lispobj
+copy_object(lispobj object, int nwords)
+{
+	int tag;
+	lispobj *new;
+	lispobj *source, *dest;
+
+	gc_assert(Pointerp(object));
+	gc_assert(from_space_p(object));
+	gc_assert((nwords & 0x01) == 0);
+
+	/* get tag of object */
+	tag = LowtagOf(object);
+
+	/* allocate space */
+	new = new_space_free_pointer;
+	new_space_free_pointer += nwords;
+
+	dest = new;
+	source = (lispobj *) PTR(object);
+
+	/* copy the object */
+	while (nwords > 0) {
+            dest[0] = source[0];
+            dest[1] = source[1];
+            dest += 2;
+            source += 2;
+            nwords -= 2;
+	}
+
+	/* return lisp pointer of new object */
+	return ((lispobj) new) | tag;
+}
+
+
+/* Collect Garbage */
+
+#ifdef PRINTNOISE
+static double tv_diff(struct timeval *x, struct timeval *y)
+{
+    return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
+	    ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
+}
+#endif
+
+#define BYTES_ZERO_BEFORE_END (1<<12)
+
+static void zero_stack(void)
+{
+    unsigned long *ptr = (unsigned long *)current_control_stack_pointer;
+
+  search:
+    do {
+	if (*ptr)
+	    goto fill;
+	ptr++;
+    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
+    return;
+
+  fill:
+    do {
+	*ptr++ = 0;
+    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
+    goto search;
+}
+
+void collect_garbage(void)
+{
+#ifdef PRINTNOISE
+	struct timeval start_tv, stop_tv;
+	struct rusage start_rusage, stop_rusage;
+	double real_time, system_time, user_time;
+	double percent_retained, gc_rate;
+	unsigned long size_discarded;
+	unsigned long size_retained;
+#endif
+	lispobj *current_static_space_free_pointer;
+	unsigned long static_space_size;
+	unsigned long control_stack_size, binding_stack_size;
+	int oldmask;
+	
+#ifdef PRINTNOISE
+	printf("[Collecting garbage ... \n");
+
+	getrusage(RUSAGE_SELF, &start_rusage);
+	gettimeofday(&start_tv, (struct timezone *) 0);
+#endif
+
+	oldmask = sigblock(BLOCKABLE);
+
+	current_static_space_free_pointer =
+		(lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER);
+
+
+	/* Set up from space and new space pointers. */
+
+	from_space = current_dynamic_space;
+#ifndef ibmrt
+	from_space_free_pointer = current_dynamic_space_free_pointer;
+#else
+	from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
+#endif
+
+	if (current_dynamic_space == dynamic_0_space)
+		new_space = dynamic_1_space;
+	else if (current_dynamic_space == dynamic_1_space)
+		new_space = dynamic_0_space;
+	else
+	    lose("GC lossage.  Current dynamic space is bogus!\n");
+
+	new_space_free_pointer = new_space;
+
+
+	/* Initialize the weak pointer list. */
+	weak_pointers = (struct weak_pointer *) NULL;
+
+
+	/* Scavenge all of the roots. */
+#ifdef PRINTNOISE
+	printf("Scavenging interrupt contexts ...\n");
+#endif
+	scavenge_interrupt_contexts();
+
+#ifdef PRINTNOISE
+	printf("Scavenging interrupt handlers (%d bytes) ...\n",
+	       sizeof(interrupt_handlers));
+#endif
+	scavenge((lispobj *) interrupt_handlers,
+		 sizeof(interrupt_handlers) / sizeof(lispobj));
+
+	control_stack_size = current_control_stack_pointer - control_stack;
+#ifdef PRINTNOISE
+	printf("Scavenging the control stack (%d bytes) ...\n",
+	       control_stack_size * sizeof(lispobj));
+#endif
+	scavenge(control_stack, control_stack_size);
+
+#ifndef ibmrt
+	binding_stack_size = current_binding_stack_pointer - binding_stack;
+#else
+	binding_stack_size =
+	    (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
+#endif
+#ifdef PRINTNOISE
+	printf("Scavenging the binding stack (%d bytes) ...\n",
+	       binding_stack_size * sizeof(lispobj));
+#endif
+	scavenge(binding_stack, binding_stack_size);
+
+	static_space_size = current_static_space_free_pointer - static_space;
+#ifdef PRINTNOISE
+	printf("Scavenging static space (%d bytes) ...\n",
+	       static_space_size * sizeof(lispobj));
+#endif
+	scavenge(static_space, static_space_size);
+
+
+	/* Scavenge newspace. */
+#ifdef PRINTNOISE
+	printf("Scavenging new space (%d bytes) ...\n",
+	       (new_space_free_pointer - new_space) * sizeof(lispobj));
+#endif
+	scavenge_newspace();
+
+
+#if defined(DEBUG_PRINT_GARBAGE)
+	print_garbage(from_space, from_space_free_pointer);
+#endif
+
+	/* Scan the weak pointers. */
+#ifdef PRINTNOISE
+	printf("Scanning weak pointers ...\n");
+#endif
+	scan_weak_pointers();
+
+
+	/* Flip spaces. */
+#ifdef PRINTNOISE
+	printf("Flipping spaces ...\n");
+#endif
+
+	os_zero((os_vm_address_t) current_dynamic_space,
+		(os_vm_size_t) DYNAMIC_SPACE_SIZE);
+
+	current_dynamic_space = new_space;
+#ifndef ibmrt
+	current_dynamic_space_free_pointer = new_space_free_pointer;
+#else
+	SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
+#endif
+
+#ifdef PRINTNOISE
+	size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
+	size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
+#endif
+
+	/* Zero stack. */
+#ifdef PRINTNOISE
+	printf("Zeroing empty part of control stack ...\n");
+#endif
+	zero_stack();
+
+	(void) sigsetmask(oldmask);
+
+
+#ifdef PRINTNOISE
+	gettimeofday(&stop_tv, (struct timezone *) 0);
+	getrusage(RUSAGE_SELF, &stop_rusage);
+
+	printf("done.]\n");
+	
+	percent_retained = (((float) size_retained) /
+			     ((float) size_discarded)) * 100.0;
+
+	printf("Total of %d bytes out of %d bytes retained (%3.2f%%).\n",
+	       size_retained, size_discarded, percent_retained);
+
+	real_time = tv_diff(&stop_tv, &start_tv);
+	user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
+	system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
+
+#if 0
+	printf("Statistics:\n");
+	printf("%10.2f sec of real time\n", real_time);
+	printf("%10.2f sec of user time,\n", user_time);
+	printf("%10.2f sec of system time.\n", system_time);
+#else
+        printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
+               real_time, user_time, system_time);
+#endif        
+
+	gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
+
+	printf("%10.2f M bytes/sec collected.\n", gc_rate);
+#endif
+}
+
+
+/* Scavenging */
+
+static void
+scavenge(lispobj *start, long nwords)
+{
+	while (nwords > 0) {
+		lispobj object;
+		int type, words_scavenged;
+
+		object = *start;
+		type = TypeOf(object);
+
+#if defined(DEBUG_SCAVENGE_VERBOSE)
+		printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
+		       (unsigned long) start, (unsigned long) object, type);
+#endif
+
+#if 0
+		words_scavenged = (scavtab[type])(start, object);
+#else
+                if (Pointerp(object)) {
+                    /* It be a pointer. */
+                    if (from_space_p(object)) {
+                        /* It currently points to old space.  Check for a */
+                        /* forwarding pointer. */
+                        lispobj first_word;
+
+                        first_word = *((lispobj *)PTR(object));
+                        if (Pointerp(first_word) && new_space_p(first_word)) {
+                            /* Yep, there be a forwarding pointer. */
+                            *start = first_word;
+                            words_scavenged = 1;
+                        }
+                        else {
+                            /* Scavenge that pointer. */
+                            words_scavenged = (scavtab[type])(start, object);
+                        }
+                    }
+                    else {
+                        /* It points somewhere other than oldspace.  Leave */
+                        /* it alone. */
+                        words_scavenged = 1;
+                    }
+                }
+                else if ((object & 3) == 0) {
+                    /* It's a fixnum.  Real easy. */
+                    words_scavenged = 1;
+                }
+                else {
+                    /* It's some random header object. */
+                    words_scavenged = (scavtab[type])(start, object);
+                }
+#endif
+
+		start += words_scavenged;
+		nwords -= words_scavenged;
+	}
+	gc_assert(nwords == 0);
+}
+
+static void scavenge_newspace(void)
+{
+    lispobj *here, *next;
+
+    here = new_space;
+    while (here < new_space_free_pointer) {
+	next = new_space_free_pointer;
+	scavenge(here, next - here);
+	here = next;
+    }
+}
+
+
+/* Scavenging Interrupt Contexts */
+
+static int boxed_registers[] = BOXED_REGISTERS;
+
+static void scavenge_interrupt_context(struct sigcontext *context)
+{
+	int i;
+#ifdef reg_LIP
+	unsigned long lip;
+	unsigned long lip_offset;
+	int lip_register_pair;
+	unsigned long pc_code_offset;
+#if defined(sparc) || defined(parisc)
+	unsigned long npc_code_offset;
+#endif defined(sparc) || defined(parisc)
+#endif
+
+	/* Find the LIP's register pair and calculate it's offset */
+	/* before we scavenge the context. */
+#ifdef reg_LIP
+	lip = SC_REG(context, reg_LIP);
+	lip_offset = 0x7FFFFFFF;
+	lip_register_pair = -1;
+	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
+		unsigned long reg;
+		long offset;
+		int index;
+
+		index = boxed_registers[i];
+		reg = SC_REG(context, index);
+		if (PTR(reg) <= lip) {
+			offset = lip - reg;
+			if (offset < lip_offset) {
+				lip_offset = offset;
+				lip_register_pair = index;
+			}
+		}
+	}
+
+	/* Compute the PC's offset from the start of the CODE */
+	/* register. */
+	pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE);
+#ifdef sparc
+	npc_code_offset = context->sc_npc - context->sc_regs[CODE];
+#endif sparc
+#ifdef parisc
+	npc_code_offset = context->sc_pcoqt - SC_REG(context, reg_CODE);
+#endif parisc
+#endif reg_LIP
+	       
+	/* Scanvenge all boxed registers in the context. */
+	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
+		int index;
+
+		index = boxed_registers[i];
+		scavenge((lispobj *) &(SC_REG(context, index)), 1);
+	}
+
+#ifdef reg_LIP
+	/* Fix the LIP */
+	SC_REG(context, reg_LIP) =
+		SC_REG(context, lip_register_pair) + lip_offset;
+	
+	/* Fix the PC if it was in from space */
+	if (from_space_p(SC_PC(context)))
+		SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset;
+#ifdef sparc
+	if (from_space_p(context->sc_npc))
+		context->sc_npc = context->sc_regs[CODE] + npc_code_offset;
+#endif sparc
+#ifdef parisc
+	if (from_space_p(context->sc_pcoqt))
+	    context->sc_pcoqt = SC_REG(context, reg_CODE) + npc_code_offset;
+#endif parisc
+#endif reg_LIP   
+}
+
+void scavenge_interrupt_contexts(void)
+{
+	int i, index;
+	struct sigcontext *context;
+
+	index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
+#if defined(DEBUG_PRINT_CONTEXT_INDEX)
+	printf("Number of active contexts: %d\n", index);
+#endif
+
+	for (i = 0; i < index; i++) {
+		context = lisp_interrupt_contexts[i];
+		scavenge_interrupt_context(context); 
+	}
+}
+
+
+/* Debugging Code */
+
+void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
+{
+	lispobj *start;
+	int total_words_not_copied;
+
+	printf("Scanning from space ...\n");
+
+	total_words_not_copied = 0;
+	start = from_space;
+	while (start < from_space_free_pointer) {
+		lispobj object;
+		int forwardp, type, nwords;
+		lispobj header;
+
+		object = *start;
+		forwardp = Pointerp(object) && new_space_p(object);
+
+		if (forwardp) {
+			int tag;
+			lispobj *pointer;
+
+			tag = LowtagOf(object);
+
+			switch (tag) {
+			case type_ListPointer:
+				nwords = 2;
+				break;
+			case type_StructurePointer:
+				printf("Don't know about structures yet!\n");
+				nwords = 1;
+				break;
+			case type_FunctionPointer:
+				nwords = 1;
+				break;
+			case type_OtherPointer:
+				pointer = (lispobj *) PTR(object);
+				header = *pointer;
+				type = TypeOf(header);
+				nwords = (sizetab[type])(pointer);
+			}
+		} else {
+			type = TypeOf(object);
+			nwords = (sizetab[type])(start);
+			total_words_not_copied += nwords;
+			printf("%4d words not copied at 0x%08x; ",
+			       nwords, (unsigned long) start);
+			printf("Header word is 0x%08x\n", (unsigned long) object);
+		}
+		start += nwords;
+	}
+	printf("%d total words not copied.\n", total_words_not_copied);
+}
+
+
+/* Code and Code-Related Objects */
+
+#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
+
+static lispobj trans_function_header(lispobj object);
+static lispobj trans_boxed(lispobj object);
+
+static int
+scav_function_pointer(lispobj *where, lispobj object)
+{
+	gc_assert(Pointerp(object));
+
+	if (from_space_p(object)) {
+		lispobj first, *first_pointer;
+
+		/* object is a pointer into from space.  check to see */
+		/* if it has been forwarded */
+		first_pointer = (lispobj *) PTR(object);
+		first = *first_pointer;
+		
+		if (!(Pointerp(first) && new_space_p(first))) {
+			int type;
+			lispobj copy;
+
+			/* must transport object -- object may point */
+			/* to either a function header, a closure */
+			/* function header, or to a closure header. */
+			
+			type = TypeOf(first);
+			switch (type) {
+			  case type_FunctionHeader:
+			  case type_ClosureFunctionHeader:
+			    copy = trans_function_header(object);
+			    break;
+			  default:
+			    copy = trans_boxed(object);
+			    break;
+			}
+
+			first = *first_pointer = copy;
+		}
+
+		gc_assert(Pointerp(first));
+		gc_assert(!from_space_p(first));
+
+		*where = first;
+	}
+	return 1;
+}
+
+static struct code *
+trans_code(struct code *code)
+{
+	struct code *new_code;
+	lispobj first, l_code, l_new_code;
+	int nheader_words, ncode_words, nwords;
+	unsigned long displacement;
+	lispobj fheaderl, *prev_pointer;
+
+#if defined(DEBUG_CODE_GC)
+	printf("\nTransporting code object located at 0x%08x.\n",
+	       (unsigned long) code);
+#endif
+
+	/* if object has already been transported, just return pointer */
+	first = code->header;
+	if (Pointerp(first) && new_space_p(first))
+		return (struct code *) PTR(first);
+	
+	gc_assert(TypeOf(first) == type_CodeHeader);
+
+	/* prepare to transport the code vector */
+	l_code = (lispobj) code | type_OtherPointer;
+
+	ncode_words = fixnum_value(code->code_size);
+	nheader_words = HeaderValue(code->header);
+	nwords = ncode_words + nheader_words;
+	nwords = CEILING(nwords, 2);
+
+	l_new_code = copy_object(l_code, nwords);
+	new_code = (struct code *) PTR(l_new_code);
+
+	displacement = l_new_code - l_code;
+
+#if defined(DEBUG_CODE_GC)
+	printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
+	       (unsigned long) code, (unsigned long) new_code);
+	printf("Code object is %d words long.\n", nwords);
+#endif
+
+	/* set forwarding pointer */
+	code->header = l_new_code;
+	
+	/* set forwarding pointers for all the function headers in the */
+	/* code object.  also fix all self pointers */
+
+	fheaderl = code->entry_points;
+	prev_pointer = &new_code->entry_points;
+
+	while (fheaderl != NIL) {
+		struct function_header *fheaderp, *nfheaderp;
+		lispobj nfheaderl;
+		
+		fheaderp = (struct function_header *) PTR(fheaderl);
+		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
+
+		/* calcuate the new function pointer and the new */
+		/* function header */
+		nfheaderl = fheaderl + displacement;
+		nfheaderp = (struct function_header *) PTR(nfheaderl);
+
+		/* set forwarding pointer */
+		fheaderp->header = nfheaderl;
+		
+		/* fix self pointer */
+		nfheaderp->self = nfheaderl;
+
+		*prev_pointer = nfheaderl;
+
+		fheaderl = fheaderp->next;
+		prev_pointer = &nfheaderp->next;
+	}
+
+	return new_code;
+}
+
+static int
+scav_code_header(lispobj *where, lispobj object)
+{
+	struct code *code;
+	int nheader_words, ncode_words, nwords;
+	lispobj fheaderl;
+	struct function_header *fheaderp;
+
+	code = (struct code *) where;
+	ncode_words = fixnum_value(code->code_size);
+	nheader_words = HeaderValue(object);
+	nwords = ncode_words + nheader_words;
+	nwords = CEILING(nwords, 2);
+
+#if defined(DEBUG_CODE_GC)
+	printf("\nScavening code object at 0x%08x.\n",
+	       (unsigned long) where);
+	printf("Code object is %d words long.\n", nwords);
+	printf("Scavenging boxed section of code data block (%d words).\n",
+	       nheader_words - 1);
+#endif
+
+	/* Scavenge the boxed section of the code data block */
+	scavenge(where + 1, nheader_words - 1);
+
+	/* Scavenge the boxed section of each function object in the */
+	/* code data block */
+	fheaderl = code->entry_points;
+	while (fheaderl != NIL) {
+		fheaderp = (struct function_header *) PTR(fheaderl);
+		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
+		
+#if defined(DEBUG_CODE_GC)
+		printf("Scavenging boxed section of entry point located at 0x%08x.\n",
+		       (unsigned long) PTR(fheaderl));
+#endif
+		scavenge(&fheaderp->name, 1);
+		scavenge(&fheaderp->arglist, 1);
+		scavenge(&fheaderp->type, 1);
+		
+		fheaderl = fheaderp->next;
+	}
+	
+	return nwords;
+}
+
+static lispobj
+trans_code_header(lispobj object)
+{
+	struct code *ncode;
+
+	ncode = trans_code((struct code *) PTR(object));
+	return (lispobj) ncode | type_OtherPointer;
+}
+
+static int
+size_code_header(lispobj *where)
+{
+	struct code *code;
+	int nheader_words, ncode_words, nwords;
+
+	code = (struct code *) where;
+	
+	ncode_words = fixnum_value(code->code_size);
+	nheader_words = HeaderValue(code->header);
+	nwords = ncode_words + nheader_words;
+	nwords = CEILING(nwords, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_return_pc_header(lispobj *where, lispobj object)
+{
+    fprintf(stderr, "GC lossage.  Should not be scavenging a ");
+    fprintf(stderr, "Return PC Header.\n");
+    fprintf(stderr, "where = 0x%08x, object = 0x%08x",
+	    (unsigned long) where, (unsigned long) object);
+    lose(NULL);
+    return 0;
+}
+
+static lispobj
+trans_return_pc_header(lispobj object)
+{
+	struct function_header *return_pc;
+	unsigned long offset;
+	struct code *code, *ncode;
+	
+	return_pc = (struct function_header *) PTR(object);
+	offset = HeaderValue(return_pc->header) * 4;
+
+	/* Transport the whole code object */
+	code = (struct code *) ((unsigned long) return_pc - offset);
+	ncode = trans_code(code);
+
+	return ((lispobj) ncode + offset) | type_OtherPointer;
+}
+
+/* On the 386, closures hold a pointer to the raw address instead of the
+   function object, so we can use CALL [$FDEFN+const] to invoke the function
+   without loading it into a register.  Given that code objects don't move,
+   we don't need to update anything, but we do have to figure out that the
+   function is still live. */
+#ifdef i386
+static
+scav_closure_header(where, object)
+lispobj *where, object;
+{
+	struct closure *closure;
+	lispobj fun;
+
+	closure = (struct closure *)where;
+	fun = closure->function - RAW_ADDR_OFFSET;
+	scavenge(&fun, 1);
+
+	return 2;
+}
+#endif
+
+static int
+scav_function_header(lispobj *where, lispobj object)
+{
+    fprintf(stderr, "GC lossage.  Should not be scavenging a ");
+    fprintf(stderr, "Function Header.\n");
+    fprintf(stderr, "where = 0x%08x, object = 0x%08x",
+	    (unsigned long) where, (unsigned long) object);
+    lose(NULL);
+    return 0;
+}
+
+static lispobj
+trans_function_header(lispobj object)
+{
+	struct function_header *fheader;
+	unsigned long offset;
+	struct code *code, *ncode;
+	
+	fheader = (struct function_header *) PTR(object);
+	offset = HeaderValue(fheader->header) * 4;
+
+	/* Transport the whole code object */
+	code = (struct code *) ((unsigned long) fheader - offset);
+	ncode = trans_code(code);
+
+	return ((lispobj) ncode + offset) | type_FunctionPointer;
+}
+
+
+
+/* Structures */
+
+static int
+scav_structure_pointer(lispobj *where, lispobj object)
+{
+    if (from_space_p(object)) {
+	lispobj first, *first_pointer;
+
+	/* object is a pointer into from space.  check to see */
+	/* if it has been forwarded */
+	first_pointer = (lispobj *) PTR(object);
+	first = *first_pointer;
+		
+	if (!(Pointerp(first) && new_space_p(first)))
+	    first = *first_pointer = trans_boxed(object);
+	*where = first;
+    }
+    return 1;
+}
+
+
+/* Lists and Conses */
+
+static lispobj trans_list(lispobj object);
+
+static int
+scav_list_pointer(lispobj *where, lispobj object)
+{
+	gc_assert(Pointerp(object));
+
+	if (from_space_p(object)) {
+		lispobj first, *first_pointer;
+
+		/* object is a pointer into from space.  check to see */
+		/* if it has been forwarded */
+		first_pointer = (lispobj *) PTR(object);
+		first = *first_pointer;
+		
+		if (!(Pointerp(first) && new_space_p(first)))
+			first = *first_pointer = trans_list(object);
+
+		gc_assert(Pointerp(first));
+		gc_assert(!from_space_p(first));
+	
+		*where = first;
+	}
+	return 1;
+}
+
+static lispobj
+trans_list(lispobj object)
+{
+	lispobj new_list_pointer;
+	struct cons *cons, *new_cons;
+	
+	cons = (struct cons *) PTR(object);
+
+	/* ### Don't use copy_object here. */
+	new_list_pointer = copy_object(object, 2);
+	new_cons = (struct cons *) PTR(new_list_pointer);
+
+	/* Set forwarding pointer. */
+	cons->car = new_list_pointer;
+	
+	/* Try to linearize the list in the cdr direction to help reduce */
+	/* paging. */
+
+	while (1) {
+		lispobj cdr, new_cdr, first;
+		struct cons *cdr_cons, *new_cdr_cons;
+
+		cdr = cons->cdr;
+
+                if (LowtagOf(cdr) != type_ListPointer ||
+                    !from_space_p(cdr) ||
+                    (Pointerp(first = *(lispobj *)PTR(cdr)) &&
+                     new_space_p(first)))
+                	break;
+
+		cdr_cons = (struct cons *) PTR(cdr);
+
+		/* ### Don't use copy_object here */
+		new_cdr = copy_object(cdr, 2);
+		new_cdr_cons = (struct cons *) PTR(new_cdr);
+
+		/* Set forwarding pointer */
+		cdr_cons->car = new_cdr;
+
+		/* Update the cdr of the last cons copied into new */
+		/* space to keep the newspace scavenge from having to */
+		/* do it. */
+		new_cons->cdr = new_cdr;
+		
+		cons = cdr_cons;
+		new_cons = new_cdr_cons;
+	}
+
+	return new_list_pointer;
+}
+
+
+/* Scavenging and Transporting Other Pointers */
+
+static int
+scav_other_pointer(lispobj *where, lispobj object)
+{
+	gc_assert(Pointerp(object));
+
+	if (from_space_p(object)) {
+		lispobj first, *first_pointer;
+
+		/* object is a pointer into from space.  check to see */
+		/* if it has been forwarded */
+		first_pointer = (lispobj *) PTR(object);
+		first = *first_pointer;
+		
+		if (!(Pointerp(first) && new_space_p(first)))
+			first = *first_pointer = 
+				(transother[TypeOf(first)])(object);
+
+		gc_assert(Pointerp(first));
+		gc_assert(!from_space_p(first));
+
+		*where = first;
+	}
+	return 1;
+}
+
+
+/* Immediate, Boxed, and Unboxed Objects */
+
+static int
+size_pointer(lispobj *where)
+{
+    return 1;
+}
+
+static int
+scav_immediate(lispobj *where, lispobj object)
+{
+    return 1;
+}
+
+static lispobj
+trans_immediate(lispobj object)
+{
+    fprintf(stderr, "GC lossage.  Trying to transport an immediate!?\n");
+    lose(NULL);
+    return NIL;
+}
+
+static int
+size_immediate(lispobj *where)
+{
+    return 1;
+}
+
+
+static int
+scav_boxed(lispobj *where, lispobj object)
+{
+    return 1;
+}
+
+static lispobj
+trans_boxed(lispobj object)
+{
+	lispobj header;
+	unsigned long length;
+
+	gc_assert(Pointerp(object));
+
+	header = *((lispobj *) PTR(object));
+	length = HeaderValue(header) + 1;
+	length = CEILING(length, 2);
+
+	return copy_object(object, length);
+}
+
+static int
+size_boxed(lispobj *where)
+{
+	lispobj header;
+	unsigned long length;
+
+	header = *where;
+	length = HeaderValue(header) + 1;
+	length = CEILING(length, 2);
+
+	return length;
+}
+
+/* Note: on the sparc we don't have to do anything special for fdefns, */
+/* cause the raw-addr has a function lowtag. */
+#ifndef sparc
+static int
+scav_fdefn(lispobj *where, lispobj object)
+{
+    struct fdefn *fdefn;
+
+    fdefn = (struct fdefn *)where;
+    
+    if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) {
+        scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
+        fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
+        return sizeof(struct fdefn) / sizeof(lispobj);
+    }
+    else
+        return 1;
+}
+#endif
+
+static int
+scav_unboxed(lispobj *where, lispobj object)
+{
+	unsigned long length;
+
+	length = HeaderValue(object) + 1;
+	length = CEILING(length, 2);
+
+	return length;
+}
+
+static lispobj
+trans_unboxed(lispobj object)
+{
+	lispobj header;
+	unsigned long length;
+
+
+	gc_assert(Pointerp(object));
+
+	header = *((lispobj *) PTR(object));
+	length = HeaderValue(header) + 1;
+	length = CEILING(length, 2);
+
+	return copy_object(object, length);
+}
+
+static int
+size_unboxed(lispobj *where)
+{
+	lispobj header;
+	unsigned long length;
+
+	header = *where;
+	length = HeaderValue(header) + 1;
+	length = CEILING(length, 2);
+
+	return length;
+}
+
+
+/* Vector-Like Objects */
+
+#define NWORDS(x,y) (CEILING((x),(y)) / (y))
+
+static int
+scav_string(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	/* NOTE: Strings contain one more byte of data than the length */
+	/* slot indicates. */
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length) + 1;
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_string(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	/* NOTE: Strings contain one more byte of data than the length */
+	/* slot indicates. */
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length) + 1;
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_string(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	/* NOTE: Strings contain one more byte of data than the length */
+	/* slot indicates. */
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length) + 1;
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return nwords;
+}
+
+static int
+scav_vector(lispobj *where, lispobj object)
+{
+    if (HeaderValue(object) == subtype_VectorValidHashing)
+        *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
+
+    return 1;
+}
+
+
+static lispobj
+trans_vector(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_bit(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_bit(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_bit(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 32) + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 16) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_unsigned_byte_2(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 16) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_unsigned_byte_2(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 16) + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 8) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_unsigned_byte_4(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 8) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_unsigned_byte_4(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 8) + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_unsigned_byte_8(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_unsigned_byte_8(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 4) + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 2) + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_unsigned_byte_16(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 2) + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_unsigned_byte_16(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(NWORDS(length, 2) + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_unsigned_byte_32(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_unsigned_byte_32(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_single_float(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_single_float(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_single_float(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length + 2, 2);
+
+	return nwords;
+}
+
+
+static int
+scav_vector_double_float(lispobj *where, lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length * 2 + 2, 2);
+
+	return nwords;
+}
+
+static lispobj
+trans_vector_double_float(lispobj object)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	gc_assert(Pointerp(object));
+
+	vector = (struct vector *) PTR(object);
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length * 2 + 2, 2);
+
+	return copy_object(object, nwords);
+}
+
+static int
+size_vector_double_float(lispobj *where)
+{
+	struct vector *vector;
+	int length, nwords;
+
+	vector = (struct vector *) where;
+	length = fixnum_value(vector->length);
+	nwords = CEILING(length * 2 + 2, 2);
+
+	return nwords;
+}
+
+
+/* Weak Pointers */
+
+#define WEAK_POINTER_NWORDS \
+	CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
+
+static int
+scav_weak_pointer(lispobj *where, lispobj object)
+{
+	/* Do not let GC scavenge the value slot of the weak pointer */
+	/* (that is why it is a weak pointer).  Note:  we could use */
+	/* the scav_unboxed method here. */
+
+	return WEAK_POINTER_NWORDS;
+}
+
+static lispobj
+trans_weak_pointer(lispobj object)
+{
+	lispobj copy;
+	struct weak_pointer *wp;
+
+	gc_assert(Pointerp(object));
+
+#if defined(DEBUG_WEAK)
+	printf("Transporting weak pointer from 0x%08x\n", object);
+#endif
+
+	/* Need to remember where all the weak pointers are that have */
+	/* been transported so they can be fixed up in a post-GC pass. */
+
+	copy = copy_object(object, WEAK_POINTER_NWORDS);
+	wp = (struct weak_pointer *) PTR(copy);
+	
+
+	/* Push the weak pointer onto the list of weak pointers. */
+	wp->next = weak_pointers;
+	weak_pointers = wp;
+
+	return copy;
+}
+
+static int
+size_weak_pointer(lispobj *where)
+{
+	return WEAK_POINTER_NWORDS;
+}
+
+void scan_weak_pointers(void)
+{
+	struct weak_pointer *wp;
+
+	for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
+	     wp = wp->next) {
+		lispobj value;
+		lispobj first, *first_pointer;
+
+		value = wp->value;
+
+#if defined(DEBUG_WEAK)
+		printf("Weak pointer at 0x%08x\n", (unsigned long) wp);
+		printf("Value: 0x%08x\n", (unsigned long) value);
+#endif		
+
+		if (!(Pointerp(value) && from_space_p(value)))
+			continue;
+
+		/* Now, we need to check if the object has been */
+		/* forwarded.  If it has been, the weak pointer is */
+		/* still good and needs to be updated.  Otherwise, the */
+		/* weak pointer needs to be nil'ed out. */
+
+		first_pointer = (lispobj *) PTR(value);
+		first = *first_pointer;
+		
+#if defined(DEBUG_WEAK)
+		printf("First: 0x%08x\n", (unsigned long) first);
+#endif		
+
+		if (Pointerp(first) && new_space_p(first))
+			wp->value = first;
+		else {
+			wp->value = NIL;
+			wp->broken = T;
+		}
+	}
+}
+
+
+
+/* Initialization */
+
+static int
+scav_lose(lispobj *where, lispobj object)
+{
+    fprintf(stderr, "GC lossage.  No scavenge function for object 0x%08x\n",
+	    (unsigned long) object);
+    lose(NULL);
+    return 0;
+}
+
+static lispobj
+trans_lose(lispobj object)
+{
+    fprintf(stderr, "GC lossage.  No transport function for object 0x%08x\n",
+	    (unsigned long) object);
+    lose(NULL);
+    return NIL;
+}
+
+static int
+size_lose(lispobj *where)
+{
+	fprintf(stderr, "Size lossage.  No size function for object at 0x%08x\n",
+		(unsigned long) where);
+	fprintf(stderr, "First word of object: 0x%08x\n",
+		(unsigned long) *where);
+	return 1;
+}
+
+void gc_init(void)
+{
+	int i;
+
+	/* Scavenge Table */
+	for (i = 0; i < 256; i++)
+		scavtab[i] = scav_lose;
+
+	for (i = 0; i < 32; i++) {
+		scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
+		scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
+		/* OtherImmediate0 */
+		scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
+		scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
+		scavtab[type_StructurePointer|(i<<3)] = scav_structure_pointer;
+		/* OtherImmediate1 */
+		scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
+	}
+
+	scavtab[type_Bignum] = scav_unboxed;
+	scavtab[type_Ratio] = scav_boxed;
+	scavtab[type_SingleFloat] = scav_unboxed;
+	scavtab[type_DoubleFloat] = scav_unboxed;
+	scavtab[type_Complex] = scav_boxed;
+	scavtab[type_SimpleArray] = scav_boxed;
+	scavtab[type_SimpleString] = scav_string;
+	scavtab[type_SimpleBitVector] = scav_vector_bit;
+	scavtab[type_SimpleVector] = scav_vector;
+	scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
+	scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
+	scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
+	scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
+	scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
+	scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
+	scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
+	scavtab[type_ComplexString] = scav_boxed;
+	scavtab[type_ComplexBitVector] = scav_boxed;
+	scavtab[type_ComplexVector] = scav_boxed;
+	scavtab[type_ComplexArray] = scav_boxed;
+	scavtab[type_CodeHeader] = scav_code_header;
+	scavtab[type_FunctionHeader] = scav_function_header;
+	scavtab[type_ClosureFunctionHeader] = scav_function_header;
+	scavtab[type_ReturnPcHeader] = scav_return_pc_header;
+#ifdef i386
+	scavtab[type_ClosureHeader] = scav_closure_header;
+	scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
+	scavtab[type_ByteCodeFunction] = scav_closure_header;
+	scavtab[type_ByteCodeClosure] = scav_closure_header;
+#else
+	scavtab[type_ClosureHeader] = scav_boxed;
+	scavtab[type_FuncallableInstanceHeader] = scav_boxed;
+	scavtab[type_ByteCodeFunction] = scav_boxed;
+	scavtab[type_ByteCodeClosure] = scav_boxed;
+#endif
+	scavtab[type_ValueCellHeader] = scav_boxed;
+        scavtab[type_SymbolHeader] = scav_boxed;
+	scavtab[type_BaseChar] = scav_immediate;
+	scavtab[type_Sap] = scav_unboxed;
+	scavtab[type_UnboundMarker] = scav_immediate;
+	scavtab[type_WeakPointer] = scav_weak_pointer;
+        scavtab[type_StructureHeader] = scav_boxed;
+#ifndef sparc
+        scavtab[type_Fdefn] = scav_fdefn;
+#else
+        scavtab[type_Fdefn] = scav_boxed;
+#endif
+
+	/* Transport Other Table */
+	for (i = 0; i < 256; i++)
+		transother[i] = trans_lose;
+
+	transother[type_Bignum] = trans_unboxed;
+	transother[type_Ratio] = trans_boxed;
+	transother[type_SingleFloat] = trans_unboxed;
+	transother[type_DoubleFloat] = trans_unboxed;
+	transother[type_Complex] = trans_boxed;
+	transother[type_SimpleArray] = trans_boxed;
+	transother[type_SimpleString] = trans_string;
+	transother[type_SimpleBitVector] = trans_vector_bit;
+	transother[type_SimpleVector] = trans_vector;
+	transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
+	transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
+	transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
+	transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
+	transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
+	transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
+	transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
+	transother[type_ComplexString] = trans_boxed;
+	transother[type_ComplexBitVector] = trans_boxed;
+	transother[type_ComplexVector] = trans_boxed;
+	transother[type_ComplexArray] = trans_boxed;
+	transother[type_CodeHeader] = trans_code_header;
+	transother[type_FunctionHeader] = trans_function_header;
+	transother[type_ClosureFunctionHeader] = trans_function_header;
+	transother[type_ReturnPcHeader] = trans_return_pc_header;
+	transother[type_ClosureHeader] = trans_boxed;
+	transother[type_FuncallableInstanceHeader] = trans_boxed;
+	transother[type_ByteCodeFunction] = trans_boxed;
+	transother[type_ByteCodeClosure] = trans_boxed;
+	transother[type_ValueCellHeader] = trans_boxed;
+	transother[type_SymbolHeader] = trans_boxed;
+	transother[type_BaseChar] = trans_immediate;
+	transother[type_Sap] = trans_unboxed;
+	transother[type_UnboundMarker] = trans_immediate;
+	transother[type_WeakPointer] = trans_weak_pointer;
+        transother[type_StructureHeader] = trans_vector;
+	transother[type_Fdefn] = trans_boxed;
+
+	/* Size table */
+
+	for (i = 0; i < 256; i++)
+		sizetab[i] = size_lose;
+
+	for (i = 0; i < 32; i++) {
+		sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
+		sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
+		/* OtherImmediate0 */
+		sizetab[type_ListPointer|(i<<3)] = size_pointer;
+		sizetab[type_OddFixnum|(i<<3)] = size_immediate;
+		sizetab[type_StructurePointer|(i<<3)] = size_pointer;
+		/* OtherImmediate1 */
+		sizetab[type_OtherPointer|(i<<3)] = size_pointer;
+	}
+
+	sizetab[type_Bignum] = size_unboxed;
+	sizetab[type_Ratio] = size_boxed;
+	sizetab[type_SingleFloat] = size_unboxed;
+	sizetab[type_DoubleFloat] = size_unboxed;
+	sizetab[type_Complex] = size_boxed;
+	sizetab[type_SimpleArray] = size_boxed;
+	sizetab[type_SimpleString] = size_string;
+	sizetab[type_SimpleBitVector] = size_vector_bit;
+	sizetab[type_SimpleVector] = size_vector;
+	sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
+	sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
+	sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
+	sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
+	sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
+	sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
+	sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
+	sizetab[type_ComplexString] = size_boxed;
+	sizetab[type_ComplexBitVector] = size_boxed;
+	sizetab[type_ComplexVector] = size_boxed;
+	sizetab[type_ComplexArray] = size_boxed;
+	sizetab[type_CodeHeader] = size_code_header;
+#if 0
+	/* Shouldn't see these so just lose if it happens */
+	sizetab[type_FunctionHeader] = size_function_header;
+	sizetab[type_ClosureFunctionHeader] = size_function_header;
+	sizetab[type_ReturnPcHeader] = size_return_pc_header;
+#endif
+	sizetab[type_ClosureHeader] = size_boxed;
+	sizetab[type_FuncallableInstanceHeader] = size_boxed;
+	sizetab[type_ValueCellHeader] = size_boxed;
+	sizetab[type_SymbolHeader] = size_boxed;
+	sizetab[type_BaseChar] = size_immediate;
+	sizetab[type_Sap] = size_unboxed;
+	sizetab[type_UnboundMarker] = size_immediate;
+	sizetab[type_WeakPointer] = size_weak_pointer;
+        sizetab[type_StructureHeader] = size_vector;
+	sizetab[type_Fdefn] = size_boxed;
+}
+
+
+
+/* Noise to manipulate the gc trigger stuff. */
+
+#ifndef ibmrt
+
+void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
+{
+    os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
+	dynamic_usage;
+    long length =
+	DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
+
+    if(addr < (os_vm_address_t)current_dynamic_space_free_pointer) {
+	fprintf(stderr,
+	   "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %d)\n",
+		dynamic_usage,
+		(os_vm_address_t)current_dynamic_space_free_pointer
+		- (os_vm_address_t)current_dynamic_space);
+	return;
+    }
+    else if (length < 0) {
+	fprintf(stderr,
+		"set_auto_gc_trigger: tried to set gc trigger too high! (%d)\n",
+		dynamic_usage);
+	return;
+    }
+
+    addr=os_round_up_to_page(addr);
+    length=os_trunc_size_to_page(length);
+
+#ifndef MACH
+    os_invalidate(addr,length);
+#else
+    os_protect(addr, length, 0);
+#endif
+
+    current_auto_gc_trigger = (lispobj *)addr;
+}
+
+void clear_auto_gc_trigger(void)
+{
+    if(current_auto_gc_trigger!=NULL){
+#ifndef MACH /* don't want to force whole space into swapping mode... */
+	os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
+	os_vm_size_t length=
+	    DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
+
+	os_validate(addr,length);
+#else
+	os_protect((os_vm_address_t)current_dynamic_space,
+		   DYNAMIC_SPACE_SIZE,
+		   OS_VM_PROT_ALL);
+#endif
+
+	current_auto_gc_trigger = NULL;
+    }
+}
+
+#endif
diff --git a/lisp/gc.h b/lisp/gc.h
new file mode 100644
index 000000000..a1e83f814
--- /dev/null
+++ b/lisp/gc.h
@@ -0,0 +1,22 @@
+/*
+ * Header file for GC
+ *
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.h,v 1.1 1992/07/28 20:14:28 wlott Exp $
+ */
+
+#ifndef _GC_H_
+#define _GC_H_
+
+extern void gc_init(void);
+extern void collect_garbage(void);
+
+#ifndef ibmrt
+
+#include "os.h"
+
+extern void set_auto_gc_trigger(os_vm_size_t usage);
+extern void clear_auto_gc_trigger(void);
+
+#endif ibmrt
+
+#endif _GC_H_
diff --git a/lisp/globals.c b/lisp/globals.c
new file mode 100644
index 000000000..a8d9595d5
--- /dev/null
+++ b/lisp/globals.c
@@ -0,0 +1,53 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.c,v 1.1 1992/07/28 20:14:29 wlott Exp $ */
+
+/* Variables everybody needs to look at or frob on. */
+
+#include <stdio.h>
+
+#include "lisp.h"
+#include "internals.h"
+#include "globals.h"
+
+int foreign_function_call_active;
+
+lispobj *current_control_stack_pointer;
+lispobj *current_control_frame_pointer;
+#ifndef BINDING_STACK_POINTER
+lispobj *current_binding_stack_pointer;
+#endif
+
+lispobj *read_only_space;
+lispobj *static_space;
+lispobj *dynamic_0_space;
+lispobj *dynamic_1_space;
+lispobj *control_stack;
+lispobj *binding_stack;
+
+lispobj *current_dynamic_space;
+#ifndef ALLOCATION_POINTER
+lispobj *current_dynamic_space_free_pointer;
+#endif
+#ifndef INTERNAL_GC_TRIGGER
+lispobj *current_auto_gc_trigger;
+#endif
+
+void globals_init(void)
+{
+    /* Space, stack, and free pointer vars are initialized by
+       validate() and coreparse(). */
+
+#ifndef INTERNAL_GC_TRIGGER
+    /* No GC trigger yet */
+    current_auto_gc_trigger = NULL;
+#endif
+
+    /* Set foreign function call active. */
+    foreign_function_call_active = 1;
+
+    /* Initialize the current lisp state. */
+    current_control_stack_pointer = control_stack;
+    current_control_frame_pointer = (lispobj *)0;
+#ifndef BINDING_STACK_POINTER
+    current_binding_stack_pointer = binding_stack;
+#endif
+}
diff --git a/lisp/globals.h b/lisp/globals.h
new file mode 100644
index 000000000..d2c98d770
--- /dev/null
+++ b/lisp/globals.h
@@ -0,0 +1,62 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.1 1992/07/28 20:14:31 wlott Exp $ */
+
+#if !defined(_INCLUDE_GLOBALS_H_)
+#define _INCLUDED_GLOBALS_H_
+
+#ifndef LANGUAGE_ASSEMBLY
+
+#include "lisp.h"
+
+extern int foreign_function_call_active;
+
+extern lispobj *current_control_stack_pointer;
+extern lispobj *current_control_frame_pointer;
+#ifndef ibmrt
+extern lispobj *current_binding_stack_pointer;
+#endif
+
+extern lispobj *read_only_space;
+extern lispobj *static_space;
+extern lispobj *dynamic_0_space;
+extern lispobj *dynamic_1_space;
+extern lispobj *control_stack;
+extern lispobj *binding_stack;
+
+extern lispobj *current_dynamic_space;
+#ifndef ibmrt
+extern lispobj *current_dynamic_space_free_pointer;
+extern lispobj *current_auto_gc_trigger;
+#endif
+
+extern void globals_init(void);
+
+#else  LANGUAGE_ASSEMBLY
+
+/* These are needed by ./assem.s */
+
+#ifdef mips
+#define EXTERN(name,bytes) .extern name bytes
+#endif
+#ifdef sparc
+#define EXTERN(name,bytes) .global _/**/name
+#endif
+#ifdef ibmrt
+#define EXTERN(name,bytes) .globl _/**/name
+#endif
+
+EXTERN(foreign_function_call_active, 4)
+
+EXTERN(current_control_stack_pointer, 4)
+EXTERN(current_control_frame_pointer, 4)
+#ifndef ibmrt
+EXTERN(current_binding_stack_pointer, 4)
+EXTERN(current_dynamic_space_free_pointer, 4)
+#endif
+
+#ifdef mips
+EXTERN(current_flags_register, 4)
+#endif
+
+#endif LANGUAGE_ASSEMBLY
+
+#endif _INCLUDED_GLOBALS_H_
diff --git a/lisp/interr.c b/lisp/interr.c
new file mode 100644
index 000000000..46773b374
--- /dev/null
+++ b/lisp/interr.c
@@ -0,0 +1,150 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.c,v 1.1 1992/07/28 20:14:32 wlott Exp $
+ *
+ * Stuff to handle internal errors.
+ *
+ */
+
+#include <stdio.h>
+#include <stdarg.h>
+
+#include "signal.h"
+
+#include "lisp.h"
+#include "internals.h"
+#include "interr.h"
+#include "print.h"
+#include "lispregs.h"
+#include "arch.h"
+
+
+/* Lossage handler. */
+
+static void default_lossage_handler(void)
+{
+    exit(1);
+}
+
+static void (*lossage_handler)(void) = default_lossage_handler;
+
+void set_lossage_handler(void handler(void))
+{
+    lossage_handler = handler;
+}
+
+void lose(char *fmt, ...)
+{
+    va_list ap;
+
+    if (fmt != NULL) {
+	va_start(ap, fmt);
+	vfprintf(stderr, fmt, ap);
+	fflush(stderr);
+	va_end(ap);
+    }
+    lossage_handler();
+}
+
+
+/* Internal error handler for when the Lisp error system doesn't exist. */
+
+static char *errors[] = ERRORS;
+
+void internal_error(struct sigcontext *context)
+{
+    unsigned char *ptr = arch_internal_error_arguments(context);
+    int len, scoffset, sc, offset, ch;
+
+    len = *ptr++;
+    printf("Error: %s\n", errors[*ptr++]);
+    len--;
+    while (len > 0) {
+	scoffset = *ptr++;
+	len--;
+	if (scoffset == 253) {
+	    scoffset = *ptr++;
+	    len--;
+	}
+	else if (scoffset == 254) {
+	    scoffset = ptr[0] + ptr[1]*256;
+	    ptr += 2;
+	    len -= 2;
+	}
+	else if (scoffset == 255) {
+	    scoffset = ptr[0] + (ptr[1]<<8) + (ptr[2]<<16) + (ptr[3]<<24);
+	    ptr += 4;
+	    len -= 4;
+	}
+	sc = scoffset & 0x1f;
+	offset = scoffset >> 5;
+		
+	printf("    SC: %d, Offset: %d", sc, offset);
+	switch (sc) {
+	  case sc_AnyReg:
+	  case sc_DescriptorReg:
+	    putchar('\t');
+	    brief_print(SC_REG(context, offset));
+	    break;
+
+	  case sc_BaseCharReg:
+	    ch = SC_REG(context, offset);
+#ifdef i386
+	    if (offset&1)
+		ch = ch>>8;
+	    ch = ch & 0xff;
+#endif
+	    switch (ch) {
+	      case '\n': printf("\t'\\n'\n"); break;
+	      case '\b': printf("\t'\\b'\n"); break;
+	      case '\t': printf("\t'\\t'\n"); break;
+	      case '\r': printf("\t'\\r'\n"); break;
+	      default:
+		if (ch < 32 || ch > 127)
+		    printf("\\%03o", ch);
+		else
+		    printf("\t'%c'\n", ch);
+		break;
+	    }
+	    break;
+	  case sc_SapReg:
+#ifdef sc_WordPointerReg
+	  case sc_WordPointerReg:
+#endif
+	    printf("\t0x%08x\n", SC_REG(context, offset));
+	    break;
+	  case sc_SignedReg:
+	    printf("\t%ld\n", SC_REG(context, offset));
+	    break;
+	  case sc_UnsignedReg:
+	    printf("\t%lu\n", SC_REG(context, offset));
+	    break;
+#ifdef sc_SingleFloatReg
+	  case sc_SingleFloatReg:
+	    printf("\t%g\n", *(float *)&context->sc_fpregs[offset]);
+	    break;
+#endif
+#ifdef sc_DoubleFloatReg
+	  case sc_DoubleFloatReg:
+	    printf("\t%g\n", *(double *)&context->sc_fpregs[offset]);
+	    break;
+#endif
+	  default:
+	    printf("\t???\n");
+	    break;
+	}
+    }
+
+    lose(NULL);
+}
+
+
+
+
+/* Utility routines used by random pieces of code. */
+
+lispobj debug_print(lispobj string)
+{
+    printf("%s\n", (char *)(((struct vector *)PTR(string))->data));
+
+    return NIL;
+}
diff --git a/lisp/interr.h b/lisp/interr.h
new file mode 100644
index 000000000..58a9e5de5
--- /dev/null
+++ b/lisp/interr.h
@@ -0,0 +1,16 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.h,v 1.1 1992/07/28 20:14:34 wlott Exp $
+ */
+
+#ifndef _INTERR_H_
+#define _INTERR_H_
+
+#define crap_out(msg) do { write(2, msg, sizeof(msg)); lose(); } while (0)
+
+extern void lose(char *fmt, ...);
+extern void set_lossage_handler(void fun(void));
+extern void internal_error(struct sigcontext *context);
+
+extern lispobj debug_print(lispobj string);
+
+#endif
diff --git a/lisp/interrupt.c b/lisp/interrupt.c
new file mode 100644
index 000000000..67efb693a
--- /dev/null
+++ b/lisp/interrupt.c
@@ -0,0 +1,335 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.1 1992/07/28 20:14:35 wlott Exp $ */
+
+/* Interrupt handing magic. */
+
+#include <stdio.h>
+
+#include <signal.h>
+#ifdef mips
+#include <mips/cpu.h>
+#endif
+
+#include "lisp.h"
+#include "internals.h"
+#include "os.h"
+#include "arch.h"
+#include "globals.h"
+#include "lispregs.h"
+#include "interrupt.h"
+#include "validate.h"
+#include "monitor.h"
+#include "gc.h"
+#include "alloc.h"
+#include "dynbind.h"
+#include "interr.h"
+
+boolean internal_errors_enabled = 0;
+
+struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS];
+
+union interrupt_handler interrupt_handlers[NSIG];
+void (*interrupt_low_level_handlers[NSIG])(int signal, int code,
+					   struct sigcontext *scp) = {0};
+
+static int pending_signal = 0, pending_code = 0, pending_mask = 0;
+static boolean maybe_gc_pending = FALSE;
+
+
+/****************************************************************\
+* Utility routines used by various signal handlers.              *
+\****************************************************************/
+
+void fake_foreign_function_call(struct sigcontext *context)
+{
+    int context_index;
+    lispobj oldcont;
+    
+    /* Get current LISP state from context */
+#ifdef reg_ALLOC
+    current_dynamic_space_free_pointer = (lispobj *)SC_REG(context, reg_ALLOC);
+#endif
+#ifdef reg_BSP
+    current_binding_stack_pointer = (lispobj *)SC_REG(context, reg_BSP);
+#endif
+    
+#ifndef i386
+    /* Build a fake stack frame */
+    current_control_frame_pointer = (lispobj *)SC_REG(context, reg_CSP);
+    if ((lispobj *)SC_REG(context, reg_CFP)==current_control_frame_pointer) {
+        /* There is a small window during call where the callee's frame */
+        /* isn't built yet. */
+        if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) {
+            /* We have called, but not built the new frame, so
+               build it for them. */
+            current_control_frame_pointer[0] = SC_REG(context, reg_OCFP);
+            current_control_frame_pointer[1] = SC_REG(context, reg_LRA);
+            current_control_frame_pointer += 8;
+            /* Build our frame on top of it. */
+            oldcont = (lispobj)SC_REG(context, reg_CFP);
+        }
+        else {
+            /* We haven't yet called, build our frame as if the
+               partial frame wasn't there. */
+            oldcont = (lispobj)SC_REG(context, reg_OCFP);
+        }
+    }
+    /* ### We can't tell if we are still in the caller if it had to
+       reg_ALLOCate the stack frame due to stack arguments. */
+    /* ### Can anything strange happen during return? */
+    else
+        /* Normal case. */
+        oldcont = (lispobj)SC_REG(context, reg_CFP);
+    
+    current_control_stack_pointer = current_control_frame_pointer + 8;
+
+    current_control_frame_pointer[0] = oldcont;
+    current_control_frame_pointer[1] = NIL;
+    current_control_frame_pointer[2] = (lispobj)SC_REG(context, reg_CODE);
+#endif
+    
+    /* Do dynamic binding of the active interrupt context index
+       and save the context in the context array. */
+    context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+    
+    if (context_index >= MAX_INTERRUPTS) {
+        fprintf(stderr,
+		"Maximum number (%d) of interrupts exceeded.  Exiting.\n",
+                MAX_INTERRUPTS);
+        exit(1);
+    }
+    
+    bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
+		  make_fixnum(context_index + 1));
+    
+    lisp_interrupt_contexts[context_index] = context;
+    
+    /* No longer in Lisp now. */
+    foreign_function_call_active = 1;
+}
+
+void undo_fake_foreign_function_call(struct sigcontext *context)
+{
+    /* Block all blockable signals */
+    sigblock(BLOCKABLE);
+    
+    /* Going back into lisp. */
+    foreign_function_call_active = 0;
+    
+    /* Undo dynamic binding. */
+    /* ### Do I really need to unbind_to_here()? */
+    unbind();
+    
+#ifdef reg_ALLOC
+    /* Put the dynamic space free pointer back into the context. */
+    SC_REG(context, reg_ALLOC) =
+        (unsigned long) current_dynamic_space_free_pointer;
+#endif
+}
+
+void interrupt_internal_error(int signal, int code, struct sigcontext *context,
+			      boolean continuable)
+{
+    sigsetmask(context->sc_mask);
+    fake_foreign_function_call(context);
+    if (internal_errors_enabled)
+	funcall2(SymbolFunction(INTERNAL_ERROR), alloc_sap(context),
+		 continuable ? T : NIL);
+    else
+	internal_error(context);
+    undo_fake_foreign_function_call(context);
+    if (continuable)
+	arch_skip_instruction(context);
+}
+
+void interrupt_handle_pending(struct sigcontext *context)
+{
+    boolean were_in_lisp = !foreign_function_call_active;
+
+    SetSymbolValue(INTERRUPT_PENDING, NIL);
+
+    if (maybe_gc_pending) {
+	maybe_gc_pending = FALSE;
+	if (were_in_lisp)
+	    fake_foreign_function_call(context);
+	funcall0(SymbolFunction(MAYBE_GC));
+	if (were_in_lisp)
+	    undo_fake_foreign_function_call(context);
+    }
+    if (pending_signal) {
+	int signal, code;
+
+	signal = pending_signal;
+	code = pending_code;
+	pending_signal = 0;
+	pending_code = 0;
+	interrupt_handle_now(signal, code, context);
+    }
+    context->sc_mask = pending_mask;
+    pending_mask = 0;
+}
+
+
+/****************************************************************\
+* interrupt_handle_now, maybe_now_maybe_later                    *
+*    the two main signal handlers.                               *
+\****************************************************************/
+
+void interrupt_handle_now(int signal, int code, struct sigcontext *context)
+{
+    int were_in_lisp;
+    union interrupt_handler handler;
+    
+    handler = interrupt_handlers[signal];
+
+    if(handler.c==SIG_IGN)
+	return;
+
+    were_in_lisp = !foreign_function_call_active;
+    if (were_in_lisp)
+        fake_foreign_function_call(context);
+    
+    /* Allow signals again. */
+    sigsetmask(context->sc_mask);
+
+    if (handler.c==SIG_DFL)
+	/* This can happen if someone tries to ignore or default on of the */
+	/* signals we need for runtime support, and the runtime support */
+	/* decides to pass on it.  */
+	lose("interrupt_handle_now: No handler for signal %d?\n", signal);
+    else if (LowtagOf(handler.lisp) == type_FunctionPointer)
+	funcall3(handler.lisp, make_fixnum(signal), make_fixnum(code),
+	         alloc_sap(context));
+    else
+        (*handler.c)(signal, code, context);
+    
+    if (were_in_lisp)
+        undo_fake_foreign_function_call(context);
+}
+
+static void maybe_now_maybe_later(int signal, int code,
+				  struct sigcontext *context)
+{
+    if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
+        pending_signal = signal;
+        pending_code = code;
+        pending_mask = context->sc_mask;
+        context->sc_mask |= BLOCKABLE;
+        SetSymbolValue(INTERRUPT_PENDING, T);
+    } else if ((!foreign_function_call_active)
+	       && arch_pseudo_atomic_atomic(context)) {
+        pending_signal = signal;
+        pending_code = code;
+        pending_mask = context->sc_mask;
+        context->sc_mask |= BLOCKABLE;
+	arch_set_pseudo_atomic_interrupted(context);
+    } else
+        interrupt_handle_now(signal, code, context);
+}
+
+/****************************************************************\
+* Stuff to detect and handle hitting the gc trigger.             *
+\****************************************************************/
+
+#ifndef INTERNAL_GC_TRIGGER
+static boolean gc_trigger_hit(struct sigcontext *context)
+{
+    if (current_auto_gc_trigger == NULL)
+	return FALSE;
+    else{
+	lispobj *badaddr=(lispobj *)arch_get_bad_addr(context);
+
+	return (badaddr >= current_auto_gc_trigger &&
+		badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE);
+    }
+}
+#endif
+
+
+boolean interrupt_maybe_gc(struct sigcontext *context)
+{
+    if (!foreign_function_call_active
+#ifndef INTERNAL_GC_TRIGGER
+		  && gc_trigger_hit(context)
+#endif
+	) {
+#ifndef INTERNAL_GC_TRIGGER
+	clear_auto_gc_trigger();
+#endif
+
+	if (arch_pseudo_atomic_atomic(context)) {
+	    maybe_gc_pending = TRUE;
+	    if (pending_signal == 0) {
+		pending_mask = context->sc_mask;
+		context->sc_mask |= BLOCKABLE;
+	    }
+	    arch_set_pseudo_atomic_interrupted(context);
+	}
+	else {
+	    fake_foreign_function_call(context);
+	    funcall0(SymbolFunction(MAYBE_GC));
+	    undo_fake_foreign_function_call(context);
+	}
+
+	return TRUE;
+    }else
+	return FALSE;
+}
+
+/****************************************************************\
+* Noise to install handlers.                                     *
+\****************************************************************/
+
+void interrupt_install_low_level_handler
+    (int signal,
+     void handler(int signal, int code, struct sigcontext *handler))
+{
+    struct sigvec sv;
+
+    sv.sv_handler=handler;
+    sv.sv_mask=BLOCKABLE;
+    sv.sv_flags=0;
+
+    sigvec(signal,&sv,NULL);
+
+    interrupt_low_level_handlers[signal]=(handler==SIG_DFL ? 0 : handler);
+}
+
+unsigned long install_handler(int signal,
+			      void handler(int signal, int code,
+					   struct sigcontext *handler))
+{
+    struct sigvec sv;
+    int oldmask;
+    union interrupt_handler oldhandler;
+
+    oldmask = sigblock(sigmask(signal));
+
+    if(interrupt_low_level_handlers[signal]==0){
+	if(handler==SIG_DFL || handler==SIG_IGN)
+	    sv.sv_handler = handler;
+	else if (sigmask(signal)&BLOCKABLE)
+	    sv.sv_handler = maybe_now_maybe_later;
+	else
+	    sv.sv_handler = interrupt_handle_now;
+
+	sv.sv_mask = BLOCKABLE;
+	sv.sv_flags = 0;
+
+	sigvec(signal, &sv, NULL);
+    }
+
+    oldhandler = interrupt_handlers[signal];
+    interrupt_handlers[signal].c = handler;
+
+    sigsetmask(oldmask);
+
+    return (unsigned long)oldhandler.lisp;
+}
+
+void interrupt_init(void)
+{
+    int i;
+
+    for (i = 0; i < NSIG; i++)
+        interrupt_handlers[i].c = SIG_DFL;
+}
diff --git a/lisp/interrupt.h b/lisp/interrupt.h
new file mode 100644
index 000000000..df36b3d7e
--- /dev/null
+++ b/lisp/interrupt.h
@@ -0,0 +1,44 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.h,v 1.1 1992/07/28 20:14:37 wlott Exp $ */
+
+#if !defined(_INCLUDE_INTERRUPT_H_)
+#define _INCLUDE_INTERRUPT_H_
+
+#include <signal.h>
+
+#define MAX_INTERRUPTS (4096)
+
+extern struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS];
+
+union interrupt_handler {
+	lispobj lisp;
+	void (*c)(int signal, int code, struct sigcontext *scp);
+};
+
+extern void interrupt_init(void);
+extern void fake_foreign_function_call(struct sigcontext *context);
+extern void undo_fake_foreign_function_call(struct sigcontext *context);
+extern void interrupt_handle_now(int signal, int code, struct sigcontext *scp);
+extern void interrupt_handle_pending(struct sigcontext *scp);
+extern void interrupt_internal_error(int signal, int code,
+				     struct sigcontext *scp,
+				     boolean continuable);
+extern boolean interrupt_maybe_gc(struct sigcontext *context);
+extern void interrupt_install_low_level_handler
+    (int signal,
+     void handler(int signal, int code, struct sigcontext *handler));
+extern unsigned long install_handler(int signal,
+				     void handler(int signal, int code,
+						  struct sigcontext *handler));
+
+extern union interrupt_handler interrupt_handlers[NSIG];
+
+#define BLOCKABLE (sigmask(SIGHUP) | sigmask(SIGINT) | \
+		   sigmask(SIGQUIT) | sigmask(SIGPIPE) | \
+		   sigmask(SIGALRM) | sigmask(SIGURG) | \
+		   sigmask(SIGTSTP) | sigmask(SIGCHLD) | \
+		   sigmask(SIGIO) | sigmask(SIGXCPU) | \
+		   sigmask(SIGXFSZ) | sigmask(SIGVTALRM) | \
+		   sigmask(SIGPROF) | sigmask(SIGWINCH) | \
+		   sigmask(SIGUSR1) | sigmask(SIGUSR2))
+
+#endif
diff --git a/lisp/lisp.c b/lisp/lisp.c
new file mode 100644
index 000000000..61b25f089
--- /dev/null
+++ b/lisp/lisp.c
@@ -0,0 +1,215 @@
+/*
+ * main() entry point for a stand alone lisp image.
+ *
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.1 1992/07/28 20:14:38 wlott Exp $
+ *
+ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+#include <sys/file.h>
+#include <sys/param.h>
+#include <sys/stat.h>
+
+#include "signal.h"
+
+#include "lisp.h"
+#include "internals.h"
+#include "alloc.h"
+#include "vars.h"
+#include "globals.h"
+#include "os.h"
+#include "arch.h"
+#include "gc.h"
+#include "monitor.h"
+#include "validate.h"
+#include "interrupt.h"
+#include "core.h"
+#include "save.h"
+#include "lispregs.h"
+
+lispobj lisp_nil_reg = NIL;
+char *lisp_csp_reg, *lisp_bsp_reg;
+
+
+/* SIGINT handler that invokes the monitor. */
+
+static void sigint_handler(int signal, int code, struct sigcontext *context)
+{
+    printf("\nSIGINT hit at 0x%08X\n", SC_PC(context));
+    ldb_monitor();
+}
+
+/* Not static, because we want to be able to call it from lisp land. */
+void sigint_init(void)
+{
+    install_handler(SIGINT, sigint_handler);
+}
+
+
+/* Noise to convert argv and argp into lists. */
+
+static lispobj alloc_str_list(char *list[])
+{
+    lispobj result, newcons;
+    struct cons *ptr;
+
+    if (*list == NULL)
+        result = NIL;
+    else {
+        result = newcons = alloc_cons(alloc_string(*list++), NIL);
+
+        while (*list != NULL) {
+            ptr = (struct cons *)PTR(newcons);
+            newcons = alloc_cons(alloc_string(*list++), NIL);
+            ptr->cdr = newcons;
+        }
+    }
+
+    return result;
+}
+
+
+/* stuff to start a kernel core */
+
+extern void call_on_stack(void fn(), os_vm_address_t new_sp);
+
+void call_initial_function()
+{
+    funcall0(SymbolFunction(INITIAL_FUNCTION));
+    printf("%%INITIAL-FUNCTION returned?\n");
+}
+
+void call_ldb_monitor()
+{
+    while (1)
+	ldb_monitor();
+}
+
+
+
+/* And here be main. */
+
+void main(int argc, char *argv[], char *envp[])
+{
+    char *arg, **argptr;
+    char *core = NULL, *default_core;
+    boolean restore_state, monitor;
+
+    mach_init();
+#ifdef parisc
+    printf("lisp running, pid=%d\n", getpid());
+#endif
+
+    set_lossage_handler(ldb_monitor);
+
+    define_var("nil", NIL, TRUE);
+    define_var("t", T, TRUE);
+    monitor = FALSE;
+
+    argptr = argv;
+    while ((arg = *++argptr) != NULL) {
+        if (strcmp(arg, "-core") == 0) {
+            if (core != NULL) {
+                fprintf(stderr, "can only specify one core file.\n");
+                exit(1);
+            }
+            core = *++argptr;
+            if (core == NULL) {
+                fprintf(stderr, "-core must be followed by the name of the core file to use.\n");
+                exit(1);
+            }
+        }
+	else if (strcmp(arg, "-monitor") == 0) {
+	    monitor = TRUE;
+	}
+    }
+
+    default_core = arch_init();
+    if (default_core == NULL)
+	default_core = "lisp.core";
+
+    /* Note: the /usr/misc/.cmucl/lib/ default path is also wired into */
+    /* the lisp code in .../code/save.lisp. */
+
+    if (core == NULL) {
+	extern char *getenv(char *var);
+	static char buf[MAXPATHLEN];
+	char *lib = getenv("CMUCLLIB");
+
+	if (lib != NULL) {
+	    char *dst;
+	    struct stat statbuf;
+
+	    do {
+		dst = buf;
+		while (*lib != '\0' && *lib != ':')
+		    *dst++ = *lib++;
+		if (dst != buf && dst[-1] != '/')
+		    *dst++ = '/';
+		strcpy(dst, default_core);
+		if (stat(buf, &statbuf) == 0) {
+		    core = buf;
+		    break;
+		}
+	    } while (*lib++ == ':');
+	}
+	if (core == NULL) {
+	    strcpy(buf, "/usr/misc/.cmucl/lib/");
+	    strcat(buf, default_core);
+	    core = buf;
+	}
+    }
+
+    os_init();
+    gc_init();
+    validate();
+    globals_init();
+
+    restore_state = load_core_file(core);
+
+    if (!restore_state) {
+#ifdef BINDING_STACK_POINTER
+	SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
+#endif
+#ifdef INTERNAL_GC_TRIGGER
+	SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1));
+#endif
+    }
+
+    interrupt_init();
+
+    arch_install_interrupt_handlers();
+    os_install_interrupt_handlers();
+
+    /* Convert the argv and envp to something Lisp can grok. */
+    SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv));
+    SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
+
+#ifdef PSEUDO_ATOMIC_ATOMIC
+    /* Turn on pseudo atomic for when we call into lisp. */
+    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, fixnum(1));
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, fixnum(0));
+#endif
+
+    /* Pick off sigint until the lisp system gets far enough along to */
+    /* install it's own. */
+    sigint_init();
+
+    if (restore_state) {
+	if (monitor) {
+	    printf("exit ldb monitor to restore\n");
+	    ldb_monitor();
+	}
+	restore();
+    }
+    else
+	call_on_stack(monitor ? call_ldb_monitor : call_initial_function,
+#ifdef NUMBER_STACK_GROWS_UP
+			NUMBER_STACK_START
+#else
+			NUMBER_STACK_START+NUMBER_STACK_SIZE
+#endif
+			);
+}
diff --git a/lisp/lisp.h b/lisp/lisp.h
new file mode 100644
index 000000000..2ea27b4f2
--- /dev/null
+++ b/lisp/lisp.h
@@ -0,0 +1,43 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.h,v 1.1 1992/07/28 20:14:40 wlott Exp $ */
+
+#ifndef _LISP_H_
+#define _LISP_H_
+
+#define lowtag_Bits 3
+#define lowtag_Mask ((1<<lowtag_Bits)-1)
+#define LowtagOf(obj) ((obj)&lowtag_Mask)
+#define type_Bits 8
+#define type_Mask ((1<<type_Bits)-1)
+#define TypeOf(obj) ((obj)&type_Mask)
+#define HeaderValue(obj) ((unsigned long) ((obj)>>type_Bits))
+
+#define Pointerp(obj) ((obj) & 0x01)
+#define PTR(obj) ((obj)&~lowtag_Mask)
+
+#define CONS(obj) ((struct cons *)((obj)-type_ListPointer))
+#define SYMBOL(obj) ((struct symbol *)((obj)-type_OtherPointer))
+#define FDEFN(obj) ((struct fdefn *)((obj)-type_OtherPointer))
+
+typedef unsigned long lispobj;
+
+#define make_fixnum(n) ((lispobj)((n)<<2))
+#define fixnum_value(n) (((long)n)>>2)
+
+#define boolean int
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#define SymbolValue(sym) \
+    (((struct symbol *)((sym)-type_OtherPointer))->value)
+#define SetSymbolValue(sym,val) \
+    (((struct symbol *)((sym)-type_OtherPointer))->value = (val))
+
+/* This only words for static symbols. */
+#define SymbolFunction(sym) \
+    (((struct fdefn *)(SymbolValue(sym)-type_OtherPointer))->function)
+
+#endif _LISP_H_
diff --git a/lisp/lispregs.h b/lisp/lispregs.h
new file mode 100644
index 000000000..956f07224
--- /dev/null
+++ b/lisp/lispregs.h
@@ -0,0 +1,25 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lispregs.h,v 1.1 1992/07/28 20:14:41 wlott Exp $ */
+
+#ifdef mips
+#include "mips-lispregs.h"
+#endif
+
+#ifdef sparc
+#include "sparc-lispregs.h"
+#endif
+
+#ifdef ibmrt
+#include "rt-lispregs.h"
+#endif
+
+#ifdef i386
+#include "x86-lispregs.h"
+#endif
+
+#ifdef parisc
+#include "hppa-lispregs.h"
+#endif
+
+#ifndef LANGUAGE_ASSEMBLY
+extern char *lisp_register_names[];
+#endif
diff --git a/lisp/mach-os.c b/lisp/mach-os.c
new file mode 100644
index 000000000..f7e904fa6
--- /dev/null
+++ b/lisp/mach-os.c
@@ -0,0 +1,182 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mach-os.c,v 1.1 1992/07/28 20:14:54 wlott Exp $
+ *
+ * OS-dependent routines.  This file (along with os.h) exports an
+ * OS-independent interface to the operating system VM facilities.
+ * Suprisingly, this interface looks a lot like the Mach interface
+ * (but simpler in some places).  For some operating systems, a subset
+ * of these functions will have to be emulated.
+ *
+ * This is the Mach version.
+ *
+ */
+
+#include <stdio.h>
+#include <mach.h>
+#include <sys/file.h>
+#include "./signal.h"
+#include "os.h"
+#include "arch.h"
+#include "interrupt.h"
+
+#define MAX_SEGS 32
+
+static struct segment {
+    vm_address_t start;
+    vm_size_t length;
+} addr_map[MAX_SEGS];
+static int segments = -1;
+
+vm_size_t os_vm_page_size;
+
+#if defined(i386) || defined(parisc)
+mach_port_t task_self()
+{
+    return mach_task_self();
+}
+#endif
+
+void os_init()
+{
+	os_vm_page_size = vm_page_size;
+}
+
+os_vm_address_t os_validate(addr, len)
+vm_address_t addr;
+vm_size_t len;
+{
+    kern_return_t res;
+
+    res = vm_allocate(task_self(), &addr, len, addr==NULL);
+
+    if (res != KERN_SUCCESS)
+	return 0;
+
+    segments = -1;
+
+    vm_protect(task_self(), addr, len, TRUE,
+	       VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE);
+
+    return addr;
+}
+
+void os_invalidate(addr, len)
+vm_address_t addr;
+vm_size_t len;
+{
+    kern_return_t res;
+
+    res = vm_deallocate(task_self(), addr, len);
+
+    if (res != KERN_SUCCESS)
+        mach_error("Could not vm_allocate memory: ", res);
+
+    segments = -1;
+}
+
+vm_address_t os_map(fd, offset, addr, len)
+int fd, offset;
+vm_address_t addr;
+vm_size_t len;
+{
+    kern_return_t res;
+
+    res = map_fd(fd, offset, &addr, 0, len);
+
+    if (res != KERN_SUCCESS) {
+	char buf[256];
+	sprintf(buf, "Could not map_fd(%d, %d, 0x%08x, 0x%08x): ",
+		fd, offset, addr, len);
+        mach_error(buf, res);
+
+	lseek(fd, offset, L_SET);
+	read(fd, addr, len);
+    }
+
+    segments = -1;
+
+    vm_protect(task_self(), addr, len, TRUE,
+	       VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE);
+
+    return addr;
+}
+
+void os_flush_icache(address, length)
+vm_address_t address;
+vm_size_t length;
+{
+#ifdef mips
+	vm_machine_attribute_val_t flush;
+	kern_return_t kr;
+
+	flush = MATTR_VAL_ICACHE_FLUSH;
+
+	kr = vm_machine_attribute(task_self(), address, length,
+				  MATTR_CACHE, &flush);
+	if (kr != KERN_SUCCESS)
+		mach_error("Could not flush the instruction cache", kr);
+#endif
+}
+
+void os_protect(address, length, protection)
+vm_address_t address;
+vm_size_t length;
+vm_prot_t protection;
+{
+	vm_protect(task_self(), address, length, FALSE, protection);
+}
+
+
+boolean valid_addr(test)
+vm_address_t test;
+{
+    vm_address_t addr;
+    vm_size_t size;
+    int bullshit;
+    int curseg;
+
+    if (segments == -1) {
+        addr = 0;
+        curseg = 0;
+
+        while (1) {
+            if (vm_region(task_self(), &addr, &size, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit) != KERN_SUCCESS)
+                break;
+
+            if (curseg > 0 && addr_map[curseg-1].start + addr_map[curseg-1].length == addr)
+                addr_map[curseg-1].length += size;
+            else {
+                addr_map[curseg].start = addr;
+                addr_map[curseg].length = size;
+                curseg++;
+            }
+
+            addr += size;
+        }
+
+        segments = curseg;
+    }
+    
+    for (curseg = 0; curseg < segments; curseg++)
+        if (addr_map[curseg].start <= test && test < addr_map[curseg].start + addr_map[curseg].length)
+            return TRUE;
+    return FALSE;
+}
+
+#ifndef ibmrt
+static void sigbus_handler(int signal, int code, struct sigcontext *context)
+{
+    if(!interrupt_maybe_gc(context))
+	interrupt_handle_now(signal, code, context);
+}
+#endif
+
+void os_install_interrupt_handlers(void)
+{
+#ifndef ibmrt
+    interrupt_install_low_level_handler(SIGBUS,sigbus_handler);
+#endif
+#ifdef mips
+    interrupt_install_low_level_handler(SIGSEGV,sigbus_handler);
+#endif
+}
diff --git a/lisp/mach-os.h b/lisp/mach-os.h
new file mode 100644
index 000000000..ff3b27570
--- /dev/null
+++ b/lisp/mach-os.h
@@ -0,0 +1,12 @@
+#include <mach.h>
+
+typedef vm_address_t os_vm_address_t;
+typedef vm_size_t os_vm_size_t;
+typedef vm_offset_t os_vm_offset_t;
+typedef vm_prot_t os_vm_prot_t;
+
+#define OS_VM_PROT_READ VM_PROT_READ
+#define OS_VM_PROT_WRITE VM_PROT_WRITE
+#define OS_VM_PROT_EXECUTE VM_PROT_EXECUTE
+
+#define OS_VM_DEFAULT_PAGESIZE	4096
diff --git a/lisp/mips-arch.c b/lisp/mips-arch.c
new file mode 100644
index 000000000..20d8de727
--- /dev/null
+++ b/lisp/mips-arch.c
@@ -0,0 +1,286 @@
+#include <stdio.h>
+#include <mips/cpu.h>
+
+#include "lisp.h"
+#include "globals.h"
+#include "validate.h"
+#include "os.h"
+#include "internals.h"
+#include "arch.h"
+#include "lispregs.h"
+#include "signal.h"
+#include "alloc.h"
+#include "interrupt.h"
+#include "interr.h"
+#include "breakpoint.h"
+
+char *arch_init(void)
+{
+    return NULL;
+}
+
+os_vm_address_t arch_get_bad_addr(struct sigcontext *scp)
+{
+    /* Finding the bad address on the mips is easy. */
+    return (os_vm_address_t)scp->sc_badvaddr;
+}
+
+void arch_skip_instruction(scp)
+struct sigcontext *scp;
+{
+    /* Skip the offending instruction */
+    if (scp->sc_cause & CAUSE_BD)
+        emulate_branch(scp, *(unsigned long *)scp->sc_pc);
+    else
+        scp->sc_pc += 4;
+}
+
+unsigned char *arch_internal_error_arguments(struct sigcontext *scp)
+{
+    if (scp->sc_cause & CAUSE_BD)
+	return (unsigned char *)(scp->sc_pc+8);
+    else
+	return (unsigned char *)(scp->sc_pc+4);
+}
+
+boolean arch_pseudo_atomic_atomic(struct sigcontext *scp)
+{
+    return (scp->sc_regs[reg_ALLOC] & 1);
+}
+
+void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
+{
+    scp->sc_regs[reg_NL4] += 0x70000000;
+}
+
+void arch_clear_pseudo_atomic_interrupted(struct sigcontext *scp)
+{
+    scp->sc_regs[reg_ALLOC] += (scp->sc_regs[reg_NL4]-0x70000000);
+    arch_skip_instruction(scp);
+}
+
+unsigned long arch_install_breakpoint(void *pc)
+{
+    unsigned long *ptr = (unsigned long *)pc;
+    unsigned long result = *ptr;
+    *ptr = (trap_Breakpoint << 16) | 0xd;
+    return result;
+}
+
+void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
+{
+    *(unsigned long *)pc = orig_inst;
+}
+
+static unsigned long *skipped_break_addr, displaced_after_inst;
+
+void arch_do_displaced_inst(struct sigcontext *scp,
+				   unsigned long orig_inst)
+{
+    unsigned long *pc = (unsigned long *)scp->sc_pc;
+    unsigned long *break_pc, *next_pc;
+    unsigned long next_inst;
+    int opcode;
+    struct sigcontext tmp;
+
+    /* Figure out where the breakpoint is, and what happens next. */
+    if (scp->sc_cause & CAUSE_BD) {
+	break_pc = pc+1;
+	next_inst = *pc;
+    }
+    else {
+	break_pc = pc;
+	next_inst = orig_inst;
+    }
+
+    /* Put the original instruction back. */
+    *break_pc = orig_inst;
+    skipped_break_addr = break_pc;
+
+    /* Figure out where it goes. */
+    opcode = next_inst >> 26;
+    if (opcode == 1 || ((opcode & 0x3c) == 0x4) || ((next_inst & 0xf00e0000) == 0x80000000)) {
+	tmp = *scp;
+	emulate_branch(&tmp, next_inst);
+        next_pc = (unsigned long *)scp->sc_pc;
+    }
+    else
+	next_pc = pc+1;
+
+    displaced_after_inst = *next_pc;
+    *next_pc = (trap_AfterBreakpoint << 16) | 0xd;
+
+    sigreturn(scp);
+}
+
+static void sigtrap_handler(int signal, int code, struct sigcontext *scp)
+{
+    switch (code) {
+      case trap_PendingInterrupt:
+	interrupt_handle_pending(scp);
+	break;
+
+      case trap_Halt:
+	fake_foreign_function_call(scp);
+	lose("%%primitive halt called; the party is over.\n");
+
+      case trap_Error:
+      case trap_Cerror:
+	interrupt_internal_error(signal, code, scp, code==trap_Cerror);
+	break;
+
+      case trap_Breakpoint:
+	sigsetmask(scp->sc_mask);
+	fake_foreign_function_call(scp);
+	handle_breakpoint(signal, code, scp);
+	undo_fake_foreign_function_call(scp);
+	break;
+
+      case trap_FunctionEndBreakpoint:
+	sigsetmask(scp->sc_mask);
+	fake_foreign_function_call(scp);
+	handle_function_end_breakpoint(signal, code, scp);
+	undo_fake_foreign_function_call(scp);
+	break;
+
+      case trap_AfterBreakpoint:
+	*skipped_break_addr = (trap_Breakpoint << 16) | 0xd;
+	skipped_break_addr = NULL;
+	*(unsigned long *)scp->sc_pc = displaced_after_inst;
+	break;
+
+      default:
+	interrupt_handle_now(signal, code, scp);
+	break;
+    }
+}
+
+#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
+
+static void sigfpe_handler(int signal, int code, struct sigcontext *scp)
+{
+    unsigned long bad_inst;
+    unsigned int op, rs, rt, rd, funct, dest;
+    int immed;
+    long result;
+
+    if (scp->sc_cause & CAUSE_BD)
+        bad_inst = *(unsigned long *)(scp->sc_pc + 4);
+    else
+        bad_inst = *(unsigned long *)(scp->sc_pc);
+
+    op = (bad_inst >> 26) & 0x3f;
+    rs = (bad_inst >> 21) & 0x1f;
+    rt = (bad_inst >> 16) & 0x1f;
+    rd = (bad_inst >> 11) & 0x1f;
+    funct = bad_inst & 0x3f;
+    immed = (((int)(bad_inst & 0xffff)) << 16) >> 16;
+
+    switch (op) {
+        case 0x0: /* SPECIAL */
+            switch (funct) {
+                case 0x20: /* ADD */
+		    /* Check to see if this is really a pa_interrupted hit */
+		    if (rs == reg_ALLOC && rt == reg_NL4) {
+			scp->sc_regs[reg_ALLOC] +=
+			    (scp->sc_regs[reg_NL4] - 0x70000000);
+			arch_skip_instruction(scp);
+			interrupt_handle_pending(scp);
+			return;
+		    }
+                    result = FIXNUM_VALUE(scp->sc_regs[rs]) + FIXNUM_VALUE(scp->sc_regs[rt]);
+                    dest = rd;
+                    break;
+
+                case 0x22: /* SUB */
+                    result = FIXNUM_VALUE(scp->sc_regs[rs]) - FIXNUM_VALUE(scp->sc_regs[rt]);
+                    dest = rd;
+                    break;
+
+                default:
+                    dest = 32;
+                    break;
+            }
+            break;
+
+        case 0x8: /* ADDI */
+            result = FIXNUM_VALUE(scp->sc_regs[rs]) + (immed>>2);
+            dest = rt;
+            break;
+
+        default:
+            dest = 32;
+            break;
+    }
+
+    if (dest < 32) {
+        current_dynamic_space_free_pointer =
+            (lispobj *) scp->sc_regs[reg_ALLOC];
+
+        scp->sc_regs[dest] = alloc_number(result);
+
+	scp->sc_regs[reg_ALLOC] =
+	    (unsigned long) current_dynamic_space_free_pointer;
+
+        arch_skip_instruction(scp);
+
+    }
+    else
+        interrupt_handle_now(signal, code, scp);
+}
+
+void arch_install_interrupt_handlers()
+{
+    interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
+    interrupt_install_low_level_handler(SIGFPE,sigfpe_handler);
+}
+
+extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
+
+lispobj funcall0(lispobj function)
+{
+    lispobj *args = current_control_stack_pointer;
+
+    return call_into_lisp(function, args, 0);
+}
+
+lispobj funcall1(lispobj function, lispobj arg0)
+{
+    lispobj *args = current_control_stack_pointer;
+
+    current_control_stack_pointer += 1;
+    args[0] = arg0;
+
+    return call_into_lisp(function, args, 1);
+}
+
+lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
+{
+    lispobj *args = current_control_stack_pointer;
+
+    current_control_stack_pointer += 2;
+    args[0] = arg0;
+    args[1] = arg1;
+
+    return call_into_lisp(function, args, 2);
+}
+
+lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
+{
+    lispobj *args = current_control_stack_pointer;
+
+    current_control_stack_pointer += 3;
+    args[0] = arg0;
+    args[1] = arg1;
+    args[2] = arg2;
+
+    return call_into_lisp(function, args, 3);
+}
+
+
+/* This is apparently called by emulate_branch, but isn't defined.  So */
+/* just do nothing and hope it works... */
+
+void cacheflush(void)
+{
+}
diff --git a/lisp/mips-assem.S b/lisp/mips-assem.S
new file mode 100644
index 000000000..58862c343
--- /dev/null
+++ b/lisp/mips-assem.S
@@ -0,0 +1,363 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-assem.S,v 1.1 1992/07/28 20:15:02 wlott Exp $ */
+#include <machine/regdef.h>
+
+#include "internals.h"
+#include "lispregs.h"
+#include "globals.h"
+
+#if !defined(s8)
+#define s8 $30
+#endif
+
+/*
+ * Function to transfer control into lisp.
+ */
+	.text
+	.globl	call_into_lisp
+	.ent	call_into_lisp
+call_into_lisp:
+#define framesize 12*4
+	subu	sp, framesize
+	.frame	sp, framesize, ra
+	/* Save all the C regs. */
+	.mask	0xc0ff0000, 0
+	sw	ra, framesize(sp)
+	sw	s8, framesize-4(sp)
+	sw	s7, framesize-12(sp)
+	sw	s6, framesize-16(sp)
+	sw	s5, framesize-20(sp)
+	sw	s4, framesize-24(sp)
+	sw	s3, framesize-28(sp)
+	sw	s2, framesize-32(sp)
+	sw	s1, framesize-36(sp)
+	sw	s0, framesize-40(sp)
+
+	/* Clear descriptor regs */
+	move	t0, zero
+	move	t1, zero
+	move	t2, zero
+	move	t3, zero
+	move	t4, zero
+	move	t5, zero
+	move	t6, zero
+	move	t7, zero
+	move	s0, zero
+	move	s1, zero
+	move	s2, zero
+	move	s3, zero
+	move	ra, zero
+
+	li	reg_NIL, NIL
+
+	/* Start pseudo-atomic. */
+	.set	noreorder
+	li	reg_NL4, -1
+	li	reg_ALLOC, 1
+        .set    reorder
+
+	/* No longer in foreign call. */
+	sw	zero, foreign_function_call_active
+
+	/* Load the allocation pointer, preserving the low-bit of alloc */
+	lw	v0, current_dynamic_space_free_pointer
+	add	reg_ALLOC, v0
+
+	/* Load the rest of the LISP state. */
+	lw	reg_BSP, current_binding_stack_pointer
+	lw	reg_CSP, current_control_stack_pointer
+	lw	reg_OCFP, current_control_frame_pointer
+
+	/* Check for interrupt */
+        .set    noreorder
+	add	reg_ALLOC, reg_NL4
+	.set	reorder
+
+	/* Pass in args */
+	move	reg_LEXENV, $4
+	move	reg_CFP, $5
+	sll	reg_NARGS, $6, 2
+	lw	reg_A0, 0(reg_CFP)
+	lw	reg_A1, 4(reg_CFP)
+	lw	reg_A2, 8(reg_CFP)
+	lw	reg_A3, 12(reg_CFP)
+	lw	reg_A4, 16(reg_CFP)
+	lw	reg_A5, 20(reg_CFP)
+
+	/* Calculate LRA */
+	la	reg_LRA, lra + type_OtherPointer
+
+	/* Indirect closure */
+	lw	reg_CODE, 4-1(reg_LEXENV)
+
+	/* Jump into lisp land. */
+	addu	reg_LIP, reg_CODE, 6*4 - type_FunctionPointer
+	j	reg_LIP
+
+	.set	noreorder
+	.align	3
+lra:
+	.word	type_ReturnPcHeader
+
+	/* Multiple value return spot, clear stack */
+	move	reg_CSP, reg_OCFP
+	nop
+
+	/* Set pseudo-atomic flag. */
+	li	reg_NL4, -1
+	addu	reg_ALLOC, 1
+	.set	reorder
+
+	/* Pass one return value back to C land. */
+	move	v0, reg_A0
+
+	/* Save LISP registers. */
+	subu	reg_NL0, reg_ALLOC, 1
+	sw	reg_NL0, current_dynamic_space_free_pointer
+	sw	reg_BSP, current_binding_stack_pointer
+	sw	reg_CSP, current_control_stack_pointer
+	sw	reg_CFP, current_control_frame_pointer
+
+	/* Back in foreign function call */
+	sw	reg_CFP, foreign_function_call_active
+
+	/* Check for interrupt */
+	.set	noreorder
+	add	reg_ALLOC, reg_NL4
+	.set	reorder
+
+	/* Restore C regs */
+	lw	ra, framesize(sp)
+	lw	s8, framesize-4(sp)
+	lw	s7, framesize-12(sp)
+	lw	s6, framesize-16(sp)
+	lw	s5, framesize-20(sp)
+	lw	s4, framesize-24(sp)
+	lw	s3, framesize-28(sp)
+	lw	s2, framesize-32(sp)
+	lw	s1, framesize-36(sp)
+	lw	s0, framesize-40(sp)
+
+	/* Restore C stack. */
+	addu	sp, framesize
+
+	/* Back we go. */
+	j	ra
+
+	.end	call_into_lisp
+
+/*
+ * Transfering control from Lisp into C
+ */
+	.text
+	.globl	call_into_c
+	.ent	call_into_c
+call_into_c:
+	/* Set up a stack frame. */
+	move	reg_OCFP, reg_CFP
+	move	reg_CFP, reg_CSP
+	addu	reg_CSP, reg_CFP, 32
+	sw	reg_OCFP, 0(reg_CFP)
+	subu	reg_NL4, reg_LIP, reg_CODE
+	addu	reg_NL4, type_OtherPointer
+	sw	reg_NL4, 4(reg_CFP)
+	sw	reg_CODE, 8(reg_CFP)
+
+	/* Note: the C stack is already set up. */
+
+	/* Set the pseudo-atomic flag. */
+	.set	noreorder
+	li	reg_NL4, -1
+	addu	reg_ALLOC, 1
+	.set	reorder
+
+	/* Save lisp state. */
+	subu	t0, reg_ALLOC, 1
+	sw	t0, current_dynamic_space_free_pointer
+	sw	reg_BSP, current_binding_stack_pointer
+	sw	reg_CSP, current_control_stack_pointer
+	sw	reg_CFP, current_control_frame_pointer
+
+	/* Mark us as in C land. */
+	sw	reg_CSP, foreign_function_call_active
+
+	/* Were we interrupted? */
+	.set	noreorder
+	add	reg_ALLOC, reg_NL4
+	.set	reorder
+
+	/* Into C land we go. */
+	jal	reg_CFUNC
+
+	/* Clear unsaved descriptor regs */
+	move	t0, zero
+	move	t1, zero
+	move	t2, zero
+	move	t3, zero
+	move	t4, zero
+	move	t5, zero
+	move	t6, zero
+	move	t7, zero
+	move	ra, zero
+
+	/* Turn on pseudo-atomic. */
+	.set	noreorder
+	li	reg_NL4, -1
+	li	reg_ALLOC, 1
+	.set	reorder
+
+	/* Mark us at in Lisp land. */
+	sw	zero, foreign_function_call_active
+
+	/* Restore ALLOC, preserving pseudo-atomic-atomic */
+	lw	a0, current_dynamic_space_free_pointer
+	addu	reg_ALLOC, a0
+
+	/* Check for interrupt */
+	.set	noreorder
+	add	reg_ALLOC, reg_NL4
+	.set	reorder
+
+	/* Restore LRA & CODE (they may have been GC'ed) */
+	lw	reg_CODE, 8(reg_CFP)
+	lw	a0, 4(reg_CFP)
+	subu	a0, type_OtherPointer
+	addu	reg_LIP, reg_CODE, a0
+
+	/* Reset the lisp stack. */
+	/* Note: OCFP and CFP are in saved regs. */
+	move	reg_CSP, reg_CFP
+	move	reg_CFP, reg_OCFP
+
+	/* Return to LISP. */
+	j	reg_LIP
+
+	.end	call_into_c
+
+	.text
+	.globl	start_of_tramps
+start_of_tramps:
+
+/*
+ * The undefined-function trampoline.
+ */
+        .text
+        .globl  undefined_tramp
+        .ent    undefined_tramp
+undefined_tramp:
+        break   10
+        .byte    4
+        .byte    23
+        .byte    254
+        .byte    208
+        .byte    1
+        .align 2
+        .end    undefined_tramp
+
+/*
+ * The closure trampoline.
+ */
+        .text
+        .globl  closure_tramp
+        .ent    closure_tramp
+closure_tramp:
+        lw      reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN)
+        lw      reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
+        addu    reg_LIP, reg_L0, FUNCTION_HEADER_CODE_OFFSET
+        j       reg_LIP
+        .end    closure_tramp
+
+	.text
+	.globl	end_of_tramps
+end_of_tramps:
+
+
+/*
+ * Function-end breakpoint magic.
+ */
+
+	.text
+	.align	2
+	.set	noreorder
+	.globl	function_end_breakpoint_guts
+function_end_breakpoint_guts:
+	.word	type_ReturnPcHeader
+	beq	zero, zero, 1f
+	nop
+	move	reg_OCFP, reg_CSP
+	addu	reg_CSP, 4
+	li	reg_NARGS, 4
+	move	reg_A1, reg_NIL
+	move	reg_A2, reg_NIL
+	move	reg_A3, reg_NIL
+	move	reg_A4, reg_NIL
+	move	reg_A5, reg_NIL
+1:
+
+	.globl	function_end_breakpoint_trap
+function_end_breakpoint_trap:
+	break	trap_FunctionEndBreakpoint
+	beq	zero, zero, 1b
+	nop
+
+	.globl	function_end_breakpoint_end
+function_end_breakpoint_end:
+	.set	reorder
+
+
+	.text
+	.align	2
+	.globl	call_on_stack
+	.ent	call_on_stack
+call_on_stack:
+	subu	sp, a1, 16
+	jal	a0
+	break	0
+	.end	call_on_stack
+
+	.globl	save_state
+	.ent	save_state
+save_state:
+	subu	sp, 40
+	.frame	sp, 40, ra
+	/* Save all the C regs. */
+	.mask	0xc0ff0000, 0
+	sw	ra, 40(sp)
+	sw	s8, 40-4(sp)
+	sw	s7, 40-8(sp)
+	sw	s6, 40-12(sp)
+	sw	s5, 40-16(sp)
+	sw	s4, 40-20(sp)
+	sw	s3, 40-24(sp)
+	sw	s2, 40-28(sp)
+	sw	s1, 40-32(sp)
+	sw	s0, 40-36(sp)
+
+	/* Should also save the floating point state. */
+
+	move	t0, a0
+	move	a0, sp
+
+	jal	t0
+
+_restore_state:
+
+	lw	ra, 40(sp)
+	lw	s8, 40-4(sp)
+	lw	s7, 40-8(sp)
+	lw	s6, 40-12(sp)
+	lw	s5, 40-16(sp)
+	lw	s4, 40-20(sp)
+	lw	s3, 40-24(sp)
+	lw	s2, 40-28(sp)
+	lw	s1, 40-32(sp)
+	lw	s0, 40-36(sp)
+
+	addu	sp, 40
+	j	ra
+
+	.globl	restore_state
+restore_state:
+	move	sp, a0
+	move	v0, a1
+	j	_restore_state
+	.end	save_state
diff --git a/lisp/mips-lispregs.h b/lisp/mips-lispregs.h
new file mode 100644
index 000000000..cd6d27e09
--- /dev/null
+++ b/lisp/mips-lispregs.h
@@ -0,0 +1,58 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-lispregs.h,v 1.1 1992/07/28 20:16:54 wlott Exp $ */
+
+#ifdef LANGUAGE_ASSEMBLY
+#define REG(num) $num
+#else
+#define REG(num) num
+#endif
+
+#define NREGS	(32)
+
+#define reg_ZERO    REG(0)
+#define reg_NL3     REG(1)
+#define reg_CFUNC   REG(2)
+#define reg_NL4     REG(3)
+#define reg_NL0     REG(4)
+#define reg_NL1     REG(5)
+#define reg_NL2     REG(6)
+#define reg_NARGS   REG(7)
+#define reg_A0      REG(8)
+#define reg_A1      REG(9)
+#define reg_A2      REG(10)
+#define reg_A3      REG(11)
+#define reg_A4      REG(12)
+#define reg_A5      REG(13)
+#define reg_FDEFN   REG(14)
+#define reg_LEXENV  REG(15)
+#define reg_NFP     REG(16)
+#define reg_OCFP    REG(17)
+#define reg_LRA     REG(18)
+#define reg_L0      REG(19)
+#define reg_NIL     REG(20)
+#define reg_BSP     REG(21)
+#define reg_CFP     REG(22)
+#define reg_CSP     REG(23)
+#define reg_L1      REG(24)
+#define reg_ALLOC   REG(25)
+#define reg_NSP     REG(29)
+#define reg_CODE    REG(30)
+#define reg_LIP     REG(31)
+
+#define REGNAMES \
+	"ZERO",		"NL3",		"CFUNC",	"NL4", \
+	"NL0",		"NL1",		"NL2",		"NARGS", \
+	"A0",		"A1",		"A2",		"A3", \
+	"A4",		"A5",		"FDEFN",       	"LEXENV", \
+	"NFP",		"OCFP",		"LRA",		"L0", \
+	"NIL",		"BSP",		"CFP",		"CSP", \
+	"L1",		"ALLOC",	"K0",		"K1", \
+	"GP",		"NSP",		"CODE",		"LIP"
+
+
+#define BOXED_REGISTERS { \
+    reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, reg_FDEFN, reg_LEXENV, \
+    reg_NFP, reg_OCFP, reg_LRA, reg_L0, reg_L1, reg_CODE \
+}
+
+#define SC_REG(sc, n) ((sc)->sc_regs[n])
+#define SC_PC(sc) ((sc)->sc_pc)
diff --git a/lisp/mips-validate.h b/lisp/mips-validate.h
new file mode 100644
index 000000000..749ac5b01
--- /dev/null
+++ b/lisp/mips-validate.h
@@ -0,0 +1,19 @@
+
+#define READ_ONLY_SPACE_START   (0x01000000)
+#define READ_ONLY_SPACE_SIZE    (0x04000000)
+
+#define STATIC_SPACE_START	(0x05000000)
+#define STATIC_SPACE_SIZE	(0x02000000)
+
+#define DYNAMIC_0_SPACE_START	(0x07000000)
+#define DYNAMIC_1_SPACE_START	(0x0b000000)
+#define DYNAMIC_SPACE_SIZE	(0x04000000)
+
+#define CONTROL_STACK_START	(0x50000000)
+#define CONTROL_STACK_SIZE	(0x00100000)
+
+#define BINDING_STACK_START	(0x60000000)
+#define BINDING_STACK_SIZE	(0x00100000)
+
+#define NUMBER_STACK_START	(0x70000000)
+#define NUMBER_STACK_SIZE	(0x00100000)
diff --git a/lisp/monitor.c b/lisp/monitor.c
new file mode 100644
index 000000000..c95de35e4
--- /dev/null
+++ b/lisp/monitor.c
@@ -0,0 +1,480 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.1 1992/07/28 20:15:06 wlott Exp $ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <signal.h>
+
+#include "lisp.h"
+#include "internals.h"
+#include "globals.h"
+#include "vars.h"
+#include "parse.h"
+#include "interrupt.h"
+#include "lispregs.h"
+#include "os.h"
+#include "monitor.h"
+#include "print.h"
+#include "arch.h"
+#include "gc.h"
+#include "search.h"
+#include "purify.h"
+#include "save.h"
+
+extern boolean isatty(int fd);
+
+typedef void cmd(char **ptr);
+
+static cmd call_cmd, dump_cmd, print_cmd, quit, help;
+static cmd flush_cmd, search_cmd, regs_cmd, exit_cmd;
+static cmd gc_cmd, print_context_cmd;
+static cmd backtrace_cmd, purify_cmd, catchers_cmd, save_cmd;
+static cmd grab_sigs_cmd;
+
+static struct cmd {
+    char *cmd, *help;
+    void (*fn)(char **ptr);
+} Cmds[] = {
+    {"help", "Display this info", help},
+    {"?", NULL, help},
+    {"backtrace", "backtrace up to N frames", backtrace_cmd},
+    {"call", "call FUNCTION with ARG1, ARG2, ...", call_cmd},
+    {"catchers", "Print a list of all the active catchers.", catchers_cmd},
+    {"context", "print interrupt context number I.", print_context_cmd},
+    {"dump", "dump memory starting at ADDRESS for COUNT words.", dump_cmd},
+    {"d", NULL, dump_cmd},
+    {"exit", "Exit this instance of the monitor.", exit_cmd},
+    {"flush", "flush all temp variables.", flush_cmd},
+    {"gc", "collect garbage (caveat collector).", gc_cmd},
+    {"grab-signals", "Set the signal handlers to call LDB.", grab_sigs_cmd},
+    {"purify", "purify (caveat purifier).", purify_cmd},
+    {"print", "print object at ADDRESS.", print_cmd},
+    {"p", NULL, print_cmd},
+    {"quit", "quit.", quit},
+    {"regs", "display current lisp regs.", regs_cmd},
+    {"save", "save the current lisp image.", save_cmd},
+    {"search", "search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd},
+    {"s", NULL, search_cmd},
+    {NULL, NULL, NULL}
+};
+
+
+static jmp_buf curbuf;
+
+
+static int visable(unsigned char c)
+{
+    if (c < ' ' || c > '~')
+        return ' ';
+    else
+        return c;
+}
+
+static void dump_cmd(char **ptr)
+{
+    static char *lastaddr = 0;
+    static int lastcount = 20;
+
+    char *addr = lastaddr;
+    int count = lastcount, displacement;
+
+    if (more_p(ptr)) {
+        addr = parse_addr(ptr);
+
+        if (more_p(ptr))
+            count = parse_number(ptr);
+    }
+
+    if (count == 0) {
+        printf("COUNT must be non-zero.\n");
+        return;
+    }
+        
+    lastcount = count;
+
+    if (count > 0)
+        displacement = 4;
+    else {
+        displacement = -4;
+        count = -count;
+    }
+
+    while (count-- > 0) {
+        printf("0x%08X: ", (unsigned long)addr);
+        if (valid_addr((os_vm_address_t)addr)) {
+            unsigned long *lptr = (unsigned long *)addr;
+            unsigned short *sptr = (unsigned short *)addr;
+            unsigned char *cptr = (unsigned char *)addr;
+
+            printf("0x%08x   0x%04x 0x%04x   0x%02x 0x%02x 0x%02x 0x%02x    %c%c%c%c\n", lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), visable(cptr[3]));
+        }
+        else
+            printf("invalid address\n");
+
+        addr += displacement;
+    }
+
+    lastaddr = addr;
+}
+
+static void print_cmd(char **ptr)
+{
+    lispobj obj = parse_lispobj(ptr);
+    
+    print(obj);
+}
+
+static void regs_cmd(char **ptr)
+{
+    printf("CSP\t=\t0x%08X\n", (unsigned long)current_control_stack_pointer);
+    printf("FP\t=\t0x%08X\n", (unsigned long)current_control_frame_pointer);
+#ifndef ibmrt
+    printf("BSP\t=\t0x%08X\n", (unsigned long)current_binding_stack_pointer);
+#endif
+
+    printf("DYNAMIC\t=\t0x%08X\n", (unsigned long)current_dynamic_space);
+#ifdef ibmrt
+    printf("ALLOC\t=\t0x08X\n", SymbolValue(ALLOCATION_POINTER));
+    printf("TRIGGER\t=\t0x08X\n", SymbolValue(INTERNAL_GC_TRIGGER));
+#else
+    printf("ALLOC\t=\t0x%08X\n",
+	   (unsigned long)current_dynamic_space_free_pointer);
+    printf("TRIGGER\t=\t0x%08X\n", (unsigned long)current_auto_gc_trigger);
+#endif
+    printf("STATIC\t=\t0x%08X\n", SymbolValue(STATIC_SPACE_FREE_POINTER));
+    printf("RDONLY\t=\t0x%08X\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+
+#ifdef MIPS
+    printf("FLAGS\t=\t0x%08x\n", current_flags_register);
+#endif
+}
+
+static void search_cmd(char **ptr)
+{
+    static int lastval = 0, lastcount = 0;
+    static lispobj *start = 0, *end = 0;
+    int val, count;
+    lispobj *addr, obj;
+
+    if (more_p(ptr)) {
+        val = parse_number(ptr);
+        if (val < 0 || val > 0xff) {
+            printf("Can only search for single bytes.\n");
+            return;
+        }
+        if (more_p(ptr)) {
+            addr = (lispobj *)PTR((long)parse_addr(ptr));
+            if (more_p(ptr)) {
+                count = parse_number(ptr);
+            }
+            else {
+                /* Speced value and address, but no count. Only one. */
+                count = -1;
+            }
+        }
+        else {
+            /* Speced a value, but no address, so search same range. */
+            addr = start;
+            count = lastcount;
+        }
+    }
+    else {
+        /* Speced nothing, search again for val. */
+        val = lastval;
+        addr = end;
+        count = lastcount;
+    }
+
+    lastval = val;
+    start = end = addr;
+    lastcount = count;
+
+    printf("searching for 0x%x at 0x%08X\n", val, (unsigned long)end);
+
+    while (search_for_type(val, &end, &count)) {
+        printf("found 0x%x at 0x%08X:\n", val, (unsigned long)end);
+        obj = *end;
+        addr = end;
+        end += 2;
+        if (TypeOf(obj) == type_FunctionHeader)
+            print((long)addr | type_FunctionPointer);
+        else if (LowtagOf(obj) == type_OtherImmediate0 || LowtagOf(obj) == type_OtherImmediate1)
+            print((lispobj)addr | type_OtherPointer);
+        else
+            print((lispobj)addr);
+        if (count == -1)
+            return;
+    }
+}
+
+static void call_cmd(char **ptr)
+{
+    lispobj thing = parse_lispobj(ptr), function, result, cons, args[3];
+    int numargs;
+
+    if (LowtagOf(thing) == type_OtherPointer) {
+	switch (TypeOf(*(lispobj *)(thing-type_OtherPointer))) {
+	  case type_SymbolHeader:
+	    for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS);
+		 cons != NIL;
+		 cons = CONS(cons)->cdr) {
+		if (FDEFN(CONS(cons)->car)->name == thing) {
+		    thing = CONS(cons)->car;
+		    goto fdefn;
+		}
+	    }
+	    printf("symbol 0x%08x is undefined.\n", thing);
+	    return;
+
+	  case type_Fdefn:
+	  fdefn:
+	    function = FDEFN(thing)->function;
+	    if (function == NIL) {
+		printf("fdefn 0x%08x is undefined.\n", thing);
+		return;
+	    }
+	    break;
+	  default:
+	    printf(
+	      "0x%08x is not a function pointer, symbol, or fdefn object.\n",
+		   thing);
+	    return;
+	}
+    }
+    else if (LowtagOf(thing) != type_FunctionPointer) {
+        printf("0x%08x is not a function pointer, symbol, or fdefn object.\n",
+	       thing);
+        return;
+    }
+
+    numargs = 0;
+    while (more_p(ptr)) {
+	if (numargs >= 3) {
+	    printf("Too many arguments.  3 at most.\n");
+	    return;
+	}
+	args[numargs++] = parse_lispobj(ptr);
+    }
+
+    switch (numargs) {
+      case 0:
+	result = funcall0(function);
+	break;
+      case 1:
+	result = funcall1(function, args[0]);
+	break;
+      case 2:
+	result = funcall2(function, args[0], args[1]);
+	break;
+      case 3:
+	result = funcall3(function, args[0], args[1], args[2]);
+	break;
+    }
+
+    print(result);
+}
+
+static void flush_cmd(char **ptr)
+{
+    flush_vars();
+}
+
+static void quit(char **ptr)
+{
+    char buf[10];
+
+    printf("Really quit? [y] ");
+    fflush(stdout);
+    fgets(buf, sizeof(buf), stdin);
+    if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
+        exit(0);
+}
+
+static void help(char **ptr)
+{
+    struct cmd *cmd;
+
+    for (cmd = Cmds; cmd->cmd != NULL; cmd++)
+        if (cmd->help != NULL)
+            printf("%s\t%s\n", cmd->cmd, cmd->help);
+}
+
+static int done;
+
+static void exit_cmd(char **ptr)
+{
+    done = TRUE;
+}
+
+static void gc_cmd(char **ptr)
+{
+    collect_garbage();
+}
+
+static void purify_cmd(char **ptr)
+{
+    purify(NIL, NIL);
+}
+
+static void print_context(struct sigcontext *context)
+{
+	int i;
+
+	for (i = 0; i < NREGS; i++) {
+		printf("%s:\t", lisp_register_names[i]);
+		brief_print((lispobj) SC_REG(context, i));
+	}
+	printf("PC:\t\t  0x%08x\n", SC_PC(context));
+}
+
+static void print_context_cmd(char **ptr)
+{
+	int free;
+
+	free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+	
+        if (more_p(ptr)) {
+		int index;
+
+		index = parse_number(ptr);
+
+		if ((index >= 0) && (index < free)) {
+			printf("There are %d interrupt contexts.\n", free);
+			printf("Printing context %d\n", index);
+			print_context(lisp_interrupt_contexts[index]);
+		} else {
+			printf("There aren't that many/few contexts.\n");
+			printf("There are %d interrupt contexts.\n", free);
+		}
+	} else {
+		if (free == 0)
+			printf("There are no interrupt contexts!\n");
+		else {
+			printf("There are %d interrupt contexts.\n", free);
+			printf("Printing context %d\n", free - 1);
+			print_context(lisp_interrupt_contexts[free - 1]);
+		}
+	}
+}
+
+static void backtrace_cmd(char **ptr)
+{
+    void backtrace(int frames);
+    int n;
+
+    if (more_p(ptr))
+	n = parse_number(ptr);
+    else
+	n = 100;
+
+    printf("Backtrace:\n");
+    backtrace(n);
+}
+
+static void catchers_cmd(char **ptr)
+{
+    struct catch_block *catch;
+
+    catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK);
+
+    if (catch == NULL)
+        printf("There are no active catchers!\n");
+    else {
+        while (catch != NULL) {
+            printf("0x%08X:\n\tuwp: 0x%08X\n\tfp: 0x%08X\n\tcode: 0x%08x\n\tentry: 0x%08x\n\ttag: ", (unsigned long)catch, (unsigned long)(catch->current_uwp), (unsigned long)(catch->current_cont), catch->current_code, catch->entry_pc);
+            brief_print((lispobj)catch->tag);
+            catch = catch->previous_catch;
+        }
+    }
+}
+
+static void save_cmd(char **ptr)
+{
+    if (more_p(ptr))
+        save(*ptr);
+    else
+        save("lisp.core");
+}
+
+static void grab_sigs_cmd(char **ptr)
+{
+    extern void sigint_init(void);
+
+    printf("Grabbing signals.\n");
+    sigint_init();
+}
+
+static void sub_monitor(void)
+{
+    struct cmd *cmd, *found;
+    char buf[256];
+    char *line, *ptr, *token;
+    int ambig;
+
+    while (!done) {
+        printf("ldb> ");
+        fflush(stdout);
+        line = gets(buf);
+        if (line == NULL) {
+	    if (isatty(0)) {
+		putchar('\n');
+	        continue;
+	    }
+	    else {
+		fprintf(stderr, "\nEOF on something other than a tty.\n");
+		exit(0);
+	    }
+	}
+        ptr = line;
+        if ((token = parse_token(&ptr)) == NULL)
+            continue;
+        ambig = 0;
+        found = NULL;
+        for (cmd = Cmds; cmd->cmd != NULL; cmd++) {
+            if (strcmp(token, cmd->cmd) == 0) {
+                found = cmd;
+                ambig = 0;
+                break;
+            }
+            else if (strncmp(token, cmd->cmd, strlen(token)) == 0) {
+                if (found)
+                    ambig = 1;
+                else
+                    found = cmd;
+            }
+        }
+        if (ambig)
+            printf("``%s'' is ambiguous.\n", token);
+        else if (found == NULL)
+            printf("unknown command: ``%s''\n", token);
+        else {
+            reset_printer();
+            (*found->fn)(&ptr);
+        }
+    }
+}
+
+void ldb_monitor()
+{
+    jmp_buf oldbuf;
+
+    bcopy(curbuf, oldbuf, sizeof(oldbuf));
+
+    printf("LDB monitor\n");
+
+    setjmp(curbuf);
+
+    sub_monitor();
+
+    done = FALSE;
+
+    bcopy(oldbuf, curbuf, sizeof(curbuf));
+}
+
+void throw_to_monitor()
+{
+    longjmp(curbuf, 1);
+}
diff --git a/lisp/monitor.h b/lisp/monitor.h
new file mode 100644
index 000000000..152e94955
--- /dev/null
+++ b/lisp/monitor.h
@@ -0,0 +1,4 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.h,v 1.1 1992/07/28 20:15:08 wlott Exp $ */
+
+extern void ldb_monitor(void);
+extern void throw_to_monitor(void);
diff --git a/lisp/os-common.c b/lisp/os-common.c
new file mode 100644
index 000000000..2a9377015
--- /dev/null
+++ b/lisp/os-common.c
@@ -0,0 +1,91 @@
+#include <stdio.h>
+
+#include "os.h"
+
+void os_zero(addr, length)
+os_vm_address_t addr;
+os_vm_size_t length;
+{
+    os_vm_address_t block_start;
+    os_vm_size_t block_size;
+
+#ifdef DEBUG
+    fprintf(stderr,";;; os_zero: addr: 0x%08x, len: 0x%08x\n",addr,length);
+#endif
+
+    block_start=os_round_up_to_page(addr);
+
+    length-=block_start-addr;
+    block_size=os_trunc_size_to_page(length);
+
+    if(block_start>addr)
+	bzero((char *)addr,block_start-addr);
+    if(block_size<length)
+	bzero((char *)block_start+block_size,length-block_size);
+    
+    if (block_size != 0) {
+	/* Now deallocate and allocate the block so that it */
+	/* faults in  zero-filled. */
+
+	os_invalidate(block_start,block_size);
+	addr=os_validate(block_start,block_size);
+
+	if(addr==NULL || addr!=block_start)
+	    fprintf(stderr,"os_zero: block moved, 0x%08x ==> 0x%08x!\n",block_start,addr);
+    }
+}
+
+os_vm_address_t os_allocate(len)
+os_vm_size_t len;
+{
+    return os_validate((os_vm_address_t)NULL,len);
+}
+
+os_vm_address_t os_allocate_at(os_vm_address_t addr, os_vm_size_t len)
+{
+    return os_validate(addr, len);
+}
+
+void os_deallocate(addr,len)
+os_vm_address_t addr;
+os_vm_size_t len;
+{
+    os_invalidate(addr,len);
+}
+
+os_vm_address_t os_reallocate(os_vm_address_t addr, os_vm_size_t old_len,
+			      os_vm_size_t len)
+{
+    addr=os_trunc_to_page(addr);
+    len=os_round_up_size_to_page(len);
+    old_len=os_round_up_size_to_page(old_len);
+
+    if(addr==NULL)
+	return os_allocate(len);
+    else{
+	long len_diff=len-old_len;
+
+	if(len_diff<0)
+	    os_invalidate(addr+len,-len_diff);
+	else if(len_diff!=0){
+	    os_vm_address_t new=os_validate(addr+old_len,len_diff);
+
+	    if(new==NULL || new!=addr+old_len){
+		if(new!=NULL)
+		    /* allocated alright, but in the wrong place */
+		    os_invalidate(new,len_diff);
+
+		new=os_allocate(len);
+		
+		if(new!=NULL){
+		    bcopy(addr,new,old_len);
+		    os_invalidate(addr,old_len);
+		}
+		
+		addr=new;
+	    }
+	}
+	
+	return addr;
+    }
+}
diff --git a/lisp/os.h b/lisp/os.h
new file mode 100644
index 000000000..68d5281e4
--- /dev/null
+++ b/lisp/os.h
@@ -0,0 +1,56 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.1 1992/07/28 20:15:12 wlott Exp $
+ *
+ * Common interface for os-dependent functions.
+ *
+ */
+
+#if !defined(_OS_H_INCLUDED_)
+
+#define _OS_H_INCLUDED_
+
+#include "lisp.h"
+
+#ifdef MACH
+#include "mach-os.h"
+#else
+#ifdef sun
+#include "sunos-os.h"
+#endif
+#endif
+
+#define OS_VM_PROT_ALL (OS_VM_PROT_READ|OS_VM_PROT_WRITE|OS_VM_PROT_EXECUTE)
+
+extern os_vm_size_t os_vm_page_size;
+
+extern void os_init(void);
+extern void os_install_interrupt_handlers(void);
+
+extern os_vm_address_t os_allocate(os_vm_size_t len);
+extern os_vm_address_t os_allocate_at(os_vm_address_t addr, os_vm_size_t len);
+extern os_vm_address_t os_reallocate(os_vm_address_t addr,
+				     os_vm_size_t old_len,
+				     os_vm_size_t len);
+extern void os_deallocate(os_vm_address_t addr, os_vm_size_t len);
+extern void os_zero(os_vm_address_t addr, os_vm_size_t length);
+
+extern os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len);
+extern void os_invalidate(os_vm_address_t addr, os_vm_size_t len);
+extern os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr,
+			      os_vm_size_t len);
+extern void os_flush_icache(os_vm_address_t addr, os_vm_size_t len);
+extern void os_protect(os_vm_address_t addr, os_vm_size_t len,
+		       os_vm_prot_t protection);
+extern boolean valid_addr(os_vm_address_t test);
+
+#define os_trunc_to_page(addr) \
+    (os_vm_address_t)(((long)(addr))&~(os_vm_page_size-1))
+#define os_round_up_to_page(addr) \
+    os_trunc_to_page((addr)+(os_vm_page_size-1))
+
+#define os_trunc_size_to_page(size) \
+    (os_vm_size_t)(((long)(size))&~(os_vm_page_size-1))
+#define os_round_up_size_to_page(size) \
+    os_trunc_size_to_page((size)+(os_vm_page_size-1))
+
+#endif
diff --git a/lisp/parse.c b/lisp/parse.c
new file mode 100644
index 000000000..d89ecac5a
--- /dev/null
+++ b/lisp/parse.c
@@ -0,0 +1,361 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.c,v 1.1 1992/07/28 20:15:14 wlott Exp $ */
+#include <stdio.h>
+#include <ctype.h>
+#include <signal.h>
+
+#include "lisp.h"
+#include "internals.h"
+#include "globals.h"
+#include "vars.h"
+#include "parse.h"
+#include "interrupt.h"
+#include "lispregs.h"
+#include "monitor.h"
+#include "arch.h"
+#include "os.h"
+#include "search.h"
+
+#ifndef MACH
+
+static int strcasecmp(s1,s2)
+char *s1,*s2;
+{
+    int c1, c2;
+
+    do{
+	c1=(*s1++);
+	if(isupper(c1))
+	    c1=tolower(c1);
+
+	c2=(*s2++);
+	if(isupper(c2))
+	    c2=tolower(c2);
+    }while(c1==c2 && c1!=0);
+
+    return c1-c2;
+}
+
+#endif
+
+static void skip_ws(char **ptr)
+{
+    while (**ptr <= ' ' && **ptr != '\0')
+        (*ptr)++;
+}
+
+static boolean string_to_long(char *token, long *value)
+{
+    int base, digit;
+    long num;
+    char *ptr;
+
+    if (token == 0)
+        return FALSE;
+
+    if (token[0] == '0')
+        if (token[1] == 'x') {
+            base = 16;
+            token += 2;
+        }
+        else {
+            base = 8;
+            token++;
+        }
+    else if (token[0] == '#') {
+        switch (token[1]) {
+            case 'x':
+            case 'X':
+                base = 16;
+                token += 2;
+                break;            
+            case 'o':
+            case 'O':
+                base = 8;
+                token += 2;
+                break;
+            default:
+                return FALSE;
+        }
+    }
+    else
+        base = 10;
+
+    num = 0;
+    ptr = token;
+    while (*ptr != '\0') {
+        if (*ptr >= 'a' && *ptr <= 'f')
+            digit = *ptr + 10 - 'a';
+        else if (*ptr >= 'A' && *ptr <= 'F')
+            digit = *ptr + 10 - 'A';
+        else if (*ptr >= '0' && *ptr <= '9')
+            digit = *ptr - '0';
+        else
+            return FALSE;
+        if (digit < 0 || digit >= base)
+            return FALSE;
+
+        ptr++;
+        num = num * base + digit;
+    }
+
+    *value = num;
+    return TRUE;
+}
+
+static boolean lookup_variable(char *name, lispobj *result)
+{
+    struct var *var = lookup_by_name(name);
+
+    if (var == NULL)
+        return FALSE;
+    else {
+        *result = var_value(var);
+        return TRUE;
+    }
+}
+
+
+boolean more_p(ptr)
+char **ptr;
+{
+    skip_ws(ptr);
+
+    if (**ptr == '\0')
+        return FALSE;
+    else
+        return TRUE;
+}
+
+char *parse_token(ptr)
+char **ptr;
+{
+    char *token;
+
+    skip_ws(ptr);
+    
+    if (**ptr == '\0')
+        return NULL;
+
+    token = *ptr;
+
+    while (**ptr > ' ')
+        (*ptr)++;
+
+    if (**ptr != '\0') {
+        **ptr = '\0';
+        (*ptr)++;
+    }
+
+    return token;
+}
+
+#if 0
+static boolean number_p(token)
+char *token;
+{
+    char *okay;
+
+    if (token == NULL)
+        return FALSE;
+
+    okay = "abcdefABCDEF987654321d0";
+
+    if (token[0] == '0')
+        if (token[1] == 'x' || token[1] == 'X')
+            token += 2;
+        else {
+            token++;
+            okay += 14;
+        }
+    else if (token[0] == '#') {
+        switch (token[1]) {
+            case 'x':
+            case 'X':
+                break;
+            case 'o':
+            case 'O':
+                okay += 14;
+                break;
+            default:
+                return FALSE;
+        }
+    }
+    else
+        okay += 12;
+
+    while (*token != '\0')
+        if (index(okay, *token++) == NULL)
+            return FALSE;
+    return TRUE;
+}
+#endif
+
+long parse_number(ptr)
+char **ptr;
+{
+    char *token = parse_token(ptr);
+    long result;
+
+    if (token == NULL) {
+        printf("Expected a number.\n");
+        throw_to_monitor();
+    }
+    else if (string_to_long(token, &result))
+        return result;
+    else {
+        printf("Invalid number: ``%s''\n", token);
+        throw_to_monitor();
+    }
+    return 0;
+}
+
+char *parse_addr(ptr)
+char **ptr;
+{
+    char *token = parse_token(ptr);
+    long result;
+
+    if (token == NULL) {
+        printf("Expected an address.\n");
+        throw_to_monitor();
+    }
+    else if (token[0] == '$') {
+        if (!lookup_variable(token+1, (lispobj *)&result)) {
+            printf("Unknown variable: ``%s''\n", token);
+            throw_to_monitor();
+        }
+        result &= ~7;
+    }
+    else {
+        if (!string_to_long(token, &result)) {
+            printf("Invalid number: ``%s''\n", token);
+            throw_to_monitor();
+        }
+        result &= ~3;
+    }
+
+    if (!valid_addr(result)) {
+        printf("Invalid address: 0x%x\n", result);
+        throw_to_monitor();
+    }
+
+    return (char *)result;
+}
+
+static boolean lookup_symbol(char *name, lispobj *result)
+{
+    int count;
+    lispobj *headerptr;
+
+    /* Search static space */
+    headerptr = static_space;
+    count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) -
+	     static_space);
+    if (search_for_symbol(name, &headerptr, &count)) {
+        *result = (lispobj)headerptr | type_OtherPointer;
+        return TRUE;
+    }
+
+    /* Search dynamic space */
+    headerptr = current_dynamic_space;
+#ifndef ibmrt
+    count = current_dynamic_space_free_pointer - current_dynamic_space;
+#else
+    count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - current_dynamic_space;
+#endif
+    if (search_for_symbol(name, &headerptr, &count)) {
+        *result = (lispobj)headerptr | type_OtherPointer;
+        return TRUE;
+    }
+
+    return FALSE;
+}
+
+static int
+parse_regnum(char *s)
+{
+	if ((s[1] == 'R') || (s[1] == 'r')) {
+		int regnum;
+
+		if (s[2] == '\0')
+			return -1;
+
+		/* skip the $R part and call atoi on the number */
+		regnum = atoi(s + 2);
+		if ((regnum >= 0) && (regnum < NREGS))
+			return regnum;
+		else
+			return -1;
+	} else {
+		int i;
+
+		for (i = 0; i < NREGS ; i++)
+			if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
+				return i;
+		
+		return -1;
+	}
+}
+
+lispobj parse_lispobj(ptr)
+char **ptr;
+{
+    char *token = parse_token(ptr);
+    long pointer;
+    lispobj result;
+
+    if (token == NULL) {
+        printf("Expected an object.\n");
+        throw_to_monitor();
+    } else if (token[0] == '$') {
+	if (isalpha(token[1])) {
+		int free;
+		int regnum;
+		struct sigcontext *context;
+
+		free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+
+		if (free == 0) {
+			printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
+			throw_to_monitor();
+		}
+
+		context = lisp_interrupt_contexts[free - 1];
+
+		regnum = parse_regnum(token);
+		if (regnum < 0) {
+			printf("Bogus register: ``%s''\n", token);
+			throw_to_monitor();
+		}
+
+		result = SC_REG(context, regnum);
+	} else if (!lookup_variable(token+1, &result)) {
+            printf("Unknown variable: ``%s''\n", token);
+            throw_to_monitor();
+        }
+    } else if (token[0] == '@') {
+        if (string_to_long(token+1, &pointer)) {
+            pointer &= ~3;
+            if (valid_addr(pointer))
+                result = *(lispobj *)pointer;
+            else {
+                printf("Invalid address: ``%s''\n", token+1);
+                throw_to_monitor();
+            }
+        }
+        else {
+            printf("Invalid address: ``%s''\n", token+1);
+            throw_to_monitor();
+        }
+    }
+    else if (string_to_long(token, (long *)&result))
+        ;
+    else if (lookup_symbol(token, &result))
+        ;
+    else {
+        printf("Invalid lisp object: ``%s''\n", token);
+        throw_to_monitor();
+    }
+
+    return result;
+}
diff --git a/lisp/parse.h b/lisp/parse.h
new file mode 100644
index 000000000..37b218582
--- /dev/null
+++ b/lisp/parse.h
@@ -0,0 +1,9 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.h,v 1.1 1992/07/28 20:15:16 wlott Exp $ */
+
+/* All parse routines take a char ** as their only argument */
+
+extern boolean more_p(char **ptr);
+extern char *parse_token(char **ptr);
+extern lispobj parse_lispobj(char **ptr);
+extern char *parse_addr(char **ptr);
+extern long parse_number(char **ptr);
diff --git a/lisp/print.c b/lisp/print.c
new file mode 100644
index 000000000..ddad031b2
--- /dev/null
+++ b/lisp/print.c
@@ -0,0 +1,570 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.1 1992/07/28 20:15:17 wlott Exp $ */
+#include <stdio.h>
+
+#include "print.h"
+#include "lisp.h"
+#include "internals.h"
+#include "monitor.h"
+#include "vars.h"
+#include "os.h"
+
+static int max_lines = 20, cur_lines = 0;
+static int max_depth = 5, brief_depth = 2, cur_depth = 0;
+static int max_length = 5;
+static boolean dont_decend = FALSE, skip_newline = FALSE;
+static cur_clock = 0;
+
+static void print_obj(char *prefix, lispobj obj);
+
+#define NEWLINE if (continue_p(TRUE)) newline(NULL); else return;
+
+char *lowtag_Names[] = {
+    "even fixnum",
+    "function pointer",
+    "other immediate [0]",
+    "list pointer",
+    "odd fixnum",
+    "structure pointer",
+    "other immediate [1]",
+    "other pointer"
+};
+
+char *subtype_Names[] = {
+    "unused 0",
+    "unused 1",
+    "bignum",
+    "ratio",
+    "single float",
+    "double float",
+    "complex",
+    "simple-array",
+    "simple-string",
+    "simple-bit-vector",
+    "simple-vector",
+    "(simple-array (unsigned-byte 2) (*))",
+    "(simple-array (unsigned-byte 4) (*))",
+    "(simple-array (unsigned-byte 8) (*))",
+    "(simple-array (unsigned-byte 16) (*))",
+    "(simple-array (unsigned-byte 32) (*))",
+    "(simple-array single-float (*))",
+    "(simple-array double-float (*))",
+    "complex-string",
+    "complex-bit-vector",
+    "(array * (*))",
+    "array",
+    "code header",
+    "function header",
+    "closure header",
+    "funcallable-instance header",
+    "unused function header 1",
+    "unused function header 2",
+    "unused function header 3",
+    "closure function header",
+    "return PC header",
+    "value cell header",
+    "symbol header",
+    "character",
+    "SAP",
+    "unbound marker",
+    "weak pointer",
+    "structure header",
+    "fdefn"
+};
+
+static void indent(int in)
+{
+    static char *spaces = "                                                                ";
+
+    while (in > 64) {
+        fputs(spaces, stdout);
+        in -= 64;
+    }
+    if (in != 0)
+        fputs(spaces + 64 - in, stdout);
+}
+
+static boolean continue_p(boolean newline)
+{
+    char buffer[256];
+
+    if (cur_depth >= max_depth || dont_decend)
+        return FALSE;
+
+    if (newline) {
+        if (skip_newline)
+            skip_newline = FALSE;
+        else
+            putchar('\n');
+
+        if (cur_lines >= max_lines) {
+            printf("More? [y] ");
+            fflush(stdout);
+
+            gets(buffer);
+
+            if (buffer[0] == 'n' || buffer[0] == 'N')
+                throw_to_monitor();
+            else
+                cur_lines = 0;
+        }
+    }
+
+    return TRUE;
+}
+
+static void newline(char *label)
+{
+    cur_lines++;
+    if (label != NULL)
+        fputs(label, stdout);
+    putchar('\t');
+    indent(cur_depth * 2);
+}
+
+
+static void brief_fixnum(lispobj obj)
+{
+    printf("%d", ((long)obj)>>2);
+}
+
+static void print_fixnum(lispobj obj)
+{
+    printf(": %d", ((long)obj)>>2);
+}
+
+static void brief_otherimm(lispobj obj)
+{
+    int type, c, idx;
+    char buffer[10];
+
+    type = TypeOf(obj);
+    switch (type) {
+        case type_BaseChar:
+            c = (obj>>8)&0xff;
+            switch (c) {
+                case '\0':
+                    printf("#\\Null");
+                    break;
+                case '\n':
+                    printf("#\\Newline");
+                    break;
+                case '\b':
+                    printf("#\\Backspace");
+                    break;
+                case '\177':
+                    printf("#\\Delete");
+                    break;
+                default:
+                    strcpy(buffer, "#\\");
+                    if (c >= 128) {
+                        strcat(buffer, "m-");
+                        c -= 128;
+                    }
+                    if (c < 32) {
+                        strcat(buffer, "c-");
+                        c += '@';
+                    }
+                    printf("%s%c", buffer, c);
+                    break;
+            }
+            break;
+
+        case type_UnboundMarker:
+            printf("<unbound marker>");
+            break;
+
+        default:
+	    idx = type >> 2;
+	    if (idx < (sizeof(subtype_Names) / sizeof(char *)))
+		    printf("%s", subtype_Names[idx]);
+	    else
+		    printf("unknown type (0x%0x)", type);
+            break;
+    }
+}
+
+static void print_otherimm(lispobj obj)
+{
+    int type, idx;
+
+    type = TypeOf(obj);
+    idx = type >> 2;
+
+    if (idx < (sizeof(subtype_Names) / sizeof(char *)))
+	    printf(", %s", subtype_Names[idx]);
+    else
+	    printf(", unknown type (0x%0x)", type);
+
+    switch (TypeOf(obj)) {
+        case type_BaseChar:
+            printf(": ");
+            brief_otherimm(obj);
+            break;
+
+        case type_Sap:
+        case type_UnboundMarker:
+            break;
+
+        default:
+            printf(": data=%d", (obj>>8)&0xffffff);
+            break;
+    }
+}
+
+static void brief_list(lispobj obj)
+{
+    int space = FALSE;
+    int length = 0;
+
+    if (!valid_addr(obj))
+	    printf("(invalid address)");
+    else if (obj == NIL)
+        printf("NIL");
+    else {
+        putchar('(');
+        while (LowtagOf(obj) == type_ListPointer) {
+            struct cons *cons = (struct cons *)PTR(obj);
+
+            if (space)
+                putchar(' ');
+            if (++length >= max_length) {
+                printf("...");
+                obj = NIL;
+                break;
+            }
+            print_obj(NULL, cons->car);
+            obj = cons->cdr;
+            space = TRUE;
+            if (obj == NIL)
+                break;
+        }
+        if (obj != NIL) {
+            printf(" . ");
+            print_obj(NULL, obj);
+        }
+        putchar(')');
+    }
+}
+
+static void print_list(lispobj obj)
+{
+    if (!valid_addr(obj))
+	    printf("(invalid address)");
+    else if (obj == NIL)
+        printf(" (NIL)");
+    else {
+        struct cons *cons = (struct cons *)PTR(obj);
+
+        print_obj("car: ", cons->car);
+        print_obj("cdr: ", cons->cdr);
+    }
+}
+
+static void brief_struct(lispobj obj)
+{
+    printf("#<ptr to ");
+    print_obj(NULL, ((struct structure *)PTR(obj))->slots[0]);
+    printf(" structure>");
+}
+
+static void print_struct(lispobj obj)
+{
+    struct structure *structure = (struct structure *)PTR(obj);
+    int i;
+    char buffer[16];
+
+    print_obj("type: ", structure->slots[0]);
+    for (i = 1; i < HeaderValue(structure->header); i++) {
+	sprintf(buffer, "slot %d: ", i);
+	print_obj(buffer, structure->slots[i]);
+    }
+}
+
+static void brief_otherptr(lispobj obj)
+{
+    lispobj *ptr, header;
+    int type;
+    struct symbol *symbol;
+    struct vector *vector;
+    char *charptr;
+
+    ptr = (lispobj *) PTR(obj);
+
+    if (!valid_addr(obj)) {
+	    printf("(invalid address)");
+	    return;
+    }
+
+    header = *ptr;
+    type = TypeOf(header);
+    switch (type) {
+        case type_SymbolHeader:
+            symbol = (struct symbol *)ptr;
+            vector = (struct vector *)PTR(symbol->name);
+            for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
+                if (*charptr == '"')
+                    putchar('\\');
+                putchar(*charptr);
+            }
+            break;
+
+        case type_SimpleString:
+            vector = (struct vector *)ptr;
+            putchar('"');
+            for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
+                if (*charptr == '"')
+                    putchar('\\');
+                putchar(*charptr);
+            }
+            putchar('"');
+            break;
+            
+        default:
+            printf("#<ptr to ");
+            brief_otherimm(header);
+            putchar('>');
+    }
+}
+
+static void print_slots(char **slots, int count, lispobj *ptr)
+{
+    while (count-- > 0)
+        if (*slots)
+            print_obj(*slots++, *ptr++);
+        else
+            print_obj("???: ", *ptr++);
+}
+
+static char *symbol_slots[] = {"value: ", "unused: ",
+    "plist: ", "name: ", "package: ", NULL};
+static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
+static char *complex_slots[] = {"real: ", "imag: ", NULL};
+static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
+static char *fn_slots[] = {"self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
+static char *closure_slots[] = {"fn: ", NULL};
+static char *weak_pointer_slots[] = {"value: ", NULL};
+static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
+
+static void print_otherptr(lispobj obj)
+{
+    if (!valid_addr(obj))
+	    printf("(invalid address)");
+    else {
+        unsigned long *ptr; 
+        unsigned long header;
+        unsigned long length;
+        int count, type, index;
+        char *cptr, buffer[16];
+
+	ptr = (unsigned long *) PTR(obj);
+	if (ptr == (unsigned long *) NULL) {
+		printf(" (NULL Pointer)");
+		return;
+	}
+
+	header = *ptr++;
+	length = (*ptr) >> 2;
+	count = header>>8;
+	type = TypeOf(header);
+
+        print_obj("header: ", header);
+        if (LowtagOf(header) != type_OtherImmediate0 && LowtagOf(header) != type_OtherImmediate1) {
+            NEWLINE;
+            printf("(invalid header object)");
+            return;
+        }
+
+        switch (type) {
+            case type_Bignum:
+                ptr += count;
+                NEWLINE;
+                printf("0x");
+                while (count-- > 0)
+                    printf("%08x", *--ptr);
+                break;
+
+            case type_Ratio:
+                print_slots(ratio_slots, count, ptr);
+                break;
+
+            case type_Complex:
+                print_slots(complex_slots, count, ptr);
+                break;
+
+            case type_SymbolHeader:
+                print_slots(symbol_slots, count, ptr);
+                break;
+
+            case type_SingleFloat:
+                NEWLINE;
+                printf("%f", ((struct single_float *)PTR(obj))->value);
+                break;
+
+            case type_DoubleFloat:
+                NEWLINE;
+                printf("%f", ((struct double_float *)PTR(obj))->value);
+                break;
+
+            case type_SimpleString:
+                NEWLINE;
+                cptr = (char *)(ptr+1);
+                putchar('\"');
+                while (length-- > 0)
+                    putchar(*cptr++);
+                putchar('\"');
+                break;
+
+            case type_SimpleVector:
+            case type_StructureHeader:
+                NEWLINE;
+                printf("length = %d", length);
+                ptr++;
+                index = 0;
+                while (length-- > 0) {
+                    sprintf(buffer, "%d: ", index++);
+                    print_obj(buffer, *ptr++);
+                }
+                break;
+
+            case type_SimpleArray:
+            case type_SimpleBitVector:
+            case type_SimpleArrayUnsignedByte2:
+            case type_SimpleArrayUnsignedByte4:
+            case type_SimpleArrayUnsignedByte8:
+            case type_SimpleArrayUnsignedByte16:
+            case type_SimpleArrayUnsignedByte32:
+            case type_SimpleArraySingleFloat:
+            case type_SimpleArrayDoubleFloat:
+            case type_ComplexString:
+            case type_ComplexBitVector:
+            case type_ComplexVector:
+            case type_ComplexArray:
+                break;
+
+            case type_CodeHeader:
+                print_slots(code_slots, count-1, ptr);
+                break;
+
+            case type_FunctionHeader:
+            case type_ClosureFunctionHeader:
+                print_slots(fn_slots, 5, ptr);
+                break;
+
+            case type_ReturnPcHeader:
+                print_obj("code: ", obj - (count * 4));
+                break;
+
+            case type_ClosureHeader:
+                print_slots(closure_slots, count, ptr);
+                break;
+
+            case type_Sap:
+                NEWLINE;
+                printf("0x%08x", *ptr);
+                break;
+
+            case type_WeakPointer:
+		print_slots(weak_pointer_slots, 1, ptr);
+                break;
+
+            case type_BaseChar:
+            case type_UnboundMarker:
+                NEWLINE;
+                printf("pointer to an immediate?");
+                break;
+
+	      case type_Fdefn:
+		print_slots(fdefn_slots, count, ptr);
+		break;
+		
+            default:
+                NEWLINE;
+                printf("Unknown header object?");
+                break;
+        }
+    }
+}
+
+static void print_obj(char *prefix, lispobj obj)
+{
+    static void (*verbose_fns[])(lispobj obj)
+	= {print_fixnum, print_otherptr, print_otherimm, print_list,
+	   print_fixnum, print_struct, print_otherimm, print_otherptr};
+    static void (*brief_fns[])(lispobj obj)
+	= {brief_fixnum, brief_otherptr, brief_otherimm, brief_list,
+	   brief_fixnum, brief_struct, brief_otherimm, brief_otherptr};
+    int type = LowtagOf(obj);
+    struct var *var = lookup_by_obj(obj);
+    char buffer[256];
+    boolean verbose = cur_depth < brief_depth;
+
+    
+    if (!continue_p(verbose))
+        return;
+
+    if (var != NULL && var_clock(var) == cur_clock)
+        dont_decend = TRUE;
+
+    if (var == NULL && (obj & type_FunctionPointer & type_ListPointer & type_StructurePointer & type_OtherPointer) != 0)
+        var = define_var(NULL, obj, FALSE);
+
+    if (var != NULL)
+        var_setclock(var, cur_clock);
+
+    cur_depth++;
+    if (verbose) {
+        if (var != NULL) {
+            sprintf(buffer, "$%s=", var_name(var));
+            newline(buffer);
+        }
+        else
+            newline(NULL);
+        printf("%s0x%08x: ", prefix, obj);
+        if (cur_depth < brief_depth) {
+            fputs(lowtag_Names[type], stdout);
+            (*verbose_fns[type])(obj);
+        }
+        else
+            (*brief_fns[type])(obj);
+    }
+    else {
+        if (dont_decend)
+            printf("$%s", var_name(var));
+        else {
+            if (var != NULL)
+                printf("$%s=", var_name(var));
+            (*brief_fns[type])(obj);
+        }
+    }
+    cur_depth--;
+    dont_decend = FALSE;
+}
+
+void reset_printer()
+{
+    cur_clock++;
+    cur_lines = 0;
+    dont_decend = FALSE;
+}
+
+void print(lispobj obj)
+{
+    skip_newline = TRUE;
+    cur_depth = 0;
+    max_depth = 5;
+    max_lines = 20;
+
+    print_obj("", obj);
+
+    putchar('\n');
+}
+
+void brief_print(lispobj obj)
+{
+    skip_newline = TRUE;
+    max_depth = 1;
+    max_lines = 5000;
+
+    print_obj("", obj);
+    putchar('\n');
+}
diff --git a/lisp/print.h b/lisp/print.h
new file mode 100644
index 000000000..e77adde94
--- /dev/null
+++ b/lisp/print.h
@@ -0,0 +1,14 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.h,v 1.1 1992/07/28 20:15:19 wlott Exp $ */
+
+#ifndef _PRINT_H_
+#define _PRINT_H_
+
+#include "lisp.h"
+
+extern char *lowtag_Names[], *subtype_Names[];
+
+extern void print(lispobj obj);
+extern void brief_print(lispobj obj);
+extern void reset_printer(void);
+
+#endif
diff --git a/lisp/purify.c b/lisp/purify.c
new file mode 100644
index 000000000..a15ac8999
--- /dev/null
+++ b/lisp/purify.c
@@ -0,0 +1,752 @@
+/* Purify. */
+
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.1 1992/07/28 20:15:23 wlott Exp $ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+
+#include "lisp.h"
+#include "os.h"
+#include "internals.h"
+#include "globals.h"
+#include "validate.h"
+#include "interrupt.h"
+#include "purify.h"
+#include "interr.h"
+
+#define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
+			__FILE__, __LINE__)
+
+#if 0
+#define gc_assert(ex) do { \
+	if (!(ex)) gc_abort(); \
+} while (0)
+#else
+#define gc_assert(ex)
+#endif
+
+
+/* These hold the original end of the read_only and static spaces so we can */
+/* tell what are forwarding pointers. */
+
+static lispobj *read_only_end, *static_end;
+
+static lispobj *read_only_free, *static_free;
+static lispobj *pscav(lispobj *addr, int nwords, boolean constant);
+
+#define LATERBLOCKSIZE 1020
+#define LATERMAXCOUNT 10
+
+static struct later {
+    struct later *next;
+    union {
+        lispobj *ptr;
+        int count;
+    } u[LATERBLOCKSIZE];
+} *later_blocks = NULL;
+static int later_count = 0;
+
+#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
+#define NWORDS(x,y) (CEILING((x),(y)) / (y))
+
+#ifdef sparc
+#define RAW_ADDR_OFFSET 0
+#else
+#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
+#endif
+
+static boolean forwarding_pointer_p(lispobj obj)
+{
+    lispobj *ptr;
+
+    ptr = (lispobj *)obj;
+
+    return ((static_end <= ptr && ptr <= static_free) ||
+            (read_only_end <= ptr && ptr <= read_only_free));
+}
+
+static boolean dynamic_pointer_p(lispobj ptr)
+{
+    return ptr >= (lispobj)dynamic_0_space;
+}
+
+static void pscav_later(lispobj *where, int count)
+{
+    struct later *new;
+
+    if (count > LATERMAXCOUNT) {
+        while (count > LATERMAXCOUNT) {
+            pscav_later(where, LATERMAXCOUNT);
+            count -= LATERMAXCOUNT;
+            where += LATERMAXCOUNT;
+        }
+    }
+    else {
+        if (later_blocks == NULL || later_count == LATERBLOCKSIZE ||
+            (later_count == LATERBLOCKSIZE-1 && count > 1)) {
+            new  = (struct later *)malloc(sizeof(struct later));
+            new->next = later_blocks;
+            if (later_blocks && later_count < LATERBLOCKSIZE)
+                later_blocks->u[later_count].ptr = NULL;
+            later_blocks = new;
+            later_count = 0;
+        }
+
+        if (count != 1)
+            later_blocks->u[later_count++].count = count;
+        later_blocks->u[later_count++].ptr = where;
+    }
+}
+
+static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant)
+{
+    int nwords;
+    lispobj result, *new, *old;
+
+    nwords = 1 + HeaderValue(header);
+
+    /* Allocate it */
+    old = (lispobj *)PTR(thing);
+    if (constant) {
+        new = read_only_free;
+        read_only_free += CEILING(nwords, 2);
+    }
+    else {
+        new = static_free;
+        static_free += CEILING(nwords, 2);
+    }
+
+    /* Copy it. */
+    bcopy(old, new, nwords * sizeof(lispobj));
+
+    /* Deposit forwarding pointer. */
+    result = (lispobj)new | LowtagOf(thing);
+    *old = result;
+        
+    /* Scavenge it. */
+    pscav(new, nwords, constant);
+
+    return result;
+}
+
+static lispobj ptrans_fdefn(lispobj thing, lispobj header)
+{
+    int nwords;
+    lispobj result, *new, *old, oldfn;
+    struct fdefn *fdefn;
+
+    nwords = 1 + HeaderValue(header);
+
+    /* Allocate it */
+    old = (lispobj *)PTR(thing);
+    new = static_free;
+    static_free += CEILING(nwords, 2);
+
+    /* Copy it. */
+    bcopy(old, new, nwords * sizeof(lispobj));
+
+    /* Deposit forwarding pointer. */
+    result = (lispobj)new | LowtagOf(thing);
+    *old = result;
+
+    /* Scavenge the function. */
+    fdefn = (struct fdefn *)new;
+    oldfn = fdefn->function;
+    pscav(&fdefn->function, 1, FALSE);
+    if ((char *)oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr)
+        fdefn->raw_addr = (char *)fdefn->function + RAW_ADDR_OFFSET;
+
+    return result;
+}
+
+static lispobj ptrans_unboxed(lispobj thing, lispobj header)
+{
+    int nwords;
+    lispobj result, *new, *old;
+
+    nwords = 1 + HeaderValue(header);
+
+    /* Allocate it */
+    old = (lispobj *)PTR(thing);
+    new = read_only_free;
+    read_only_free += CEILING(nwords, 2);
+
+    /* Copy it. */
+    bcopy(old, new, nwords * sizeof(lispobj));
+
+    /* Deposit forwarding pointer. */
+    result = (lispobj)new | LowtagOf(thing);
+    *old = result;
+
+    return result;
+}
+
+static lispobj ptrans_vector(lispobj thing, int bits, int extra,
+			     boolean boxed, boolean constant)
+{
+    struct vector *vector;
+    int nwords;
+    lispobj result, *new;
+
+    vector = (struct vector *)PTR(thing);
+    nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5);
+
+    if (boxed && !constant) {
+        new = static_free;
+        static_free += CEILING(nwords, 2);
+    }
+    else {
+        new = read_only_free;
+        read_only_free += CEILING(nwords, 2);
+    }
+
+    bcopy(vector, new, nwords * sizeof(lispobj));
+
+    result = (lispobj)new | LowtagOf(thing);
+    vector->header = result;
+
+    if (boxed)
+        pscav(new, nwords, constant);
+
+    return result;
+}
+
+
+static lispobj ptrans_code(lispobj thing)
+{
+    struct code *code, *new;
+    int nwords;
+    lispobj func, result;
+
+    code = (struct code *)PTR(thing);
+    nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
+
+    new = (struct code *)read_only_free;
+    read_only_free += CEILING(nwords, 2);
+
+    bcopy(code, new, nwords * sizeof(lispobj));
+    
+    result = (lispobj)new | type_OtherPointer;
+
+    /* Stick in a forwarding pointer for the code object. */
+    *(lispobj *)code = result;
+
+    /* Put in forwarding pointers for all the functions. */
+    for (func = code->entry_points;
+         func != NIL;
+         func = ((struct function_header *)PTR(func))->next) {
+
+        gc_assert(LowtagOf(func) == type_FunctionPointer);
+
+        *(lispobj *)PTR(func) = result + (func - thing);
+    }
+
+    /* Arrange to scavenge the debug info later. */
+    pscav_later(&new->debug_info, 1);
+
+    /* Scavenge the constants. */
+    pscav(new->constants, HeaderValue(new->header)-5, TRUE);
+
+    /* Scavenge all the functions. */
+    pscav(&new->entry_points, 1, TRUE);
+    for (func = new->entry_points;
+         func != NIL;
+         func = ((struct function_header *)PTR(func))->next) {
+        gc_assert(LowtagOf(func) == type_FunctionPointer);
+        gc_assert(!dynamic_pointer_p(func));
+        pscav(&((struct function_header *)PTR(func))->self, 2, TRUE);
+        pscav_later(&((struct function_header *)PTR(func))->name, 3);
+    }
+
+    return result;
+}
+
+static lispobj ptrans_func(lispobj thing, lispobj header)
+{
+    int nwords;
+    lispobj code, *new, *old, result;
+    struct function_header *function;
+
+    /* THING can either be a function header, a closure function header, */
+    /* a closure, or a funcallable-instance.  If it's a closure or a */
+    /* funcallable-instance, we do the same as ptrans_boxed. */
+    /* Otherwise we have to do something strange, 'cause it is buried inside */
+    /* a code object. */
+
+    if (TypeOf(header) == type_FunctionHeader ||
+        TypeOf(header) == type_ClosureFunctionHeader) {
+
+	/* We can only end up here if the code object has not been */
+        /* scavenged, because if it had been scavenged, forwarding pointers */
+        /* would have been left behind for all the entry points. */
+
+        function = (struct function_header *)PTR(thing);
+        code = (PTR(thing)-(HeaderValue(function->header)*sizeof(lispobj))) |
+            type_OtherPointer;
+
+        /* This will cause the function's header to be replaced with a */
+        /* forwarding pointer. */
+        ptrans_code(code);
+
+        /* So we can just return that. */
+        return function->header;
+    }
+    else {
+	/* It's some kind of closure-like thing. */
+        nwords = 1 + HeaderValue(header);
+        old = (lispobj *)PTR(thing);
+
+	/* Allocate the new one. */
+	if (TypeOf(header) == type_FuncallableInstanceHeader) {
+	    /* FINs *must* not go in read_only space. */
+	    new = static_free;
+	    static_free += CEILING(nwords, 2);
+	}
+	else {
+	    /* Closures can always go in read-only space, 'caues */
+	    /* they never change. */
+	    new = read_only_free;
+	    read_only_free += CEILING(nwords, 2);
+	}
+
+        /* Copy it. */
+        bcopy(old, new, nwords * sizeof(lispobj));
+
+        /* Deposit forwarding pointer. */
+        result = (lispobj)new | LowtagOf(thing);
+        *old = result;
+
+        /* Scavenge it. */
+        pscav(new, nwords, TRUE);
+
+        return result;
+    }
+}
+
+static lispobj ptrans_returnpc(lispobj thing, lispobj header)
+{
+    lispobj code, new;
+
+    /* Find the corresponding code object. */
+    code = thing - HeaderValue(header)*sizeof(lispobj);
+
+    /* Make sure it's been transported. */
+    new = *(lispobj *)PTR(code);
+    if (!forwarding_pointer_p(new))
+        new = ptrans_code(code);
+
+    /* Maintain the offset: */
+    return new + (thing - code);
+}
+
+#define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2)
+
+static lispobj ptrans_list(lispobj thing, boolean constant)
+{
+    struct cons *old, *new, *orig;
+    int length;
+
+    if (constant)
+        orig = (struct cons *)read_only_free;
+    else
+        orig = (struct cons *)static_free;
+    length = 0;
+
+    do {
+        /* Allocate a new cons cell. */
+        old = (struct cons *)PTR(thing);
+        if (constant) {
+            new = (struct cons *)read_only_free;
+            read_only_free += WORDS_PER_CONS;
+        }
+        else {
+            new = (struct cons *)static_free;
+            static_free += WORDS_PER_CONS;
+        }
+
+        /* Copy the cons cell and keep a pointer to the cdr. */
+        new->car = old->car;
+        thing = new->cdr = old->cdr;
+
+        /* Set up the forwarding pointer. */
+        *(lispobj *)old = ((lispobj)new) | type_ListPointer;
+
+        /* And count this cell. */
+        length++;
+    } while (LowtagOf(thing) == type_ListPointer &&
+             dynamic_pointer_p(thing) &&
+             !(forwarding_pointer_p(*(lispobj *)PTR(thing))));
+
+    /* Scavenge the list we just copied. */
+    pscav((lispobj *)orig, length * WORDS_PER_CONS, constant);
+
+    return ((lispobj)orig) | type_ListPointer;
+}
+
+static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
+{
+    switch (TypeOf(header)) {
+      case type_Bignum:
+      case type_SingleFloat:
+      case type_DoubleFloat:
+      case type_Sap:
+        return ptrans_unboxed(thing, header);
+
+      case type_Ratio:
+      case type_Complex:
+      case type_SimpleArray:
+      case type_ComplexString:
+      case type_ComplexVector:
+      case type_ComplexArray:
+        return ptrans_boxed(thing, header, constant);
+
+      case type_ValueCellHeader:
+      case type_WeakPointer:
+        return ptrans_boxed(thing, header, FALSE);
+
+      case type_SymbolHeader:
+        return ptrans_boxed(thing, header, FALSE);
+
+      case type_SimpleString:
+        return ptrans_vector(thing, 8, 1, FALSE, constant);
+
+      case type_SimpleBitVector:
+        return ptrans_vector(thing, 1, 0, FALSE, constant);
+
+      case type_SimpleVector:
+        return ptrans_vector(thing, 32, 0, TRUE, constant);
+
+      case type_SimpleArrayUnsignedByte2:
+        return ptrans_vector(thing, 2, 0, FALSE, constant);
+
+      case type_SimpleArrayUnsignedByte4:
+        return ptrans_vector(thing, 4, 0, FALSE, constant);
+
+      case type_SimpleArrayUnsignedByte8:
+        return ptrans_vector(thing, 8, 0, FALSE, constant);
+
+      case type_SimpleArrayUnsignedByte16:
+        return ptrans_vector(thing, 16, 0, FALSE, constant);
+
+      case type_SimpleArrayUnsignedByte32:
+        return ptrans_vector(thing, 32, 0, FALSE, constant);
+
+      case type_SimpleArraySingleFloat:
+        return ptrans_vector(thing, 32, 0, FALSE, constant);
+
+      case type_SimpleArrayDoubleFloat:
+        return ptrans_vector(thing, 64, 0, FALSE, constant);
+
+      case type_CodeHeader:
+        return ptrans_code(thing);
+
+      case type_ReturnPcHeader:
+        return ptrans_returnpc(thing, header);
+
+      case type_Fdefn:
+	return ptrans_fdefn(thing, header);
+
+      default:
+        /* Should only come across other pointers to the above stuff. */
+        gc_abort();
+	return NIL;
+    }
+}
+
+static int pscav_fdefn(struct fdefn *fdefn)
+{
+    boolean fix_func;
+
+    fix_func = ((char *)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr);
+    pscav(&fdefn->name, 1, TRUE);
+    pscav(&fdefn->function, 1, FALSE);
+    if (fix_func)
+        fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
+    return sizeof(struct fdefn) / sizeof(lispobj);
+}
+
+#ifdef i386
+static int pscav_closure_header(closure)
+     struct closure *closure;
+{
+    lispobj fun = closure->function - RAW_ADDR_OFFSET;
+    int nwords = HeaderValue(closure->header);
+
+    pscav(&fun, 1, TRUE);
+    pscav(closure->info, nwords-1, TRUE);
+    return nwords+1;
+}
+#endif
+
+static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
+{
+    lispobj thing, *thingp, header;
+    int count;
+    struct vector *vector;
+
+    while (nwords > 0) {
+        thing = *addr;
+        if (Pointerp(thing)) {
+            /* It's a pointer.  Is it something we might have to move? */
+            if (dynamic_pointer_p(thing)) {
+                /* Maybe.  Have we already moved it? */
+                thingp = (lispobj *)PTR(thing);
+                header = *thingp;
+                if (Pointerp(header) && forwarding_pointer_p(header))
+                    /* Yep, so just copy the forwarding pointer. */
+                    thing = header;
+                else {
+                    /* Nope, copy the object. */
+                    switch (LowtagOf(thing)) {
+                      case type_FunctionPointer:
+                        thing = ptrans_func(thing, header);
+                        break;
+                    
+                      case type_ListPointer:
+                        thing = ptrans_list(thing, constant);
+                        break;
+                    
+                      case type_StructurePointer:
+                        thing = ptrans_boxed(thing, header, constant);
+                        break;
+                    
+                      case type_OtherPointer:
+                        thing = ptrans_otherptr(thing, header, constant);
+                        break;
+
+                      default:
+                        /* It was a pointer, but not one of them? */
+                        gc_abort();
+                    }
+                }
+                *addr = thing;
+            }
+            count = 1;
+        }
+        else if (thing & 3) {
+            /* It's an other immediate.  Maybe the header for an unboxed */
+            /* object. */
+            switch (TypeOf(thing)) {
+              case type_Bignum:
+              case type_SingleFloat:
+              case type_DoubleFloat:
+              case type_Sap:
+                /* It's an unboxed simple object. */
+                count = HeaderValue(thing)+1;
+                break;
+
+              case type_SimpleVector:
+                if (HeaderValue(thing) == subtype_VectorValidHashing)
+                    *addr = (subtype_VectorMustRehash<<type_Bits) |
+                        type_SimpleVector;
+                count = 1;
+                break;
+
+              case type_SimpleString:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
+                break;
+
+              case type_SimpleBitVector:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2);
+                break;
+
+              case type_SimpleArrayUnsignedByte2:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2);
+                break;
+
+              case type_SimpleArrayUnsignedByte4:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2);
+                break;
+
+              case type_SimpleArrayUnsignedByte8:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
+                break;
+
+              case type_SimpleArrayUnsignedByte16:
+                vector = (struct vector *)addr;
+                count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
+                break;
+
+              case type_SimpleArrayUnsignedByte32:
+                vector = (struct vector *)addr;
+                count = CEILING(fixnum_value(vector->length)+2,2);
+                break;
+
+              case type_SimpleArraySingleFloat:
+                vector = (struct vector *)addr;
+                count = CEILING(fixnum_value(vector->length)+2,2);
+                break;
+
+              case type_SimpleArrayDoubleFloat:
+                vector = (struct vector *)addr;
+                count = fixnum_value(vector->length)*2+2;
+                break;
+
+              case type_CodeHeader:
+                gc_abort(); /* No code headers in static space */
+                break;
+
+              case type_FunctionHeader:
+              case type_ClosureFunctionHeader:
+              case type_ReturnPcHeader:
+                /* We should never hit any of these, 'cause they occure */
+                /* buried in the middle of code objects. */
+                gc_abort();
+
+#ifdef i386
+	      case type_ClosureHeader:
+	      case type_FuncallableInstanceHeader:
+	      case type_ByteCodeFunction:
+	      case type_ByteCodeClosure:
+		count = pscav_closure_header((struct closure *)addr);
+		break;
+#endif
+
+              case type_WeakPointer:
+                /* Weak pointers get preserved during purify, 'cause I don't */
+                /* feel like figuring out how to break them. */
+                pscav(addr+1, 2, constant);
+                count = 4;
+                break;
+
+	      case type_Fdefn:
+		/* We have to handle fdefn objects specially, so we can fix */
+		/* up the raw function address. */
+		count = pscav_fdefn((struct fdefn *)addr);
+		break;
+
+              default:
+                count = 1;
+                break;
+            }
+        }
+        else {
+            /* It's a fixnum. */
+            count = 1;
+        }
+            
+        addr += count;
+        nwords -= count;
+    }
+
+    return addr;
+}
+
+int purify(lispobj static_roots, lispobj read_only_roots)
+{
+    lispobj *clean;
+    int count, i;
+    struct later *laters, *next;
+
+#ifdef PRINTNOISE
+    printf("[Doing purification:");
+    fflush(stdout);
+#endif
+
+    if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) {
+        printf(" Ack! Can't purify interrupt contexts. ");
+        fflush(stdout);
+        return 0;
+    }
+
+    read_only_end = read_only_free =
+        (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
+    static_end = static_free =
+        (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER);
+
+#ifdef PRINTNOISE
+    printf(" roots");
+    fflush(stdout);
+#endif
+    pscav(&static_roots, 1, FALSE);
+    pscav(&read_only_roots, 1, TRUE);
+
+#ifdef PRINTNOISE
+    printf(" handlers");
+    fflush(stdout);
+#endif
+    pscav((lispobj *) interrupt_handlers,
+          sizeof(interrupt_handlers) / sizeof(lispobj),
+          FALSE);
+
+#ifdef PRINTNOISE
+    printf(" stack");
+    fflush(stdout);
+#endif
+    pscav(control_stack, current_control_stack_pointer - control_stack, FALSE);
+
+#ifdef PRINTNOISE
+    printf(" bindings");
+    fflush(stdout);
+#endif
+#ifndef ibmrt
+    pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE);
+#else
+    pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE);
+#endif
+
+#ifdef PRINTNOISE
+    printf(" static");
+    fflush(stdout);
+#endif
+    clean = static_space;
+    do {
+        while (clean != static_free)
+            clean = pscav(clean, static_free - clean, FALSE);
+        laters = later_blocks;
+        count = later_count;
+        later_blocks = NULL;
+        later_count = 0;
+        while (laters != NULL) {
+            for (i = 0; i < count; i++) {
+                if (laters->u[i].count == 0)
+                    ;
+                else if (laters->u[i].count <= LATERMAXCOUNT) {
+                    pscav(laters->u[i+1].ptr, laters->u[i].count, TRUE);
+                    i++;
+                }
+                else
+                    pscav(laters->u[i].ptr, 1, TRUE);
+            }
+            next = laters->next;
+            free(laters);
+            laters = next;
+            count = LATERBLOCKSIZE;
+        }
+    } while (clean != static_free || later_blocks != NULL);
+
+
+#ifdef PRINTNOISE
+    printf(" cleanup");
+    fflush(stdout);
+#endif
+    os_zero((os_vm_address_t) current_dynamic_space,
+            (os_vm_size_t) DYNAMIC_SPACE_SIZE);
+
+    /* Zero stack. */
+    os_zero((os_vm_address_t) current_control_stack_pointer,
+            (os_vm_size_t) (CONTROL_STACK_SIZE -
+                            ((current_control_stack_pointer - control_stack) *
+                             sizeof(lispobj))));
+
+#ifndef ibmrt
+    current_dynamic_space_free_pointer = current_dynamic_space;
+#else
+    SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space);
+#endif
+    SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
+    SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
+
+#ifdef PRINTNOISE
+    printf(" Done.]\n");
+    fflush(stdout);
+#endif
+
+    return 0;
+}
diff --git a/lisp/purify.h b/lisp/purify.h
new file mode 100644
index 000000000..f9433a910
--- /dev/null
+++ b/lisp/purify.h
@@ -0,0 +1,10 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.h,v 1.1 1992/07/28 20:15:25 wlott Exp $
+ */
+
+#if !defined(_PURIFY_H_)
+#define _PURIFY_H_
+
+extern int purify(lispobj static_roots, lispobj read_only_roots);
+
+#endif
diff --git a/lisp/regnames.c b/lisp/regnames.c
new file mode 100644
index 000000000..b88ca363c
--- /dev/null
+++ b/lisp/regnames.c
@@ -0,0 +1,5 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/regnames.c,v 1.1 1992/07/28 20:15:27 wlott Rel $ */
+
+#include "lispregs.h"
+
+char *lisp_register_names[] = { REGNAMES, 0 };
diff --git a/lisp/save.c b/lisp/save.c
new file mode 100644
index 000000000..33748565e
--- /dev/null
+++ b/lisp/save.c
@@ -0,0 +1,229 @@
+
+#include <stdio.h>
+#include <signal.h>
+#include <sys/file.h>
+
+#include "lisp.h"
+#include "os.h"
+#include "internals.h"
+#include "core.h"
+#include "globals.h"
+#include "lispregs.h"
+#include "interrupt.h"
+#include "save.h"
+#include "validate.h"
+
+extern int version;
+
+extern void restore_state(char *stack_ptr, int result);
+extern int save_state(int fn(char *stack_ptr, FILE *file), FILE *file);
+
+static long write_bytes(FILE *file, char *addr, long bytes)
+{
+    long count, here, data;
+
+    fflush(file);
+    here = ftell(file);
+    fseek(file, 0, 2);
+    data = (ftell(file)+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1);
+    fseek(file, data, 0);
+
+    while (bytes > 0) {
+        count = fwrite(addr, 1, bytes, file);
+        if (count > 0) {
+            bytes -= count;
+            addr += count;
+        }
+        else {
+            perror("Error writing to save file");
+            bytes = 0;
+        }
+    }
+    fflush(file);
+    fseek(file, here, 0);
+    return data/CORE_PAGESIZE - 1;
+}
+
+static void output_space(FILE *file, int id, lispobj *addr, lispobj *end)
+{
+    int words, bytes, data;
+    static char *names[] = {NULL, "Dynamic", "Static", "Read-Only"};
+
+    putw(id, file);
+    words = end - addr;
+    putw(words, file);
+
+    bytes = words * sizeof(lispobj);
+
+    printf("Writing %d bytes from the %s space at 0x%08X.\n",
+           bytes, names[id], (unsigned long)addr);
+
+    data = write_bytes(file, (char *)addr, bytes);
+
+    putw(data, file);
+    putw((os_vm_address_t)((long)addr / CORE_PAGESIZE), file);
+    putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, file);
+}
+
+static long write_stack(FILE *file, char *name, char *start, char *end)
+{
+    long len;
+
+    start = (char *)os_trunc_to_page((os_vm_address_t)start);
+    end = (char *)os_round_up_to_page((os_vm_address_t)end);
+
+    len = end-start;
+
+    printf("Writing %d bytes from the %s stack at 0x%08X.\n", len, name,
+	   (unsigned long)start);
+
+    return write_bytes(file, start, len);
+}
+
+static int do_save(char *stack_ptr, FILE *file)
+{
+    struct machine_state ms;
+
+    putw(CORE_MAGIC, file);
+
+    putw(CORE_VERSION, file);
+    putw(3, file);
+    putw(version, file);
+
+    putw(CORE_NDIRECTORY, file);
+    putw((5*3)+2, file);
+
+    output_space(file, READ_ONLY_SPACE_ID, read_only_space,
+		 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+    output_space(file, STATIC_SPACE_ID, static_space,
+		 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
+#ifdef reg_ALLOC
+    output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space,
+		 current_dynamic_space_free_pointer);
+#else
+    output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space,
+		 (lispobj *)SymbolValue(ALLOCATION_POINTER));
+#endif
+
+    putw(CORE_MACHINE_STATE, file);
+    putw(2 + sizeof(ms)/sizeof(long), file);
+
+    ms.csp = current_control_stack_pointer;
+    ms.cfp = current_control_frame_pointer;
+    ms.control_stack_page = write_stack(file, "Control",
+       (char *)control_stack,
+       (char *)current_control_stack_pointer);
+
+#ifdef reg_BSP
+    ms.bsp = current_binding_stack_pointer;
+    ms.binding_stack_page = write_stack(file, "Binding",
+       (char *)binding_stack,
+       (char *)current_binding_stack_pointer);
+#else
+    ms.binding_stack_page = write_stack(file, "Binding",
+       (char *)binding_stack,
+       (char *)SymbolValue(BINDING_STACK_POINTER));
+#endif
+
+    ms.nsp = stack_ptr;
+#ifdef NUMBER_STACK_GROWS_UP
+    ms.number_stack_page = write_stack(file, "Number",
+	(char *)NUMBER_STACK_START,
+	stack_ptr);
+#else
+    ms.number_stack_page = write_stack(file, "Number", stack_ptr,
+       (char *)(NUMBER_STACK_START+NUMBER_STACK_SIZE));
+#endif
+
+    fwrite((void *)&ms, sizeof(ms), 1, file);
+
+    putw(CORE_END, file);
+    fclose(file);
+
+    printf("done.]\n");
+
+    return 1;
+}
+
+int save(char *filename)
+{
+    FILE *file;
+
+    /* Open the file: */
+    unlink(filename);
+    file = fopen(filename, "w");
+    if (file == NULL) {
+        perror(filename);
+        return TRUE;
+    }
+    printf("[Saving current lisp image into %s:\n", filename);
+
+    return save_state(do_save, file);
+}
+
+static os_vm_address_t map_stack(int fd, os_vm_address_t start,
+				 os_vm_address_t end,
+				 long data_page,
+				 char *name)
+{
+    os_vm_size_t len;
+
+    start = os_trunc_to_page(start);
+    len = os_round_up_to_page(end) - start;
+
+    if (len != 0) {
+#ifdef PRINTNOISE
+        printf("Mapping %d bytes onto the %s stack at 0x%08x.\n", len, name, start);
+#endif
+        start=os_map(fd, (1+data_page)*CORE_PAGESIZE, start, len);
+    }
+
+    return start;
+}
+
+static char *restored_nsp;
+
+void load(int fd, struct machine_state *ms)
+{
+    current_control_stack_pointer = ms->csp;
+    current_control_frame_pointer = ms->cfp;
+#ifdef reg_BSP
+    current_binding_stack_pointer = ms->bsp;
+#endif
+
+    map_stack(fd,
+              (os_vm_address_t)control_stack,
+              (os_vm_address_t)current_control_stack_pointer,
+              ms->control_stack_page,
+              "Control");
+
+    map_stack(fd,
+              (os_vm_address_t)binding_stack,
+#ifdef reg_BSP
+              (os_vm_address_t)current_binding_stack_pointer,
+#else
+	      (os_vm_address_t)SymbolValue(BINDING_STACK_POINTER),
+#endif
+              ms->binding_stack_page,
+              "Binding");
+
+    map_stack(fd,
+#ifdef NUMBER_STACK_GROWS_UP
+		NUMBER_STACK_START,
+		(os_vm_address_t)ms->nsp,
+#else
+		(os_vm_address_t)ms->nsp,
+		NUMBER_STACK_START+NUMBER_STACK_SIZE,
+#endif
+		ms->number_stack_page,
+		"Number");
+
+    restored_nsp = ms->nsp;
+}
+
+void restore(void)
+{
+    restore_state(restored_nsp, 0);
+
+    fprintf(stderr, "Hm, tried to restore, but nothing happened.\n");
+}
diff --git a/lisp/save.h b/lisp/save.h
new file mode 100644
index 000000000..f197387b1
--- /dev/null
+++ b/lisp/save.h
@@ -0,0 +1,14 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.h,v 1.1 1992/07/28 20:15:30 wlott Exp $
+ */
+
+#ifndef _SAVE_H_
+#define _SAVE_H_
+
+#include "core.h"
+
+extern void restore(void);
+extern boolean save(char *filename);
+extern void load(int fd, struct machine_state *ms);
+
+#endif
diff --git a/lisp/search.c b/lisp/search.c
new file mode 100644
index 000000000..1f879957e
--- /dev/null
+++ b/lisp/search.c
@@ -0,0 +1,44 @@
+
+#include "lisp.h"
+#include "internals.h"
+#include "os.h"
+#include "search.h"
+
+boolean search_for_type(int type, lispobj **start, int *count)
+{
+    lispobj obj, *addr;
+
+    while ((*count == -1 || (*count > 0)) &&
+	   valid_addr((os_vm_address_t)*start)) {
+        obj = **start;
+        addr = *start;
+        if (*count != -1)
+            *count -= 2;
+
+        if (TypeOf(obj) == type)
+            return TRUE;
+
+        (*start) += 2;
+    }
+    return FALSE;
+}
+
+
+boolean search_for_symbol(char *name, lispobj **start, int *count)
+{
+    struct symbol *symbol;
+    struct vector *symbol_name;
+
+    while (search_for_type(type_SymbolHeader, start, count)) {
+        symbol = (struct symbol *)PTR((lispobj)*start);
+	if (LowtagOf(symbol->name) == type_OtherPointer) {
+            symbol_name = (struct vector *)PTR(symbol->name);
+            if (valid_addr((os_vm_address_t)symbol_name) &&
+		TypeOf(symbol_name->header) == type_SimpleString &&
+		strcmp((char *)symbol_name->data, name) == 0)
+                return TRUE;
+	}
+        (*start) += 2;
+    }
+    return FALSE;
+}
diff --git a/lisp/search.h b/lisp/search.h
new file mode 100644
index 000000000..0b51b09f0
--- /dev/null
+++ b/lisp/search.h
@@ -0,0 +1,11 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/search.h,v 1.1 1992/07/28 20:15:32 wlott Exp $
+ */
+
+#ifndef _SEARCH_H_
+#define _SEARCH_H_
+
+extern boolean search_for_type(int type, lispobj **start, int *count);
+extern boolean search_for_symbol(char *name, lispobj **start, int *count);
+
+#endif
diff --git a/lisp/socket.c b/lisp/socket.c
new file mode 100644
index 000000000..f8c843ebc
--- /dev/null
+++ b/lisp/socket.c
@@ -0,0 +1,144 @@
+/* Copyright    Massachusetts Institute of Technology    1988	*/
+/*
+ * THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived
+ * systems.  VMS and System V should plan to have their own version.
+ *
+ * This code was cribbed from lib/X/XConnDis.c.
+ * Compile using   
+ *                    % cc -c socket.c -DUNIXCONN
+ */
+
+#include <stdio.h>
+#include <X11/Xos.h>
+#include <X11/Xproto.h>
+#include <errno.h>
+#include <netinet/in.h>
+#include <sys/ioctl.h>
+#include <netdb.h> 
+#include <sys/socket.h>
+#ifndef hpux
+#include <netinet/tcp.h>
+#endif
+
+extern int errno;		/* Certain (broken) OS's don't have this */
+				/* decl in errno.h */
+
+#ifdef UNIXCONN
+#include <sys/un.h>
+#ifndef X_UNIX_PATH
+#ifdef hpux
+#define X_UNIX_PATH "/usr/spool/sockets/X11/"
+#define OLD_UNIX_PATH "/tmp/.X11-unix/X"
+#else /* hpux */
+#define X_UNIX_PATH "/tmp/.X11-unix/X"
+#endif /* hpux */
+#endif /* X_UNIX_PATH */
+#endif /* UNIXCONN */
+void bcopy();
+
+/* 
+ * Attempts to connect to server, given host and display. Returns file 
+ * descriptor (network socket) or 0 if connection fails.
+ */
+
+int connect_to_server (host, display)
+     char *host;
+     int display;
+{
+  struct sockaddr_in inaddr;	/* INET socket address. */
+  struct sockaddr *addr;		/* address to connect to */
+  struct hostent *host_ptr;
+  int addrlen;			/* length of address */
+#ifdef UNIXCONN
+  struct sockaddr_un unaddr;	/* UNIX socket address. */
+#endif
+  extern char *getenv();
+  extern struct hostent *gethostbyname();
+  int fd;				/* Network socket */
+  {
+#ifdef UNIXCONN
+    if ((host[0] == '\0') || (strcmp("unix", host) == 0)) {
+	/* Connect locally using Unix domain. */
+	unaddr.sun_family = AF_UNIX;
+	(void) strcpy(unaddr.sun_path, X_UNIX_PATH);
+	sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display);
+	addr = (struct sockaddr *) &unaddr;
+	addrlen = strlen(unaddr.sun_path) + 2;
+	/*
+	 * Open the network connection.
+	 */
+	if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) {
+#ifdef hpux /* this is disgusting */  /* cribbed from X11R4 xlib source */
+  	    if (errno == ENOENT) {  /* No such file or directory */
+	      sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display);
+              addrlen = strlen(unaddr.sun_path) + 2;
+              if ((fd = socket ((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
+                return(-1);     /* errno set by most recent system call. */
+	    } else 
+#endif /* hpux */
+	    return(-1);	    /* errno set by system call. */
+        }
+    } else 
+#endif /* UNIXCONN */
+    {
+      /* Get the statistics on the specified host. */
+      if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) 
+	{
+	  if ((host_ptr = gethostbyname(host)) == NULL) 
+	    {
+	      /* No such host! */
+	      errno = EINVAL;
+	      return(-1);
+	    }
+	  /* Check the address type for an internet host. */
+	  if (host_ptr->h_addrtype != AF_INET) 
+	    {
+	      /* Not an Internet host! */
+	      errno = EPROTOTYPE;
+	      return(-1);
+	    }
+	  /* Set up the socket data. */
+	  inaddr.sin_family = host_ptr->h_addrtype;
+	  bcopy((char *)host_ptr->h_addr, 
+		(char *)&inaddr.sin_addr, 
+		sizeof(inaddr.sin_addr));
+	} 
+      else 
+	{
+	  inaddr.sin_family = AF_INET;
+	}
+      addr = (struct sockaddr *) &inaddr;
+      addrlen = sizeof (struct sockaddr_in);
+      inaddr.sin_port = display + X_TCP_PORT;
+      inaddr.sin_port = htons(inaddr.sin_port);
+      /*
+       * Open the network connection.
+       */
+      if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){
+	return(-1);	    /* errno set by system call. */}
+      /* make sure to turn off TCP coalescence */
+#ifdef TCP_NODELAY
+      {
+	int mi = 1;
+	setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
+      }
+#endif
+    }
+
+    /*
+     * Changed 9/89 to retry connection if system call was interrupted.  This
+     * is necessary for multiprocessing implementations that use timers,
+     * since the timer results in a SIGALRM.	-- jdi
+     */
+    while (connect(fd, addr, addrlen) == -1) {
+	if (errno != EINTR) {
+  	    (void) close (fd);
+  	    return(-1); 	    /* errno set by system call. */
+	}
+      }
+  }
+  /*
+   * Return the id if the connection succeeded.
+   */
+  return(fd);
+}
diff --git a/lisp/validate.c b/lisp/validate.c
new file mode 100644
index 000000000..89ed7c2b1
--- /dev/null
+++ b/lisp/validate.c
@@ -0,0 +1,63 @@
+/*
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.1 1992/07/28 20:15:36 wlott Exp $
+ *
+ * Memory Validation
+ */
+
+#include <stdio.h>
+#include "lisp.h"
+#include "os.h"
+#include "globals.h"
+#include "validate.h"
+
+static void ensure_space(lispobj *start, unsigned long size)
+{
+    if(os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL){
+	fprintf(stderr,
+		"ensure_space: Failed to validate %ld bytes at 0x%08X\n",
+		size,
+		(unsigned long)start);
+	exit(1);
+    }
+}
+
+void validate(void)
+{
+#ifdef PRINTNOISE
+	printf("Validating memory ...");
+	fflush(stdout);
+#endif
+
+	/* Read-Only Space */
+	read_only_space = (lispobj *) READ_ONLY_SPACE_START;
+	ensure_space(read_only_space, READ_ONLY_SPACE_SIZE);
+
+	/* Static Space */
+	static_space = (lispobj *) STATIC_SPACE_START;
+	ensure_space(static_space, STATIC_SPACE_SIZE);
+
+	/* Dynamic-0 Space */
+	dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START;
+	ensure_space(dynamic_0_space, DYNAMIC_SPACE_SIZE);
+
+	current_dynamic_space = dynamic_0_space;
+
+	/* Dynamic-1 Space */
+	dynamic_1_space = (lispobj *) DYNAMIC_1_SPACE_START;
+	ensure_space(dynamic_1_space, DYNAMIC_SPACE_SIZE);
+
+	/* Control Stack */
+	control_stack = (lispobj *) CONTROL_STACK_START;
+	ensure_space(control_stack, CONTROL_STACK_SIZE);
+
+	/* Binding Stack */
+	binding_stack = (lispobj *) BINDING_STACK_START;
+	ensure_space(binding_stack, BINDING_STACK_SIZE);
+
+	/* Number stack */
+	ensure_space((lispobj *)NUMBER_STACK_START, NUMBER_STACK_SIZE);
+
+#ifdef PRINTNOISE
+	printf(" done.\n");
+#endif
+}
diff --git a/lisp/validate.h b/lisp/validate.h
new file mode 100644
index 000000000..b01d8f59e
--- /dev/null
+++ b/lisp/validate.h
@@ -0,0 +1,28 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.h,v 1.1 1992/07/28 20:15:37 wlott Exp $ */
+
+#if !defined(_INCLUDE_VALIDATE_H_)
+#define _INCLUDE_VALIDATE_H_
+
+#ifdef parisc
+#include "hppa-validate.h"
+#endif parisc
+
+#ifdef mips
+#include "mips-validate.h"
+#endif
+
+#ifdef ibmrt
+#include "rt-validate.h"
+#endif
+
+#ifdef sparc
+#include "sparc-validate.h"
+#endif
+
+#ifdef i386
+#include "x86-validate.h"
+#endif
+
+extern void validate(void);
+
+#endif
diff --git a/lisp/vars.c b/lisp/vars.c
new file mode 100644
index 000000000..09aacbd76
--- /dev/null
+++ b/lisp/vars.c
@@ -0,0 +1,173 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.c,v 1.1 1992/07/28 20:15:38 wlott Exp $ */
+#include <stdio.h>
+#include <sys/types.h>
+#include <stdlib.h>
+
+#include "lisp.h"
+#include "vars.h"
+
+#define NAME_BUCKETS 31
+#define OBJ_BUCKETS 31
+
+static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
+static int tempcntr = 1;
+
+struct var {
+    lispobj obj;
+    lispobj (*update_fn)(struct var *var);
+    char *name;
+    long clock;
+    boolean map_back, permanent;
+
+    struct var *nnext; /* Next in name list */
+    struct var *onext; /* Next in object list */
+};
+
+static int hash_name(char *name)
+{
+    unsigned long value = 0;
+
+    while (*name != '\0') {
+        value = (value << 1) ^ *(unsigned char *)(name++);
+        value = (value & (1-(1<<24))) ^ (value >> 24);
+    }
+
+    return value % NAME_BUCKETS;
+}
+
+static int hash_obj(lispobj obj)
+{
+    return (unsigned long)obj % OBJ_BUCKETS;
+}
+
+
+void flush_vars()
+{
+    int index;
+    struct var *var, *next, *perm = NULL;
+
+    /* Note: all vars in the object hash table also appear in the name hash table, so if we free everything in the name hash table, we free everything in the object hash table. */
+
+    for (index = 0; index < NAME_BUCKETS; index++)
+        for (var = NameHash[index]; var != NULL; var = next) {
+            next = var->nnext;
+            if (var->permanent) {
+                var->nnext = perm;
+                perm = var;
+            }
+            else {
+                free(var->name);
+                free(var);
+            }
+        }
+    bzero(NameHash, sizeof(NameHash));
+    bzero(ObjHash, sizeof(ObjHash));
+    tempcntr = 1;
+
+    for (var = perm; var != NULL; var = next) {
+        next = var->nnext;
+        index = hash_name(var->name);
+        var->nnext = NameHash[index];
+        NameHash[index] = var;
+        if (var->map_back) {
+            index = hash_obj(var->obj);
+            var->onext = ObjHash[index];
+            ObjHash[index] = var;
+        }
+    }
+}
+
+struct var *lookup_by_name(name)
+char *name;
+{
+    struct var *var;
+
+    for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
+        if (strcmp(var->name, name) == 0)
+            return var;
+    return NULL;
+}
+
+struct var *lookup_by_obj(obj)
+lispobj obj;
+{
+    struct var *var;
+
+    for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
+        if (var->obj == obj)
+            return var;
+    return NULL;
+}
+
+static struct var *make_var(char *name, boolean perm)
+{
+    struct var *var = (struct var *)malloc(sizeof(struct var));
+    char buffer[256];
+    int index;
+
+    if (name == NULL) {
+        sprintf(buffer, "%d", tempcntr++);
+        name = buffer;
+    }
+    var->name = (char *)malloc(strlen(name)+1);
+    strcpy(var->name, name);
+    var->clock = 0;
+    var->permanent = perm;
+    var->map_back = FALSE;
+    
+    index = hash_name(name);
+    var->nnext = NameHash[index];
+    NameHash[index] = var;
+
+    return var;
+}    
+
+struct var *define_var(char *name, lispobj obj, boolean perm)
+{
+    struct var *var = make_var(name, perm);
+    int index;
+
+    var->obj = obj;
+    var->update_fn = NULL;
+
+    if (lookup_by_obj(obj) == NULL) {
+        var->map_back = TRUE;
+        index = hash_obj(obj);
+        var->onext = ObjHash[index];
+        ObjHash[index] = var;
+    }
+
+    return var;
+}
+
+struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *),
+			       boolean perm)
+{
+    struct var *var = make_var(name, perm);
+
+    var->update_fn = updatefn;
+
+    return var;
+}
+
+char *var_name(struct var *var)
+{
+    return var->name;
+}
+
+lispobj var_value(struct var *var)
+{
+    if (var->update_fn != NULL)
+        var->obj = (*var->update_fn)(var);
+    return var->obj;
+}
+
+long var_clock(struct var *var)
+{
+    return var->clock;
+}
+
+void var_setclock(struct var *var, long val)
+{
+    var->clock = val;
+}
diff --git a/lisp/vars.h b/lisp/vars.h
new file mode 100644
index 000000000..196f7f7be
--- /dev/null
+++ b/lisp/vars.h
@@ -0,0 +1,15 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.h,v 1.1 1992/07/28 20:15:39 wlott Exp $ */
+
+
+extern void flush_vars(void);
+extern struct var *lookup_by_name(char *name);
+extern struct var *lookup_by_obj(lispobj obj);
+extern struct var *define_var(char *name, lispobj obj, boolean perm);
+extern struct var *define_dynamic_var(char *name,
+				      lispobj update_fn(struct var *var),
+				      boolean perm);
+
+extern char *var_name(struct var *var);
+extern lispobj var_value(struct var *var);
+extern long var_clock(struct var *var);
+extern void var_setclock(struct var *var, long value);
diff --git a/lisp/version.c b/lisp/version.c
new file mode 100644
index 000000000..e0f531bac
--- /dev/null
+++ b/lisp/version.c
@@ -0,0 +1,2 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/version.c,v 1.1 1992/07/28 20:15:40 wlott Rel $ */
+int version = VERSION;
-- 
GitLab