;; uid, gid
(define-call "geteuid" uid-t never-fails) ; "always successful", it says
- (define-call "getresuid" uid-t never-fails)
+#-sunos (define-call "getresuid" uid-t never-fails)
(define-call "getuid" uid-t never-fails)
(define-call "seteuid" int minusp (uid uid-t))
- (define-call "setfsuid" int minusp (uid uid-t))
+#-sunos (define-call "setfsuid" int minusp (uid uid-t))
(define-call "setreuid" int minusp (ruid uid-t) (euid uid-t))
- (define-call "setresuid" int minusp (ruid uid-t) (euid uid-t) (suid uid-t))
+#-sunos (define-call "setresuid" int minusp (ruid uid-t) (euid uid-t) (suid uid-t))
(define-call "setuid" int minusp (uid uid-t))
(define-call "getegid" gid-t never-fails)
(define-call "getgid" gid-t never-fails)
- (define-call "getresgid" gid-t never-fails)
+#-sunos (define-call "getresgid" gid-t never-fails)
(define-call "setegid" int minusp (gid gid-t))
- (define-call "setfsgid" int minusp (gid gid-t))
+#-sunos (define-call "setfsgid" int minusp (gid gid-t))
(define-call "setgid" int minusp (gid gid-t))
(define-call "setregid" int minusp (rgid gid-t) (egid gid-t))
- (define-call "setresgid" int minusp (rgid gid-t) (egid gid-t) (sgid gid-t))
+#-sunos (define-call "setresgid" int minusp (rgid gid-t) (egid gid-t) (sgid gid-t))
;; processes, signals
(define-call "alarm" int never-fails (seconds unsigned))
+ ;; FIXME this is a lie, of course this can fail, but there's no
+ ;; error handling here yet!
#+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 ()
- (tagbody
- (sb-thread::with-all-threads-lock
- (when (cdr sb-thread::*all-threads*)
- (go :error))
- (let ((pid (posix-fork)))
- (when (= pid 0)
- (setup-mach-exceptions))
- (return-from fork pid)))
- :error
- (error "Cannot fork with multiple threads running.")))
- (export 'fork :sb-posix))
-
- #-mach-exception-handler
- (define-call "fork" pid-t minusp)
+ (define-call "setup_mach_exceptions" void never-fails)
+ (define-call ("posix_fork" :c-name "fork") pid-t minusp)
+ (defun fork ()
+ "Forks the current process, returning 0 in the new process and the PID of
+the child process in the parent. Forking while multiple threads are running is
+not supported."
+ (tagbody
+ (sb-thread::with-all-threads-lock
+ (when (cdr sb-thread::*all-threads*)
+ (go :error))
+ (let ((pid (posix-fork)))
+ #+mach-exception-handler
+ (when (= pid 0)
+ (setup-mach-exceptions))
+ (return-from fork pid)))
+ :error
+ (error "Cannot fork with multiple threads running.")))
+ (export 'fork :sb-posix)
(define-call "getpgid" pid-t minusp (pid pid-t))
(define-call "getppid" pid-t never-fails)
"Returns the resolved target of a symbolic link as a string."
(flet ((%readlink (path buf length)
(alien-funcall
- (extern-alien "readlink" (function int c-string (* t) int))
+ (extern-alien "readlink" (function int (c-string :not-null t) (* t) int))
path buf length)))
(with-growing-c-string (buf size)
(let ((count (%readlink (filename pathspec) buf size)))
nil
(,conv r)))))))
-(define-obj-call "getpwnam" login-name (function (* alien-passwd) c-string) alien-to-passwd)
-(define-obj-call "getpwuid" uid (function (* alien-passwd) uid-t) alien-to-passwd)
-(define-obj-call "getgrnam" login-name (function (* alien-group) c-string) alien-to-group)
-(define-obj-call "getgrgid" gid (function (* alien-group) gid-t) alien-to-group)
+(define-obj-call "getpwnam" login-name (function (* alien-passwd) (c-string :not-null t))
+ alien-to-passwd)
+(define-obj-call "getpwuid" uid (function (* alien-passwd) uid-t)
+ alien-to-passwd)
+(define-obj-call "getgrnam" login-name (function (* alien-group) (c-string :not-null t))
+ alien-to-group)
+(define-obj-call "getgrgid" gid (function (* alien-group) gid-t)
+ alien-to-group)
#-win32
(define-stat-call #-win32 "stat" #+win32 "_stat"
pathname filename
- (function int c-string (* alien-stat)))
+ (function int (c-string :not-null t) (* alien-stat)))
#-win32
(define-stat-call "lstat"
pathname filename
- (function int c-string (* alien-stat)))
+ (function int (c-string :not-null t) (* alien-stat)))
;;; No symbolic links on Windows, so use stat
#+win32
(progn
result)))
(export 'utime :sb-posix)
(defun utime (filename &optional access-time modification-time)
- (let ((fun (extern-alien "utime" (function int c-string
+ (let ((fun (extern-alien "utime" (function int (c-string :not-null t)
(* alien-utimbuf))))
(name (filename filename)))
(if (not (and access-time modification-time))
(if (minusp value)
(syscall-error)
value)))
- (let ((fun (extern-alien "utimes" (function int c-string
+ (let ((fun (extern-alien "utimes" (function int (c-string :not-null t)
(* (array alien-timeval 2)))))
(name (filename filename)))
(if (not (and access-time modification-time))
(export 'getenv :sb-posix))
(defun getenv (name)
(let ((r (alien-funcall
- (extern-alien "getenv" (function (* char) c-string))
+ (extern-alien "getenv" (function (* char) (c-string :not-null t)))
name)))
(declare (type (alien (* char)) r))
(unless (null-alien r)
(cast r c-string))))
#-win32
(progn
- (define-call "setenv" int minusp (name c-string) (value c-string) (overwrite int))
- (define-call "unsetenv" int minusp (name c-string))
+ (define-call "setenv" int minusp
+ (name (c-string :not-null t))
+ (value (c-string :not-null t))
+ (overwrite int))
+ (define-call "unsetenv" int minusp (name (c-string :not-null t)))
(export 'putenv :sb-posix)
(defun putenv (string)
(declare (string string))
#+win32
(progn
;; Windows doesn't define a POSIX setenv, but happily their _putenv is sane.
- (define-call* "putenv" int minusp (string c-string))
+ (define-call* "putenv" int minusp (string (c-string :not-null t)))
(export 'setenv :sb-posix)
(defun setenv (name value overwrite)
(declare (string name value))
(export 'closelog :sb-posix)
(defun openlog (ident options &optional (facility log-user))
(alien-funcall (extern-alien
- "openlog" (function void c-string int int))
+ "openlog" (function void (c-string :not-null t) int int))
ident options facility))
(defun syslog (priority format &rest args)
"Send a message to the syslog facility, with severity level
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))
+ "syslog" (function void int
+ (c-string :not-null t)
+ (c-string :not-null t)))
priority "%s" message)))
(syslog1 priority (apply #'format nil format args))))
(define-call "closelog" void never-fails))
projects / sbcl.git / blobdiff