From: Cyrus H. <sl...@us...> - 2006-12-26 23:10:28
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-posix In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21157/contrib/sb-posix Modified Files: interface.lisp macros.lisp Log Message: 1.0.1.1: mach exception handlers for x86/macos Added experimental support for mach exception handling under x86/macos. To enable this, turn on the feature :mach-exception-handler at build time. * restructure args to sb-posix:define-call so that :largefile becomes :options :largefile and add a new :c-name keyword arg. * for #+mach-exception-handler builds, make sb-posix:fork reestablish the mach exception handling thread after forking. * add doc/internals-notes/mach-exception-handler-notes. * memory_fault_handler no longer static for BSD. * added mach_error_memory_fault_handler for unexpected memory faults. * #+mach-exception-handler thread changes to allocate and deallocate mach ports. * added protect_control_stack_{return_}guard_page_thread calls that take a thread argument * sigill_handler no longer static on x86. * mach exception handling code in x86-darwin-os.c. See doc/internals-notes/mach-exception-handler-notes for details. Index: interface.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/interface.lisp,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- interface.lisp 3 Dec 2006 15:24:10 -0000 1.32 +++ interface.lisp 26 Dec 2006 23:10:23 -0000 1.33 @@ -87,7 +87,7 @@ (define-call* "dup" int minusp (oldfd file-descriptor)) (define-call* "dup2" int minusp (oldfd file-descriptor) (newfd file-descriptor)) -(define-call* ("lseek" :largefile) +(define-call* ("lseek" :options :largefile) off-t minusp (fd file-descriptor) (offset off-t) (whence int)) (define-call* "mkdir" int minusp (pathname filename) (mode mode-t)) @@ -107,7 +107,7 @@ (define-call* "rmdir" int minusp (pathname filename)) (define-call* "unlink" int minusp (pathname filename)) (define-call "opendir" (* t) null-alien (pathname filename)) -(define-call ("readdir" :largefile) (* dirent) +(define-call ("readdir" :options :largefile) (* dirent) ;; readdir() has the worst error convention in the world. It's just ;; too painful to support. (return is NULL _and_ errno "unchanged" ;; is not an error, it's EOF). @@ -128,7 +128,7 @@ (define-call "fchown" int minusp (fd file-descriptor) (owner uid-t) (group gid-t)) (define-call "fdatasync" int minusp (fd file-descriptor)) - (define-call ("ftruncate" :largefile) + (define-call ("ftruncate" :options :largefile) int minusp (fd file-descriptor) (length off-t)) (define-call "fsync" int minusp (fd file-descriptor)) (define-call "lchown" int minusp (pathname filename) @@ -137,7 +137,7 @@ (define-call "mkfifo" int minusp (pathname filename) (mode mode-t)) (define-call "symlink" int minusp (oldpath filename) (newpath filename)) (define-call "sync" void never-fails) - (define-call ("truncate" :largefile) + (define-call ("truncate" :options :largefile) int minusp (pathname filename) (length off-t)) ;; FIXME: Windows does have _mktemp, which has a slightlty different ;; interface @@ -189,7 +189,25 @@ ;; processes, signals (define-call "alarm" int never-fails (seconds unsigned)) + + + + #+mach-exception-handler + (progn + ;; FIXME this is a lie, of course this can fail, but there's no + ;; error handling here yet! + (define-call "setup_mach_exceptions" void never-fails) + (define-call ("posix_fork" :c-name "fork") pid-t minusp) + (defun fork () + (let ((pid (posix-fork))) + (when (= pid 0) + (setup-mach-exceptions)) + pid)) + (export 'fork :sb-posix)) + + #-mach-exception-handler (define-call "fork" pid-t minusp) + (define-call "getpgid" pid-t minusp (pid pid-t)) (define-call "getppid" pid-t never-fails) (define-call "getpgrp" pid-t never-fails) @@ -245,7 +263,7 @@ ;;; mmap, msync #-win32 (progn - (define-call ("mmap" :largefile) sb-sys:system-area-pointer + (define-call ("mmap" :options :largefile) sb-sys:system-area-pointer (lambda (res) (= (sb-sys:sap-int res) #.(1- (expt 2 sb-vm::n-machine-word-bits)))) (addr sap-or-nil) (length unsigned) (prot unsigned) @@ -312,7 +330,7 @@ (declare (type (or null (sb-alien:alien (* alien-stat))) stat)) (with-alien-stat a-stat () (let ((r (alien-funcall - (extern-alien ,(real-c-name (list name :largefile)) ,type) + (extern-alien ,(real-c-name (list name :options :largefile)) ,type) (,designator-fun ,arg) a-stat))) (when (minusp r) Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/macros.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- macros.lisp 12 Nov 2006 23:04:59 -0000 1.17 +++ macros.lisp 26 Dec 2006 23:10:23 -0000 1.18 @@ -28,13 +28,15 @@ (defun real-c-name (name) (etypecase name (list - (destructuring-bind (name &rest options) name - - (cond #+largefile - ((member :largefile options) - (format nil "~a_largefile" name)) - (t - name)))) + (destructuring-bind (name &key c-name options) name + (if c-name + c-name + (cond #+largefile + ((or (eql options :largefile) + (member :largefile options)) + (format nil "~a_largefile" name)) + (t + name))))) (string name))) |