(define-alien-routine ("getenv" posix-getenv) c-string
"Return the \"value\" part of the environment string \"name=value\" which
corresponds to NAME, or NIL if there is none."
- (name c-string))
+ (name (c-string :not-null t)))
\f
;;; from stdio.h
#!-win32
(defun unix-rename (name1 name2)
(declare (type unix-pathname name1 name2))
- (void-syscall ("rename" c-string c-string) name1 name2))
+ (void-syscall ("rename" (c-string :not-null t)
+ (c-string :not-null t))
+ name1 name2))
\f
;;; from sys/types.h and gnu/types.h
(declare (type unix-pathname path)
(type fixnum flags)
(type unix-file-mode mode))
- (int-syscall ("open" c-string int int)
- path
- (logior #!+win32 o_binary
- #!+largefile o_largefile
- flags)
- mode))
+ (with-restarted-syscall (value errno)
+ (int-syscall ("open" c-string int int)
+ path
+ (logior #!+win32 o_binary
+ #!+largefile o_largefile
+ flags)
+ mode)))
;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file
;;; associated with it.
(void-syscall ("access" c-string int) path mode))
;;; values for the second argument to UNIX-LSEEK
+;;; Note that nowadays these are called SEEK_SET, SEEK_CUR, and SEEK_END
(defconstant l_set 0) ; to set the file pointer
(defconstant l_incr 1) ; to increment the file pointer
(defconstant l_xtnd 2) ; to extend the file size
;;; Terminate the current process with an optional error code. If
;;; successful, the call doesn't return. If unsuccessful, the call
;;; returns NIL and an error number.
-(defun unix-exit (&optional (code 0))
- (declare (type (signed-byte 32) code))
- (void-syscall ("exit" int) code))
+(deftype exit-code ()
+ `(signed-byte 32))
+(defun os-exit (code &key abort)
+ #!+sb-doc
+ "Exit the process with CODE. If ABORT is true, exit is performed using _exit(2),
+avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
+ (unless (typep code 'exit-code)
+ (setf code (if abort 1 0)))
+ (if abort
+ (void-syscall ("_exit" int) code)
+ (void-syscall ("exit" int) code)))
+
+(define-deprecated-function :early "1.0.56.55" unix-exit os-exit (code)
+ (os-exit code))
;;; Return the process id of the current process.
(define-alien-routine ("getpid" unix-getpid) int)
;;; Return the namestring of the home directory, being careful to
;;; include a trailing #\/
#!-win32
-(defun uid-homedir (uid)
- (or (newcharstar-string (alien-funcall (extern-alien "uid_homedir"
- (function (* char) int))
- uid))
- (error "failed to resolve home directory for Unix uid=~S" uid)))
+(progn
+ (defun uid-homedir (uid)
+ (or (newcharstar-string (alien-funcall (extern-alien "uid_homedir"
+ (function (* char) int))
+ uid))
+ (error "failed to resolve home directory for Unix uid=~S" uid)))
+
+ (defun user-homedir (uid)
+ (or (newcharstar-string (alien-funcall (extern-alien "user_homedir"
+ (function (* char) c-string))
+ uid))
+ (error "failed to resolve home directory for Unix uid=~S" uid))))
;;; Invoke readlink(2) on the file name specified by PATH. Return
;;; (VALUES LINKSTRING NIL) on success, or (VALUES NIL ERRNO) on
(syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
(%extract-stat-results (addr buf))
fd (addr buf))))
+
+#!-win32
+(defun fd-type (fd)
+ (declare (type unix-fd fd))
+ (let ((fmt (logand
+ sb!unix:s-ifmt
+ (or (with-alien ((buf (struct wrapped_stat)))
+ (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
+ (slot buf 'st-mode)
+ fd (addr buf)))
+ 0))))
+ (cond ((logtest sb!unix:s-ififo fmt)
+ :fifo)
+ ((logtest sb!unix:s-ifchr fmt)
+ :character)
+ ((logtest sb!unix:s-ifdir fmt)
+ :directory)
+ ((logtest sb!unix:s-ifblk fmt)
+ :block)
+ ((logtest sb!unix:s-ifreg fmt)
+ :regular)
+ ((logtest sb!unix:s-ifsock fmt)
+ :socket)
+ (t
+ :unknown))))
\f
;;;; time.h
(defun nanosleep (secs nsecs)
(with-alien ((req (struct timespec))
(rem (struct timespec)))
- (setf (slot req 'tv-sec) secs)
- (setf (slot req 'tv-nsec) nsecs)
- (loop while (eql sb!unix:eintr
- (nth-value 1
- (int-syscall ("nanosleep" (* (struct timespec))
- (* (struct timespec)))
- (addr req) (addr rem))))
- do (rotatef req rem))))
+ (setf (slot req 'tv-sec) secs
+ (slot req 'tv-nsec) nsecs)
+ (loop while (and (eql sb!unix:eintr
+ (nth-value 1
+ (int-syscall ("nanosleep" (* (struct timespec))
+ (* (struct timespec)))
+ (addr req) (addr rem))))
+ ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
+ ;; take longer than the requested time, the call will
+ ;; return with EINT and (unsigned)-1 seconds in the
+ ;; remainder timespec, which would cause us to enter
+ ;; nanosleep again for ~136 years. So, we check that the
+ ;; remainder time is actually decreasing.
+ ;;
+ ;; It would be neat to do this bit of defensive
+ ;; programming on all platforms, but unfortunately on
+ ;; Linux, REM can be a little higher than REQ if the
+ ;; nanosleep() call is interrupted quickly enough,
+ ;; probably due to the request being rounded up to the
+ ;; nearest HZ. This would cause the sleep to return way
+ ;; too early.
+ #!+darwin
+ (let ((rem-sec (slot rem 'tv-sec))
+ (rem-nsec (slot rem 'tv-nsec)))
+ (when (or (> secs rem-sec)
+ (and (= secs rem-sec) (>= nsecs rem-nsec)))
+ ;; Update for next round.
+ (setf secs rem-sec
+ nsecs rem-nsec)
+ t)))
+ do (setf (slot req 'tv-sec) (slot rem 'tv-sec)
+ (slot req 'tv-nsec) (slot rem 'tv-nsec)))))
(defun unix-get-seconds-west (secs)
(multiple-value-bind (ignore seconds dst) (get-timezone secs)
projects / sbcl.git / blobdiff