From: Christophe Rhodes Date: Mon, 25 Mar 2002 18:25:03 +0000 (+0000) Subject: 0.7.1.1: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0d669e68a1ffbea42af6216f2ae8c7d7ca12ffb6;p=sbcl.git 0.7.1.1: Merged support for SPARC/SunOS (aka Solaris) ... added relevant runtime and -os.lisp files; ... cleaned up sparc backend runtime, actually _using_ the abstractions that were written for the SPARC/Linux port; ... added some #includes for compilation (nothing breaks on Linux, but BSD has not yet been tested; ... removed some bash-/ksh-isms from build and test scripts; ... abstraced wait3() constants into grovel_headers and unix.lisp. --- diff --git a/clean.sh b/clean.sh index 57c4fb9..9eaa20e 100755 --- a/clean.sh +++ b/clean.sh @@ -67,28 +67,28 @@ done # *.x86f, *.axpf, *.lbytef, *.fasl # typical extensions for fasl files find . \( \ - -type l -or \ - -name '*~' -or \ - -name '#*#' -or \ - -name '.#*' -or \ - -name '?*.x86f' -or \ - -name '?*.axpf' -or \ - -name '?*.lbytef' -or \ - -name '?*.fasl' -or \ - -name 'core' -or \ - -name '?*.core' -or \ - -name '*.map' -or \ - -name '*.nm' -or \ - -name '*.host-obj' -or \ - -name '*.lisp-obj' -or \ - -name '*.target-obj' -or \ - -name '*.lib' -or \ - -name '*.tmp' -or \ - -name '*.o' -or \ - -name 'sbcl' -or \ - -name 'sbcl.h' -or \ - -name 'depend' -or \ - -name '*.htm' -or \ - -name '*.html' -or \ - -name 'TAGS' -or \ + -type l -o \ + -name '*~' -o \ + -name '#*#' -o \ + -name '.#*' -o \ + -name '?*.x86f' -o \ + -name '?*.axpf' -o \ + -name '?*.lbytef' -o \ + -name '?*.fasl' -o \ + -name 'core' -o \ + -name '?*.core' -o \ + -name '*.map' -o \ + -name '*.nm' -o \ + -name '*.host-obj' -o \ + -name '*.lisp-obj' -o \ + -name '*.target-obj' -o \ + -name '*.lib' -o \ + -name '*.tmp' -o \ + -name '*.o' -o \ + -name 'sbcl' -o \ + -name 'sbcl.h' -o \ + -name 'depend' -o \ + -name '*.htm' -o \ + -name '*.html' -o \ + -name 'TAGS' -o \ -name 'local-target-features.lisp-expr' \) -print | xargs rm -f diff --git a/make-config.sh b/make-config.sh index 8907833..653a60e 100644 --- a/make-config.sh +++ b/make-config.sh @@ -26,13 +26,14 @@ echo //initializing $ltf echo ';;;; This is a machine-generated file.' > $ltf echo ';;;; Please do not edit it by hand.' >> $ltf echo ';;;; See make-config.sh.' >> $ltf -echo -n '(' >> $ltf +printf '(' >> $ltf echo //guessing default target CPU architecture from host architecture case `uname -m` in *86) guessed_sbcl_arch=x86 ;; [Aa]lpha) guessed_sbcl_arch=alpha ;; sparc*) guessed_sbcl_arch=sparc ;; + sun*) guessed_sbcl_arch=sparc ;; ppc) guessed_sbcl_arch=ppc ;; *) # If we're not building on a supported target architecture, we @@ -49,7 +50,7 @@ if [ "$sbcl_arch" = "" ] ; then echo "can't guess target SBCL architecture, need SBCL_ARCH environment var" exit 1 fi -echo -n ":$sbcl_arch" >> $ltf +printf ":%s" "$sbcl_arch" >> $ltf # KLUDGE: currently the x86 only works with the generational garbage # collector (indicated by the presence of :GENCGC in *FEATURES*) and # alpha, sparc and ppc with the stop'n'copy collector (indicated by @@ -59,7 +60,7 @@ echo -n ":$sbcl_arch" >> $ltf # if we're building for x86. -- CSR, 2002-02-21 Then we do something # similar with :STACK-GROWS-FOOWARD, too. -- WHN 2002-03-03 if [ "$sbcl_arch" = "x86" ] ; then - echo -n ' :gencgc :stack-grows-downward-not-upward' >> $ltf + printf ' :gencgc :stack-grows-downward-not-upward' >> $ltf else # Nothing need be done in this case, but sh syntax wants a placeholder. echo > /dev/null @@ -68,9 +69,9 @@ for d in src/compiler src/assembly; do echo //setting up symlink $d/target original_dir=`pwd` cd $d - if [ -L target ] ; then + if [ -h target ] ; then rm target - elif [ -e target ] ; then + elif [ -w target ] ; then echo "I'm afraid to replace non-symlink $d/target with a symlink." exit 1 fi @@ -94,22 +95,22 @@ ln -s $sbcl_arch-arch.h target-arch.h ln -s $sbcl_arch-lispregs.h target-lispregs.h case `uname` in Linux) - echo -n ' :linux' >> $ltf + printf ' :linux' >> $ltf ln -s Config.$sbcl_arch-linux Config ln -s $sbcl_arch-linux-os.h target-arch-os.h ln -s linux-os.h target-os.h ;; *BSD) - echo -n ' :bsd' >> $ltf + printf ' :bsd' >> $ltf ln -s $sbcl_arch-bsd-os.h target-arch-os.h ln -s bsd-os.h target-os.h case `uname` in FreeBSD) - echo -n ' :freebsd' >> $ltf + printf ' :freebsd' >> $ltf ln -s Config.$sbcl_arch-freebsd Config ;; OpenBSD) - echo -n ' :openbsd' >> $ltf + printf ' :openbsd' >> $ltf ln -s Config.$sbcl_arch-openbsd Config ;; *) @@ -118,6 +119,12 @@ case `uname` in ;; esac ;; + SunOS) + printf ' :sunos' >> $ltf + ln -s Config.$sbcl_arch-sunos Config + ln -s $sbcl_arch-sunos-os.h target-arch-os.h + ln -s sunos-os.h target-os.h + ;; *) echo unsupported OS type: `uname` exit 1 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e98b3f7..8c3b9d9 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1592,7 +1592,9 @@ no guarantees of interface stability." "UNIX-TRUNCATE" "UNIX-TTYNAME" "UNIX-UID" "UNIX-UNLINK" "UNIX-UTIMES" "UNIX-WRITE" "WINSIZE" "WRITEGRP" "WRITEOTH" "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL" - "WS-YPIXEL" "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO" + "WS-YPIXEL" + "WNOHANG" "WSTOPPED" "WUNTRACED" + "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO" "SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2" "EALREADY" "SIGPIPE" "CHECK" "SIGXCPU" "EOPNOTSUPP" "SIGFPE" "SIGHUP" "ENOTSOCK" "EINTR" diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 7343ada..237583f 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -617,7 +617,9 @@ Function and macro commands: (when old-hook (let ((*debugger-hook* nil)) (funcall old-hook condition old-hook)))) - (sb!unix:unix-sigsetmask 0) + ;; FIXME: No-one seems to know what this is for. Nothing is noticeably + ;; broken on sunos... + #!-sunos (sb!unix:unix-sigsetmask 0) ;; Elsewhere in the system, we use the SANE-PACKAGE function for ;; this, but here causing an exception just as we're trying to handle diff --git a/src/code/load.lisp b/src/code/load.lisp index c04b5f9..4f30cd7 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -354,7 +354,8 @@ (defun find-foreign-symbol-in-table (name table) (let ((prefixes #!+(or linux freebsd) #("" "ldso_stub__") - #!+openbsd #("" "_"))) + #!+openbsd #("" "_") + #!+sunos #("" "ldso_stub__"))) (declare (notinline some)) ; to suppress bug 117 bogowarning (some (lambda (prefix) (gethash (concatenate 'string prefix name) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index fc02f3e..372fe26 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -97,25 +97,21 @@ (options sb-alien:int) (rusage sb-alien:int)) -(defconstant wait-wnohang #-svr4 1 #+svr4 #o100) -(defconstant wait-wuntraced #-svr4 2 #+svr4 4) -(defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced) - (defun wait3 (&optional do-not-hang check-for-stopped) "Return any available status information on child process. " (multiple-value-bind (pid status) (c-wait3 (logior (if do-not-hang - wait-wnohang + sb-unix:wnohang 0) (if check-for-stopped - wait-wuntraced + sb-unix:wuntraced 0)) 0) (cond ((or (minusp pid) (zerop pid)) nil) ((eql (ldb (byte 8 0) status) - wait-wstopped) + sb-unix:wstopped) (values pid :stopped (ldb (byte 8 8) status))) diff --git a/src/code/sunos-os.lisp b/src/code/sunos-os.lisp new file mode 100644 index 0000000..9aad8b6 --- /dev/null +++ b/src/code/sunos-os.lisp @@ -0,0 +1,65 @@ +;;;; OS interface functions for CMU CL under Solaris (FIXME: SunOS?) + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!SYS") + +;;; Check that target machine features are set up consistently with +;;; this file. +#!-sunos (error "missing :SUNOS feature") + +(defun software-type () + #!+sb-doc + "Return a string describing the supporting software." + (values "Solaris")) + +(defvar *software-version* nil) + +(defun software-version () + #!+sb-doc + "Return a string describing version of the supporting software, or NIL + if not available." + (or *software-version* + (setf *software-version* + (string-trim '(#\newline) + (with-output-to-string (stream) + (sb!ext:run-program "/bin/uname" `("-r") + :output stream)))))) + +(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here + (/show "entering solaris-os.lisp OS-COLD-INIT-OR-REINIT") + (setf *software-version* nil) + (/show "setting *DEFAULT-PATHNAME-DEFAULTS*") + (setf *default-pathname-defaults* + ;; (temporary value, so that #'PATHNAME won't blow up when + ;; we call it below:) + (make-trivial-default-pathname) + *default-pathname-defaults* + ;; (final value, constructed using #'PATHNAME:) + (pathname (sb!unix:posix-getcwd/))) + (/show "leaving solaris-os.lisp OS-COLD-INIT-OR-REINIT")) + +;;; Return system time, user time and number of page faults. +(defun get-system-info () + (multiple-value-bind + (err? utime stime maxrss ixrss idrss isrss minflt majflt) + (sb!unix:unix-getrusage sb!unix:rusage_self) + (declare (ignore maxrss ixrss idrss isrss minflt)) + (unless err? ; FIXME: nonmnemonic (reversed) name for ERR? + (error "Unix system call getrusage failed: ~A." (strerror utime))) + (values utime stime majflt))) + +;;; Return the system page size. +(defun get-page-size () + ;; probably should call getpagesize() + ;; FIXME: Or we could just get rid of this, since the uses of it look + ;; disposable. + ;; FIXME II: this could well be wrong + 8192) diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 447d181..1d99910 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -47,6 +47,7 @@ ;;; can pull it out of the CMU CL sources, or the old SBCL sources; ;;; but you might also consider doing things the SBCL way and moving ;;; this kind of C-level work down to C wrapper functions.) +#!-sunos (sb!alien:define-alien-routine ("sigsetmask" unix-sigsetmask) sb!alien:unsigned-long (mask sb!alien:unsigned-long)) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index a53794b..381a2b2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -477,7 +477,7 @@ (abort "Reduce debugger level (leaving debugger, returning to toplevel).") (catch 'toplevel-catcher - (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for? + #!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for? (repl noprint) (critically-unreachable "after REPL"))))))) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 0978918..0035134 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -281,12 +281,23 @@ ;; behavior, automatically allocating memory when a null buffer ;; pointer is used. On a system which doesn't support that ;; extension, it'll have to be rewritten somehow. - #!-(or linux openbsd freebsd) (,stub,) + ;; + ;; SunOS provides almost as useful an extension: if given a null + ;; buffer pointer, it will automatically allocate size space. The + ;; KLUDGE in this solution arises because we have just read off + ;; PATH_MAX+1 from the Solaris header files and stuck it in here as + ;; a constant. Going the grovel_headers route doesn't seem to be + ;; helpful, either, as Solaris doesn't export PATH_MAX from + ;; unistd.h. + #!-(or linux openbsd freebsd sunos) (,stub,) + #!+(or linux openbsd freebsd sunos) (or (newcharstar-string (alien-funcall (extern-alien "getcwd" (function (* char) (* char) size-t)) - nil 0)) + nil + #!+(or linux openbsd freebsd) 0 + #!+sunos 1025)) (simple-perror "getcwd"))) ;;; Return the Unix current directory as a SIMPLE-STRING terminated @@ -836,6 +847,17 @@ (t (subseq dst 0 dst-len))))) +;;;; A magic constant for wait3(). +;;;; +;;;; FIXME: This used to be defined in run-program.lisp as +;;;; (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced) +;;;; According to some of the man pages, the #o177 is part of the API +;;;; for wait3(); that said, under SunOS there is a WSTOPPED thing in +;;;; the headers that may or may not be the same thing. To be +;;;; investigated. -- CSR, 2002-03-25 +(defconstant wstopped #o177) + + ;;;; stuff not yet found in the header files ;;;; ;;;; Abandon all hope who enters here... diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 51e3efd..7bee941 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -146,11 +146,29 @@ (defconstant binding-stack-start #x60000000) (defconstant binding-stack-end #x61000000)) -#!+solaris ; maybe someday. +#!+sunos ; might as well start by trying the same numbers (progn - (defparameter target-read-only-space-start #x10000000) - (defparameter target-static-space-start #x28000000) - (defparameter target-dynamic-space-start #x40000000)) + (defconstant read-only-space-start #x10000000) + (defconstant read-only-space-end #x15000000) + + (defconstant static-space-start #x28000000) + (defconstant static-space-end #x2c000000) + + (defconstant dynamic-space-start #x30000000) + (defconstant dynamic-space-end #x38000000) + + (defconstant dynamic-0-space-start #x30000000) + (defconstant dynamic-0-space-end #x38000000) + + (defconstant dynamic-1-space-start #x40000000) + (defconstant dynamic-1-space-end #x48000000) + + (defconstant control-stack-start #x50000000) + (defconstant control-stack-end #x51000000) + + (defconstant binding-stack-start #x60000000) + (defconstant binding-stack-end #x61000000)) + ;;;; other random constants. @@ -224,13 +242,22 @@ ;;;; Assembler parameters: ;;; The number of bits per element in the assemblers code vector. -;;; (defparameter *assembly-unit-length* 8) ;;;; Pseudo-atomic trap number -;;; KLUDGE + +;;; KLUDGE: Linux on the SPARC doesn't seem to conform to any kind of +;;; standards at all. So we use an explicitly undefined trap, because +;;; that currently does the right thing. Expect this to break +;;; eventually (but with luck, at that point we'll be able to revert +;;; to the compliant trap number... +;;; +;;; KLUDGE: Maybe this should be called pseudo-atomic-magic-number, +;;; allowing other architectures (which don't necessarily use traps +;;; for pseudo-atomic) to propagate a magic number to C land via +;;; sbcl.h. #!-linux -(defconstant pseudo-atomic-trap 16) +(defconstant pseudo-atomic-trap #x10) #!+linux (defconstant pseudo-atomic-trap #x40) diff --git a/src/runtime/Config.sparc-sunos b/src/runtime/Config.sparc-sunos new file mode 100644 index 0000000..bbe9537 --- /dev/null +++ b/src/runtime/Config.sparc-sunos @@ -0,0 +1,27 @@ +# This software is part of the SBCL system. See the README file for +# more information. +# +# This software is derived from the CMU CL system, which was +# written at Carnegie Mellon University and released into the +# public domain. The software is in the public domain and is +# provided with absolutely no warranty. See the COPYING and CREDITS +# files for more information. + + +CC=gcc +CFLAGS = -g -O3 -Wall -Dsparc -DSVR4 +ASFLAGS = -g -Wall -Dsparc -DSVR4 +LD = ld +LINKFLAGS = -v -g +NM = nm -p + +ASSEM_SRC = sparc-assem.S +#ARCH_SRC = sparc-arch.c undefineds.c +ARCH_SRC = sparc-arch.c ldso-stubs.S + +OS_SRC = sunos-os.c sparc-sunos-os.c os-common.c +#LINKFLAGS+=-static +LINKFLAGS+= +OS_LIBS= -ldl -lsocket -lnsl + +GC_SRC= gc.c diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index 1276c07..38452ef 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -18,6 +18,8 @@ #include #include #include +#include +#include #include #ifdef irix diff --git a/src/runtime/ldso-stubs.S b/src/runtime/ldso-stubs.S index 736edab..5e3351d 100644 --- a/src/runtime/ldso-stubs.S +++ b/src/runtime/ldso-stubs.S @@ -157,7 +157,9 @@ ldso_stub__ ## fct: ; \ LDSO_STUBIFY(send) LDSO_STUBIFY(setitimer) LDSO_STUBIFY(setpgrp) +#if !defined(SVR4) LDSO_STUBIFY(sigsetmask) +#endif LDSO_STUBIFY(sinh) LDSO_STUBIFY(socket) LDSO_STUBIFY(stat) diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 4d7e1ee..dc66cd2 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -16,6 +16,7 @@ #include #include #include +#include #include "runtime.h" #include "os.h" diff --git a/src/runtime/sparc-arch.c b/src/runtime/sparc-arch.c index f6e7928..ac7875e 100644 --- a/src/runtime/sparc-arch.c +++ b/src/runtime/sparc-arch.c @@ -86,7 +86,7 @@ os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *contex void arch_skip_instruction(os_context_t *context) { ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context)); - context->si_regs.npc += 4; + ((char *) *os_context_npc_addr(context)) += 4; } unsigned char *arch_internal_error_arguments(os_context_t *context) @@ -128,7 +128,7 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) { unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context)); /* FIXME */ - unsigned long *npc = &context->si_regs.npc; + unsigned long *npc = (unsigned long *)(*os_context_npc_addr(context)); /* orig_sigmask = context->sigmask; sigemptyset(&context->sigmask); */ @@ -142,8 +142,6 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) *npc = trap_AfterBreakpoint; os_flush_icache((os_vm_address_t) npc, sizeof(unsigned long)); - /* How much is this not going to work? */ - sigreturn(context); } static int pseudo_atomic_trap_p(os_context_t *context) @@ -187,7 +185,7 @@ static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); - sigprocmask(SIG_SETMASK, &context->si_mask, 0); + sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0); if ((siginfo->si_code) == ILL_ILLOPC #ifdef linux @@ -222,7 +220,7 @@ static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context) case trap_FunEndBreakpoint: *os_context_pc_addr(context) = (int) handle_fun_end_breakpoint(signal, siginfo, context); - context->si_regs.npc = *os_context_pc_addr(context) + 4; + *os_context_npc_addr(context) = *os_context_pc_addr(context) + 4; break; case trap_AfterBreakpoint: diff --git a/src/runtime/sparc-sunos-os.c b/src/runtime/sparc-sunos-os.c new file mode 100644 index 0000000..76459f4 --- /dev/null +++ b/src/runtime/sparc-sunos-os.c @@ -0,0 +1,85 @@ +/* + * This is the SPARC Linux incarnation of arch-dependent OS-dependent + * routines. See also "linux-os.c". + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include +#include +#include +#include "./signal.h" +#include "os.h" +#include "arch.h" +#include "globals.h" +#include "interrupt.h" +#include "interr.h" +#include "lispregs.h" +#include "sbcl.h" +#include +#include + +#include +#include +/* #include */ +#include +#include +#include + +#include "validate.h" + +#if defined GENCGC /* unlikely ... */ +#include "gencgc.h" +#endif + +os_context_register_t * +os_context_register_addr(os_context_t *context, int offset) +{ + if (offset == 0) { + static int zero; + zero = 0; + return &zero; + } else if (offset < 16) { + return &context->uc_mcontext.gregs[offset+3]; + } else if (offset < 32) { + /* FIXME: You know, this (int *) stuff looks decidedly + dubious */ + int *sp = (int*) context->uc_mcontext.gregs[REG_SP]; + return &(sp[offset-16]); + } else { + return 0; + } +} + +os_context_register_t * +os_context_pc_addr(os_context_t *context) +{ + return &(context->uc_mcontext.gregs[REG_PC]); +} + +os_context_register_t * +os_context_npc_addr(os_context_t *context) +{ + return &(context->uc_mcontext.gregs[REG_nPC]); +} + +sigset_t * +os_context_sigmask_addr(os_context_t *context) +{ + return &(context->uc_sigmask); +} + +void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +{ + /* FIXME. There's a bit of stuff in the CMUCL version. It may or + may not be needed */ +} diff --git a/src/runtime/sparc-sunos-os.h b/src/runtime/sparc-sunos-os.h new file mode 100644 index 0000000..e88eae5 --- /dev/null +++ b/src/runtime/sparc-sunos-os.h @@ -0,0 +1,11 @@ +#ifndef _SPARC_SOLARIS_OS_H +#define _SPARC_SOLARIS_OS_H + +typedef ucontext_t os_context_t; + +static inline os_context_t *arch_os_get_context(void **void_context) { + asm volatile ("ta 0x03"); /* ta ST_FLUSH_WINDOWS */ + return (os_context_t *) (*void_context); +} + +#endif /* _SPARC_SOLARIS_OS_H */ diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c new file mode 100644 index 0000000..dc58ee4 --- /dev/null +++ b/src/runtime/sunos-os.c @@ -0,0 +1,154 @@ +#include + +#include +#include + +#include +#include +#include + +#include "os.h" +#include "arch.h" +#include "interr.h" +#include "interrupt.h" +#include "globals.h" +#include "validate.h" +#include "sbcl.h" +#include "target-arch-os.h" + +#define OS_VM_DEFAULT_PAGESIZE 8192 + +long os_vm_page_size=(-1); +static long os_real_page_size=(-1); + +static os_vm_size_t real_page_size_difference=0; + +void +os_init(void) +{ + /* I do not understand this at all. FIXME. */ + os_vm_page_size = os_real_page_size = sysconf(_SC_PAGESIZE); + + if(os_vm_page_size>OS_VM_DEFAULT_PAGESIZE){ + fprintf(stderr,"os_init: Pagesize too large (%d > %d)\n", + os_vm_page_size,OS_VM_DEFAULT_PAGESIZE); + exit(1); + }else{ + /* + * we do this because there are apparently dependencies on + * the pagesize being OS_VM_DEFAULT_PAGESIZE somewhere... + * but since the OS doesn't know we're using this restriction, + * we have to grovel around a bit to enforce it, thus anything + * that uses real_page_size_difference. + */ + /* FIXME: Is this still true? */ + real_page_size_difference=OS_VM_DEFAULT_PAGESIZE-os_vm_page_size; + os_vm_page_size=OS_VM_DEFAULT_PAGESIZE; + } +} + +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) +{ + int flags = MAP_PRIVATE | MAP_NORESERVE | MAP_ANON; + + if (addr) + flags |= MAP_FIXED; + + addr = mmap(addr, len, + OS_VM_PROT_ALL, + flags, + -1, 0); + if (addr == MAP_FAILED) { + perror("mmap"); + lose ("Error in mmap(..)"); + } + + return addr; +} + +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) +{ + if(munmap((void*) addr, len) == -1) + perror("munmap"); +} + + + +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) +{ + + addr = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FIXED, + fd, (off_t) offset); + + if (addr == MAP_FAILED) { + perror("mmap"); + lose("Unexpedted mmap(..) failure"); + } + + return addr; +} + +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) +{ + if(mprotect((void*)address, length, prot) == -1) { + perror("mprotect"); + } +} + +static boolean +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) +{ + char* beg = (char*) sbeg; + char* end = (char*) sbeg + slen; + char* adr = (char*) a; + return (adr >= beg && adr < end); +} + +boolean +is_valid_lisp_addr(os_vm_address_t addr) +{ + /* Just assume address is valid if it lies within one of the known + spaces. (Unlike sunos-os which keeps track of every valid page.) */ + return ( in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) + || in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE ) + || in_range_p(addr, DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE ) + || in_range_p(addr, DYNAMIC_1_SPACE_START, DYNAMIC_SPACE_SIZE ) + || in_range_p(addr, CONTROL_STACK_START , CONTROL_STACK_SIZE ) + || in_range_p(addr, BINDING_STACK_START , BINDING_STACK_SIZE )); +} + + + +#if defined GENCGC + +#error "GENCGC is not yet supported (presumably on x86 solaris?)" + +#else + +static void +sigsegv_handler(int signal, siginfo_t *info, void* void_context) +{ + os_context_t *context = arch_os_get_context(&void_context); + os_vm_address_t addr; + + addr = arch_get_bad_addr(signal, info, context); + /* There's some complicated recovery code in linux-os.c here + that I'm currently too confused to understand. Fixme. */ + if(!interrupt_maybe_gc(signal, info, context)) { + interrupt_handle_now(signal, info, context); + } +} + +#endif + +void +os_install_interrupt_handlers() +{ + undoably_install_low_level_interrupt_handler(SIGSEGV,sigsegv_handler); +} diff --git a/src/runtime/sunos-os.h b/src/runtime/sunos-os.h new file mode 100644 index 0000000..6132fd9 --- /dev/null +++ b/src/runtime/sunos-os.h @@ -0,0 +1,34 @@ +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include +#include +#include +#include +#include + +#include "target-arch-os.h" +#include "target-arch.h" + +/* FIXME: Stolen from CMUCL. Investigate. */ +typedef unsigned long os_vm_address_t; +typedef long os_vm_size_t; +typedef off_t os_vm_offset_t; +typedef int os_vm_prot_t; + +/* typedef struct ucontext os_context_t;*/ + +#define OS_VM_PROT_READ PROT_READ +#define OS_VM_PROT_WRITE PROT_WRITE +#define OS_VM_PROT_EXECUTE PROT_EXEC + +/* Yaargh?! */ +typedef int os_context_register_t ; diff --git a/src/runtime/undefineds.h b/src/runtime/undefineds.h index dc20144..c8ec517 100644 --- a/src/runtime/undefineds.h +++ b/src/runtime/undefineds.h @@ -148,7 +148,9 @@ F(shutdown) #if !defined(hpux) && !defined(SVR4) && !defined(__i386__) F(sigreturn) #endif +#if !defined(SVR4) F(sigsetmask) +#endif #if !defined(SVR4) && !defined(__FreeBSD__) && !defined(__OpenBSD__) F(sigstack) F(sigvec) diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh index 9f7b9ab..788c0f5 100644 --- a/tests/run-program.test.sh +++ b/tests/run-program.test.sh @@ -15,7 +15,8 @@ # Make sure that there's at least something in the environment (for # one of the tests below). -export SOMETHING_IN_THE_ENVIRONMENT='yes there is' +SOMETHING_IN_THE_ENVIRONMENT='yes there is' +export SOMETHING_IN_THE_ENVIRONMENT ${SBCL:-sbcl} < #include #include +#include #include #include @@ -96,5 +97,10 @@ main(int argc, char *argv[]) defconstant("s-ifsock", S_IFSOCK); printf("\n"); + printf(";;; for wait3(2) in run-program.lisp\n"); + defconstant("wnohang", WNOHANG); + defconstant("wuntraced", WUNTRACED); + printf("\n"); + return 0; } diff --git a/version.lisp-expr b/version.lisp-expr index c085784..13b12a8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.2" +"0.7.2.1"