From 555746e0333d79a44bb4c57493449ac1cd3ca2e6 Mon Sep 17 00:00:00 2001 From: cshapiro <cshapiro> Date: Fri, 6 Jul 2007 08:04:40 +0000 Subject: [PATCH] Import x86 Darwin port. --- code/bsd-os.lisp | 4 ++- code/debug-int.lisp | 6 ++-- code/float-trap.lisp | 8 ++--- code/unix.lisp | 67 ++++++---------------------------------- code/x86-vm.lisp | 45 ++++++++++++++++++++------- compiler/x86/c-call.lisp | 3 +- compiler/x86/parms.lisp | 5 ++- compiler/x86/print.lisp | 16 +++++++++- lisp/Config.x86_darwin | 19 ++++++++++++ lisp/Darwin-os.c | 64 +++++++++++++++++++++++++------------- lisp/breakpoint.c | 6 ++-- lisp/coreparse.c | 5 ++- lisp/gencgc.c | 39 +++++++++++++---------- lisp/interrupt.c | 14 +++++++-- lisp/lisp.c | 6 ++-- lisp/os-common.c | 4 +-- lisp/purify.c | 8 ++--- lisp/x86-arch.c | 8 ++--- lisp/x86-assem.S | 65 +++++++++++++++++++------------------- lisp/x86-lispregs.h | 9 ++++-- lisp/x86-validate.h | 8 ++--- tools/create-target.sh | 6 +++- 22 files changed, 234 insertions(+), 181 deletions(-) create mode 100644 lisp/Config.x86_darwin diff --git a/code/bsd-os.lisp b/code/bsd-os.lisp index 1b7309800..e4b4de2a5 100644 --- a/code/bsd-os.lisp +++ b/code/bsd-os.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bsd-os.lisp,v 1.8 2005/07/13 13:40:55 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bsd-os.lisp,v 1.9 2007/07/06 08:04:38 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -35,6 +35,8 @@ (register-lisp-feature :freebsd4) #+elf (register-lisp-feature :elf) +#+mach-o +(register-lisp-feature :mach-o) (setq *software-type* #+OpenBSD "OpenBSD" #+NetBSD "NetBSD" diff --git a/code/debug-int.lisp b/code/debug-int.lisp index c25bc5de2..8f3abe803 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.127 2007/03/28 04:30:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.128 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -954,11 +954,11 @@ (when (zerop depth) (format t "Debug: Both still valid ~s ~s ~s ~s~%" lisp-ocfp lisp-ra c-ocfp c-ra)) - #+FreeBSD4 + #+(or darwin FreeBSD4) (if (sap> lisp-ocfp c-ocfp) (values lisp-ra lisp-ocfp) (values c-ra c-ocfp)) - #-FreeBSD4 + #-(or darwin FreeBSD4) (values lisp-ra lisp-ocfp)) (lisp-path-fp ;; The lisp convention is looking good. diff --git a/code/float-trap.lisp b/code/float-trap.lisp index 2450e5bc0..a0646e43c 100644 --- a/code/float-trap.lisp +++ b/code/float-trap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.29 2006/12/02 15:22:36 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.30 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -116,7 +116,7 @@ (when current-x-p (setf (ldb float-exceptions-byte modes) (float-trap-mask current-exceptions)) - #+darwin + #+(and darwin ppc) (when (member :invalid current-exceptions) ;; Clear out the bits for the detected invalid operation (setf (ldb vm:float-invalid-op-1-byte modes) 0))) @@ -124,7 +124,7 @@ (when accrued-x-p (setf (ldb float-sticky-bits modes) (float-trap-mask accrued-exceptions)) - #+darwin + #+(and darwin ppc) (when (member :invalid current-exceptions) ;; Clear out the bits for the detected invalid operation (setf (ldb vm:float-invalid-op-1-byte modes) 0))) @@ -247,7 +247,7 @@ (alien:sap-alien scp (* unix:sigcontext)))) (traps (logand (ldb float-exceptions-byte modes) (ldb float-traps-byte modes)))) - #+darwin + #+(and darwin ppc) (let ((new-modes modes)) ;; Clear out all exceptions and save them to the context. ;; diff --git a/code/unix.lisp b/code/unix.lisp index 30f78d6db..4b8625a43 100644 --- a/code/unix.lisp +++ b/code/unix.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.109 2006/01/19 04:07:53 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.110 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -489,7 +489,7 @@ (st-blocks #-alpha long #+alpha int) (st-spare4 (array long 2)))) -#+(and :BSD (not :darwin)) +#+bsd (def-alien-type nil (struct stat (st-dev dev-t) @@ -512,37 +512,6 @@ (st-lspare long) (st-qspare (array long 4)))) -#+(and :BSD :darwin) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - #+LONG-STAT - (st-size off-t) - #-LONG-STAT - (st-sizeh unsigned-long) - #-LONG-STAT - (st-size unsigned-long) - #+LONG-STAT - (st-blocks int64-t) - #-LONG-STAT - (st-blocksh unsigned-long) - #-LONG-STAT - (st-blocks unsigned-long) - (st-blksize unsigned-long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-lspare long) - (st-qspare (array long 4)))) ; 2 quads - #+(or linux svr4) (def-alien-type nil (struct stat @@ -1014,7 +983,7 @@ (pw-dir (* char)) ; user's home directory (pw-shell (* char)))) ; user's login shell -#+freebsd +#+bsd (def-alien-type nil (struct passwd (pw-name (* char)) ; user's login name @@ -1027,22 +996,8 @@ (pw-dir (* char)) ; user's home directory (pw-shell (* char)) ; user's login shell (pw-expire int) ; account expiration - (pw-fields int))) ; internal - -#+(or netbsd darwin) -(def-alien-type nil - (struct passwd - (pw-name (* char)) ; user's login name - (pw-passwd (* char)) ; no longer used - (pw-uid uid-t) ; user id - (pw-gid gid-t) ; group id - (pw-change time-t) ; password change time - (pw-class (* char)) ; user access class - (pw-gecos (* char)) ; typically user's full name - (pw-dir (* char)) ; user's home directory - (pw-shell (* char)) ; user's login shell - (pw-expire int))) ; account expiration - + #+(or freebsd darwin) + (pw-fields int))) ; internal ;; see <grp.h> (def-alien-type nil @@ -3092,7 +3047,7 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) -#+(or FreeBSD NetBSD darwin) +#+bsd (defun unix-getpwnam (login) "Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." (declare (type simple-string login)) @@ -3248,7 +3203,7 @@ :until (zerop (sap-int (alien-sap member))) :collect (string (cast member c-call:c-string)))))))) -#+(or FreeBSD NetBSD (and ppc darwin)) +#+bsd (defun unix-getgrgid (gid) "Return a GROUP-INFO structure for the group identified by GID, or NIL if not found." (declare (type unix-gid gid)) @@ -3304,15 +3259,13 @@ :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) ;; From sys/utsname.h -#+(or solaris darwin freebsd netbsd) +#+(or solaris bsd) (eval-when (:compile-toplevel :load-toplevel :execute) (defconstant +sys-namelen+ #+solaris 257 - #+darwin 256 - #+freebsd 32 - #+netbsd 256)) + #+bsd 256)) -#+(or solaris darwin freebsd netbsd) +#+(or solaris bsd) (progn (def-alien-type nil (struct utsname diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp index 6078286bb..03e5368f4 100644 --- a/code/x86-vm.lisp +++ b/code/x86-vm.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.23 2005/12/29 10:23:12 rswindells Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.24 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -55,6 +55,33 @@ (fpreg (array (struct fpreg) 8)) (status unsigned-long))) +#+darwin +(def-alien-type sigcontext + (struct nil + ;; x86_exception_state32_t + (trapno unsigned-int) + (err unsigned-int) + (faultvaddr unsigned-int) + ;; x86_thread_state32_t + (sc-eax unsigned-int) + (sc-ebx unsigned-int) + (sc-ecx unsigned-int) + (sc-edx unsigned-int) + (sc-edi unsigned-int) + (sc-esi unsigned-int) + (sc-fp unsigned-int) + (sc-sp unsigned-int) + (ss unsigned-int) + (eflags unsigned-int) + (sc-pc unsigned-int) + (cs unsigned-int) + (ds unsigned-int) + (es unsigned-int) + (fs unsigned-int) + (gs unsigned-int) + ;; x86_float_state32_t + (fpstate (array char 512)))) + ;;; for FreeBSD #+(and freebsd (not freebsd4)) (def-alien-type sigcontext @@ -549,19 +576,13 @@ ;;; same format as returned by FLOATING-POINT-MODES. ;;; -#+(or freebsd openbsd) +#+bsd (defun sigcontext-floating-point-modes (scp) (declare (type (alien (* sigcontext)) scp) (ignore scp)) ;; This is broken until some future release of FreeBSD/OpenBSD!!! (floating-point-modes)) -#+netbsd -(defun sigcontext-floating-point-modes (ucp) - (declare (type (alien (* sigcontext)) ucp) - (ignore ucp)) - (floating-point-modes)) - #+linux (defun sigcontext-floating-point-modes (scp) (declare (type (alien (* sigcontext)) scp)) @@ -582,10 +603,10 @@ ;;; (defun extern-alien-name (name) (declare (type simple-string name)) - #+(and bsd (not elf)) - (concatenate 'string "_" name) - #-(and bsd (not elf)) - name) + #+(or elf mach-o) + name + #-(or elf mach-o) + (concatenate 'string "_" name)) #+(and (or linux (and freebsd elf)) (not linkage-table)) (defun lisp::foreign-symbol-address-aux (name flavor) diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp index 1801ee58e..c3916b0b8 100644 --- a/compiler/x86/c-call.lisp +++ b/compiler/x86/c-call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.16 2004/10/24 16:58:55 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.17 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -273,6 +273,7 @@ (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) (inst sub esp-tn delta))) + #+darwin (inst and esp-tn #xfffffff0) (move result esp-tn))) (define-vop (dealloc-number-stack-space) diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp index 92d44c9e7..4d0e51e9e 100644 --- a/compiler/x86/parms.lisp +++ b/compiler/x86/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.31 2006/08/18 02:29:28 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.32 2007/07/06 08:04:39 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -191,8 +191,7 @@ #-FreeBSD #x28000000) (defconstant target-dynamic-space-start #+linux #x58100000 - #+(or FreeBSD OpenBSD) #x48000000 - #+NetBSD #x48800000) + #-linux #x48000000) (defconstant target-foreign-linkage-space-start #+linux #x58000000 #-linux #xB0000000) diff --git a/compiler/x86/print.lisp b/compiler/x86/print.lisp index 899a5b5d5..fdd3823ac 100644 --- a/compiler/x86/print.lisp +++ b/compiler/x86/print.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/print.lisp,v 1.4 1999/12/04 16:06:08 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/print.lisp,v 1.5 2007/07/06 08:04:39 cshapiro Rel $") ;;; ;;; ********************************************************************** ;;; @@ -23,11 +23,25 @@ (:args (object :scs (descriptor-reg any-reg))) (:temporary (:sc unsigned-reg :offset eax-offset :target result :from :eval :to :result) eax) + #+darwin + (:temporary (:sc unsigned-reg) temp) (:results (result :scs (descriptor-reg))) (:save-p t) + #-darwin (:generator 100 (inst push object) (inst lea eax (make-fixup (extern-alien-name "debug_print") :foreign)) (inst call (make-fixup (extern-alien-name "call_into_c") :foreign)) (inst add esp-tn word-bytes) + (move result eax)) + #+darwin + (:generator 100 + (inst mov temp esp-tn) + (inst sub esp-tn 8) + (inst and esp-tn #xfffffff0) + (inst mov (make-ea :dword :base esp-tn) object) + (inst mov (make-ea :dword :base esp-tn :disp 4) temp) + (inst lea eax (make-fixup (extern-alien-name "debug_print") :foreign)) + (inst call (make-fixup (extern-alien-name "call_into_c") :foreign)) + (inst mov esp-tn (make-ea :dword :base esp-tn :disp 4)) (move result eax))) diff --git a/lisp/Config.x86_darwin b/lisp/Config.x86_darwin new file mode 100644 index 000000000..4697e8422 --- /dev/null +++ b/lisp/Config.x86_darwin @@ -0,0 +1,19 @@ +PATH1 = ../../src/lisp +vpath %.h $(PATH1) +vpath %.c $(PATH1) +vpath %.S $(PATH1) +INCLUDES = -iquote . -iquote $(PATH1) +CC = gcc +LD = ld +CPP = cpp +CPPFLAGS = -Di386 -DDARWIN -DGENCGC -DLINKAGE_TABLE +CFLAGS = -Wstrict-prototypes -Wall -g3 $(CPPFLAGS) $(INCLUDES) +ASFLAGS = -g3 -DGENCGC -DLINKAGE_TABLE $(INCLUDES) +NM = nm -gp +UNDEFSYMPATTERN = -Xlinker -u -Xlinker & +ASSEM_SRC = x86-assem.S +ARCH_SRC = x86-arch.c +OS_SRC = Darwin-os.c os-common.c e_rem_pio2.c k_rem_pio2.c +# OS_LINK_FLAGS = -dynamic -export-dynamic +OS_LIBS = +GC_SRC = gencgc.c diff --git a/lisp/Darwin-os.c b/lisp/Darwin-os.c index e396e94e1..ef4e99db9 100644 --- a/lisp/Darwin-os.c +++ b/lisp/Darwin-os.c @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.8 2007/06/12 03:21:46 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.9 2007/07/06 08:04:39 cshapiro Exp $ * */ @@ -22,7 +22,7 @@ #include <sys/param.h> #include <sys/file.h> #include <errno.h> -#include "./signal.h" +#include <dlfcn.h> #include "os.h" #include "arch.h" #include "globals.h" @@ -38,7 +38,6 @@ /* #include <sys/sysinfo.h> */ /* #include <sys/proc.h> */ /* For timebase info */ -#include <sys/param.h> #include <sys/sysctl.h> @@ -62,6 +61,7 @@ int cycles_per_tick = 1; * counter; we have to derive the relationship ourselves. */ +#ifdef __ppc__ void timebase_init() { @@ -97,13 +97,16 @@ timebase_init() cycles_per_tick = cpufrequency / tbfrequency; } +#endif void os_init(void) { os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; +#ifdef __ppc__ timebase_init(); +#endif } int @@ -119,7 +122,7 @@ os_set_errno(int newvalue) return errno; } - +#if defined(__ppc__) int * sc_reg(os_context_t * context, int offset) { @@ -206,6 +209,33 @@ sc_reg(os_context_t * context, int offset) return (int *) 0; } +#elif defined(__i386__) +int * +sc_reg(os_context_t *context, int offset) +{ + struct i386_thread_state *ss = &context->uc_mcontext->ss; + switch (offset) { + case 0: + return &ss->eax; + case 2: + return &ss->ecx; + case 4: + return &ss->edx; + case 6: + return &ss->ebx; + case 8: + return &ss->esp; + case 10: + return &ss->ebp; + case 12: + return &ss->esi; + case 14: + return &ss->edi; + } + + return (int *) 0; +} +#endif void os_save_context(void) @@ -228,7 +258,7 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) if (addr) flags |= MAP_FIXED; - DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); + DPRINTF(0, (stderr, "os_validate %p %d => ", addr, len)); addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); @@ -237,7 +267,7 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) return NULL; } - DPRINTF(0, (stderr, "%x\n", addr)); + DPRINTF(0, (stderr, "%p\n", addr)); return addr; } @@ -245,7 +275,7 @@ os_validate(os_vm_address_t addr, os_vm_size_t len) void os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); + DPRINTF(0, (stderr, "os_invalidate %p %d\n", addr, len)); if (munmap(addr, len) == -1) perror("munmap"); @@ -267,8 +297,10 @@ os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { +#ifdef __ppc__ /* see ppc-arch.c */ ppc_flush_icache(address, length); +#endif } void @@ -293,7 +325,6 @@ in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) boolean valid_addr(os_vm_address_t addr) { - int ret; os_vm_address_t newaddr; newaddr = os_trunc_to_page(addr); @@ -311,6 +342,7 @@ valid_addr(os_vm_address_t addr) } +#ifdef __ppc__ static void sigbus_handler(HANDLER_ARGS) { @@ -360,26 +392,16 @@ sigbus_handler(HANDLER_ARGS) /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context); } +#endif void os_install_interrupt_handlers(void) { -/* interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); */ +#ifdef __ppc__ interrupt_install_low_level_handler(SIGBUS, sigbus_handler); +#endif } -void -map_core_sections(char *exec_name) -{ - fprintf(stderr, "Linked cores not supported for Darwin!\n"); - exit(1); -} - -#define RTLD_LAZY 1 -#define RTLD_NOW 2 -#define RTLD_GLOBAL 0x100 - - void * os_dlsym(const char *sym_name, lispobj lib_list) { diff --git a/lisp/breakpoint.c b/lisp/breakpoint.c index 82c1d971a..79a68dd56 100644 --- a/lisp/breakpoint.c +++ b/lisp/breakpoint.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.c,v 1.19 2007/01/01 11:53:02 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.c,v 1.20 2007/07/06 08:04:39 cshapiro 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. @@ -93,7 +93,7 @@ find_code(os_context_t * scp) static lispobj find_code(os_context_t * scp) { - lispobj *codeptr = component_ptr_from_pc(SC_PC(scp)); + lispobj *codeptr = component_ptr_from_pc((lispobj *) SC_PC(scp)); if (codeptr == NULL) return NIL; @@ -126,7 +126,7 @@ compute_offset(os_context_t * scp, lispobj code, boolean function_end) if (offset >= codeptr->code_size) { if (function_end) { -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) /* * We're in a function end breakpoint. Compute the * offset from the (known) breakpoint location and the diff --git a/lisp/coreparse.c b/lisp/coreparse.c index a498bbc52..f08ac5cfb 100644 --- a/lisp/coreparse.c +++ b/lisp/coreparse.c @@ -1,12 +1,11 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.10 2005/09/15 18:26:51 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.11 2007/07/06 08:04:39 cshapiro Exp $ */ #include <stdio.h> #include <sys/types.h> #include <sys/file.h> -#if defined(irix) || defined(sparc) #include <fcntl.h> #include <stdlib.h> -#endif +#include <unistd.h> #include "os.h" #include "lisp.h" diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 0ecee050b..2075a1b7b 100644 --- a/lisp/gencgc.c +++ b/lisp/gencgc.c @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997, 1998, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.86 2007/05/30 17:52:08 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.87 2007/07/06 08:04:39 cshapiro Exp $ * */ @@ -107,7 +107,7 @@ #define set_current_region_end(value) \ SetSymbolValue(CURRENT_REGION_END_ADDR, (value)) -#elif defined(DARWIN) +#elif defined(DARWIN) && defined(__ppc__) #ifndef pseudo_atomic_InterruptedValue #define pseudo_atomic_InterruptedValue 1 #endif @@ -162,7 +162,7 @@ static void *invalid_stack_start, *invalid_stack_end; static inline void check_escaped_stack_object(lispobj * where, lispobj obj) { -#ifndef DARWIN +#if !defined(DARWIN) && !defined(__ppc__) void *p; if (Pointerp(obj) @@ -246,7 +246,11 @@ unsigned counters_verbose = 0; * To enable the use of page protection to help avoid the scavenging * of pages that don't have pointers to younger generations. */ +#if defined(DARWIN) && defined(__i386__) +boolean enable_page_protection = FALSE; +#else boolean enable_page_protection = TRUE; +#endif /* * Hunt for pointers to old-space, when GCing generations >= verify_gen. @@ -518,6 +522,8 @@ unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; int last_free_page; +static void scan_weak_tables(void); +static void scan_weak_objects(void); /* * Misc. heap functions. @@ -637,7 +643,7 @@ print_generation_stats(int verbose) */ #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) long long fpu_state[FPU_STATE_SIZE]; -#elif defined(DARWIN) +#elif defined(DARWIN) && defined(__ppc__) #define FPU_STATE_SIZE 32 long long fpu_state[FPU_STATE_SIZE]; #endif @@ -1913,7 +1919,7 @@ copy_large_object(lispobj object, int nwords) gc_assert((nwords & 0x01) == 0); if (gencgc_verbose && nwords > 1024 * 1024) - fprintf(stderr, "** copy_large_object: %d\n", nwords * sizeof(lispobj)); + fprintf(stderr, "** copy_large_object: %lu\n", nwords * sizeof(lispobj)); /* Check if it's a large object. */ first_page = find_page_index((void *) object); @@ -2098,7 +2104,7 @@ copy_large_unboxed_object(lispobj object, int nwords) gc_assert((nwords & 0x01) == 0); if (gencgc_verbose && nwords > 1024 * 1024) - fprintf(stderr, "** copy_large_unboxed_object: %d\n", + fprintf(stderr, "** copy_large_unboxed_object: %lu\n", nwords * sizeof(lispobj)); /* Check if it's a large object. */ @@ -2429,7 +2435,7 @@ scavenge_interrupt_contexts(void) * Aargh! Why is SPARC so different here? What is the advantage of * making it different from all the other ports? */ -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) #define RAW_ADDR_OFFSET 0 #else #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer) @@ -3459,7 +3465,7 @@ size_boxed(lispobj * where) } /* Not needed on sparc and ppc because the raw_addr has a function lowtag */ -#if !(defined(sparc) || defined(DARWIN)) +#if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__))) static int scav_fdefn(lispobj * where, lispobj object) { @@ -4039,7 +4045,6 @@ static void scan_weak_tables(void) { lispobj table, next; - int more_scavenged; for (table = weak_hash_tables; table != NIL; table = next) { struct hash_table *ht = (struct hash_table *) PTR(table); @@ -4109,7 +4114,7 @@ scav_hash_vector(lispobj * where, lispobj object) } #endif -#if !(defined(sparc) || defined(DARWIN)) +#if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__))) gc_assert(where == (lispobj *) PTR(hash_table->table)); #endif gc_assert(TypeOf(hash_table->instance_header) == type_InstanceHeader); @@ -4903,7 +4908,7 @@ gc_init_tables(void) * Note: for sparc and ppc we don't have to do anything special * for fdefns, cause the raw-addr has a function lowtag. */ -#if !(defined(sparc) || defined(DARWIN)) +#if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__))) scavtab[type_Fdefn] = scav_fdefn; #else scavtab[type_Fdefn] = scav_boxed; @@ -6112,7 +6117,7 @@ scavenge_newspace_generation_one_scan(int generation) /* Scan all weak objects and reset weak object lists */ static void -scan_weak_objects() +scan_weak_objects(void) { scan_weak_tables(); scan_weak_pointers(); @@ -6460,7 +6465,7 @@ print_ptr(lispobj * addr) *(addr + 2), *(addr + 3), *(addr + 4)); } -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) extern char closure_tramp; extern char undefined_tramp; #else @@ -6535,7 +6540,7 @@ verify_space(lispobj * start, size_t words) } else { /* Verify that it points to another valid space */ if (!to_readonly_space && !to_static_space && -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) !((thing == (int) &closure_tramp) || (thing == (int) &undefined_tramp)) #else @@ -6547,7 +6552,7 @@ verify_space(lispobj * start, size_t words) (unsigned long) thing, (unsigned long) start, (unsigned long) &undefined_tramp); -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) fprintf(stderr, " (closure_tramp = %lx)", (unsigned long) &closure_tramp); #endif @@ -7573,7 +7578,7 @@ void do_pending_interrupt(void); char * alloc(int nbytes) { -#if !(defined(sparc) || defined(DARWIN)) +#if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__))) /* * *current-region-free-pointer* is the same as alloc-tn (= * current_dynamic_space_free_pointer) and therefore contains the @@ -7715,7 +7720,7 @@ get_bytes_allocated_lower(void) } if (counters_verbose) - fprintf(stderr, ">%10d%10d%10d%10d%10d (max%d @0x%lX)\n", size, + fprintf(stderr, ">%10d%10d%10lu%10lu%10lu (max%lu @0x%lX)\n", size, previous != -1 ? size - previous : -1, (size_t) current_region_free_pointer - (size_t) boxed_region.start_addr, diff --git a/lisp/interrupt.c b/lisp/interrupt.c index 4297b1142..ecbaaea86 100644 --- a/lisp/interrupt.c +++ b/lisp/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.46 2007/01/01 11:53:03 cshapiro Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.47 2007/07/06 08:04:39 cshapiro Exp $ */ /* Interrupt handling magic. */ @@ -170,7 +170,11 @@ interrupt_internal_error(HANDLER_ARGS, boolean continuable) /* Allocate the SAP object while the interrupts are still disabled. */ if (internal_errors_enabled) +#if defined(DARWIN) && defined(__i386__) + context_sap = alloc_sap(&context->uc_mcontext); +#else context_sap = alloc_sap(context); +#endif #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); @@ -258,7 +262,7 @@ interrupt_handle_now_handler(HANDLER_ARGS) interrupt_handle_now(signal, code, context); #endif -#ifdef DARWIN +#if defined(DARWIN) && defined(__ppc__) /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context); #endif @@ -306,7 +310,11 @@ interrupt_handle_now(HANDLER_ARGS) else if (LowtagOf(handler.lisp) == type_FunctionPointer) { /* Allocate the SAP object while the interrupts are still disabled. */ +#if defined(DARWIN) && defined(__i386__) + lispobj context_sap = alloc_sap(&context->uc_mcontext); +#else lispobj context_sap = alloc_sap(context); +#endif /* Allow signals again. */ #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) @@ -428,7 +436,7 @@ maybe_now_maybe_later(HANDLER_ARGS) } -#ifdef DARWIN +#if defined(DARWIN) && defined(__ppc__) /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context); #endif diff --git a/lisp/lisp.c b/lisp/lisp.c index a3d844060..93c7f670f 100644 --- a/lisp/lisp.c +++ b/lisp/lisp.c @@ -1,7 +1,7 @@ /* * main() entry point for a stand alone lisp image. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.51 2007/05/30 17:52:08 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.52 2007/07/06 08:04:39 cshapiro Exp $ * */ @@ -12,6 +12,8 @@ #include <sys/file.h> #include <sys/param.h> #include <sys/stat.h> +#include <string.h> +#include <unistd.h> #include "signal.h" @@ -108,7 +110,7 @@ static int debug_lisp_search = FALSE; * default for CMUCLLIB */ char * -default_cmucllib(const char *argv0arg) +default_cmucllib(char *argv0arg) { char *p; char *defpath; diff --git a/lisp/os-common.c b/lisp/os-common.c index b0e8bdab5..f76083f02 100644 --- a/lisp/os-common.c +++ b/lisp/os-common.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.21 2006/11/07 11:24:12 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.22 2007/07/06 08:04:39 cshapiro 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. @@ -156,7 +156,7 @@ os_foreign_linkage_init(void) lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, &call_into_c, 1); -#elif defined(DARWIN) +#elif (defined(DARWIN) && defined(__ppc__)) if (type != 1 || strcmp((char *) symbol_name->data, "_call_into_c")) { fprintf(stderr, "linkage_data is %s but expected call_into_c\n", (char *) symbol_name->data); diff --git a/lisp/purify.c b/lisp/purify.c index c07aee741..bbf059252 100644 --- a/lisp/purify.c +++ b/lisp/purify.c @@ -10,7 +10,7 @@ and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997, 1998. - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.39 2007/06/10 05:03:09 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.40 2007/07/06 08:04:39 cshapiro Exp $ */ #include <stdio.h> @@ -86,7 +86,7 @@ static int later_count = 0; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) -#if defined(sparc) || defined(DARWIN) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) #define RAW_ADDR_OFFSET 0 #else #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) @@ -1673,7 +1673,7 @@ purify(lispobj static_roots, lispobj read_only_roots) (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - read_only_space; - fprintf(stderr, "Scavenge read only space: %d bytes\n", + fprintf(stderr, "Scavenge read only space: %ld bytes\n", read_only_space_size * sizeof(lispobj)); pscav(read_only_space, read_only_space_size, FALSE); } @@ -1782,7 +1782,7 @@ purify(lispobj static_roots, lispobj read_only_roots) verify_space((lispobj *) static_space, static_free - static_space); #endif -#if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) && !((defined(sparc) || defined(DARWIN)) && defined(GENCGC)) +#if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) && !((defined(sparc) || (defined(DARWIN) && defined(__ppc__))) && defined(GENCGC)) current_dynamic_space_free_pointer = current_dynamic_space; #else #if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c index bde056b74..f18785fc2 100644 --- a/lisp/x86-arch.c +++ b/lisp/x86-arch.c @@ -1,6 +1,6 @@ /* x86-arch.c -*- Mode: C; comment-column: 40 -*- * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.25 2005/10/06 21:52:53 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.26 2007/07/06 08:04:39 cshapiro Exp $ * */ @@ -242,7 +242,7 @@ sigtrap_handler(HANDLER_ARGS) case trap_Halt: { -#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) +#ifndef __linux__ int fpu_state[27]; fpu_save(fpu_state); @@ -250,7 +250,7 @@ sigtrap_handler(HANDLER_ARGS) fake_foreign_function_call(context); lose("%%primitive halt called; the party is over.\n"); undo_fake_foreign_function_call(context); -#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) +#ifndef __linux__ fpu_restore(fpu_state); #endif arch_skip_instruction(context); @@ -259,7 +259,7 @@ sigtrap_handler(HANDLER_ARGS) case trap_Error: case trap_Cerror: - DPRINTF(0, (stderr, "<trap Error %d>\n", code)); + DPRINTF(0, (stderr, "<trap Error %p>\n", code)); #ifdef __linux__ interrupt_internal_error(signal, contextstruct, code == trap_Cerror); #else diff --git a/lisp/x86-assem.S b/lisp/x86-assem.S index 6c52b2ff1..8c783c89c 100644 --- a/lisp/x86-assem.S +++ b/lisp/x86-assem.S @@ -1,6 +1,6 @@ ### x86-assem.S -*- Mode: Asm; -*- /** - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.27 2007/06/27 10:25:02 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.28 2007/07/06 08:04:39 cshapiro Exp $ * * Authors: Paul F. Werkowski <pw@snoopy.mv.com> * Douglas T. Crosher @@ -19,31 +19,33 @@ #include "lispregs.h" /* Minimize conditionalization for different OS naming schemes */ -#if defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) +#ifndef DARWIN #define GNAME(var) var +#define FUNCDEF(x) \ + .text ; \ + .balign 4,0x90 ; \ + .globl GNAME(x) ; \ + .type x,@function ; \ +GNAME(x): ; +#define ENDFUNC(x) \ + .size GNAME(x),.-GNAME(x) #else #define GNAME(var) _##var +#define FUNCDEF(x) \ + .text ; \ + .align 2,0x90 ; \ + .globl GNAME(x) ; \ +GNAME(x): ; +#define ENDFUNC(x) #endif /* Get the right type of alignment. Linux wants alignment in bytes. */ #if defined (__linux__) || defined (__FreeBSD__) -#define align_4byte 4 -#define align_16byte 16 +#define align_16byte 16 #else -#define align_4byte 2 #define align_16byte 4 #endif -#define FUNCDEF(x) \ - .text ; \ - .balign 4,0x90 ; \ - .globl GNAME(x) ; \ - .type x,@function ; \ -GNAME(x): ; - -#define ENDFUNC(x) \ - .size GNAME(x),.-GNAME(x) - .text .globl GNAME(foreign_function_call_active) @@ -742,29 +744,30 @@ ENDFUNC(alloc_overflow_edi) FUNCDEF(resolve_linkage_tramp) pushl %ebp # save old frame pointer movl %esp,%ebp # establish new frame - pushl %eax - pushl %ebx - pushl %ecx - pushl %edx - pushl %edi - pushl %esi + subl $28, %esp + andl $-16, %esp + movl %eax, 24(%esp) + movl %ecx, 20(%esp) + movl %edx, 16(%esp) + movl %ebx, 12(%esp) + movl %esi, 8(%esp) + movl %edi, 4(%esp) /* calling location (plus offset) was on top of stack */ movl 4(%ebp), %eax - pushl %eax # push for C function + movl %eax, (%esp) # push for C function call GNAME(lazy_resolve_linkage) /* real address of target is in %eax. Replace return address on stack * with it. That way we can get out of here without trashing any *registers! */ movl %eax,4(%ebp) - addl $4, %esp # bump off argument to lazy_resolve_linkage - popl %esi - popl %edi - popl %edx - popl %ecx - popl %ebx - popl %eax - popl %ebp + movl 4(%esp), %edi + movl 8(%esp), %esi + movl 12(%esp), %ebx + movl 16(%esp), %edx + movl 20(%esp), %ecx + movl 24(%esp), %eax + leave ret # jump to the real target ENDFUNC(resolve_linkage_tramp) @@ -793,5 +796,3 @@ FUNCDEF(undefined_foreign_symbol_trap) ENDFUNC(undefined_foreign_symbol_trap) #endif /* LINKAGE_TABLE */ - - .end diff --git a/lisp/x86-lispregs.h b/lisp/x86-lispregs.h index d78a590d6..c28d7baf8 100644 --- a/lisp/x86-lispregs.h +++ b/lisp/x86-lispregs.h @@ -1,5 +1,5 @@ /* x86-lispregs.h -*- Mode: C; -*- - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-lispregs.h,v 1.5 2006/11/07 11:24:12 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-lispregs.h,v 1.6 2007/07/06 08:04:39 cshapiro Exp $ */ #ifndef _X86_LISPREGS_H_ @@ -46,11 +46,14 @@ #define SC_REG(sc, n) (*sc_reg(sc,n)) -#ifdef __NetBSD__ +#if defined(__NetBSD__) #define SC_PC(uc) ((uc)->uc_mcontext.__gregs[_REG_EIP]) #define SC_SP(uc) ((uc)->uc_mcontext.__gregs[_REG_ESP]) +#elif defined(DARWIN) +#define SC_PC(sc) ((sc)->uc_mcontext->ss.eip) +#define SC_SP(sc) SC_REG(sc, reg_ESP) #else -#define SC_PC(sc) ((sc)->sc_pc) +#define SC_PC(sc) ((sc)->sc_eip) #define SC_SP(sc) ((sc)->sc_esp) #endif diff --git a/lisp/x86-validate.h b/lisp/x86-validate.h index 261937b03..dc83179bb 100644 --- a/lisp/x86-validate.h +++ b/lisp/x86-validate.h @@ -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: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.27 2007/05/01 15:35:09 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.28 2007/07/06 08:04:39 cshapiro Rel $ * */ @@ -121,7 +121,7 @@ #define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ #endif -#ifdef __NetBSD__ +#if defined(__NetBSD__) || defined(DARWIN) #define READ_ONLY_SPACE_START (0x10000000) #define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ @@ -137,7 +137,7 @@ #define SIGNAL_STACK_START (0x47fd8000) #define SIGNAL_STACK_SIZE SIGSTKSZ -#define DYNAMIC_0_SPACE_START (0x48800000) +#define DYNAMIC_0_SPACE_START (0x48000000) #ifdef GENCGC #define DYNAMIC_SPACE_SIZE (0x67800000) /* 1.656GB */ #else @@ -148,7 +148,7 @@ #define FOREIGN_LINKAGE_SPACE_START (0xb0000000) #define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ #endif -#endif +#endif /* __NetBSD__ || DARWIN */ #ifdef __linux__ #define READ_ONLY_SPACE_START (SpaceStart_TargetReadOnly) diff --git a/tools/create-target.sh b/tools/create-target.sh index 859698421..44c590fcd 100755 --- a/tools/create-target.sh +++ b/tools/create-target.sh @@ -28,7 +28,11 @@ if [ $# = 1 ]; then case `uname -s` in SunOS) LISP_VARIANT=sun4_solaris_gcc ;; Linux) LISP_VARIANT=linux_gencgc ;; - Darwin) LISP_VARIANT=ppc_darwin ;; + Darwin) case `uname -m` in + ppc) LISP_VARIANT=ppc_darwin ;; + i386) LISP_VARIANT=x86_darwin ;; + esac + ;; FreeBSD) LISP_VARIANT=FreeBSD_gencgc ;; # Please fill in some other common systems *) echo "Sorry, please specify the desired Lisp variant." -- GitLab