[cmucl-commit] CMUCL commit: cross-sol-x86-branch src (10 files)
Raymond Toy
rtoy at common-lisp.net
Tue Dec 14 05:25:11 CET 2010
Date: Monday, December 13, 2010 @ 23:25:11
Author: rtoy
Path: /project/cmucl/cvsroot/src
Tag: cross-sol-x86-branch
Added: lisp/Config.x86_solaris_sunc
tools/cross-scripts/cross-x86-osx-solaris.lisp
Modified: compiler/x86/parms.lisp lisp/Config.sparc_common
lisp/Config.sparc_sunc lisp/interrupt.c lisp/solaris-os.c
lisp/sunos-os.h lisp/x86-assem.S lisp/x86-validate.h
First cut at a build for Solaris/x86. Result doesn't work; it gets as
far as TYPE-INIT, but then crashes.
These changes still allow solaris/sparc and darwin/x86 to build, so we
haven't broken both sparc and x86 while doing this.
tools/cross-scripts/cross-x86-osx-solaris.lisp:
o New cross-compile script to use darwin/x86 to cross-compile to
solaris/x86.
compiler/x86/parms.lisp:
o For now, put thel linkage space start at 0xc0000000 on Solaris/x86.
lisp/Config.sparc_common:
o Separate out the common parts between Solaris sparc and x86. Move
the different parts into the appropriate file.
lisp/Config.sparc_sunc:
o Add ASSEM_SRC and ARCH_SRC here, with the appropriate OS_SRC,
OS_LINK_FLAGS, and OS_LIBS>
lisp/Config.x86_solaris_sunc:
o New file for building solaris/x86 using Sun C (aka Sun Studio aka
Solaris Studio)
lisp/interrupt.c:
o Use a static array for the altstack. Should eventually do what
other x86 platforms do.
lisp/solaris-os.c:
o Don't need os_flush_icache on x86 (?), so make the body empty for
x86.
o Add x86 version of os_sigcontext_reg and os_sigcontext_pc.
lisp/sunos-os.h:
o The pagesize is 4096 on x86 instead of 8192.
o Don't need (?) SAVE_CONTEXT.
lisp/x86-assem.S:
o Update to support Sun C assembler:
- Add appropriate GNAME, FUNCDEF and ENDFUNC macros.
- Sun assembler doesn't have int3 instruction, so add INT3 macro to
do the appropriate things.
- Sun assembler doesn't like control L characters in the file so
remove them.
lisp/x86-validate.h:
o Add entry for Solaris. This needs work, but it looks like these
values will work.
------------------------------------------------+
compiler/x86/parms.lisp | 5
lisp/Config.sparc_common | 8
lisp/Config.sparc_sunc | 7
lisp/Config.x86_solaris_sunc | 14 +
lisp/interrupt.c | 6
lisp/solaris-os.c | 37 +++
lisp/sunos-os.h | 8
lisp/x86-assem.S | 61 +++--
lisp/x86-validate.h | 31 ++-
tools/cross-scripts/cross-x86-osx-solaris.lisp | 236 +++++++++++++++++++++++
10 files changed, 378 insertions(+), 35 deletions(-)
Index: src/compiler/x86/parms.lisp
diff -u src/compiler/x86/parms.lisp:1.41 src/compiler/x86/parms.lisp:1.41.2.1
--- src/compiler/x86/parms.lisp:1.41 Sat Dec 4 12:32:34 2010
+++ src/compiler/x86/parms.lisp Mon Dec 13 23:25:11 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.41.2.1 2010-12-14 04:25:11 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -65,7 +65,8 @@
(setf (c::backend-foreign-linkage-space-start *target-backend*)
#+linux #x58000000
- #-linux #xB0000000
+ #+solaris #xC0000000
+ #-(or linux solaris) #xB0000000
(c::backend-foreign-linkage-entry-size *target-backend*)
8)
); eval-when
Index: src/lisp/Config.sparc_common
diff -u src/lisp/Config.sparc_common:1.3 src/lisp/Config.sparc_common:1.3.6.1
--- src/lisp/Config.sparc_common:1.3 Wed Jul 28 21:51:12 2010
+++ src/lisp/Config.sparc_common Mon Dec 13 23:25:11 2010
@@ -38,11 +38,11 @@
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.2.12.1
--- src/lisp/Config.sparc_sunc:1.2 Mon Feb 1 11:41:39 2010
+++ src/lisp/Config.sparc_sunc Mon Dec 13 23:25:11 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.1.2.1
--- /dev/null Mon Dec 13 23:25:11 2010
+++ src/lisp/Config.x86_solaris_sunc Mon Dec 13 23:25:11 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/interrupt.c
diff -u src/lisp/interrupt.c:1.60 src/lisp/interrupt.c:1.60.12.1
--- src/lisp/interrupt.c:1.60 Mon Nov 2 10:05:07 2009
+++ src/lisp/interrupt.c Mon Dec 13 23:25:11 2010
@@ -1,4 +1,4 @@
-/* $Header: /project/cmucl/cvsroot/src/lisp/interrupt.c,v 1.60 2009-11-02 15:05:07 rtoy Rel $ */
+/* $Header: /project/cmucl/cvsroot/src/lisp/interrupt.c,v 1.60.12.1 2010-12-14 04:25:11 rtoy Exp $ */
/* Interrupt handling magic. */
@@ -396,7 +396,7 @@
* Noise to install handlers. *
\****************************************************************/
-#if !(defined(i386) || defined(__x86_64))
+#if defined(SOLARIS) || !(defined(i386) || defined(__x86_64))
#define SIGNAL_STACK_SIZE SIGSTKSZ
static char altstack[SIGNAL_STACK_SIZE];
#endif
@@ -422,7 +422,7 @@
if (signal == PROTECTION_VIOLATION_SIGNAL) {
stack_t sigstack;
-#if (defined( i386 ) || defined(__x86_64))
+#if !defined(SOLARIS) && (defined( i386 ) || defined(__x86_64))
sigstack.ss_sp = (void *) SIGNAL_STACK_START;
#else
sigstack.ss_sp = (void *) altstack;
Index: src/lisp/solaris-os.c
diff -u src/lisp/solaris-os.c:1.26 src/lisp/solaris-os.c:1.26.4.1
--- src/lisp/solaris-os.c:1.26 Fri Nov 12 07:57:32 2010
+++ src/lisp/solaris-os.c Mon Dec 13 23:25:11 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.26.4.1 2010-12-14 04:25:11 rtoy Exp $
*
* OS-dependent routines. This file (along with os.h) exports an
* OS-independent interface to the operating system VM facilities.
@@ -138,6 +138,7 @@
void
os_flush_icache(os_vm_address_t address, os_vm_size_t length)
{
+#ifndef i386
static int flushit = -1;
/*
@@ -158,6 +159,7 @@
fprintf(stderr, ";;;iflush %p - %lx\n", (void *) address, length);
flush_icache((unsigned int *) address, length);
}
+#endif
}
void
@@ -492,3 +494,36 @@
return sym_addr;
}
+
+#ifdef i386
+unsigned long *
+os_sigcontext_reg(ucontext_t *scp, int index)
+{
+ 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)
+{
+ return (unsigned long *) &scp->uc_mcontext.gregs[EIP];
+}
+
+#endif
Index: src/lisp/sunos-os.h
diff -u src/lisp/sunos-os.h:1.13 src/lisp/sunos-os.h:1.13.32.1
--- src/lisp/sunos-os.h:1.13 Mon Mar 17 23:58:45 2008
+++ src/lisp/sunos-os.h Mon Dec 13 23:25:11 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.13.32.1 2010-12-14 04:25:11 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-assem.S
diff -u src/lisp/x86-assem.S:1.34 src/lisp/x86-assem.S:1.34.6.1
--- src/lisp/x86-assem.S:1.34 Mon Jul 19 19:08:37 2010
+++ src/lisp/x86-assem.S Mon Dec 13 23:25:11 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.34.6.1 2010-12-14 04:25:11 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.31 src/lisp/x86-validate.h:1.31.8.1
--- src/lisp/x86-validate.h:1.31 Fri May 21 15:26:53 2010
+++ src/lisp/x86-validate.h Mon Dec 13 23:25:11 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.31 2010-05-21 19:26:53 rtoy Rel $
+ * $Header: /project/cmucl/cvsroot/src/lisp/x86-validate.h,v 1.31.8.1 2010-12-14 04:25:11 rtoy Exp $
*
*/
@@ -172,7 +172,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)
@@ -188,6 +188,33 @@
#endif
#endif
+#ifdef SOLARIS
+#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_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/cross-scripts/cross-x86-osx-solaris.lisp
diff -u /dev/null src/tools/cross-scripts/cross-x86-osx-solaris.lisp:1.1.2.1
--- /dev/null Mon Dec 13 23:25:11 2010
+++ src/tools/cross-scripts/cross-x86-osx-solaris.lisp Mon Dec 13 23:25:11 2010
@@ -0,0 +1,236 @@
+;; 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
+ ;; The :sse2 and :x87 features will get set by the compiling
+ ;; lisp, so don't set it here!
+ )
+ ;; 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*)
+ #xC0000000
+ (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)))
More information about the cmucl-commit
mailing list