[cmucl-commit] CMUCL commit: src (19 files)
Raymond Toy
rtoy at common-lisp.net
Wed Dec 22 03:12:52 CET 2010
Date: Tuesday, December 21, 2010 @ 21:12:52
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: code/float-trap.lisp code/signal.lisp code/sunos-os.lisp
code/unix.lisp compiler/x86/parms.lisp lisp/Config.sparc_common
lisp/Config.sparc_sunc lisp/Config.x86_solaris_sunc lisp/gencgc.c
lisp/os-common.c lisp/solaris-os.c lisp/sunos-os.h lisp/x86-arch.c
lisp/x86-assem.S lisp/x86-validate.h tools/clean-target.sh
tools/create-target.sh
tools/cross-scripts/cross-x86-osx-solaris.lisp tools/make-dist.sh
Merge changes from cross-sol-x86-2010-12-20 which adds support for
Solaris/x86. There should be no functional changes for either other
x86 ports or for the sparc port.
------------------------------------------------+
code/float-trap.lisp | 9
code/signal.lisp | 10
code/sunos-os.lisp | 7
code/unix.lisp | 5
compiler/x86/parms.lisp | 8
lisp/Config.sparc_common | 22 +-
lisp/Config.sparc_sunc | 7
lisp/Config.x86_solaris_sunc | 14 +
lisp/gencgc.c | 68 ++++--
lisp/os-common.c | 4
lisp/solaris-os.c | 122 +++++++++++
lisp/sunos-os.h | 8
lisp/x86-arch.c | 47 ++++
lisp/x86-assem.S | 61 +++--
lisp/x86-validate.h | 49 ++++
tools/clean-target.sh | 8
tools/create-target.sh | 9
tools/cross-scripts/cross-x86-osx-solaris.lisp | 238 +++++++++++++++++++++++
tools/make-dist.sh | 13 -
19 files changed, 636 insertions(+), 73 deletions(-)
Index: src/code/float-trap.lisp
diff -u src/code/float-trap.lisp:1.38 src/code/float-trap.lisp:1.39
--- src/code/float-trap.lisp:1.38 Tue Apr 20 13:57:44 2010
+++ src/code/float-trap.lisp Tue Dec 21 21:12:51 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/float-trap.lisp,v 1.38 2010-04-20 17:57:44 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/code/float-trap.lisp,v 1.39 2010-12-22 02:12:51 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -290,6 +290,13 @@
:operation fop
:operands operands))
(t
+ ;; It looks like the sigcontext on Solaris/x86 doesn't
+ ;; actually save the status word of the FPU. The
+ ;; operands also seem to be missing. Signal a general
+ ;; arithmetic error.
+ #+solaris
+ (error 'arithmetic-error :operands operands)
+ #-solaris
(error (intl:gettext "SIGFPE with no exceptions currently enabled?")))))))
;;; WITH-FLOAT-TRAPS-MASKED -- Public
Index: src/code/signal.lisp
diff -u src/code/signal.lisp:1.41 src/code/signal.lisp:1.42
--- src/code/signal.lisp:1.41 Tue Jul 13 23:13:20 2010
+++ src/code/signal.lisp Tue Dec 21 21:12:51 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/signal.lisp,v 1.41 2010-07-14 03:13:20 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/code/signal.lisp,v 1.42 2010-12-22 02:12:51 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -104,7 +104,7 @@
(def-unix-signal :SIGIOT 6 "Iot instruction") ; Compatibility
(def-unix-signal :SIGABRT 6 "C abort()")
(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
- #+sparc "cmucl-sparc-svr4"
+ #+(or sparc solaris) "cmucl-sparc-svr4"
#+bsd "cmucl-bsd-os")
#-linux
(def-unix-signal :SIGEMT 7 "Emt instruction"))
@@ -115,7 +115,7 @@
(def-unix-signal :SIGBUS #-linux 10 #+linux 7 "Bus error")
(def-unix-signal :SIGSEGV 11 "Segmentation violation")
(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
- #+sparc "cmucl-sparc-svr4"
+ #+(or sparc solaris) "cmucl-sparc-svr4"
#+bsd "cmucl-bsd-os")
#-linux
(def-unix-signal :SIGSYS 12 "Bad argument to system call"))
@@ -124,7 +124,7 @@
(def-unix-signal :SIGALRM 14 "Alarm clock")
(def-unix-signal :SIGTERM 15 "Software termination signal")
(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
- #+sparc "cmucl-sparc-svr4"
+ #+(or sparc solaris) "cmucl-sparc-svr4"
#+bsd "cmucl-bsd-os")
#+linux
(def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor"))
@@ -163,7 +163,7 @@
;;; SVR4 (or Solaris?) specific signals
(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
- #+sparc "cmucl-sparc-svr4"
+ #+(or sparc solaris) "cmucl-sparc-svr4"
#+bsd "cmucl-bsd-os")
#+svr4
(def-unix-signal :SIGWAITING 32 "Process's lwps are blocked"))
Index: src/code/sunos-os.lisp
diff -u src/code/sunos-os.lisp:1.15 src/code/sunos-os.lisp:1.16
--- src/code/sunos-os.lisp:1.15 Tue Apr 20 13:57:45 2010
+++ src/code/sunos-os.lisp Tue Dec 21 21:12:51 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/sunos-os.lisp,v 1.15 2010-04-20 17:57:45 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/code/sunos-os.lisp,v 1.16 2010-12-22 02:12:51 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -21,6 +21,11 @@
(pushnew :sunos *features*)
+#+solaris
+(register-lisp-feature :solaris)
+#+svr4
+(register-lisp-feature :svr4)
+
#+executable
(register-lisp-runtime-feature :executable)
Index: src/code/unix.lisp
diff -u src/code/unix.lisp:1.131 src/code/unix.lisp:1.132
--- src/code/unix.lisp:1.131 Fri Nov 12 11:53:17 2010
+++ src/code/unix.lisp Tue Dec 21 21:12:51 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.131 2010-11-12 16:53:17 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.132 2010-12-22 02:12:51 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -3391,7 +3391,8 @@
(defun unix-uname ()
(with-alien ((names (struct utsname)))
- (syscall* (#-freebsd "uname"
+ (syscall* (#-(or freebsd solaris) "uname"
+ #+solaris "nuname" ; See /usr/include/sys/utsname.h
#+freebsd "__xuname" #+freebsd int
(* (struct utsname)))
(values (cast (slot names 'sysname) c-string)
Index: src/compiler/x86/parms.lisp
diff -u src/compiler/x86/parms.lisp:1.41 src/compiler/x86/parms.lisp:1.42
--- src/compiler/x86/parms.lisp:1.41 Sat Dec 4 12:32:34 2010
+++ src/compiler/x86/parms.lisp Tue Dec 21 21:12:52 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/parms.lisp,v 1.41 2010-12-04 17:32:34 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/parms.lisp,v 1.42 2010-12-22 02:12:52 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -65,7 +65,8 @@
(setf (c::backend-foreign-linkage-space-start *target-backend*)
#+linux #x58000000
- #-linux #xB0000000
+ #+solaris #x30000000
+ #-(or linux solaris) #xB0000000
(c::backend-foreign-linkage-entry-size *target-backend*)
8)
); eval-when
@@ -217,7 +218,8 @@
#-FreeBSD #x28000000)
(defconstant target-dynamic-space-start
#+linux #x58100000
- #-linux #x48000000)
+ #+solaris #x40000000
+ #-(or linux solaris) #x48000000)
(defconstant target-foreign-linkage-space-start
(c:backend-foreign-linkage-space-start *target-backend*))
(defconstant target-foreign-linkage-entry-size
Index: src/lisp/Config.sparc_common
diff -u src/lisp/Config.sparc_common:1.3 src/lisp/Config.sparc_common:1.4
--- src/lisp/Config.sparc_common:1.3 Wed Jul 28 21:51:12 2010
+++ src/lisp/Config.sparc_common Tue Dec 21 21:12:52 2010
@@ -27,22 +27,34 @@
GC_SRC = gencgc.c
endif
+# Enable support for SSE2. If FEATURE_X87 is set, we want SSE2
+# support in the C code too so that the same binary is built in both
+# cases. If neither is set, then we don't want any SSE2 support at
+# all.
+ifdef FEATURE_X87
+SSE2 = -DFEATURE_SSE2
+else
+ifdef FEATURE_SSE2
+SSE2 = -DFEATURE_SSE2
+endif
+endif
+
# Enable support for Unicode
ifdef FEATURE_UNICODE
UNICODE = -DUNICODE
endif
-CPPFLAGS = -I. -I$(PATH1) -DSOLARIS -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) $(UNICODE)
+CPPFLAGS = -I. -I$(PATH1) -DSOLARIS -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) $(UNICODE) $(SSE2)
CFLAGS = -g $(CC_V8PLUS)
NM = $(PATH1)/solaris-nm
-ASSEM_SRC = sparc-assem.S
-ARCH_SRC = sparc-arch.c
+#ASSEM_SRC = sparc-assem.S
+#ARCH_SRC = sparc-arch.c
DEPEND=$(CC)
-OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c
+#OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c
OS_LINK_FLAGS=
-OS_LIBS= -lsocket -lnsl -ldl
+#OS_LIBS= -lsocket -lnsl -ldl
EXEC_FINAL_OBJ = exec-final.o
Index: src/lisp/Config.sparc_sunc
diff -u src/lisp/Config.sparc_sunc:1.2 src/lisp/Config.sparc_sunc:1.3
--- src/lisp/Config.sparc_sunc:1.2 Mon Feb 1 11:41:39 2010
+++ src/lisp/Config.sparc_sunc Tue Dec 21 21:12:52 2010
@@ -20,6 +20,13 @@
AS_V8PLUS = -m32 -xarch=sparc
endif
+ASSEM_SRC = sparc-assem.S
+ARCH_SRC = sparc-arch.c
+
+OS_SRC = solaris-os.c os-common.c undefineds.c elf.c k_rem_pio2.c
+OS_LINK_FLAGS=
+OS_LIBS= -lsocket -lnsl -ldl
+
CC = cc -xlibmieee -O
CPP = cc -E
DEPEND_FLAGS = -xM
Index: src/lisp/Config.x86_solaris_sunc
diff -u /dev/null src/lisp/Config.x86_solaris_sunc:1.2
--- /dev/null Tue Dec 21 21:12:52 2010
+++ src/lisp/Config.x86_solaris_sunc Tue Dec 21 21:12:52 2010
@@ -0,0 +1,14 @@
+# -*- Mode: makefile -*-
+include Config.sparc_common
+
+CC = cc -xlibmieee -g
+CFLAGS += -Di386
+CPP = cc -E
+DEPEND_FLAGS = -xM
+
+ASSEM_SRC = x86-assem.S
+ARCH_SRC = x86-arch.c
+
+OS_SRC = solaris-os.c os-common.c undefineds.c elf.c e_rem_pio2.c k_rem_pio2.c
+OS_LINK_FLAGS=
+OS_LIBS= -lsocket -lnsl -ldl
Index: src/lisp/gencgc.c
diff -u src/lisp/gencgc.c:1.110 src/lisp/gencgc.c:1.111
--- src/lisp/gencgc.c:1.110 Mon Jul 26 13:17:13 2010
+++ src/lisp/gencgc.c Tue Dec 21 21:12:52 2010
@@ -7,7 +7,7 @@
*
* Douglas Crosher, 1996, 1997, 1998, 1999.
*
- * $Header: /project/cmucl/cvsroot/src/lisp/gencgc.c,v 1.110 2010-07-26 17:17:13 rtoy Rel $
+ * $Header: /project/cmucl/cvsroot/src/lisp/gencgc.c,v 1.111 2010-12-22 02:12:52 rtoy Exp $
*
*/
@@ -150,7 +150,7 @@
/* Define for activating assertions. */
-#if defined(DARWIN)
+#if defined(x86) && defined(SOLARIS)
#define GC_ASSERTIONS 1
#endif
@@ -2906,9 +2906,9 @@
sniff_code_object(struct code *code, unsigned displacement)
{
int nheader_words, ncode_words, nwords;
- void *p;
- void *constants_start_addr, *constants_end_addr;
- void *code_start_addr, *code_end_addr;
+ char *p;
+ char *constants_start_addr, *constants_end_addr;
+ char *code_start_addr, *code_end_addr;
int fixup_found = 0;
if (!check_code_fixups)
@@ -2932,14 +2932,14 @@
nheader_words = HeaderValue(*(lispobj *) code);
nwords = ncode_words + nheader_words;
- constants_start_addr = (void *) code + 5 * sizeof(lispobj);
- constants_end_addr = (void *) code + nheader_words * sizeof(lispobj);
- code_start_addr = (void *) code + nheader_words * sizeof(lispobj);
- code_end_addr = (void *) code + nwords * sizeof(lispobj);
+ constants_start_addr = (char *) code + 5 * sizeof(lispobj);
+ constants_end_addr = (char *) code + nheader_words * sizeof(lispobj);
+ code_start_addr = (char *) code + nheader_words * sizeof(lispobj);
+ code_end_addr = (char *) code + nwords * sizeof(lispobj);
/* Work through the unboxed code. */
for (p = code_start_addr; p < code_end_addr; p++) {
- void *data = *(void **) p;
+ char *data = *(char **) p;
unsigned d1 = *((unsigned char *) p - 1);
unsigned d2 = *((unsigned char *) p - 2);
unsigned d3 = *((unsigned char *) p - 3);
@@ -3113,8 +3113,8 @@
apply_code_fixups(struct code *old_code, struct code *new_code)
{
int nheader_words, ncode_words, nwords;
- void *constants_start_addr, *constants_end_addr;
- void *code_start_addr, *code_end_addr;
+ char *constants_start_addr, *constants_end_addr;
+ char *code_start_addr, *code_end_addr;
lispobj fixups = NIL;
unsigned long displacement =
@@ -3141,10 +3141,10 @@
"*** Compiled code object at %x: header_words=%d code_words=%d .\n",
new_code, nheader_words, ncode_words);
#endif
- constants_start_addr = (void *) new_code + 5 * sizeof(lispobj);
- constants_end_addr = (void *) new_code + nheader_words * sizeof(lispobj);
- code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj);
- code_end_addr = (void *) new_code + nwords * sizeof(lispobj);
+ constants_start_addr = (char *) new_code + 5 * sizeof(lispobj);
+ constants_end_addr = (char *) new_code + nheader_words * sizeof(lispobj);
+ code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj);
+ code_end_addr = (char *) new_code + nwords * sizeof(lispobj);
#if 0
fprintf(stderr,
"*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
@@ -3444,12 +3444,46 @@
closure = (struct closure *) where;
fun = closure->function - RAW_ADDR_OFFSET;
+#if !(defined(i386) && defined(SOLARIS))
scavenge(&fun, 1);
/* The function may have moved so update the raw address. But don't
write unnecessarily. */
if (closure->function != fun + RAW_ADDR_OFFSET)
closure->function = fun + RAW_ADDR_OFFSET;
-
+#else
+ /*
+ * For some reason, on solaris/x86, we get closures (actually, it
+ * appears to be funcallable instances where the closure function
+ * is zero. I don't know why, but they are. They don't seem to
+ * be created anywhere and it doesn't seem to be caused by GC
+ * transport.
+ *
+ * Anyway, we check for zero and skip scavenging if so.
+ * (Previously, we'd get a segfault scavenging the object at
+ * address -RAW_ADDR_OFFSET.
+ */
+ if (closure->function) {
+ scavenge(&fun, 1);
+ /*
+ * The function may have moved so update the raw address. But don't
+ * write unnecessarily.
+ */
+ if (closure->function != fun + RAW_ADDR_OFFSET) {
+#if 0
+ fprintf(stderr, "closure header 0x%04x moved from %p to %p\n",
+ closure->header, (void*) closure->function, (void*) (fun + RAW_ADDR_OFFSET));
+#endif
+ closure->function = fun + RAW_ADDR_OFFSET;
+ }
+ }
+#if 0
+ else {
+ fprintf(stderr, "Weird closure!\n");
+ fprintf(stderr, " where = %p, object = 0x%04x\n", where, object);
+ fprintf(stderr, " closure->function = %p, fun = %p\n", closure->function, fun);
+ }
+#endif
+#endif
return 2;
}
Index: src/lisp/os-common.c
diff -u src/lisp/os-common.c:1.32 src/lisp/os-common.c:1.33
--- src/lisp/os-common.c:1.32 Sat Dec 4 12:32:34 2010
+++ src/lisp/os-common.c Tue Dec 21 21:12:52 2010
@@ -1,6 +1,6 @@
/*
- $Header: /project/cmucl/cvsroot/src/lisp/os-common.c,v 1.32 2010-12-04 17:32:34 rtoy Exp $
+ $Header: /project/cmucl/cvsroot/src/lisp/os-common.c,v 1.33 2010-12-22 02:12:52 rtoy Exp $
This code was written as part of the CMU Common Lisp project at
Carnegie Mellon University, and has been placed in the public domain.
@@ -235,7 +235,7 @@
(char *) c_symbol_name);
lose("First element of linkage_data is bogus.\n");
}
- arch_make_linkage_entry(i, &resolve_linkage_tramp, 1);
+ arch_make_linkage_entry(i, (void *) &resolve_linkage_tramp, 1);
#endif
continue;
}
Index: src/lisp/solaris-os.c
diff -u src/lisp/solaris-os.c:1.26 src/lisp/solaris-os.c:1.27
--- src/lisp/solaris-os.c:1.26 Fri Nov 12 07:57:32 2010
+++ src/lisp/solaris-os.c Tue Dec 21 21:12:52 2010
@@ -1,5 +1,5 @@
/*
- * $Header: /project/cmucl/cvsroot/src/lisp/solaris-os.c,v 1.26 2010-11-12 12:57:32 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/solaris-os.c,v 1.27 2010-12-22 02:12:52 rtoy Exp $
*
* OS-dependent routines. This file (along with os.h) exports an
* OS-independent interface to the operating system VM facilities.
@@ -32,6 +32,8 @@
#if defined(GENCGC)
#include "lisp.h"
+/* Need struct code defined to get rid of warning from gencgc.h */
+#include "internals.h"
#include "gencgc.h"
#endif
@@ -138,6 +140,7 @@
void
os_flush_icache(os_vm_address_t address, os_vm_size_t length)
{
+#ifndef i386
static int flushit = -1;
/*
@@ -158,6 +161,7 @@
fprintf(stderr, ";;;iflush %p - %lx\n", (void *) address, length);
flush_icache((unsigned int *) address, length);
}
+#endif
}
void
@@ -209,6 +213,11 @@
interrupt_handle_now(signal, code, context);
}
+void real_segv_handler(HANDLER_ARGS)
+{
+ segv_handle_now(signal, code, context);
+}
+
void
segv_handler(HANDLER_ARGS)
{
@@ -263,7 +272,7 @@
fprintf(stderr, "segv_handler: Real protection violation: %p, PC = %p\n",
addr,
context->uc_mcontext.gregs[1]);
- segv_handle_now(signal, code, context);
+ real_segv_handler(signal, code, context);
}
#else
void
@@ -296,6 +305,7 @@
/* function definitions for register lvalues */
+#ifndef i386
int *
solaris_register_address(struct ucontext *context, int reg)
{
@@ -314,6 +324,7 @@
} else
return 0;
}
+#endif
/* function defintions for backward compatibilty and static linking */
@@ -492,3 +503,110 @@
return sym_addr;
}
+
+#ifdef i386
+unsigned long *
+os_sigcontext_reg(ucontext_t *scp, int index)
+{
+#if 0
+ fprintf(stderr, "os_sigcontext_reg index = %d\n", index);
+#endif
+ switch (index) {
+ case 0:
+ return (unsigned long *) &scp->uc_mcontext.gregs[EAX];
+ case 2:
+ return (unsigned long *) &scp->uc_mcontext.gregs[ECX];
+ case 4:
+ return (unsigned long *) &scp->uc_mcontext.gregs[EDX];
+ case 6:
+ return (unsigned long *) &scp->uc_mcontext.gregs[EBX];
+ case 8:
+ return (unsigned long *) &scp->uc_mcontext.gregs[ESP];
+ case 10:
+ return (unsigned long *) &scp->uc_mcontext.gregs[EBP];
+ case 12:
+ return (unsigned long *) &scp->uc_mcontext.gregs[ESI];
+ case 14:
+ return (unsigned long *) &scp->uc_mcontext.gregs[EDI];
+ }
+ return NULL;
+}
+
+unsigned long *
+os_sigcontext_pc(ucontext_t *scp)
+{
+#if 0
+ fprintf(stderr, "os_sigcontext_pc = %p\n", scp->uc_mcontext.gregs[EIP]);
+#endif
+ return (unsigned long *) &scp->uc_mcontext.gregs[EIP];
+}
+
+
+unsigned char *
+os_sigcontext_fpu_reg(ucontext_t *scp, int offset)
+{
+ fpregset_t *fpregs = &scp->uc_mcontext.fpregs;
+ unsigned char *reg = NULL;
+
+ if (offset < 8) {
+ unsigned char *fpustate;
+ unsigned char *stregs;
+
+ /*
+ * Not sure this is right. There is no structure defined for
+ * the x87 fpu state in /usr/include/sys/regset.h
+ */
+
+ /* Point to the fpchip_state */
+ fpustate = (unsigned char*) &fpregs->fp_reg_set.fpchip_state.state[0];
+ /* Skip to where the x87 fp registers are */
+ stregs = fpustate + 24;
+
+ reg = stregs + 16*offset;
+ }
+#ifdef FEATURE_SSE2
+ else {
+ reg = (unsigned char*) &fpregs->fp_reg_set.fpchip_state.xmm[offset - 8];
+ }
+#endif
+
+ return reg;
+}
+
+unsigned int
+os_sigcontext_fpu_modes(ucontext_t *scp)
+{
+ unsigned int modes;
+ unsigned short cw, sw;
+ fpregset_t *fpr;
+ unsigned int state;
+
+ fpr = &scp->uc_mcontext.fpregs;
+
+ cw = fpr->fp_reg_set.fpchip_state.state[0] & 0xffff;
+ sw = fpr->fp_reg_set.fpchip_state.state[1] & 0xffff;
+
+ modes = ((cw & 0x3f) << 7) | (sw & 0x3f);
+
+ DPRINTF(0, (stderr, "cw = 0x%04x\n", cw));
+ DPRINTF(0, (stderr, "sw = 0x%04x\n", sw));
+ DPRINTF(0, (stderr, "modes = 0x%08x\n", modes));
+
+#ifdef FEATURE_SSE2
+ /*
+ * Add in the SSE2 part, if we're running the sse2 core.
+ */
+ if (fpu_mode == SSE2) {
+ unsigned long mxcsr;
+
+ mxcsr = fpr->fp_reg_set.fpchip_state.mxcsr;
+ DPRINTF(0, (stderr, "SSE2 modes = %08lx\n", mxcsr));
+
+ modes |= mxcsr;
+ }
+#endif
+
+ modes ^= (0x3f << 7);
+ return modes;
+}
+#endif
Index: src/lisp/sunos-os.h
diff -u src/lisp/sunos-os.h:1.13 src/lisp/sunos-os.h:1.14
--- src/lisp/sunos-os.h:1.13 Mon Mar 17 23:58:45 2008
+++ src/lisp/sunos-os.h Tue Dec 21 21:12:52 2010
@@ -1,6 +1,6 @@
/*
- $Header: /project/cmucl/cvsroot/src/lisp/sunos-os.h,v 1.13 2008-03-18 03:58:45 cshapiro Rel $
+ $Header: /project/cmucl/cvsroot/src/lisp/sunos-os.h,v 1.14 2010-12-22 02:12:52 rtoy Exp $
This code was written as part of the CMU Common Lisp project at
Carnegie Mellon University, and has been placed in the public domain.
@@ -42,13 +42,19 @@
#define OS_VM_PROT_WRITE PROT_WRITE
#define OS_VM_PROT_EXECUTE PROT_EXEC
+#ifdef i386
+#define OS_VM_DEFAULT_PAGESIZE 4096
+#else
#define OS_VM_DEFAULT_PAGESIZE 8192
+#endif
#ifdef SOLARIS
#include <ucontext.h>
#define HANDLER_ARGS int signal, siginfo_t *code, struct ucontext *context
#define CODE(code) ((code) ? code->si_code : 0)
+#ifndef i386
#define SAVE_CONTEXT() save_context()
+#endif
#ifdef NULL
#undef NULL
Index: src/lisp/x86-arch.c
diff -u src/lisp/x86-arch.c:1.39 src/lisp/x86-arch.c:1.40
--- src/lisp/x86-arch.c:1.39 Tue Jan 6 13:18:43 2009
+++ src/lisp/x86-arch.c Tue Dec 21 21:12:52 2010
@@ -1,6 +1,6 @@
/* x86-arch.c -*- Mode: C; comment-column: 40 -*-
*
- * $Header: /project/cmucl/cvsroot/src/lisp/x86-arch.c,v 1.39 2009-01-06 18:18:43 rtoy Rel $
+ * $Header: /project/cmucl/cvsroot/src/lisp/x86-arch.c,v 1.40 2010-12-22 02:12:52 rtoy Exp $
*
*/
@@ -24,6 +24,50 @@
unsigned long fast_random_state = 1;
+#if defined(SOLARIS)
+/*
+ * Use the /dev/cpu/self/cpuid interface on Solaris. We could use the
+ * same method below, but the Sun C compiler miscompiles the inline
+ * assembly.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+
+void cpuid(int level, unsigned int* a, unsigned int* b,
+ unsigned int* c, unsigned int* d)
+{
+ int device;
+ uint32_t regs[4];
+ static const char devname[] = "/dev/cpu/self/cpuid";
+
+ *a = *b = *c = *d = 0;
+ if ((device = open(devname, O_RDONLY)) == -1) {
+ perror(devname);
+ goto exit;
+ }
+
+ if (pread(device, regs, sizeof(regs), 1) != sizeof(regs)) {
+ perror(devname);
+ goto exit;
+ }
+
+ *a = regs[0];
+ *b = regs[1];
+ *c = regs[2];
+ *d = regs[3];
+
+ exit:
+ (void) close(device);
+
+ return;
+}
+
+#else
#define __cpuid(level, a, b, c, d) \
__asm__ ("xchgl\t%%ebx, %1\n\t" \
"cpuid\n\t" \
@@ -43,6 +87,7 @@
*c = ecx;
*d = edx;
}
+#endif
int
arch_support_sse2(void)
Index: src/lisp/x86-assem.S
diff -u src/lisp/x86-assem.S:1.34 src/lisp/x86-assem.S:1.35
--- src/lisp/x86-assem.S:1.34 Mon Jul 19 19:08:37 2010
+++ src/lisp/x86-assem.S Tue Dec 21 21:12:52 2010
@@ -1,6 +1,6 @@
-### x86-assem.S -*- Mode: Asm; -*-
+/* ### x86-assem.S -*- Mode: Asm; -*- */
/**
- * $Header: /project/cmucl/cvsroot/src/lisp/x86-assem.S,v 1.34 2010-07-19 23:08:37 rtoy Rel $
+ * $Header: /project/cmucl/cvsroot/src/lisp/x86-assem.S,v 1.35 2010-12-22 02:12:52 rtoy Exp $
*
* Authors: Paul F. Werkowski <pw at snoopy.mv.com>
* Douglas T. Crosher
@@ -11,7 +11,7 @@
*
*/
-
+
#include "x86-validate.h"
#define LANGUAGE_ASSEMBLY
@@ -19,26 +19,43 @@
#include "lispregs.h"
/* Minimize conditionalization for different OS naming schemes */
-#ifndef DARWIN
+#ifdef DARWIN
+#define GNAME(var) _##var
+#define FUNCDEF(x) \
+ .text ; \
+ .align 2,0x90 ; \
+ .globl GNAME(x) ; \
+GNAME(x): ;
+#define ENDFUNC(x)
+#elif defined(SOLARIS)
#define GNAME(var) var
#define FUNCDEF(x) \
.text ; \
- .balign 4,0x90 ; \
+ .align 16,0x90 ; \
.globl GNAME(x) ; \
.type x, at function ; \
GNAME(x): ;
#define ENDFUNC(x) \
.size GNAME(x),.-GNAME(x)
#else
-#define GNAME(var) _##var
+#define GNAME(var) var
#define FUNCDEF(x) \
.text ; \
- .align 2,0x90 ; \
+ .balign 4,0x90 ; \
.globl GNAME(x) ; \
+ .type x, at function ; \
GNAME(x): ;
-#define ENDFUNC(x)
+#define ENDFUNC(x) \
+ .size GNAME(x),.-GNAME(x)
#endif
+#ifdef SOLARIS
+#define INT3 int $3
+
+#else
+#define INT3 int3
+#endif
+
/* Get the right type of alignment. Linux wants alignment in bytes. */
#if defined (__linux__) || defined (__FreeBSD__)
#define align_16byte 16
@@ -49,7 +66,7 @@
.text
.globl GNAME(foreign_function_call_active)
-
+
/*
* The C function will preserve ebx, esi, edi, and ebp across its
* function call - ebx is used to save the return lisp address.
@@ -122,7 +139,7 @@
jmp *%ebx
ENDFUNC(call_into_c)
-
+
/* The C conventions require that ebx, esi, edi, and ebp be preserved
across function calls. */
@@ -255,7 +272,7 @@
movl %edx,%eax # c-val
ret
ENDFUNC(call_into_lisp)
-
+
/* Support for saving and restoring the NPX state from C. */
FUNCDEF(fpu_save)
movl 4(%esp),%eax
@@ -284,7 +301,7 @@
fxrstor (%eax)
ret
ENDFUNC(sse_restore)
-
+
#if 0
/*
@@ -297,7 +314,7 @@
* The undefined-function trampoline.
*/
FUNCDEF(undefined_tramp)
- int3
+ INT3
.byte trap_Error
/* Number of argument bytes */
.byte 2
@@ -339,23 +356,23 @@
.globl GNAME(function_end_breakpoint_trap)
GNAME(function_end_breakpoint_trap):
- int3
+ INT3
.byte trap_FunctionEndBreakpoint
hlt # Should never return here.
.globl GNAME(function_end_breakpoint_end)
GNAME(function_end_breakpoint_end):
-
+
FUNCDEF(do_pending_interrupt)
- int3
+ INT3
.byte trap_PendingInterrupt
ret
ENDFUNC(do_pending_interrupt)
#ifdef trap_DynamicSpaceOverflowError
FUNCDEF(do_dynamic_space_overflow_error)
- int3
+ INT3
.byte trap_DynamicSpaceOverflowError
ret
ENDFUNC(do_dynamic_space_overflow_error)
@@ -363,13 +380,13 @@
#ifdef trap_DynamicSpaceOverflowWarning
FUNCDEF(do_dynamic_space_overflow_warning)
- int3
+ INT3
.byte trap_DynamicSpaceOverflowWarning
ret
ENDFUNC(do_dynamic_space_overflow_warning)
#endif
-
+
#ifdef WANT_CGC
/* A copy function optimized for the Pentium and works ok on
* 486 as well. This assumes (does not check) that the input
@@ -423,7 +440,7 @@
ret
ENDFUNC(fastcopy16)
#endif
-
+
/*
Allocate bytes and return the start of the allocated space
@@ -666,7 +683,7 @@
ret
ENDFUNC(alloc_16_to_edi)
-
+
#ifdef GENCGC
/* Called from lisp when an inline allocation overflows.
@@ -832,7 +849,7 @@
movl 8(%ebp),%eax
/* Now trap to Lisp */
- int3
+ INT3
.byte trap_Error
/* Number of argument bytes */
.byte 2
Index: src/lisp/x86-validate.h
diff -u src/lisp/x86-validate.h:1.32 src/lisp/x86-validate.h:1.33
--- src/lisp/x86-validate.h:1.32 Sat Dec 18 11:16:47 2010
+++ src/lisp/x86-validate.h Tue Dec 21 21:12:52 2010
@@ -3,7 +3,7 @@
* This code was written as part of the CMU Common Lisp project at
* Carnegie Mellon University, and has been placed in the public domain.
*
- * $Header: /project/cmucl/cvsroot/src/lisp/x86-validate.h,v 1.32 2010-12-18 16:16:47 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/x86-validate.h,v 1.33 2010-12-22 02:12:52 rtoy Exp $
*
*/
@@ -183,7 +183,7 @@
#define CONTROL_STACK_START 0x38000000
#define CONTROL_STACK_SIZE (0x07fff000 - 8192)
#define SIGNAL_STACK_START CONTROL_STACK_END
-#define SIGNAL_STACK_SIZE 8192
+#define SIGNAL_STACK_SIZE SIGSTKSZ
#define DYNAMIC_0_SPACE_START (SpaceStart_TargetDynamic)
@@ -199,6 +199,51 @@
#endif
#endif
+#ifdef SOLARIS
+/*
+ * The memory map for Solaris/x86 looks roughly like
+ *
+ * 0x08045000->0x08050000 C stack?
+ * 0x08050000-> Code + C heap
+ * 0x10000000->0x20000000 256 MB read-only space
+ * 0x20000000->0x28000000 128M Binding stack growing up.
+ * 0x28000000->0x30000000 256M Static Space.
+ * 0x30000000->0x31000000 16M Foreign linkage table
+ * 0x38000000->0x40000000 128M Control stack growing down.
+ * 0x40000000->0xD0000000 2304M Dynamic Space.
+ *
+ * Starting at 0xd0ce0000 there is some mapped anon memory. libc
+ * seems to start at 0xd0d40000 and other places. Looks like memory
+ * above 0xd0ffe000 or so is not mapped.
+ */
+
+#define READ_ONLY_SPACE_START (SpaceStart_TargetReadOnly)
+#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */
+
+#define STATIC_SPACE_START (SpaceStart_TargetStatic)
+#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */
+
+#define BINDING_STACK_START (0x20000000)
+#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */
+
+#define CONTROL_STACK_START 0x38000000
+#define CONTROL_STACK_SIZE (0x07fff000 - 8192)
+#define SIGNAL_STACK_START CONTROL_STACK_END
+#define SIGNAL_STACK_SIZE SIGSTKSZ
+
+#define DYNAMIC_0_SPACE_START (SpaceStart_TargetDynamic)
+
+#ifdef GENCGC
+#define DYNAMIC_SPACE_SIZE (0x66000000) /* 1.632GB */
+#else
+#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */
+#endif
+#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */
+#ifdef LINKAGE_TABLE
+#define FOREIGN_LINKAGE_SPACE_START (LinkageSpaceStart)
+#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */
+#endif
+#endif
#define CONTROL_STACK_END (CONTROL_STACK_START + CONTROL_STACK_SIZE)
Index: src/tools/clean-target.sh
diff -u src/tools/clean-target.sh:1.9 src/tools/clean-target.sh:1.10
--- src/tools/clean-target.sh:1.9 Mon May 10 15:30:40 2010
+++ src/tools/clean-target.sh Tue Dec 21 21:12:52 2010
@@ -48,9 +48,11 @@
if [ -n "$KEEP" ]; then
case $KEEP in
- lib) GREP='grep -v \(gray-streams\|gray-compat\|simple-streams\|iodefs\|external-formats\|clx\|hemlock\|clm\)-library' ;;
+ lib) GREP='egrep -v'
+ PATTERN='(gray-streams|gray-compat|simple-streams|iodefs|external-formats|clx|hemlock|clm)-library' ;;
core) CORE='' ;;
- all) GREP='grep -v \(gray-streams\|gray-compat\|simple-streams\|iodefs\|external-formats\|clx\|hemlock\|clm\)-library\|\(asdf\|defsystem\)'
+ all) GREP='egrep -v'
+ PATTERN='(gray-streams|gray-compat|simple-streams|iodefs|external-formats|clx|hemlock|clm)-library|(asdf|defsystem)'
CORE='' ;;
esac
fi
@@ -63,7 +65,7 @@
-name "*.ppcf" -o \
-name "*.sparcf" -o \
-name "*.x86f" -o \
- -name "*.sse2f" $CORE | $GREP | xargs rm 2> /dev/null
+ -name "*.sse2f" $CORE | $GREP $PATTERN | xargs rm 2> /dev/null
for d in $TARGET
do
Index: src/tools/create-target.sh
diff -u src/tools/create-target.sh:1.13 src/tools/create-target.sh:1.14
--- src/tools/create-target.sh:1.13 Mon Feb 1 21:45:54 2010
+++ src/tools/create-target.sh Tue Dec 21 21:12:52 2010
@@ -26,7 +26,12 @@
# Only target directory given. Try to deduce the lisp-variant
TARGET_DIR="$1"
case `uname -s` in
- SunOS) LISP_VARIANT=sparc_gcc ;;
+ SunOS)
+ case `uname -m` in
+ i86pc) LISP_VARIANT=x86_solaris_sunc ;;
+ sun*) LISP_VARIANT=sparc_gcc ;;
+ esac
+ ;;
Linux) LISP_VARIANT=x86_linux ;;
Darwin) case `uname -m` in
ppc) LISP_VARIANT=ppc_darwin ;;
@@ -71,7 +76,7 @@
OpenBSD*) MOTIF_VARIANT=OpenBSD ;;
*_darwin) MOTIF_VARIANT=Darwin ;;
sun4_solaris_gcc|sparc_gcc) MOTIF_VARIANT=solaris ;;
- sun4_solaris_sunc|sparc_sunc) MOTIF_VARIANT=solaris_sunc ;;
+ sun4_solaris_sunc|sparc_sunc|x86_solaris_sunc) MOTIF_VARIANT=solaris_sunc ;;
sun4c*) MOTIF_VARIANT=sun4c_411 ;;
hp700*) MOTIF_VARIANT=hpux_cc ;;
pmax_mach) MOTIF_VARIANT=pmax_mach ;;
Index: src/tools/cross-scripts/cross-x86-osx-solaris.lisp
diff -u /dev/null src/tools/cross-scripts/cross-x86-osx-solaris.lisp:1.2
--- /dev/null Tue Dec 21 21:12:52 2010
+++ src/tools/cross-scripts/cross-x86-osx-solaris.lisp Tue Dec 21 21:12:52 2010
@@ -0,0 +1,238 @@
+;; Basic cross-compile script for cross-compiling from x86 on darwin
+;; (Mac OS X) to x86 on Solaris. This is a basic x86-to-x86
+;; cross-compile, except we tweek the features and misfeatures
+;; for Solaris/x86.
+
+(in-package :cl-user)
+
+;;; Rename the X86 package and backend so that new-backend does the
+;;; right thing.
+(rename-package "X86" "OLD-X86" '("OLD-VM"))
+(setf (c:backend-name c:*native-backend*) "OLD-X86")
+
+(c::new-backend "X86"
+ ;; Features to add here. These are just examples. You may not
+ ;; need to list anything here. We list them here anyway as a
+ ;; record of typical features for all x86 ports.
+ '(:x86
+ :i486
+ :pentium
+ :stack-checking ; Catches stack overflow
+ :heap-overflow-check ; Catches heap overflows
+ :relative-package-names ; relative package names
+ :mp ; multiprocessing
+ :gencgc ; Generational GC
+ :conservative-float-type
+ :complex-fp-vops
+ :hash-new
+ :random-mt19937
+ :cmu :cmu20 :cmu20b ; Version features
+ :double-double ; double-double float support
+ :linkage-table
+
+ :solaris :svr4 :sunos
+ ;; The :sse2 and :x87 features will get set by the compiling
+ ;; lisp, so don't set it here!
+ #+x87 :x87
+ #+sse2 :sse2
+ )
+ ;; Features to remove from current *features* here. Normally don't
+ ;; need to list anything here unless you are trying to remove a
+ ;; feature.
+ '(:x86-bootstrap
+ ;; :alpha :osf1 :mips
+ :propagate-fun-type :propagate-float-type :constrain-float-type
+ ;; :openbsd :freebsd :glibc2 :linux
+ :mach-o :darwin
+ :long-float :new-random :small))
+;;;
+(setf *features* (remove :bsd *features*))
+;; Set up the linkage space stuff appropriately for sparc.
+(setf (c::backend-foreign-linkage-space-start c::*target-backend*)
+ #x30000000
+ (c::backend-foreign-linkage-entry-size c::*target-backend*)
+ 8)
+
+;;;
+;;; Compile the new backend.
+(pushnew :bootstrap *features*)
+(pushnew :building-cross-compiler *features*)
+
+;; Make fixup-code-object and sanctify-for-execution in the VM package
+;; be the same as the original. Needed to get rid of a compiler error
+;; in generic/core.lisp. (This halts cross-compilations if the
+;; compiling lisp uses the -batch flag.
+(import 'old-vm::fixup-code-object "VM")
+(import 'old-vm::sanctify-for-execution "VM")
+(export 'vm::fixup-code-object "VM")
+(export 'vm::sanctify-for-execution "VM")
+
+(load "target:tools/comcom")
+
+;;; Load the new backend.
+(setf (search-list "c:")
+ '("target:compiler/"))
+(setf (search-list "vm:")
+ '("c:x86/" "c:generic/"))
+(setf (search-list "assem:")
+ '("target:assembly/" "target:assembly/x86/"))
+
+;; Load the backend of the compiler.
+
+(in-package "C")
+
+(load "vm:vm-macs")
+(load "vm:parms")
+(load "vm:objdef")
+(load "vm:interr")
+(load "assem:support")
+
+(load "target:compiler/srctran")
+(load "vm:vm-typetran")
+(load "target:compiler/float-tran")
+(load "target:compiler/saptran")
+
+(load "vm:macros")
+(load "vm:utils")
+
+(load "vm:vm")
+(load "vm:insts")
+(load "vm:primtype")
+(load "vm:move")
+(load "vm:sap")
+(when (target-featurep :sse2)
+ (load "vm:sse2-sap"))
+(load "vm:system")
+(load "vm:char")
+(if (target-featurep :sse2)
+ (load "vm:float-sse2")
+ (load "vm:float"))
+
+(load "vm:memory")
+(load "vm:static-fn")
+(load "vm:arith")
+(load "vm:cell")
+(load "vm:subprim")
+(load "vm:debug")
+(load "vm:c-call")
+(if (target-featurep :sse2)
+ (load "vm:sse2-c-call")
+ (load "vm:x87-c-call"))
+
+(load "vm:print")
+(load "vm:alloc")
+(load "vm:call")
+(load "vm:nlx")
+(load "vm:values")
+;; These need to be loaded before array because array wants to use
+;; some vops as templates.
+(load (if (target-featurep :sse2)
+ "vm:sse2-array"
+ "vm:x87-array"))
+(load "vm:array")
+(load "vm:pred")
+(load "vm:type-vops")
+
+(load "assem:assem-rtns")
+
+(load "assem:array")
+(load "assem:arith")
+(load "assem:alloc")
+
+(load "c:pseudo-vops")
+
+(check-move-function-consistency)
+
+(load "vm:new-genesis")
+
+;;; OK, the cross compiler backend is loaded.
+
+(setf *features* (remove :building-cross-compiler *features*))
+
+;;; Info environment hacks.
+(macrolet ((frob (&rest syms)
+ `(progn ,@(mapcar #'(lambda (sym)
+ `(defconstant ,sym
+ (symbol-value
+ (find-symbol ,(symbol-name sym)
+ :vm))))
+ syms))))
+ (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS
+ OLD-VM:CHAR-BITS
+ #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
+ #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE
+ OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
+ OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE
+ OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE
+ OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE
+ OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE
+ OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
+ OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE
+ OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
+ OLD-VM:SIMPLE-BIT-VECTOR-TYPE
+ OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE
+ OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET
+ OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE
+ OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX
+ OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE
+ OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE
+ OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX
+ OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE
+ )
+ #+double-double
+ (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE
+ OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE))
+
+;; Modular arith hacks
+(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32)
+(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32)
+;; End arith hacks
+
+(let ((function (symbol-function 'kernel:error-number-or-lose)))
+ (let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
+ (setf (symbol-function 'kernel:error-number-or-lose) function)
+ (setf (info function kind 'kernel:error-number-or-lose) :function)
+ (setf (info function where-from 'kernel:error-number-or-lose) :defined)))
+
+(defun fix-class (name)
+ (let* ((new-value (find-class name))
+ (new-layout (kernel::%class-layout new-value))
+ (new-cell (kernel::find-class-cell name))
+ (*info-environment* (c:backend-info-environment c:*target-backend*)))
+ (remhash name kernel::*forward-referenced-layouts*)
+ (kernel::%note-type-defined name)
+ (setf (info type kind name) :instance)
+ (setf (info type class name) new-cell)
+ (setf (info type compiler-layout name) new-layout)
+ new-value))
+(fix-class 'c::vop-parse)
+(fix-class 'c::operand-parse)
+
+#+random-mt19937
+(declaim (notinline kernel:random-chunk))
+
+(setf c:*backend* c:*target-backend*)
+
+;;; Extern-alien-name for the new backend.
+(in-package :vm)
+(defun extern-alien-name (name)
+ (declare (type simple-string name))
+ name)
+(export 'extern-alien-name)
+(in-package :cl-user)
+
+;;; Don't load compiler parts from the target compilation
+
+(defparameter *load-stuff* nil)
+
+;; hack, hack, hack: Make old-vm::any-reg the same as
+;; x86::any-reg as an SC. Do this by adding old-vm::any-reg
+;; to the hash table with the same value as x86::any-reg.
+(let ((ht (c::backend-sc-names c::*target-backend*)))
+ (setf (gethash 'old-vm::any-reg ht)
+ (gethash 'vm::any-reg ht)))
Index: src/tools/make-dist.sh
diff -u src/tools/make-dist.sh:1.17 src/tools/make-dist.sh:1.18
--- src/tools/make-dist.sh:1.17 Thu Sep 30 17:21:41 2010
+++ src/tools/make-dist.sh Tue Dec 21 21:12:52 2010
@@ -9,7 +9,7 @@
# you extracted the two tarballs and the source distribution into that
# directory.
#
-# $Header: /project/cmucl/cvsroot/src/tools/make-dist.sh,v 1.17 2010-09-30 21:21:41 rtoy Exp $
+# $Header: /project/cmucl/cvsroot/src/tools/make-dist.sh,v 1.18 2010-12-22 02:12:52 rtoy Exp $
usage() {
echo "make-dist.sh: [-hbg] [-G group] [-O owner] [-I destdir] [-M mandir] dir version [arch os]"
@@ -52,11 +52,16 @@
def_arch_os () {
case `uname -s` in
SunOS)
- ARCH=sparcv9
+ case `uname -m` in
+ sun*)
+ ARCH=sparcv9 ;;
+ i*)
+ ARCH=x86 ;;
+ esac
uname_r=`uname -r`
case $uname_r in
- 5.*) rel=`echo $uname_r | sed 's/5\.//'`;;
- *) rel=$uname_r;;
+ 5.*) rel=`echo $uname_r | sed 's/5\.//'`;;
+ *) rel=$uname_r;;
esac
OS=solaris$rel
;;
More information about the cmucl-commit
mailing list