-;;;; This file contains Unix support that SBCL needs to implement itself. It's
-;;;; derived from Peter Van Eynde's unix-glibc2.lisp for CMU CL, which was
-;;;; derived from CMU CL unix.lisp 1.56. But those files aspired to be complete
-;;;; Unix interfaces exported to the end user, while this file aims to be as
-;;;; simple as possible and is not intended for the end user.
+;;;; This file contains Unix support that SBCL needs to implement
+;;;; itself. It's derived from Peter Van Eynde's unix-glibc2.lisp for
+;;;; CMU CL, which was derived from CMU CL unix.lisp 1.56. But those
+;;;; files aspired to be complete Unix interfaces exported to the end
+;;;; user, while this file aims to be as simple as possible and is not
+;;;; intended for the end user.
;;;;
;;;; FIXME: The old CMU CL unix.lisp code was implemented as hand
;;;; transcriptions from Unix headers into Lisp. It appears that this was as
(in-package "SB!UNIX")
-(file-comment
- "$Header$")
-
(/show0 "unix.lisp 21")
;;;; common machine-independent structures
(sb!xc:defmacro def-unix-error (name number description)
`(progn
+ (defconstant ,name ,number ,description)
(eval-when (:compile-toplevel :execute)
- (push (cons ,number ,description) *compiler-unix-errors*))
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant ,name ,number ,description))))
+ (push (cons ,number ,description) *compiler-unix-errors*))))
(sb!xc:defmacro emit-unix-errors ()
(let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*)))
(values nil (get-errno))
,success-form)))
-;;; Like SYSCALL, but if it fails, signal an error instead of returning error
-;;; codes. Should only be used for syscalls that will never really get an
-;;; error.
+;;; This is like SYSCALL, but if it fails, signal an error instead of
+;;; returning error codes. Should only be used for syscalls that will
+;;; never really get an error.
(defmacro syscall* ((name &rest arg-types) success-form &rest args)
`(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
,@args)))
(defmacro int-syscall ((name &rest arg-types) &rest args)
`(syscall (,name ,@arg-types) (values result 0) ,@args))
\f
-;;; from stdio.h
+;;;; hacking the Unix environment
-(/show0 "unix.lisp 124")
+(/show0 "unix.lisp 122")
+
+(def-alien-routine ("getenv" posix-getenv) c-string
+ "Return the environment string \"name=value\" which corresponds to NAME, or
+ NIL if there is none."
+ (name c-string))
+\f
+;;; from stdio.h
(defun unix-rename (name1 name2)
#!+sb-doc
(declare (type unix-pathname name1 name2))
(void-syscall ("rename" c-string c-string) name1 name2))
\f
-;;; from stdlib.h
-
-(def-alien-routine ("getenv" posix-getenv) c-string
- "Return the environment string \"name=value\" which corresponds to NAME, or
- NIL if there is none."
- (name c-string))
-\f
;;; from sys/types.h and gnu/types.h
-(/show0 "unix.lisp 144")
+(/show0 "unix.lisp 220")
(defconstant +max-s-long+ 2147483647)
(defconstant +max-u-long+ 4294967295)
(def-alien-type uid-t unsigned-int)
(def-alien-type ssize-t int)
-(/show0 "unix.lisp 163")
-
;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
;;; unless we have extreme provocation. Reading directories is not extreme
;;; enough, since it doesn't need to be blindingly fast: we can just implement
;;; those functions in C as a wrapper layer.
(def-alien-type fd-mask unsigned-long)
-(/show0 "unix.lisp 171")
;;; FIXME: Isn't there some way to use a C wrapper to avoid this hand-copying?
(def-alien-type dev-t
(def-alien-type nlink-t
#!+linux unsigned-int
#!+bsd unsigned-short)
-(/show0 "unix.lisp 190")
+(/show0 "unix.lisp 263")
;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
;;; unless we have extreme provocation. Reading directories is not extreme
#!+linux long
#!+bsd quad-t)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (/show0 "unix.lisp 215")
- (defconstant fd-setsize 1024))
-(/show0 "unix.lisp 217")
+(defconstant fd-setsize 1024)
(def-alien-type nil
(struct fd-set
(fds-bits (array fd-mask #.(/ fd-setsize 32)))))
-
-(/show0 "unix.lisp 223")
\f
;;;; direntry.h
(d-reclen unsigned-short) ; length of this record
(d_type unsigned-char)
(d-name (array char 256)))) ; name must be no longer than this
-(/show0 "unix.lisp 241")
+(/show0 "unix.lisp 289")
\f
;;;; dirent.h
;;;; we don't need to do horrible things like hand-copying the
;;;; direntry struct slot types into an alien struct.
-;;; FIXME: DIRECTORY is an external symbol of package CL, so we should use some
-;;; other name for this low-level implementation type.
-(defstruct directory
+;;; FIXME: DIRECTORY is an external symbol of package CL, so we should
+;;; use some other name for this low-level implementation type.
+(defstruct (directory (:copier nil))
name
(dir-struct (required-argument) :type system-area-pointer))
-(/show0 "unix.lisp 258")
+(/show0 "unix.lisp 304")
(def!method print-object ((dir directory) stream)
(print-unreadable-object (dir stream :type t)
(prin1 (directory-name dir) stream)))
-(/show0 "unix.lisp 264")
(defun open-dir (pathname)
(declare (type unix-pathname pathname))
(when (string= pathname "")
(values nil enoent))
(t
(values nil enotdir)))))
-(/show0 "unix.lisp 286")
(defun read-dir (dir)
(declare (type directory dir))
(values (cast (slot direct 'd-name) c-string)
(slot direct 'd-ino))))))
-(/show0 "unix.lisp 301")
(defun close-dir (dir)
(declare (type directory dir))
(alien-funcall (extern-alien "closedir"
(function void system-area-pointer))
(directory-dir-struct dir))
nil)
+\f
+;;;; fcntl.h
+;;;;
+;;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
-;;; dlfcn.h -> in foreign.lisp
-
-;;; fcntl.h
-;;;
-;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
-
-(/show0 "unix.lisp 318")
+(/show0 "unix.lisp 356")
(defconstant r_ok 4 #!+sb-doc "Test for read permission")
(defconstant w_ok 2 #!+sb-doc "Test for write permission")
(defconstant x_ok 1 #!+sb-doc "Test for execute permission")
(defconstant f_ok 0 #!+sb-doc "Test for presence of file")
-(/show0 "unix.lisp 352")
+;;; Open the file whose pathname is specified by PATH for reading
+;;; and/or writing as specified by the FLAGS argument. Various FLAGS
+;;; masks (O_RDONLY etc.) are defined in fcntlbits.h.
+;;;
+;;; If the O_CREAT flag is specified, then the file is created with a
+;;; permission of argument MODE if the file doesn't exist. An integer
+;;; file descriptor is returned by UNIX-OPEN.
(defun unix-open (path flags mode)
- #!+sb-doc
- "Unix-open opens the file whose pathname is specified by path
- for reading and/or writing as specified by the flags argument.
- The flags argument can be:
-
- o_rdonly Read-only flag.
- o_wronly Write-only flag.
- o_rdwr Read-and-write flag.
- o_append Append flag.
- o_creat Create-if-nonexistent flag.
- o_trunc Truncate-to-size-0 flag.
- o_excl Error if the file allready exists
- o_noctty Don't assign controlling tty
- o_ndelay Non-blocking I/O
- o_sync Synchronous I/O
- o_async Asynchronous I/O
-
- If the o_creat flag is specified, then the file is created with
- a permission of argument mode if the file doesn't exist. An
- integer file descriptor is returned by unix-open."
(declare (type unix-pathname path)
(type fixnum flags)
(type unix-file-mode mode))
;;; associated with it.
(/show0 "unix.lisp 391")
(defun unix-close (fd)
- #!+sb-doc
- "Unix-close takes an integer file descriptor as an argument and
- closes the file associated with it. T is returned upon successful
- completion, otherwise NIL and an error number."
(declare (type unix-fd fd))
(void-syscall ("close" int) fd))
\f
-;;; fcntlbits.h
-(eval-when (:compile-toplevel :load-toplevel :execute)
+;;;; fcntlbits.h
(/show0 "unix.lisp 337")
(defconstant o_rdonly 0) ; read-only flag
#!+linux #o2000
#!+bsd #x0008)
(/show0 "unix.lisp 361")
-) ; EVAL-WHEN
\f
;;;; timebits.h
(struct rusage
(ru-utime (struct timeval)) ; user time used
(ru-stime (struct timeval)) ; system time used.
- (ru-maxrss long) ; Maximum resident set size (in kilobytes)
+ (ru-maxrss long) ; maximum resident set size (in kilobytes)
(ru-ixrss long) ; integral shared memory size
(ru-idrss long) ; integral unshared data size
(ru-isrss long) ; integral unshared stack size
,num-descriptors ,read-fds ,write-fds ,exception-fds
(if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
-;;; Unix-select accepts sets of file descriptors and waits for an event
+;;; UNIX-SELECT accepts sets of file descriptors and waits for an event
;;; to happen on one of them or to time out.
-
(defmacro num-to-fd-set (fdset num)
`(if (fixnump ,num)
(progn
\f
;;;; time.h
-;; POSIX.4 structure for a time value. This is like a `struct timeval' but
-;; has nanoseconds instead of microseconds.
-
+;; the POSIX.4 structure for a time value. This is like a `struct
+;; timeval' but has nanoseconds instead of microseconds.
(def-alien-type nil
(struct timespec
(tv-sec long) ;Seconds
(tv-nsec long))) ;Nanoseconds
-;; Used by other time functions.
+;; used by other time functions
(def-alien-type nil
(struct tm
(tm-sec int) ; Seconds. [0-60] (1 leap second)
projects / sbcl.git / blobdiff