diff --git a/lisp/hppa-arch.c b/lisp/hppa-arch.c
new file mode 100644
index 0000000000000000000000000000000000000000..b86b5c3b54baa6558cbdad8cbdbcb6a4d7190506
--- /dev/null
+++ b/lisp/hppa-arch.c
@@ -0,0 +1,251 @@
+#include <stdio.h>
+#include <mach.h>
+#include <machine/trap.h>
+
+#include "lisp.h"
+#include "globals.h"
+#include "validate.h"
+#include "os.h"
+#include "arch.h"
+#include "lispregs.h"
+#include "signal.h"
+#include "internals.h"
+#include "breakpoint.h"
+
+char *arch_init(void)
+{
+    return NULL;
+}
+
+os_vm_address_t arch_get_bad_addr(struct sigcontext *scp)
+{
+    struct hp800_thread_state *state;
+    os_vm_address_t addr;
+
+    state = (struct hp800_thread_state *)(scp->sc_ap);
+
+    if (state == NULL)
+	return NULL;
+
+    /* Check the instruction address first. */
+    addr = scp->sc_pcoqh & ~3;
+    if (addr < 0x1000)
+	return addr;
+
+    /* Otherwise, it must have been a data fault. */
+    return state->cr21;
+}
+
+unsigned char *arch_internal_error_arguments(struct sigcontext *scp)
+{
+    return (unsigned char *)((scp->sc_pcoqh&~0x3)+4);
+}
+
+boolean arch_pseudo_atomic_atomic(struct sigcontext *scp)
+{
+    /* Pseudo-atomic-atomic is implemented by oring 0x4 into ALLOC. */
+
+    if (SC_REG(scp, reg_ALLOC) & 0x4)
+	return TRUE;
+    else
+	return FALSE;
+}
+
+void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
+{
+    /* Pseudo-atomic-atomic is implemented by oring 0x1 into ALLOC. */
+
+    SC_REG(scp, reg_ALLOC) |= 1;
+}
+
+void arch_skip_instruction(struct sigcontext *scp)
+{
+    /* Skip the offending instruction */
+    scp->sc_pcoqh = scp->sc_pcoqt;
+    scp->sc_pcoqt += 4;
+}
+
+unsigned long arch_install_breakpoint(void *pc)
+{
+    unsigned long *ulpc = (unsigned long *)pc;
+    unsigned long orig_inst = *ulpc;
+
+    *ulpc = trap_Breakpoint;
+    return orig_inst;
+}
+
+void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
+{
+    unsigned long *ulpc = (unsigned long *)pc;
+
+    *ulpc = orig_inst;
+}
+
+void arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst)
+{
+    /* We set the recovery counter to cover one instruction, put the */
+    /* original instruction back in, and then resume.  We will then trap */
+    /* after executing that one instruction, at which time we can put */
+    /* the breakpoint back in. */
+
+    ((struct hp800_thread_state *)scp->sc_ap)->cr0 = 1;
+    scp->sc_ps |= 0x10;
+    *(unsigned long *)SC_PC(scp) = orig_inst;
+
+    undo_fake_foreign_function_call(scp);
+
+    sigreturn(scp);
+}
+
+static void sigtrap_handler(int signal, int code, struct sigcontext *scp)
+{
+    unsigned long bad_inst;
+
+    sigsetmask(scp->sc_mask);
+
+    printf("sigtrap_handler, pc=0x%08x\n", scp->sc_pcoqh);
+
+    bad_inst = *(unsigned long *)(scp->sc_pcoqh & ~3);
+
+    if (bad_inst & 0xfc001fe0)
+	interrupt_handle_now(signal, code, scp);
+    else {
+	int im5 = bad_inst & 0x1f;
+
+	switch (im5) {
+	  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, im5==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);
+	    {
+		void *pc;
+		pc = handle_function_end_breakpoint(signal, code, scp);
+		scp->sc_pcoqh = (unsigned long)pc;
+		scp->sc_pcoqt = (unsigned long)pc + 4;
+	    }
+	    undo_fake_foreign_function_call(scp);
+	    break;
+
+	  default:
+	    interrupt_handle_now(signal, code, scp);
+	    break;
+	}
+    }
+}
+
+static void sigfpe_handler(int signal, int code, struct sigcontext *scp)
+{
+    if (code == I_OVFLO) {
+	unsigned long badinst = *(unsigned long *)(SC_PC(scp)&~3);
+	int opcode = badinst >> 26;
+	int r1, r2, t;
+	long op1, op2, res;
+
+	if (opcode == 2) {
+	    /* reg/reg inst. */
+	    r1 = (badinst >> 16) & 0x1f;
+	    op1 = fixnum_value(SC_REG(scp, r1));
+	    r2 = (badinst >> 21) & 0x1f;
+	    op2 = fixnum_value(SC_REG(scp, r2));
+	    t = badinst & 0x1f;
+
+	    switch ((badinst >> 5) & 0x7f) {
+	      case 0x70:
+		/* Add and trap on overflow. */
+		res = op1 + op2;
+		break;
+
+	      case 0x60:
+		/* Subtract and trap on overflow. */
+		res = op1 - op2;
+		break;
+
+	      default:
+		goto not_interesting;
+	    }
+	}
+	else if ((opcode & 0x37) == 0x25 && (badinst & (1<<11))) {
+	    /* Add or subtract immediate. */
+	    op1 = ((badinst >> 3) & 0xff) | ((-badinst&1)<<8);
+	    r2 = (badinst >> 16) & 0x1f;
+	    op2 = fixnum_value(SC_REG(scp, r1));
+	    t = (badinst >> 21) & 0x1f;
+	    if (opcode == 0x2d)
+		res = op1 + op2;
+	    else
+		res = op1 - op2;
+	}
+	else
+	    goto not_interesting;
+
+        current_dynamic_space_free_pointer = (lispobj *)SC_REG(scp, reg_ALLOC);
+	SC_REG(scp, t) = alloc_number(res);
+	SC_REG(scp, reg_ALLOC)
+	    = (unsigned long)current_dynamic_space_free_pointer;
+	arch_skip_instruction(scp);
+    }
+    else
+      not_interesting:
+	interrupt_handle_now(signal, code, scp);
+}
+
+void arch_install_interrupt_handlers(void)
+{
+    interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
+    interrupt_install_low_level_handler(SIGFPE,sigfpe_handler);
+}
+
+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);
+}
diff --git a/lisp/hppa-assem.S b/lisp/hppa-assem.S
new file mode 100644
index 0000000000000000000000000000000000000000..118379a2b2d0ff51df0af9f9d3ec75be8c8a12c0
--- /dev/null
+++ b/lisp/hppa-assem.S
@@ -0,0 +1,293 @@
+#define LANGUAGE_ASSEMBLY
+
+#include <machine/asm.h>
+
+#include "internals.h"
+#include "lispregs.h"
+
+	.import $global$,data
+	.import foreign_function_call_active,data
+	.import current_control_stack_pointer,data
+	.import current_control_frame_pointer,data
+	.import current_binding_stack_pointer,data
+	.import current_dynamic_space_free_pointer,data
+
+	.space	$TEXT$
+	.subspa	$CODE$
+
+
+/*
+ * Call-into-lisp
+ */
+
+	.export call_into_lisp
+call_into_lisp
+	.proc
+	.callinfo entry_gr=18,save_rp
+	.enter
+	/* arg0=function, arg1=cfp, arg2=nargs */
+
+	/* Clear the descriptor regs, moving in args as approporate. */
+	copy	r0,reg_CODE
+	copy	r0,reg_FDEFN
+	copy	arg0,reg_LEXENV
+	zdep	arg2,29,30,reg_NARGS
+	copy	r0,reg_OCFP
+	copy	r0,reg_LRA
+	copy	r0,reg_A0
+	copy	r0,reg_A1
+	copy	r0,reg_A2
+	copy	r0,reg_A3
+	copy	r0,reg_A4
+	copy	r0,reg_A5
+	copy	r0,reg_L0
+	copy	r0,reg_L1
+	copy	r0,reg_L2
+
+	/* Establish NIL. */
+	ldil	L%NIL,reg_NULL
+	ldo	R%NIL(reg_NULL),reg_NULL
+
+	/* Turn on pseudo-atomic. */
+	ldo	4(r0),reg_ALLOC
+
+	/* No longer in foreign function call land. */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	r0,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Load lisp state. */
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	ldw	R%current_dynamic_space_free_pointer-$global$(0,r1),r1
+	add	reg_ALLOC,r1,reg_ALLOC
+	addil	L%current_binding_stack_pointer-$global$,dp
+	ldw	R%current_binding_stack_pointer-$global$(0,r1),reg_BSP
+	addil	L%current_control_stack_pointer-$global$,dp
+	ldw	R%current_control_stack_pointer-$global$(0,r1),reg_CSP
+	addil	L%current_control_frame_pointer-$global$,dp
+	ldw	R%current_control_frame_pointer-$global$(0,r1),reg_OCFP
+	copy	arg1,reg_CFP
+
+	/* End of pseudo-atomic. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Establish lisp arguments. */
+	ldw	0(reg_CFP),reg_A0
+	ldw	4(reg_CFP),reg_A1
+	ldw	8(reg_CFP),reg_A2
+	ldw	12(reg_CFP),reg_A3
+	ldw	16(reg_CFP),reg_A4
+	ldw	20(reg_CFP),reg_A5
+
+	/* Calculate the LRA. */
+	ldil	L%lra+type_OtherPointer,reg_LRA
+	ldo	R%lra+type_OtherPointer(reg_LRA),reg_LRA
+
+	/* Indirect the closure */
+	ldw	CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_CODE
+	addi	6*4-type_FunctionPointer,reg_CODE,reg_LIP
+
+	/* And into lisp we go. */
+	.export break_here
+break_here
+	be,n	0(sr4,reg_LIP)
+
+	.align	8
+lra
+	.word	type_ReturnPcHeader
+	copy	reg_OCFP,reg_CSP
+
+	/* Copy CFP (r4) into someplace else and restore r4. */
+	copy	reg_CFP,reg_NL1
+	ldw	-64(0,sp),r4
+
+	/* Copy the return value. */
+	copy	reg_A0,ret0
+
+	/* Turn on pseudo-atomic. */
+	addi	4,reg_ALLOC,reg_ALLOC
+
+	/* Store the lisp state. */
+	copy	reg_ALLOC,reg_NL0
+	depi	0,31,3,reg_NL0
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	stw	reg_NL0,R%current_dynamic_space_free_pointer-$global$(0,r1)
+	addil	L%current_binding_stack_pointer-$global$,dp
+	stw	reg_BSP,R%current_binding_stack_pointer-$global$(0,r1)
+	addil	L%current_control_stack_pointer-$global$,dp
+	stw	reg_CSP,R%current_control_stack_pointer-$global$(0,r1)
+	addil	L%current_control_frame_pointer-$global$,dp
+	stw	reg_NL1,R%current_control_frame_pointer-$global$(0,r1)
+
+	/* Back in C land.  [CSP is just a handy non-zero value.] */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	reg_CSP,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Turn off pseudo-atomic and check for traps. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* And thats all. */
+	.leave
+	.procend
+
+
+/*
+ * Call-into-C
+ */
+
+	
+	.export call_into_c
+call_into_c
+	/* Set up a lisp stack frame.  Note: we convert the raw return pc into
+	 * a fixnum pc-offset because we don't have ahold of an lra object.
+	 */
+	copy	reg_CFP, reg_OCFP
+	copy	reg_CSP, reg_CFP
+	addi	32, reg_CSP, reg_CSP
+	stw	reg_OCFP, 0(0,reg_CFP)
+	sub	reg_LIP, reg_CODE, reg_NL5
+	addi	3-type_OtherPointer, reg_NL5, reg_NL5
+	stw	reg_NL5, 4(0,reg_CFP)
+	stw	reg_CODE, 8(0,reg_CFP)
+
+	/* Turn on pseudo-atomic. */
+	addi	4, reg_ALLOC, reg_ALLOC
+
+	/* Store the lisp state. */
+	copy	reg_ALLOC,reg_NL5
+	depi	0,31,3,reg_NL5
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	stw	reg_NL5,R%current_dynamic_space_free_pointer-$global$(0,r1)
+	addil	L%current_binding_stack_pointer-$global$,dp
+	stw	reg_BSP,R%current_binding_stack_pointer-$global$(0,r1)
+	addil	L%current_control_stack_pointer-$global$,dp
+	stw	reg_CSP,R%current_control_stack_pointer-$global$(0,r1)
+	addil	L%current_control_frame_pointer-$global$,dp
+	stw	reg_CFP,R%current_control_frame_pointer-$global$(0,r1)
+
+	/* Back in C land.  [CSP is just a handy non-zero value.] */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	reg_CSP,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Turn off pseudo-atomic and check for traps. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Now we can call the C function. */
+	ble	0(4,reg_CFUNC)
+	copy	r31, r2
+
+	/* Clear the callee saves descriptor regs. */
+	copy	r0, reg_A5
+	copy	r0, reg_L0
+	copy	r0, reg_L1
+	copy	r0, reg_L2
+
+	/* Turn on pseudo-atomic. */
+	ldi	4, reg_ALLOC
+
+	/* Turn off foreign function call. */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	r0,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Load ALLOC. */
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	ldw	R%current_dynamic_space_free_pointer-$global$(0,r1),r1
+	add	reg_ALLOC,r1,reg_ALLOC
+
+	/* We don't need to load OCFP, CFP, CSP, or BSP because they are
+	 * in caller saves registers.
+	 */
+
+	/* End of pseudo-atomic. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Restore CODE.  Even though it is in a callee saves register
+	 * it might have been GC'ed.
+	 */
+	ldw	8(0,reg_CFP), reg_CODE
+
+	/* Restore the return pc. */
+	ldw	4(0,reg_CFP), reg_NL0
+	addi	type_OtherPointer-3, reg_NL0, reg_NL0
+	add	reg_CODE, reg_NL0, reg_LIP
+
+	/* Pop the lisp stack frame, and back we go. */
+	copy	reg_CFP, reg_CSP
+	be	0(4,reg_LIP)
+	copy	reg_OCFP, reg_CFP
+
+
+
+/*
+ * Trampolines.
+ */
+
+	.EXPORT closure_tramp
+closure_tramp
+	/* reg_FDEFN holds the fdefn object. */
+	ldw	FDEFN_FUNCTION_OFFSET(0,reg_FDEFN),reg_LEXENV
+	ldw	CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_L0
+	addi	FUNCTION_HEADER_CODE_OFFSET, reg_L0, reg_LIP
+	bv,n	0(reg_LIP)
+
+	.EXPORT undefined_tramp
+undefined_tramp
+	break	trap_Error,0
+        .byte    4
+        .byte    23
+        .byte    254
+        .byte    46
+        .byte    1
+	.align	4
+
+
+/*
+ * Core saving/restoring support
+ */
+
+	.export call_on_stack
+call_on_stack
+	/* arg0 = fn to invoke, arg1 = new stack base */
+
+	/* Compute the new stack pointer. */
+	addi	64,arg1,sp
+
+	/* Zero out the previous stack pointer. */
+	stw	r0,-4(0,sp)
+
+	/* Invoke the function. */
+	ble	0(4,arg0)
+	copy	r31, r2
+
+	/* Flame out. */
+	break	0,0
+
+	.export	save_state
+save_state
+	.proc
+	.callinfo entry_gr=18,entry_fr=21,save_rp,calls
+	.enter
+
+	/* Remember the function we want to invoke */
+	copy	arg0,r19
+
+	/* Pass the new stack pointer in as arg0 */
+	copy	sp,arg0
+
+	/* Leave arg1 as arg1. */
+
+	/* do the call. */
+	ble	0(4,r19)
+	copy	r31, r2
+
+_restore_state
+	.leave
+	.procend
+
+	.export	restore_state
+restore_state
+	.proc
+	.callinfo
+	copy	arg0,sp
+	b	_restore_state
+	copy	arg1,ret0
+	.procend
diff --git a/lisp/hppa-assem.s b/lisp/hppa-assem.s
new file mode 100644
index 0000000000000000000000000000000000000000..118379a2b2d0ff51df0af9f9d3ec75be8c8a12c0
--- /dev/null
+++ b/lisp/hppa-assem.s
@@ -0,0 +1,293 @@
+#define LANGUAGE_ASSEMBLY
+
+#include <machine/asm.h>
+
+#include "internals.h"
+#include "lispregs.h"
+
+	.import $global$,data
+	.import foreign_function_call_active,data
+	.import current_control_stack_pointer,data
+	.import current_control_frame_pointer,data
+	.import current_binding_stack_pointer,data
+	.import current_dynamic_space_free_pointer,data
+
+	.space	$TEXT$
+	.subspa	$CODE$
+
+
+/*
+ * Call-into-lisp
+ */
+
+	.export call_into_lisp
+call_into_lisp
+	.proc
+	.callinfo entry_gr=18,save_rp
+	.enter
+	/* arg0=function, arg1=cfp, arg2=nargs */
+
+	/* Clear the descriptor regs, moving in args as approporate. */
+	copy	r0,reg_CODE
+	copy	r0,reg_FDEFN
+	copy	arg0,reg_LEXENV
+	zdep	arg2,29,30,reg_NARGS
+	copy	r0,reg_OCFP
+	copy	r0,reg_LRA
+	copy	r0,reg_A0
+	copy	r0,reg_A1
+	copy	r0,reg_A2
+	copy	r0,reg_A3
+	copy	r0,reg_A4
+	copy	r0,reg_A5
+	copy	r0,reg_L0
+	copy	r0,reg_L1
+	copy	r0,reg_L2
+
+	/* Establish NIL. */
+	ldil	L%NIL,reg_NULL
+	ldo	R%NIL(reg_NULL),reg_NULL
+
+	/* Turn on pseudo-atomic. */
+	ldo	4(r0),reg_ALLOC
+
+	/* No longer in foreign function call land. */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	r0,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Load lisp state. */
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	ldw	R%current_dynamic_space_free_pointer-$global$(0,r1),r1
+	add	reg_ALLOC,r1,reg_ALLOC
+	addil	L%current_binding_stack_pointer-$global$,dp
+	ldw	R%current_binding_stack_pointer-$global$(0,r1),reg_BSP
+	addil	L%current_control_stack_pointer-$global$,dp
+	ldw	R%current_control_stack_pointer-$global$(0,r1),reg_CSP
+	addil	L%current_control_frame_pointer-$global$,dp
+	ldw	R%current_control_frame_pointer-$global$(0,r1),reg_OCFP
+	copy	arg1,reg_CFP
+
+	/* End of pseudo-atomic. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Establish lisp arguments. */
+	ldw	0(reg_CFP),reg_A0
+	ldw	4(reg_CFP),reg_A1
+	ldw	8(reg_CFP),reg_A2
+	ldw	12(reg_CFP),reg_A3
+	ldw	16(reg_CFP),reg_A4
+	ldw	20(reg_CFP),reg_A5
+
+	/* Calculate the LRA. */
+	ldil	L%lra+type_OtherPointer,reg_LRA
+	ldo	R%lra+type_OtherPointer(reg_LRA),reg_LRA
+
+	/* Indirect the closure */
+	ldw	CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_CODE
+	addi	6*4-type_FunctionPointer,reg_CODE,reg_LIP
+
+	/* And into lisp we go. */
+	.export break_here
+break_here
+	be,n	0(sr4,reg_LIP)
+
+	.align	8
+lra
+	.word	type_ReturnPcHeader
+	copy	reg_OCFP,reg_CSP
+
+	/* Copy CFP (r4) into someplace else and restore r4. */
+	copy	reg_CFP,reg_NL1
+	ldw	-64(0,sp),r4
+
+	/* Copy the return value. */
+	copy	reg_A0,ret0
+
+	/* Turn on pseudo-atomic. */
+	addi	4,reg_ALLOC,reg_ALLOC
+
+	/* Store the lisp state. */
+	copy	reg_ALLOC,reg_NL0
+	depi	0,31,3,reg_NL0
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	stw	reg_NL0,R%current_dynamic_space_free_pointer-$global$(0,r1)
+	addil	L%current_binding_stack_pointer-$global$,dp
+	stw	reg_BSP,R%current_binding_stack_pointer-$global$(0,r1)
+	addil	L%current_control_stack_pointer-$global$,dp
+	stw	reg_CSP,R%current_control_stack_pointer-$global$(0,r1)
+	addil	L%current_control_frame_pointer-$global$,dp
+	stw	reg_NL1,R%current_control_frame_pointer-$global$(0,r1)
+
+	/* Back in C land.  [CSP is just a handy non-zero value.] */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	reg_CSP,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Turn off pseudo-atomic and check for traps. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* And thats all. */
+	.leave
+	.procend
+
+
+/*
+ * Call-into-C
+ */
+
+	
+	.export call_into_c
+call_into_c
+	/* Set up a lisp stack frame.  Note: we convert the raw return pc into
+	 * a fixnum pc-offset because we don't have ahold of an lra object.
+	 */
+	copy	reg_CFP, reg_OCFP
+	copy	reg_CSP, reg_CFP
+	addi	32, reg_CSP, reg_CSP
+	stw	reg_OCFP, 0(0,reg_CFP)
+	sub	reg_LIP, reg_CODE, reg_NL5
+	addi	3-type_OtherPointer, reg_NL5, reg_NL5
+	stw	reg_NL5, 4(0,reg_CFP)
+	stw	reg_CODE, 8(0,reg_CFP)
+
+	/* Turn on pseudo-atomic. */
+	addi	4, reg_ALLOC, reg_ALLOC
+
+	/* Store the lisp state. */
+	copy	reg_ALLOC,reg_NL5
+	depi	0,31,3,reg_NL5
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	stw	reg_NL5,R%current_dynamic_space_free_pointer-$global$(0,r1)
+	addil	L%current_binding_stack_pointer-$global$,dp
+	stw	reg_BSP,R%current_binding_stack_pointer-$global$(0,r1)
+	addil	L%current_control_stack_pointer-$global$,dp
+	stw	reg_CSP,R%current_control_stack_pointer-$global$(0,r1)
+	addil	L%current_control_frame_pointer-$global$,dp
+	stw	reg_CFP,R%current_control_frame_pointer-$global$(0,r1)
+
+	/* Back in C land.  [CSP is just a handy non-zero value.] */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	reg_CSP,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Turn off pseudo-atomic and check for traps. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Now we can call the C function. */
+	ble	0(4,reg_CFUNC)
+	copy	r31, r2
+
+	/* Clear the callee saves descriptor regs. */
+	copy	r0, reg_A5
+	copy	r0, reg_L0
+	copy	r0, reg_L1
+	copy	r0, reg_L2
+
+	/* Turn on pseudo-atomic. */
+	ldi	4, reg_ALLOC
+
+	/* Turn off foreign function call. */
+	addil	L%foreign_function_call_active-$global$,dp
+	stw	r0,R%foreign_function_call_active-$global$(0,r1)
+
+	/* Load ALLOC. */
+	addil	L%current_dynamic_space_free_pointer-$global$,dp
+	ldw	R%current_dynamic_space_free_pointer-$global$(0,r1),r1
+	add	reg_ALLOC,r1,reg_ALLOC
+
+	/* We don't need to load OCFP, CFP, CSP, or BSP because they are
+	 * in caller saves registers.
+	 */
+
+	/* End of pseudo-atomic. */
+	addit,od	-4,reg_ALLOC,reg_ALLOC
+
+	/* Restore CODE.  Even though it is in a callee saves register
+	 * it might have been GC'ed.
+	 */
+	ldw	8(0,reg_CFP), reg_CODE
+
+	/* Restore the return pc. */
+	ldw	4(0,reg_CFP), reg_NL0
+	addi	type_OtherPointer-3, reg_NL0, reg_NL0
+	add	reg_CODE, reg_NL0, reg_LIP
+
+	/* Pop the lisp stack frame, and back we go. */
+	copy	reg_CFP, reg_CSP
+	be	0(4,reg_LIP)
+	copy	reg_OCFP, reg_CFP
+
+
+
+/*
+ * Trampolines.
+ */
+
+	.EXPORT closure_tramp
+closure_tramp
+	/* reg_FDEFN holds the fdefn object. */
+	ldw	FDEFN_FUNCTION_OFFSET(0,reg_FDEFN),reg_LEXENV
+	ldw	CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_L0
+	addi	FUNCTION_HEADER_CODE_OFFSET, reg_L0, reg_LIP
+	bv,n	0(reg_LIP)
+
+	.EXPORT undefined_tramp
+undefined_tramp
+	break	trap_Error,0
+        .byte    4
+        .byte    23
+        .byte    254
+        .byte    46
+        .byte    1
+	.align	4
+
+
+/*
+ * Core saving/restoring support
+ */
+
+	.export call_on_stack
+call_on_stack
+	/* arg0 = fn to invoke, arg1 = new stack base */
+
+	/* Compute the new stack pointer. */
+	addi	64,arg1,sp
+
+	/* Zero out the previous stack pointer. */
+	stw	r0,-4(0,sp)
+
+	/* Invoke the function. */
+	ble	0(4,arg0)
+	copy	r31, r2
+
+	/* Flame out. */
+	break	0,0
+
+	.export	save_state
+save_state
+	.proc
+	.callinfo entry_gr=18,entry_fr=21,save_rp,calls
+	.enter
+
+	/* Remember the function we want to invoke */
+	copy	arg0,r19
+
+	/* Pass the new stack pointer in as arg0 */
+	copy	sp,arg0
+
+	/* Leave arg1 as arg1. */
+
+	/* do the call. */
+	ble	0(4,r19)
+	copy	r31, r2
+
+_restore_state
+	.leave
+	.procend
+
+	.export	restore_state
+restore_state
+	.proc
+	.callinfo
+	copy	arg0,sp
+	b	_restore_state
+	copy	arg1,ret0
+	.procend
diff --git a/lisp/hppa-lispregs.h b/lisp/hppa-lispregs.h
new file mode 100644
index 0000000000000000000000000000000000000000..6c9a1d625f8fd06ab3e8e46fef3904bfa6f28905
--- /dev/null
+++ b/lisp/hppa-lispregs.h
@@ -0,0 +1,59 @@
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hppa-lispregs.h,v 1.1 1992/09/04 08:16:35 wlott Exp $ */
+
+#define NREGS	(32)
+
+#ifdef LANGUAGE_ASSEMBLY
+#define REG(num) num
+#else
+#define REG(num) num
+#endif
+
+#define reg_ZERO REG(0)
+#define reg_NFP REG(1)
+#define reg_CFUNC REG(2)
+#define reg_CSP REG(3)
+#define reg_CFP REG(4)
+#define reg_BSP REG(5)
+#define reg_NULL REG(6)
+#define reg_ALLOC REG(7)
+#define reg_CODE REG(8)
+#define reg_FDEFN REG(9)
+#define reg_LEXENV REG(10)
+#define reg_NARGS REG(11)
+#define reg_OCFP REG(12)
+#define reg_LRA REG(13)
+#define reg_A0 REG(14)
+#define reg_A1 REG(15)
+#define reg_A2 REG(16)
+#define reg_A3 REG(17)
+#define reg_A4 REG(18)
+#define reg_A5 REG(19)
+#define reg_L0 REG(20)
+#define reg_L1 REG(21)
+#define reg_L2 REG(22)
+#define reg_NL3 REG(23)
+#define reg_NL2 REG(24)
+#define reg_NL1 REG(25)
+#define reg_NL0 REG(26)
+#define reg_DP REG(27)
+#define reg_NL4 REG(28)
+#define reg_NL5 REG(29)
+#define reg_NSP REG(30)
+#define reg_LIP REG(31)
+
+
+#define REGNAMES \
+    "ZERO", "NFP", "CFUNC", "CSP", "CFP", "BSP", "NULL", "ALLOC", \
+    "CODE", "FDEFN", "LEXENV", "NARGS", "OCFP", "LRA", "A0", "A1", \
+    "A2", "A3", "A4", "A5", "L0", "L1", "L2", "NL3", \
+    "NL2", "NL1", "NL0", "DP", "NL4", "NL5", "NSP", "LIP"
+
+#define BOXED_REGISTERS { \
+    reg_CODE, reg_FDEFN, reg_LEXENV, reg_NARGS, reg_OCFP, reg_LRA, \
+    reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, \
+    reg_L0, reg_L1, reg_L2 \
+}
+
+#define SC_REG(sc, n) (((unsigned long *)((sc)->sc_ap))[n])
+#define SC_PC(sc) ((sc)->sc_pcoqh)
+#define SC_NPC(sc) ((sc)->sc_pcoqt)
diff --git a/lisp/hppa-validate.h b/lisp/hppa-validate.h
new file mode 100644
index 0000000000000000000000000000000000000000..693f241fa4aa02299a1ab04a7aa2a6501ad2b3c6
--- /dev/null
+++ b/lisp/hppa-validate.h
@@ -0,0 +1,20 @@
+
+#define READ_ONLY_SPACE_START   (0x20000000)
+#define READ_ONLY_SPACE_SIZE    (0x08000000)
+
+#define STATIC_SPACE_START	(0x28000000)
+#define STATIC_SPACE_SIZE	(0x08000000)
+
+#define DYNAMIC_0_SPACE_START	(0x30000000)
+#define DYNAMIC_1_SPACE_START	(0x38000000)
+#define DYNAMIC_SPACE_SIZE	(0x08000000)
+
+#define CONTROL_STACK_START	(0x50000000)
+#define CONTROL_STACK_SIZE	(0x00100000)
+
+#define BINDING_STACK_START	(0x70000000)
+#define BINDING_STACK_SIZE	(0x00100000)
+
+#define NUMBER_STACK_START	(0x60000000)
+#define NUMBER_STACK_SIZE	(0x00100000)
+#define NUMBER_STACK_GROWS_UP