[cmucl-cvs] CMUCL commit: cross-sol-x86-branch src (10 files)

Raymond Toy rtoy at common-lisp.net
Tue Dec 14 04:25:11 UTC 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-cvs mailing list