(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))
(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).
(define-call "fchdir" int minusp (fd file-descriptor))
(define-call "fchmod" int minusp (fd file-descriptor) (mode mode-t))
(define-call "fchown" int minusp (fd file-descriptor)
- (owner uid-t) (group gid-t))
+ (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)
(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
- (define-call "mkstemp" int minusp (template c-string))
+ (defun mkstemp (template)
+ ;; we are emulating sb-alien's charset conversion for strings
+ ;; here, to accommodate for the call-by-reference nature of
+ ;; mkstemp's template strings.
+ (let ((arg (sb-ext:string-to-octets
+ (filename template)
+ :external-format sb-alien::*default-c-string-external-format*)))
+ (sb-sys:with-pinned-objects (arg)
+ (let ((result (alien-funcall (extern-alien "mkstemp"
+ (function int c-string))
+ (sap-alien (sb-alien::vector-sap arg)
+ (* char)))))
+ (when (minusp result)
+ (syscall-error))
+ (values result
+ (sb-ext:octets-to-string
+ arg
+ :external-format sb-alien::*default-c-string-external-format*))))))
(define-call-internally ioctl-without-arg "ioctl" int minusp
(fd file-descriptor) (cmd int))
(define-call-internally ioctl-with-int-arg "ioctl" int minusp
;; 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)
;;; 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)
(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)
(unless (null-alien r)
(cast r c-string))))
(define-call "putenv" int minusp (string c-string))
+
+;;; syslog
+#-win32
+(progn
+ (export 'openlog :sb-posix)
+ (export 'syslog :sb-posix)
+ (export 'closelog :sb-posix)
+ (defun openlog (ident options &optional (facility log-user))
+ (alien-funcall (extern-alien
+ "openlog" (function void c-string int int))
+ ident options facility))
+ (defun syslog (priority format &rest args)
+ "Send a message to the syslog facility, with severity level
+PRIORITY. The message will be formatted as by CL:FORMAT (rather
+than C's printf) with format string FORMAT and arguments ARGS."
+ (flet ((syslog1 (priority message)
+ (alien-funcall (extern-alien
+ "syslog" (function void int c-string c-string))
+ priority "%s" message)))
+ (syslog1 priority (apply #'format nil format args))))
+ (define-call "closelog" void never-fails))
+