/[cmucl]/src/code/unix-glibc2.lisp
ViewVC logotype

Diff of /src/code/unix-glibc2.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.35.2.1 by rtoy, Mon Dec 19 01:09:53 2005 UTC revision 1.54 by rtoy, Tue Apr 20 17:57:45 2010 UTC
# Line 58  Line 58 
58  (use-package "C-CALL")  (use-package "C-CALL")
59  (use-package "SYSTEM")  (use-package "SYSTEM")
60  (use-package "EXT")  (use-package "EXT")
61    (intl:textdomain "cmucl-unix-glibc2")
62    
63    ;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding
64    ;; is locale-dependent...else use :utf-8 on Unicode Lisps.  On 8 bit Lisps
65    ;; it must be set to :iso8859-1 (or left as NIL), making files with
66    ;; non-Latin-1 characters "mojibake", but otherwise they'll be inaccessible.
67    ;; Must be set to NIL initially to enable building Lisp!
68    (defvar *filename-encoding* nil)
69    
70  (export '(  (export '(
71            daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t            daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
# Line 81  Line 89 
89            prot_read prot_write prot_exec prot_none            prot_read prot_write prot_exec prot_none
90            map_shared map_private map_fixed map_anonymous            map_shared map_private map_fixed map_anonymous
91            ms_async ms_sync ms_invalidate            ms_async ms_sync ms_invalidate
92            unix-mmap unix-munmap unix-msync            unix-mmap unix-munmap unix-msync unix-mprotect
93            unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid            unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
94            unix-setitimer unix-getitimer            unix-setitimer unix-getitimer
95            unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec            unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
# Line 182  Line 190 
190            unix-getpid unix-getppid            unix-getpid unix-getppid
191            unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid            unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
192            unix-getpagesize unix-gethostname unix-gethostid unix-fork            unix-getpagesize unix-gethostname unix-gethostid unix-fork
193              unix-getenv unix-setenv unix-putenv unix-unsetenv
194            unix-current-directory unix-isatty unix-ttyname unix-execve            unix-current-directory unix-isatty unix-ttyname unix-execve
195            unix-socket unix-connect unix-bind unix-listen unix-accept            unix-socket unix-connect unix-bind unix-listen unix-accept
196            unix-recv unix-send unix-getpeername unix-getsockname            unix-recv unix-send unix-getpeername unix-getsockname
197            unix-getsockopt unix-setsockopt            unix-getsockopt unix-setsockopt unix-openpty
198    
199            unix-recvfrom unix-sendto unix-shutdown            unix-recvfrom unix-sendto unix-shutdown
200    
# Line 197  Line 206 
206  (pushnew :unix *features*)  (pushnew :unix *features*)
207  (pushnew :glibc2 *features*)  (pushnew :glibc2 *features*)
208    
209    ;; needed for bootstrap
210    (eval-when (:compile-toplevel)
211      (defmacro %name->file (string)
212        `(if *filename-encoding*
213             (string-encode ,string *filename-encoding*)
214             ,string))
215      (defmacro %file->name (string)
216        `(if *filename-encoding*
217             (string-decode ,string *filename-encoding*)
218             ,string)))
219    
220  ;;;; Common machine independent structures.  ;;;; Common machine independent structures.
221    
222  (eval-when (compile eval)  (eval-when (compile eval)
# Line 245  Line 265 
265  (defconstant ms_sync 4)  (defconstant ms_sync 4)
266  (defconstant ms_invalidate 2)  (defconstant ms_invalidate 2)
267    
268    ;; The return value from mmap that means mmap failed.
269    (defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
270    
271  (defun unix-mmap (addr length prot flags fd offset)  (defun unix-mmap (addr length prot flags fd offset)
272    (declare (type (or null system-area-pointer) addr)    (declare (type (or null system-area-pointer) addr)
273             (type (unsigned-byte 32) length)             (type (unsigned-byte 32) length)
# Line 252  Line 275 
275             (type (unsigned-byte 32) flags)             (type (unsigned-byte 32) flags)
276             (type (or null unix-fd) fd)             (type (or null unix-fd) fd)
277             (type (signed-byte 32) offset))             (type (signed-byte 32) offset))
278    (syscall ("mmap" system-area-pointer size-t int int int off-t)    ;; Can't use syscall, because the address that is returned could be
279             (sys:int-sap result)    ;; "negative".  Hence we explicitly check for mmap returning
280             (or addr +null+) length prot flags (or fd -1) offset))    ;; MAP_FAILED.
281      (let ((result
282             (alien-funcall (extern-alien "mmap" (function system-area-pointer
283                                                           system-area-pointer
284                                                           size-t int int int off-t))
285                            (or addr +null+) length prot flags (or fd -1) offset)))
286        (if (sap= result map_failed)
287            (values nil (unix-errno))
288            (values result 0))))
289    
290  (defun unix-munmap (addr length)  (defun unix-munmap (addr length)
291    (declare (type system-area-pointer addr)    (declare (type system-area-pointer addr)
# Line 267  Line 298 
298             (type (signed-byte 32) flags))             (type (signed-byte 32) flags))
299    (syscall ("msync" system-area-pointer size-t int) t addr length flags))    (syscall ("msync" system-area-pointer size-t int) t addr length flags))
300    
301    (defun unix-mprotect (addr length prot)
302      (declare (type system-area-pointer addr)
303               (type (unsigned-byte 32) length)
304               (type (integer 1 7) prot))
305      (syscall ("mprotect" system-area-pointer size-t int)
306               t addr length prot))
307    
308  ;;;; Lisp types used by syscalls.  ;;;; Lisp types used by syscalls.
309    
310  (deftype unix-pathname () 'simple-string)  (deftype unix-pathname () 'simple-string)
# Line 314  Line 352 
352    
353    
354  ;;;; System calls.  ;;;; System calls.
 (def-alien-variable ("errno" unix-internal-errno) int)  
355    
356  ;;; later...  (def-alien-routine ("os_get_errno" unix-get-errno) int)
357  (defun unix-get-errno ())  (def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int))
358    (defun unix-errno () (unix-get-errno))
359  (defun unix-errno () (unix-get-errno) unix-internal-errno)  (defun (setf unix-errno) (newvalue) (unix-set-errno newvalue))
 (defun (setf unix-errno) (newvalue) (setf unix-internal-errno newvalue))  
360    
361  ;;; GET-UNIX-ERROR-MSG -- public.  ;;; GET-UNIX-ERROR-MSG -- public.
362  ;;;  ;;;
363  (defun get-unix-error-msg (&optional (error-number (unix-errno)))  (defun get-unix-error-msg (&optional (error-number (unix-errno)))
364    "Returns a string describing the error number which was returned by a    _N"Returns a string describing the error number which was returned by a
365    UNIX system call."    UNIX system call."
366    (declare (type integer error-number))    (declare (type integer error-number))
367    
368    (if (array-in-bounds-p *unix-errors* error-number)    (if (array-in-bounds-p *unix-errors* error-number)
369        (svref *unix-errors* error-number)        (svref *unix-errors* error-number)
370        (format nil "Unknown error [~d]" error-number)))        (format nil (intl:gettext "Unknown error [~d]") error-number)))
371    
372  (defmacro syscall ((name &rest arg-types) success-form &rest args)  (defmacro syscall ((name &rest arg-types) success-form &rest args)
373    `(locally    `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
374      (declare (optimize (ext::float-accuracy 0)))                                  ,@args)))
375      (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))       (if (minusp result)
376                                   ,@args)))           (values nil (unix-errno))
377        (if (minusp result)           ,success-form)))
           (values nil (unix-errno))  
           ,success-form))))  
378    
379  ;;; Like syscall, but if it fails, signal an error instead of returning error  ;;; Like syscall, but if it fails, signal an error instead of returning error
380  ;;; codes.  Should only be used for syscalls that will never really get an  ;;; codes.  Should only be used for syscalls that will never really get an
381  ;;; error.  ;;; error.
382  ;;;  ;;;
383  (defmacro syscall* ((name &rest arg-types) success-form &rest args)  (defmacro syscall* ((name &rest arg-types) success-form &rest args)
384    `(locally    `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
385      (declare (optimize (ext::float-accuracy 0)))                                  ,@args)))
386      (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))       (if (minusp result)
387                                   ,@args)))           (error (intl:gettext "Syscall ~A failed: ~A") ,name (get-unix-error-msg))
388        (if (minusp result)           ,success-form)))
           (error "Syscall ~A failed: ~A" ,name (get-unix-error-msg))  
           ,success-form))))  
389    
390  (defmacro void-syscall ((name &rest arg-types) &rest args)  (defmacro void-syscall ((name &rest arg-types) &rest args)
391    `(syscall (,name ,@arg-types) (values t 0) ,@args))    `(syscall (,name ,@arg-types) (values t 0) ,@args))
# Line 361  Line 393 
393  (defmacro int-syscall ((name &rest arg-types) &rest args)  (defmacro int-syscall ((name &rest arg-types) &rest args)
394    `(syscall (,name ,@arg-types) (values result 0) ,@args))    `(syscall (,name ,@arg-types) (values result 0) ,@args))
395    
 (defun unix-get-errno ()  
   "Get the unix errno value in errno..."  
   (void-syscall ("update_errno")))  
396  ;;; From stdio.h  ;;; From stdio.h
397    
398  ;;; Unix-rename accepts two files names and renames the first to the second.  ;;; Unix-rename accepts two files names and renames the first to the second.
399    
400  (defun unix-rename (name1 name2)  (defun unix-rename (name1 name2)
401    "Unix-rename renames the file with string name1 to the string    _N"Unix-rename renames the file with string name1 to the string
402     name2.  NIL and an error code is returned if an error occured."     name2.  NIL and an error code is returned if an error occured."
403    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
404    (void-syscall ("rename" c-string c-string) name1 name2))    (void-syscall ("rename" c-string c-string)
405                    (%name->file name1) (%name->file name2)))
406    
407  ;;; From sys/types.h  ;;; From sys/types.h
408  ;;;         and  ;;;         and
# Line 473  Line 503 
503                (alien-funcall (extern-alien "opendir"                (alien-funcall (extern-alien "opendir"
504                                             (function system-area-pointer                                             (function system-area-pointer
505                                                       c-string))                                                       c-string))
506                               pathname)))                               (%name->file pathname))))
507           (if (zerop (sap-int dir-struct))           (if (zerop (sap-int dir-struct))
508               (values nil (unix-errno))               (values nil (unix-errno))
509               (make-directory :name pathname :dir-struct dir-struct))))               (make-directory :name pathname :dir-struct dir-struct))))
# Line 492  Line 522 
522      (if (zerop (sap-int daddr))      (if (zerop (sap-int daddr))
523          nil          nil
524          (with-alien ((dirent (* (struct dirent)) daddr))          (with-alien ((dirent (* (struct dirent)) daddr))
525            (values (cast (slot dirent 'd-name) c-string)            (values (%file->name (cast (slot dirent 'd-name) c-string))
526                    (slot dirent 'd-ino))))))                    (slot dirent 'd-ino))))))
527    
528  (defun close-dir (dir)  (defun close-dir (dir)
# Line 508  Line 538 
538  ;;;  ;;;
539  ;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>  ;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
540    
541  (defconstant r_ok 4 "Test for read permission")  (defconstant r_ok 4 _N"Test for read permission")
542  (defconstant w_ok 2 "Test for write permission")  (defconstant w_ok 2 _N"Test for write permission")
543  (defconstant x_ok 1 "Test for execute permission")  (defconstant x_ok 1 _N"Test for execute permission")
544  (defconstant f_ok 0 "Test for presence of file")  (defconstant f_ok 0 _N"Test for presence of file")
545    
546  (defun unix-fcntl (fd cmd arg)  (defun unix-fcntl (fd cmd arg)
547    "Unix-fcntl manipulates file descriptors accoridng to the    _N"Unix-fcntl manipulates file descriptors accoridng to the
548     argument CMD which can be one of the following:     argument CMD which can be one of the following:
549    
550     F-DUPFD         Duplicate a file descriptor.     F-DUPFD         Duplicate a file descriptor.
# Line 540  Line 570 
570    (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))    (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))
571    
572  (defun unix-open (path flags mode)  (defun unix-open (path flags mode)
573    "Unix-open opens the file whose pathname is specified by PATH    _N"Unix-open opens the file whose pathname is specified by PATH
574     for reading and/or writing as specified by the FLAGS argument.     for reading and/or writing as specified by the FLAGS argument.
575     Returns an integer file descriptor.     Returns an integer file descriptor.
576     The flags argument can be:     The flags argument can be:
# Line 562  Line 592 
592    (declare (type unix-pathname path)    (declare (type unix-pathname path)
593             (type fixnum flags)             (type fixnum flags)
594             (type unix-file-mode mode))             (type unix-file-mode mode))
595    (int-syscall ("open64" c-string int int) path flags mode))    (int-syscall ("open64" c-string int int) (%name->file path) flags mode))
596    
597  (defun unix-getdtablesize ()  (defun unix-getdtablesize ()
598    "Unix-getdtablesize returns the maximum size of the file descriptor    _N"Unix-getdtablesize returns the maximum size of the file descriptor
599     table. (i.e. the maximum number of descriptors that can exist at     table. (i.e. the maximum number of descriptors that can exist at
600     one time.)"     one time.)"
601    (int-syscall ("getdtablesize")))    (int-syscall ("getdtablesize")))
# Line 574  Line 604 
604  ;;; associated with it.  ;;; associated with it.
605    
606  (defun unix-close (fd)  (defun unix-close (fd)
607    "Unix-close takes an integer file descriptor as an argument and    _N"Unix-close takes an integer file descriptor as an argument and
608     closes the file associated with it.  T is returned upon successful     closes the file associated with it.  T is returned upon successful
609     completion, otherwise NIL and an error number."     completion, otherwise NIL and an error number."
610    (declare (type unix-fd fd))    (declare (type unix-fd fd))
# Line 584  Line 614 
614  ;;; with name and sets it mode to mode (as for chmod).  ;;; with name and sets it mode to mode (as for chmod).
615    
616  (defun unix-creat (name mode)  (defun unix-creat (name mode)
617    "Unix-creat accepts a file name and a mode (same as those for    _N"Unix-creat accepts a file name and a mode (same as those for
618     unix-chmod) and creates a file by that name with the specified     unix-chmod) and creates a file by that name with the specified
619     permission mode.  It returns a file descriptor on success,     permission mode.  It returns a file descriptor on success,
620     or NIL and an error  number otherwise.     or NIL and an error  number otherwise.
# Line 593  Line 623 
623    
624    (declare (type unix-pathname name)    (declare (type unix-pathname name)
625             (type unix-file-mode mode))             (type unix-file-mode mode))
626    (int-syscall ("creat64" c-string int) name mode))    (int-syscall ("creat64" c-string int) (%name->file name) mode))
627    
628  ;;; fcntlbits.h  ;;; fcntlbits.h
629    
630  (defconstant o_read    o_rdonly "Open for reading")  (defconstant o_read    o_rdonly _N"Open for reading")
631  (defconstant o_write   o_wronly "Open for writing")  (defconstant o_write   o_wronly _N"Open for writing")
632    
633  (defconstant o_rdonly  0 "Read-only flag.")  (defconstant o_rdonly  0 _N"Read-only flag.")
634  (defconstant o_wronly  1 "Write-only flag.")  (defconstant o_wronly  1 _N"Write-only flag.")
635  (defconstant o_rdwr    2 "Read-write flag.")  (defconstant o_rdwr    2 _N"Read-write flag.")
636  (defconstant o_accmode 3 "Access mode mask.")  (defconstant o_accmode 3 _N"Access mode mask.")
637    
638  #-alpha  #-alpha
639  (progn  (progn
640    (defconstant o_creat   #o100 "Create if nonexistant flag. (not fcntl)")    (defconstant o_creat   #o100 _N"Create if nonexistant flag. (not fcntl)")
641    (defconstant o_excl    #o200 "Error if already exists. (not fcntl)")    (defconstant o_excl    #o200 _N"Error if already exists. (not fcntl)")
642    (defconstant o_noctty  #o400 "Don't assign controlling tty. (not fcntl)")    (defconstant o_noctty  #o400 _N"Don't assign controlling tty. (not fcntl)")
643    (defconstant o_trunc   #o1000 "Truncate flag. (not fcntl)")    (defconstant o_trunc   #o1000 _N"Truncate flag. (not fcntl)")
644    (defconstant o_append  #o2000 "Append flag.")    (defconstant o_append  #o2000 _N"Append flag.")
645    (defconstant o_ndelay  #o4000 "Non-blocking I/O")    (defconstant o_ndelay  #o4000 _N"Non-blocking I/O")
646    (defconstant o_nonblock #o4000 "Non-blocking I/O")    (defconstant o_nonblock #o4000 _N"Non-blocking I/O")
647    (defconstant o_ndelay  o_nonblock)    (defconstant o_ndelay  o_nonblock)
648    (defconstant o_sync    #o10000 "Synchronous writes (on ext2)")    (defconstant o_sync    #o10000 _N"Synchronous writes (on ext2)")
649    (defconstant o_fsync    o_sync)    (defconstant o_fsync    o_sync)
650    (defconstant o_async   #o20000 "Asynchronous I/O"))    (defconstant o_async   #o20000 _N"Asynchronous I/O"))
651  #+alpha  #+alpha
652  (progn  (progn
653    (defconstant o_creat   #o1000 "Create if nonexistant flag. (not fcntl)")    (defconstant o_creat   #o1000 _N"Create if nonexistant flag. (not fcntl)")
654    (defconstant o_trunc   #o2000 "Truncate flag. (not fcntl)")    (defconstant o_trunc   #o2000 _N"Truncate flag. (not fcntl)")
655    (defconstant o_excl    #o4000 "Error if already exists. (not fcntl)")    (defconstant o_excl    #o4000 _N"Error if already exists. (not fcntl)")
656    (defconstant o_noctty  #o10000 "Don't assign controlling tty. (not fcntl)")    (defconstant o_noctty  #o10000 _N"Don't assign controlling tty. (not fcntl)")
657    (defconstant o_nonblock #o4 "Non-blocking I/O")    (defconstant o_nonblock #o4 _N"Non-blocking I/O")
658    (defconstant o_append  #o10 "Append flag.")    (defconstant o_append  #o10 _N"Append flag.")
659    (defconstant o_ndelay  o_nonblock)    (defconstant o_ndelay  o_nonblock)
660    (defconstant o_sync    #o40000 "Synchronous writes (on ext2)")    (defconstant o_sync    #o40000 _N"Synchronous writes (on ext2)")
661    (defconstant o_fsync    o_sync)    (defconstant o_fsync    o_sync)
662    (defconstant o_async   #o20000 "Asynchronous I/O"))    (defconstant o_async   #o20000 _N"Asynchronous I/O"))
663    
664  (defconstant f-dupfd    0  "Duplicate a file descriptor")  (defconstant f-dupfd    0  _N"Duplicate a file descriptor")
665  (defconstant f-getfd    1  "Get file desc. flags")  (defconstant f-getfd    1  _N"Get file desc. flags")
666  (defconstant f-setfd    2  "Set file desc. flags")  (defconstant f-setfd    2  _N"Set file desc. flags")
667  (defconstant f-getfl    3  "Get file flags")  (defconstant f-getfl    3  _N"Get file flags")
668  (defconstant f-setfl    4  "Set file flags")  (defconstant f-setfl    4  _N"Set file flags")
669    
670  #-alpha  #-alpha
671  (progn  (progn
672    (defconstant f-getlk    5   "Get lock")    (defconstant f-getlk    5   _N"Get lock")
673    (defconstant f-setlk    6   "Set lock")    (defconstant f-setlk    6   _N"Set lock")
674    (defconstant f-setlkw   7   "Set lock, wait for release")    (defconstant f-setlkw   7   _N"Set lock, wait for release")
675    (defconstant f-setown   8  "Set owner (for sockets)")    (defconstant f-setown   8  _N"Set owner (for sockets)")
676    (defconstant f-getown   9  "Get owner (for sockets)"))    (defconstant f-getown   9  _N"Get owner (for sockets)"))
677  #+alpha  #+alpha
678  (progn  (progn
679    (defconstant f-getlk    7   "Get lock")    (defconstant f-getlk    7   _N"Get lock")
680    (defconstant f-setlk    8   "Set lock")    (defconstant f-setlk    8   _N"Set lock")
681    (defconstant f-setlkw   9   "Set lock, wait for release")    (defconstant f-setlkw   9   _N"Set lock, wait for release")
682    (defconstant f-setown   5  "Set owner (for sockets)")    (defconstant f-setown   5  _N"Set owner (for sockets)")
683    (defconstant f-getown   6  "Get owner (for sockets)"))    (defconstant f-getown   6  _N"Get owner (for sockets)"))
684    
685    
686    
687  (defconstant F-CLOEXEC 1 "for f-getfl and f-setfl")  (defconstant F-CLOEXEC 1 _N"for f-getfl and f-setfl")
688    
689  #-alpha  #-alpha
690  (progn  (progn
691    (defconstant F-RDLCK 0 "for fcntl and lockf")    (defconstant F-RDLCK 0 _N"for fcntl and lockf")
692    (defconstant F-WRLCK 1 "for fcntl and lockf")    (defconstant F-WRLCK 1 _N"for fcntl and lockf")
693    (defconstant F-UNLCK 2 "for fcntl and lockf")    (defconstant F-UNLCK 2 _N"for fcntl and lockf")
694    (defconstant F-EXLCK 4 "old bsd flock (depricated)")    (defconstant F-EXLCK 4 _N"old bsd flock (depricated)")
695    (defconstant F-SHLCK 8 "old bsd flock (depricated)"))    (defconstant F-SHLCK 8 _N"old bsd flock (depricated)"))
696  #+alpha  #+alpha
697  (progn  (progn
698    (defconstant F-RDLCK 1 "for fcntl and lockf")    (defconstant F-RDLCK 1 _N"for fcntl and lockf")
699    (defconstant F-WRLCK 2 "for fcntl and lockf")    (defconstant F-WRLCK 2 _N"for fcntl and lockf")
700    (defconstant F-UNLCK 8 "for fcntl and lockf")    (defconstant F-UNLCK 8 _N"for fcntl and lockf")
701    (defconstant F-EXLCK 16 "old bsd flock (depricated)")    (defconstant F-EXLCK 16 _N"old bsd flock (depricated)")
702    (defconstant F-SHLCK 32 "old bsd flock (depricated)"))    (defconstant F-SHLCK 32 _N"old bsd flock (depricated)"))
703    
704  (defconstant F-LOCK-SH 1 "Shared lock for bsd flock")  (defconstant F-LOCK-SH 1 _N"Shared lock for bsd flock")
705  (defconstant F-LOCK-EX 2 "Exclusive lock for bsd flock")  (defconstant F-LOCK-EX 2 _N"Exclusive lock for bsd flock")
706  (defconstant F-LOCK-NB 4 "Don't block. Combine with F-LOCK-SH or F-LOCK-EX")  (defconstant F-LOCK-NB 4 _N"Don't block. Combine with F-LOCK-SH or F-LOCK-EX")
707  (defconstant F-LOCK-UN 8 "Remove lock for bsd flock")  (defconstant F-LOCK-UN 8 _N"Remove lock for bsd flock")
708    
709  (def-alien-type nil  (def-alien-type nil
710      (struct flock      (struct flock
# Line 687  Line 717 
717  ;;; Define some more compatibility macros to be backward compatible with  ;;; Define some more compatibility macros to be backward compatible with
718  ;;; BSD systems which did not managed to hide these kernel macros.  ;;; BSD systems which did not managed to hide these kernel macros.
719    
720  (defconstant FAPPEND  o_append "depricated stuff")  (defconstant FAPPEND  o_append _N"depricated stuff")
721  (defconstant FFSYNC   o_fsync  "depricated stuff")  (defconstant FFSYNC   o_fsync  _N"depricated stuff")
722  (defconstant FASYNC   o_async  "depricated stuff")  (defconstant FASYNC   o_async  _N"depricated stuff")
723  (defconstant FNONBLOCK  o_nonblock "depricated stuff")  (defconstant FNONBLOCK  o_nonblock _N"depricated stuff")
724  (defconstant FNDELAY  o_ndelay "depricated stuff")  (defconstant FNDELAY  o_ndelay _N"depricated stuff")
725    
726    
727  ;;; grp.h  ;;; grp.h
# Line 700  Line 730 
730    
731  #+(or)  #+(or)
732  (defun unix-setgrend ()  (defun unix-setgrend ()
733    "Rewind the group-file stream."    _N"Rewind the group-file stream."
734    (void-syscall ("setgrend")))    (void-syscall ("setgrend")))
735    
736  #+(or)  #+(or)
737  (defun unix-endgrent ()  (defun unix-endgrent ()
738    "Close the group-file stream."    _N"Close the group-file stream."
739    (void-syscall ("endgrent")))    (void-syscall ("endgrent")))
740    
741  #+(or)  #+(or)
742  (defun unix-getgrent ()  (defun unix-getgrent ()
743    "Read an entry from the group-file stream, opening it if necessary."    _N"Read an entry from the group-file stream, opening it if necessary."
744    
745    (let ((result (alien-funcall (extern-alien "getgrent"    (let ((result (alien-funcall (extern-alien "getgrent"
746                                               (function (* (struct group)))))))                                               (function (* (struct group)))))))
# Line 729  Line 759 
759      (ws-ypixel unsigned-short)))        ; veritical size, pixels      (ws-ypixel unsigned-short)))        ; veritical size, pixels
760    
761  (defconstant +NCC+ 8  (defconstant +NCC+ 8
762    "Size of control character vector.")    _N"Size of control character vector.")
763    
764  (def-alien-type nil  (def-alien-type nil
765    (struct termio    (struct termio
# Line 939  Line 969 
969    
970    
971  ;;; Possible values left in `h_errno'.  ;;; Possible values left in `h_errno'.
972  (defconstant netdb-internal -1 "See errno.")  (defconstant netdb-internal -1 _N"See errno.")
973  (defconstant netdb-success 0 "No problem.")  (defconstant netdb-success 0 _N"No problem.")
974  (defconstant host-not-found 1 "Authoritative Answer Host not found.")  (defconstant host-not-found 1 _N"Authoritative Answer Host not found.")
975  (defconstant try-again 2 "Non-Authoritative Host not found,or SERVERFAIL.")  (defconstant try-again 2 _N"Non-Authoritative Host not found,or SERVERFAIL.")
976  (defconstant no-recovery 3 "Non recoverable errors, FORMERR, REFUSED, NOTIMP.")  (defconstant no-recovery 3 _N"Non recoverable errors, FORMERR, REFUSED, NOTIMP.")
977  (defconstant no-data 4  "Valid name, no data record of requested type.")  (defconstant no-data 4  "Valid name, no data record of requested type.")
978  (defconstant no-address no-data "No address, look for MX record.")  (defconstant no-address no-data "No address, look for MX record.")
979    
# Line 959  Line 989 
989    
990  #+(or)  #+(or)
991  (defun unix-sethostent (stay-open)  (defun unix-sethostent (stay-open)
992    "Open host data base files and mark them as staying open even after    _N"Open host data base files and mark them as staying open even after
993  a later search if STAY_OPEN is non-zero."  a later search if STAY_OPEN is non-zero."
994    (void-syscall ("sethostent" int) stay-open))    (void-syscall ("sethostent" int) stay-open))
995    
996  #+(or)  #+(or)
997  (defun unix-endhostent ()  (defun unix-endhostent ()
998    "Close host data base files and clear `stay open' flag."    _N"Close host data base files and clear `stay open' flag."
999    (void-syscall ("endhostent")))    (void-syscall ("endhostent")))
1000    
1001  #+(or)  #+(or)
1002  (defun unix-gethostent ()  (defun unix-gethostent ()
1003    "Get next entry from host data base file.  Open data base if    _N"Get next entry from host data base file.  Open data base if
1004  necessary."  necessary."
1005      (let ((result (alien-funcall (extern-alien "gethostent"      (let ((result (alien-funcall (extern-alien "gethostent"
1006                                               (function (* (struct hostent)))))))                                               (function (* (struct hostent)))))))
# Line 981  necessary." Line 1011  necessary."
1011    
1012  #+(or)  #+(or)
1013  (defun unix-gethostbyaddr(addr length type)  (defun unix-gethostbyaddr(addr length type)
1014    "Return entry from host data base which address match ADDR with    _N"Return entry from host data base which address match ADDR with
1015  length LEN and type TYPE."  length LEN and type TYPE."
1016      (let ((result (alien-funcall (extern-alien "gethostbyaddr"      (let ((result (alien-funcall (extern-alien "gethostbyaddr"
1017                                               (function (* (struct hostent))                                               (function (* (struct hostent))
# Line 994  length LEN and type TYPE." Line 1024  length LEN and type TYPE."
1024    
1025  #+(or)  #+(or)
1026  (defun unix-gethostbyname (name)  (defun unix-gethostbyname (name)
1027    "Return entry from host data base for host with NAME."    _N"Return entry from host data base for host with NAME."
1028      (let ((result (alien-funcall (extern-alien "gethostbyname"      (let ((result (alien-funcall (extern-alien "gethostbyname"
1029                                               (function (* (struct hostent))                                               (function (* (struct hostent))
1030                                                         c-string))                                                         c-string))
# Line 1006  length LEN and type TYPE." Line 1036  length LEN and type TYPE."
1036    
1037  #+(or)  #+(or)
1038  (defun unix-gethostbyname2 (name af)  (defun unix-gethostbyname2 (name af)
1039    "Return entry from host data base for host with NAME.  AF must be    _N"Return entry from host data base for host with NAME.  AF must be
1040     set to the address type which as `AF_INET' for IPv4 or `AF_INET6'     set to the address type which as `AF_INET' for IPv4 or `AF_INET6'
1041     for IPv6."     for IPv6."
1042      (let ((result (alien-funcall (extern-alien "gethostbyname2"      (let ((result (alien-funcall (extern-alien "gethostbyname2"
# Line 1031  length LEN and type TYPE." Line 1061  length LEN and type TYPE."
1061    
1062  #+(or)  #+(or)
1063  (defun unix-setnetent (stay-open)  (defun unix-setnetent (stay-open)
1064    "Open network data base files and mark them as staying open even    _N"Open network data base files and mark them as staying open even
1065     after a later search if STAY_OPEN is non-zero."     after a later search if STAY_OPEN is non-zero."
1066    (void-syscall ("setnetent" int) stay-open))    (void-syscall ("setnetent" int) stay-open))
1067    
1068    
1069  #+(or)  #+(or)
1070  (defun unix-endnetent ()  (defun unix-endnetent ()
1071    "Close network data base files and clear `stay open' flag."    _N"Close network data base files and clear `stay open' flag."
1072    (void-syscall ("endnetent")))    (void-syscall ("endnetent")))
1073    
1074    
1075  #+(or)  #+(or)
1076  (defun unix-getnetent ()  (defun unix-getnetent ()
1077    "Get next entry from network data base file.  Open data base if    _N"Get next entry from network data base file.  Open data base if
1078     necessary."     necessary."
1079      (let ((result (alien-funcall (extern-alien "getnetent"      (let ((result (alien-funcall (extern-alien "getnetent"
1080                                               (function (* (struct netent)))))))                                               (function (* (struct netent)))))))
# Line 1056  length LEN and type TYPE." Line 1086  length LEN and type TYPE."
1086    
1087  #+(or)  #+(or)
1088  (defun unix-getnetbyaddr (net type)  (defun unix-getnetbyaddr (net type)
1089    "Return entry from network data base which address match NET and    _N"Return entry from network data base which address match NET and
1090     type TYPE."     type TYPE."
1091      (let ((result (alien-funcall (extern-alien "getnetbyaddr"      (let ((result (alien-funcall (extern-alien "getnetbyaddr"
1092                                               (function (* (struct netent))                                               (function (* (struct netent))
# Line 1069  length LEN and type TYPE." Line 1099  length LEN and type TYPE."
1099    
1100  #+(or)  #+(or)
1101  (defun unix-getnetbyname (name)  (defun unix-getnetbyname (name)
1102    "Return entry from network data base for network with NAME."    _N"Return entry from network data base for network with NAME."
1103      (let ((result (alien-funcall (extern-alien "getnetbyname"      (let ((result (alien-funcall (extern-alien "getnetbyname"
1104                                               (function (* (struct netent))                                               (function (* (struct netent))
1105                                                         c-string))                                                         c-string))
# Line 1089  length LEN and type TYPE." Line 1119  length LEN and type TYPE."
1119    
1120  #+(or)  #+(or)
1121  (defun unix-setservent (stay-open)  (defun unix-setservent (stay-open)
1122    "Open service data base files and mark them as staying open even    _N"Open service data base files and mark them as staying open even
1123     after a later search if STAY_OPEN is non-zero."     after a later search if STAY_OPEN is non-zero."
1124    (void-syscall ("setservent" int) stay-open))    (void-syscall ("setservent" int) stay-open))
1125    
1126  #+(or)  #+(or)
1127  (defun unix-endservent (stay-open)  (defun unix-endservent (stay-open)
1128    "Close service data base files and clear `stay open' flag."    _N"Close service data base files and clear `stay open' flag."
1129    (void-syscall ("endservent")))    (void-syscall ("endservent")))
1130    
1131    
1132  #+(or)  #+(or)
1133  (defun unix-getservent ()  (defun unix-getservent ()
1134    "Get next entry from service data base file.  Open data base if    _N"Get next entry from service data base file.  Open data base if
1135     necessary."     necessary."
1136      (let ((result (alien-funcall (extern-alien "getservent"      (let ((result (alien-funcall (extern-alien "getservent"
1137                                               (function (* (struct servent)))))))                                               (function (* (struct servent)))))))
# Line 1112  length LEN and type TYPE." Line 1142  length LEN and type TYPE."
1142    
1143  #+(or)  #+(or)
1144  (defun unix-getservbyname (name proto)  (defun unix-getservbyname (name proto)
1145    "Return entry from network data base for network with NAME and    _N"Return entry from network data base for network with NAME and
1146     protocol PROTO."     protocol PROTO."
1147      (let ((result (alien-funcall (extern-alien "getservbyname"      (let ((result (alien-funcall (extern-alien "getservbyname"
1148                                               (function (* (struct netent))                                               (function (* (struct netent))
# Line 1125  length LEN and type TYPE." Line 1155  length LEN and type TYPE."
1155    
1156  #+(or)  #+(or)
1157  (defun unix-getservbyport (port proto)  (defun unix-getservbyport (port proto)
1158    "Return entry from service data base which matches port PORT and    _N"Return entry from service data base which matches port PORT and
1159     protocol PROTO."     protocol PROTO."
1160      (let ((result (alien-funcall (extern-alien "getservbyport"      (let ((result (alien-funcall (extern-alien "getservbyport"
1161                                               (function (* (struct netent))                                               (function (* (struct netent))
# Line 1146  length LEN and type TYPE." Line 1176  length LEN and type TYPE."
1176    
1177  #+(or)  #+(or)
1178  (defun unix-setprotoent (stay-open)  (defun unix-setprotoent (stay-open)
1179    "Open protocol data base files and mark them as staying open even    _N"Open protocol data base files and mark them as staying open even
1180     after a later search if STAY_OPEN is non-zero."     after a later search if STAY_OPEN is non-zero."
1181    (void-syscall ("setprotoent" int) stay-open))    (void-syscall ("setprotoent" int) stay-open))
1182    
1183  #+(or)  #+(or)
1184  (defun unix-endprotoent ()  (defun unix-endprotoent ()
1185    "Close protocol data base files and clear `stay open' flag."    _N"Close protocol data base files and clear `stay open' flag."
1186    (void-syscall ("endprotoent")))    (void-syscall ("endprotoent")))
1187    
1188  #+(or)  #+(or)
1189  (defun unix-getprotoent ()  (defun unix-getprotoent ()
1190    "Get next entry from protocol data base file.  Open data base if    _N"Get next entry from protocol data base file.  Open data base if
1191     necessary."     necessary."
1192      (let ((result (alien-funcall (extern-alien "getprotoent"      (let ((result (alien-funcall (extern-alien "getprotoent"
1193                                               (function (* (struct protoent)))))))                                               (function (* (struct protoent)))))))
# Line 1168  length LEN and type TYPE." Line 1198  length LEN and type TYPE."
1198    
1199  #+(or)  #+(or)
1200  (defun unix-getprotobyname (name)  (defun unix-getprotobyname (name)
1201    "Return entry from protocol data base for network with NAME."    _N"Return entry from protocol data base for network with NAME."
1202      (let ((result (alien-funcall (extern-alien "getprotobyname"      (let ((result (alien-funcall (extern-alien "getprotobyname"
1203                                               (function (* (struct protoent))                                               (function (* (struct protoent))
1204                                                         c-string))                                                         c-string))
# Line 1180  length LEN and type TYPE." Line 1210  length LEN and type TYPE."
1210    
1211  #+(or)  #+(or)
1212  (defun unix-getprotobynumber (proto)  (defun unix-getprotobynumber (proto)
1213    "Return entry from protocol data base which number is PROTO."    _N"Return entry from protocol data base which number is PROTO."
1214      (let ((result (alien-funcall (extern-alien "getprotobynumber"      (let ((result (alien-funcall (extern-alien "getprotobynumber"
1215                                               (function (* (struct protoent))                                               (function (* (struct protoent))
1216                                                         int))                                                         int))
# Line 1192  length LEN and type TYPE." Line 1222  length LEN and type TYPE."
1222    
1223  #+(or)  #+(or)
1224  (defun unix-setnetgrent (netgroup)  (defun unix-setnetgrent (netgroup)
1225    "Establish network group NETGROUP for enumeration."    _N"Establish network group NETGROUP for enumeration."
1226    (int-syscall ("setservent" c-string) netgroup))    (int-syscall ("setservent" c-string) netgroup))
1227    
1228  #+(or)  #+(or)
1229  (defun unix-endnetgrent ()  (defun unix-endnetgrent ()
1230    "Free all space allocated by previous `setnetgrent' call."    _N"Free all space allocated by previous `setnetgrent' call."
1231    (void-syscall ("endnetgrent")))    (void-syscall ("endnetgrent")))
1232    
1233  #+(or)  #+(or)
1234  (defun unix-getnetgrent (hostp userp domainp)  (defun unix-getnetgrent (hostp userp domainp)
1235    "Get next member of netgroup established by last `setnetgrent' call    _N"Get next member of netgroup established by last `setnetgrent' call
1236     and return pointers to elements in HOSTP, USERP, and DOMAINP."     and return pointers to elements in HOSTP, USERP, and DOMAINP."
1237    (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string))    (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string))
1238                 hostp userp domainp))                 hostp userp domainp))
1239    
1240  #+(or)  #+(or)
1241  (defun unix-innetgr (netgroup host user domain)  (defun unix-innetgr (netgroup host user domain)
1242    "Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)."    _N"Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)."
1243    (int-syscall ("innetgr" c-string c-string c-string c-string)    (int-syscall ("innetgr" c-string c-string c-string c-string)
1244                 netgroup host user domain))                 netgroup host user domain))
1245    
# Line 1228  length LEN and type TYPE." Line 1258  length LEN and type TYPE."
1258    
1259  ;; Possible values for `ai_flags' field in `addrinfo' structure.  ;; Possible values for `ai_flags' field in `addrinfo' structure.
1260    
1261  (defconstant ai_passive 1 "Socket address is intended for `bind'.")  (defconstant ai_passive 1 _N"Socket address is intended for `bind'.")
1262  (defconstant ai_canonname 2 "Request for canonical name.")  (defconstant ai_canonname 2 _N"Request for canonical name.")
1263    
1264  ;; Error values for `getaddrinfo' function.  ;; Error values for `getaddrinfo' function.
1265  (defconstant eai_badflags -1 "Invalid value for `ai_flags' field.")  (defconstant eai_badflags -1 _N"Invalid value for `ai_flags' field.")
1266  (defconstant eai_noname -2 "NAME or SERVICE is unknown.")  (defconstant eai_noname -2 _N"NAME or SERVICE is unknown.")
1267  (defconstant eai_again -3 "Temporary failure in name resolution.")  (defconstant eai_again -3 _N"Temporary failure in name resolution.")
1268  (defconstant eai_fail -4 "Non-recoverable failure in name res.")  (defconstant eai_fail -4 _N"Non-recoverable failure in name res.")
1269  (defconstant eai_nodata -5 "No address associated with NAME.")  (defconstant eai_nodata -5 _N"No address associated with NAME.")
1270  (defconstant eai_family -6 "ai_family not supported.")  (defconstant eai_family -6 _N"ai_family not supported.")
1271  (defconstant eai_socktype -7 "ai_socktype not supported.")  (defconstant eai_socktype -7 _N"ai_socktype not supported.")
1272  (defconstant eai_service -8 "SERVICE not supported for ai_socktype.")  (defconstant eai_service -8 _N"SERVICE not supported for ai_socktype.")
1273  (defconstant eai_addrfamily -9 "Address family for NAME not supported.")  (defconstant eai_addrfamily -9 _N"Address family for NAME not supported.")
1274  (defconstant eai_memory -10 "Memory allocation failure.")  (defconstant eai_memory -10 _N"Memory allocation failure.")
1275  (defconstant eai_system -11 "System error returned in errno.")  (defconstant eai_system -11 _N"System error returned in errno.")
1276    
1277    
1278  #+(or)  #+(or)
1279  (defun unix-getaddrinfo (name service req pai)  (defun unix-getaddrinfo (name service req pai)
1280    "Translate name of a service location and/or a service name to set of    _N"Translate name of a service location and/or a service name to set of
1281     socket addresses."     socket addresses."
1282    (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo))    (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo))
1283                                (* (* struct addrinfo)))                                (* (* struct addrinfo)))
# Line 1256  length LEN and type TYPE." Line 1286  length LEN and type TYPE."
1286    
1287  #+(or)  #+(or)
1288  (defun unix-freeaddrinfo (ai)  (defun unix-freeaddrinfo (ai)
1289    "Free `addrinfo' structure AI including associated storage."    _N"Free `addrinfo' structure AI including associated storage."
1290    (void-syscall ("freeaddrinfo" (* struct addrinfo))    (void-syscall ("freeaddrinfo" (* struct addrinfo))
1291                  ai))                  ai))
1292    
1293    
1294  ;;; pty.h  ;;; pty.h
1295    
1296  #+(or)  (defun unix-openpty (name termp winp)
1297  (defun unix-openpty (amaster aslave name termp winp)    _N"Create pseudo tty master slave pair with NAME and set terminal
   "Create pseudo tty master slave pair with NAME and set terminal  
1298     attributes according to TERMP and WINP and return handles for both     attributes according to TERMP and WINP and return handles for both
1299     ends in AMASTER and ASLAVE."     ends in AMASTER and ASLAVE."
1300    (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))    (with-alien ((amaster int)
1301                            (* (struct winsize)))                 (aslave int))
1302                 amaster aslave name termp winp))      (values
1303         (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))
1304                                 (* (struct winsize)))
1305                      (addr amaster) (addr aslave) name termp winp)
1306         amaster aslave)))
1307    
1308  #+(or)  #+(or)
1309  (defun unix-forkpty (amaster name termp winp)  (defun unix-forkpty (amaster name termp winp)
1310    "Create child process and establish the slave pseudo terminal as the    _N"Create child process and establish the slave pseudo terminal as the
1311     child's controlling terminal."     child's controlling terminal."
1312    (int-syscall ("forkpty" (* int) c-string (* (struct termios))    (int-syscall ("forkpty" (* int) c-string (* (struct termios))
1313                            (* (struct winsize)))                            (* (struct winsize)))
# Line 1285  length LEN and type TYPE." Line 1318  length LEN and type TYPE."
1318    
1319  #+(or)  #+(or)
1320  (defun unix-setpwent ()  (defun unix-setpwent ()
1321    "Rewind the password-file stream."    _N"Rewind the password-file stream."
1322    (void-syscall ("setpwent")))    (void-syscall ("setpwent")))
1323    
1324  #+(or)  #+(or)
1325  (defun unix-endpwent ()  (defun unix-endpwent ()
1326    "Close the password-file stream."    _N"Close the password-file stream."
1327    (void-syscall ("endpwent")))    (void-syscall ("endpwent")))
1328    
1329  #+(or)  #+(or)
1330  (defun unix-getpwent ()  (defun unix-getpwent ()
1331    "Read an entry from the password-file stream, opening it if necessary."    _N"Read an entry from the password-file stream, opening it if necessary."
1332      (let ((result (alien-funcall (extern-alien "getpwent"      (let ((result (alien-funcall (extern-alien "getpwent"
1333                                               (function (* (struct passwd)))))))                                               (function (* (struct passwd)))))))
1334      (declare (type system-area-pointer result))      (declare (type system-area-pointer result))
# Line 1310  length LEN and type TYPE." Line 1343  length LEN and type TYPE."
1343      (rlim-cur long)      ; current (soft) limit      (rlim-cur long)      ; current (soft) limit
1344      (rlim-max long))); maximum value for rlim-cur      (rlim-max long))); maximum value for rlim-cur
1345    
1346  (defconstant rusage_self 0 "The calling process.")  (defconstant rusage_self 0 _N"The calling process.")
1347  (defconstant rusage_children -1 "Terminated child processes.")  (defconstant rusage_children -1 _N"Terminated child processes.")
1348  (defconstant rusage_both -2)  (defconstant rusage_both -2)
1349    
1350  (def-alien-type nil  (def-alien-type nil
# Line 1335  length LEN and type TYPE." Line 1368  length LEN and type TYPE."
1368    
1369  ;; Priority limits.  ;; Priority limits.
1370    
1371  (defconstant prio-min -20 "Minimum priority a process can have")  (defconstant prio-min -20 _N"Minimum priority a process can have")
1372  (defconstant prio-max 20 "Maximum priority a process can have")  (defconstant prio-max 20 _N"Maximum priority a process can have")
1373    
1374    
1375  ;;; The type of the WHICH argument to `getpriority' and `setpriority',  ;;; The type of the WHICH argument to `getpriority' and `setpriority',
1376  ;;; indicating what flavor of entity the WHO argument specifies.  ;;; indicating what flavor of entity the WHO argument specifies.
1377    
1378  (defconstant priority-process 0 "WHO is a process ID")  (defconstant priority-process 0 _N"WHO is a process ID")
1379  (defconstant priority-pgrp 1 "WHO is a process group ID")  (defconstant priority-pgrp 1 _N"WHO is a process group ID")
1380  (defconstant priority-user 2 "WHO is a user ID")  (defconstant priority-user 2 _N"WHO is a user ID")
1381    
1382  ;;; sched.h  ;;; sched.h
1383    
1384  #+(or)  #+(or)
1385  (defun unix-sched_setparam (pid param)  (defun unix-sched_setparam (pid param)
1386    "Rewind the password-file stream."    _N"Rewind the password-file stream."
1387    (int-syscall ("sched_setparam" pid-t (struct psched-param))    (int-syscall ("sched_setparam" pid-t (struct psched-param))
1388                  pid param))                  pid param))
1389    
1390  #+(or)  #+(or)
1391  (defun unix-sched_getparam (pid param)  (defun unix-sched_getparam (pid param)
1392    "Rewind the password-file stream."    _N"Rewind the password-file stream."
1393    (int-syscall ("sched_getparam" pid-t (struct psched-param))    (int-syscall ("sched_getparam" pid-t (struct psched-param))
1394                  pid param))                  pid param))
1395    
1396    
1397  #+(or)  #+(or)
1398  (defun unix-sched_setscheduler (pid policy param)  (defun unix-sched_setscheduler (pid policy param)
1399    "Set scheduling algorithm and/or parameters for a process."    _N"Set scheduling algorithm and/or parameters for a process."
1400    (int-syscall ("sched_setscheduler" pid-t int (struct psched-param))    (int-syscall ("sched_setscheduler" pid-t int (struct psched-param))
1401                  pid policy param))                  pid policy param))
1402    
1403  #+(or)  #+(or)
1404  (defun unix-sched_getscheduler (pid)  (defun unix-sched_getscheduler (pid)
1405    "Retrieve scheduling algorithm for a particular purpose."    _N"Retrieve scheduling algorithm for a particular purpose."
1406    (int-syscall ("sched_getscheduler" pid-t)    (int-syscall ("sched_getscheduler" pid-t)
1407                  pid))                  pid))
1408    
1409  (defun unix-sched-yield ()  (defun unix-sched-yield ()
1410    "Retrieve scheduling algorithm for a particular purpose."    _N"Retrieve scheduling algorithm for a particular purpose."
1411    (int-syscall ("sched_yield")))    (int-syscall ("sched_yield")))
1412    
1413  #+(or)  #+(or)
1414  (defun unix-sched_get_priority_max (algorithm)  (defun unix-sched_get_priority_max (algorithm)
1415    "Get maximum priority value for a scheduler."    _N"Get maximum priority value for a scheduler."
1416    (int-syscall ("sched_get_priority_max" int)    (int-syscall ("sched_get_priority_max" int)
1417                  algorithm))                  algorithm))
1418    
1419  #+(or)  #+(or)
1420  (defun unix-sched_get_priority_min (algorithm)  (defun unix-sched_get_priority_min (algorithm)
1421    "Get minimum priority value for a scheduler."    _N"Get minimum priority value for a scheduler."
1422    (int-syscall ("sched_get_priority_min" int)    (int-syscall ("sched_get_priority_min" int)
1423                  algorithm))                  algorithm))
1424    
# Line 1393  length LEN and type TYPE." Line 1426  length LEN and type TYPE."
1426    
1427  #+(or)  #+(or)
1428  (defun unix-sched_rr_get_interval (pid t)  (defun unix-sched_rr_get_interval (pid t)
1429    "Get the SCHED_RR interval for the named process."    _N"Get the SCHED_RR interval for the named process."
1430    (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec)))    (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec)))
1431                  pid t))                  pid t))
1432    
# Line 1411  length LEN and type TYPE." Line 1444  length LEN and type TYPE."
1444              (sched-priority int)))              (sched-priority int)))
1445    
1446  ;; Cloning flags.  ;; Cloning flags.
1447  (defconstant csignal       #x000000ff "Signal mask to be sent at exit.")  (defconstant csignal       #x000000ff _N"Signal mask to be sent at exit.")
1448  (defconstant clone_vm      #x00000100 "Set if VM shared between processes.")  (defconstant clone_vm      #x00000100 _N"Set if VM shared between processes.")
1449  (defconstant clone_fs      #x00000200 "Set if fs info shared between processes")  (defconstant clone_fs      #x00000200 _N"Set if fs info shared between processes")
1450  (defconstant clone_files   #x00000400 "Set if open files shared between processe")  (defconstant clone_files   #x00000400 _N"Set if open files shared between processe")
1451  (defconstant clone_sighand #x00000800 "Set if signal handlers shared.")  (defconstant clone_sighand #x00000800 _N"Set if signal handlers shared.")
1452  (defconstant clone_pid     #x00001000 "Set if pid shared.")  (defconstant clone_pid     #x00001000 _N"Set if pid shared.")
1453    
1454    
1455  ;;; shadow.h  ;;; shadow.h
# Line 1437  length LEN and type TYPE." Line 1470  length LEN and type TYPE."
1470    
1471  #+(or)  #+(or)
1472  (defun unix-setspent ()  (defun unix-setspent ()
1473    "Open database for reading."    _N"Open database for reading."
1474    (void-syscall ("setspent")))    (void-syscall ("setspent")))
1475    
1476  #+(or)  #+(or)
1477  (defun unix-endspent ()  (defun unix-endspent ()
1478    "Close database."    _N"Close database."
1479    (void-syscall ("endspent")))    (void-syscall ("endspent")))
1480    
1481  #+(or)  #+(or)
1482  (defun unix-getspent ()  (defun unix-getspent ()
1483    "Get next entry from database, perhaps after opening the file."    _N"Get next entry from database, perhaps after opening the file."
1484      (let ((result (alien-funcall (extern-alien "getspent"      (let ((result (alien-funcall (extern-alien "getspent"
1485                                               (function (* (struct spwd)))))))                                               (function (* (struct spwd)))))))
1486      (declare (type system-area-pointer result))      (declare (type system-area-pointer result))
# Line 1457  length LEN and type TYPE." Line 1490  length LEN and type TYPE."
1490    
1491  #+(or)  #+(or)
1492  (defun unix-getspnam (name)  (defun unix-getspnam (name)
1493    "Get shadow entry matching NAME."    _N"Get shadow entry matching NAME."
1494      (let ((result (alien-funcall (extern-alien "getspnam"      (let ((result (alien-funcall (extern-alien "getspnam"
1495                                               (function (* (struct spwd))                                               (function (* (struct spwd))
1496                                                         c-string))                                                         c-string))
# Line 1469  length LEN and type TYPE." Line 1502  length LEN and type TYPE."
1502    
1503  #+(or)  #+(or)
1504  (defun unix-sgetspent (string)  (defun unix-sgetspent (string)
1505    "Read shadow entry from STRING."    _N"Read shadow entry from STRING."
1506      (let ((result (alien-funcall (extern-alien "sgetspent"      (let ((result (alien-funcall (extern-alien "sgetspent"
1507                                               (function (* (struct spwd))                                               (function (* (struct spwd))
1508                                                         c-string))                                                         c-string))
# Line 1483  length LEN and type TYPE." Line 1516  length LEN and type TYPE."
1516    
1517  #+(or)  #+(or)
1518  (defun unix-lckpwdf ()  (defun unix-lckpwdf ()
1519    "Protect password file against multi writers."    _N"Protect password file against multi writers."
1520    (void-syscall ("lckpwdf")))    (void-syscall ("lckpwdf")))
1521    
1522    
1523  #+(or)  #+(or)
1524  (defun unix-ulckpwdf ()  (defun unix-ulckpwdf ()
1525    "Unlock password file."    _N"Unlock password file."
1526    (void-syscall ("ulckpwdf")))    (void-syscall ("ulckpwdf")))
1527    
1528  ;;; bits/stat.h  ;;; bits/stat.h
# Line 1529  length LEN and type TYPE." Line 1562  length LEN and type TYPE."
1562    
1563  ;; Encoding of the file mode.  ;; Encoding of the file mode.
1564    
1565  (defconstant s-ifmt   #o0170000 "These bits determine file type.")  (defconstant s-ifmt   #o0170000 _N"These bits determine file type.")
1566    
1567  ;; File types.  ;; File types.
1568    
1569  (defconstant s-ififo  #o0010000 "FIFO")  (defconstant s-ififo  #o0010000 _N"FIFO")
1570  (defconstant s-ifchr  #o0020000 "Character device")  (defconstant s-ifchr  #o0020000 _N"Character device")
1571  (defconstant s-ifdir  #o0040000 "Directory")  (defconstant s-ifdir  #o0040000 _N"Directory")
1572  (defconstant s-ifblk  #o0060000 "Block device")  (defconstant s-ifblk  #o0060000 _N"Block device")
1573  (defconstant s-ifreg  #o0100000 "Regular file")  (defconstant s-ifreg  #o0100000 _N"Regular file")
1574    
1575  ;; These don't actually exist on System V, but having them doesn't hurt.  ;; These don't actually exist on System V, but having them doesn't hurt.
1576    
1577  (defconstant s-iflnk  #o0120000 "Symbolic link.")  (defconstant s-iflnk  #o0120000 _N"Symbolic link.")
1578  (defconstant s-ifsock #o0140000 "Socket.")  (defconstant s-ifsock #o0140000 _N"Socket.")
1579    
1580  ;; Protection bits.  ;; Protection bits.
1581    
1582  (defconstant s-isuid #o0004000 "Set user ID on execution.")  (defconstant s-isuid #o0004000 _N"Set user ID on execution.")
1583  (defconstant s-isgid #o0002000 "Set group ID on execution.")  (defconstant s-isgid #o0002000 _N"Set group ID on execution.")
1584  (defconstant s-isvtx #o0001000 "Save swapped text after use (sticky).")  (defconstant s-isvtx #o0001000 _N"Save swapped text after use (sticky).")
1585  (defconstant s-iread #o0000400 "Read by owner")  (defconstant s-iread #o0000400 _N"Read by owner")
1586  (defconstant s-iwrite #o0000200 "Write by owner.")  (defconstant s-iwrite #o0000200 _N"Write by owner.")
1587  (defconstant s-iexec #o0000100 "Execute by owner.")  (defconstant s-iexec #o0000100 _N"Execute by owner.")
1588    
1589  ;;; statfsbuf.h  ;;; statfsbuf.h
1590    
# Line 1576  length LEN and type TYPE." Line 1609  length LEN and type TYPE."
1609  (def-alien-type tcflag-t unsigned-int)  (def-alien-type tcflag-t unsigned-int)
1610    
1611  (defconstant +NCCS+ 32  (defconstant +NCCS+ 32
1612    "Size of control character vector.")    _N"Size of control character vector.")
1613    
1614  (def-alien-type nil  (def-alien-type nil
1615    (struct termios    (struct termios
# Line 1695  length LEN and type TYPE." Line 1728  length LEN and type TYPE."
1728  ;;; termios.h  ;;; termios.h
1729    
1730  (defun unix-cfgetospeed (termios)  (defun unix-cfgetospeed (termios)
1731    "Get terminal output speed."    _N"Get terminal output speed."
1732    (multiple-value-bind (speed errno)    (multiple-value-bind (speed errno)
1733        (int-syscall ("cfgetospeed" (* (struct termios))) termios)        (int-syscall ("cfgetospeed" (* (struct termios))) termios)
1734      (if speed      (if speed
# Line 1703  length LEN and type TYPE." Line 1736  length LEN and type TYPE."
1736        (values speed errno))))        (values speed errno))))
1737    
1738  (defun unix-cfsetospeed (termios speed)  (defun unix-cfsetospeed (termios speed)
1739    "Set terminal output speed."    _N"Set terminal output speed."
1740    (let ((baud (or (position speed terminal-speeds)    (let ((baud (or (position speed terminal-speeds)
1741                    (error "Bogus baud rate ~S" speed))))                    (error _"Bogus baud rate ~S" speed))))
1742      (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))      (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
1743    
1744  (defun unix-cfgetispeed (termios)  (defun unix-cfgetispeed (termios)
1745    "Get terminal input speed."    _N"Get terminal input speed."
1746    (multiple-value-bind (speed errno)    (multiple-value-bind (speed errno)
1747        (int-syscall ("cfgetispeed" (* (struct termios))) termios)        (int-syscall ("cfgetispeed" (* (struct termios))) termios)
1748      (if speed      (if speed
# Line 1717  length LEN and type TYPE." Line 1750  length LEN and type TYPE."
1750        (values speed errno))))        (values speed errno))))
1751    
1752  (defun unix-cfsetispeed (termios speed)  (defun unix-cfsetispeed (termios speed)
1753    "Set terminal input speed."    _N"Set terminal input speed."
1754    (let ((baud (or (position speed terminal-speeds)    (let ((baud (or (position speed terminal-speeds)
1755                    (error "Bogus baud rate ~S" speed))))                    (error _"Bogus baud rate ~S" speed))))
1756      (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))      (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
1757    
1758  (defun unix-tcgetattr (fd termios)  (defun unix-tcgetattr (fd termios)
1759    "Get terminal attributes."    _N"Get terminal attributes."
1760    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1761    (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))    (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
1762    
1763  (defun unix-tcsetattr (fd opt termios)  (defun unix-tcsetattr (fd opt termios)
1764    "Set terminal attributes."    _N"Set terminal attributes."
1765    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1766    (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))    (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
1767    
1768  (defun unix-tcsendbreak (fd duration)  (defun unix-tcsendbreak (fd duration)
1769    "Send break"    _N"Send break"
1770    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1771    (void-syscall ("tcsendbreak" int int) fd duration))    (void-syscall ("tcsendbreak" int int) fd duration))
1772    
1773  (defun unix-tcdrain (fd)  (defun unix-tcdrain (fd)
1774    "Wait for output for finish"    _N"Wait for output for finish"
1775    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1776    (void-syscall ("tcdrain" int) fd))    (void-syscall ("tcdrain" int) fd))
1777    
1778  (defun unix-tcflush (fd selector)  (defun unix-tcflush (fd selector)
1779    "See tcflush(3)"    _N"See tcflush(3)"
1780    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1781    (void-syscall ("tcflush" int int) fd selector))    (void-syscall ("tcflush" int int) fd selector))
1782    
1783  (defun unix-tcflow (fd action)  (defun unix-tcflow (fd action)
1784    "Flow control"    _N"Flow control"
1785    (declare (type unix-fd fd))    (declare (type unix-fd fd))
1786    (void-syscall ("tcflow" int int) fd action))    (void-syscall ("tcflow" int int) fd action))
1787    
# Line 1783  length LEN and type TYPE." Line 1816  length LEN and type TYPE."
1816            (multiple-value-setq            (multiple-value-setq
1817                (result error-code)                (result error-code)
1818              (int-syscall ("execve"              (int-syscall ("execve"
1819                            (* char) system-area-pointer system-area-pointer)                            c-string system-area-pointer system-area-pointer)
1820                           (vector-sap program) argv envp)))                           program argv envp)))
1821        ;;        ;;
1822        ;; Deallocate memory        ;; Deallocate memory
1823        (when argv        (when argv
# Line 1797  length LEN and type TYPE." Line 1830  length LEN and type TYPE."
1830    
1831  (defun unix-execve (program &optional arg-list  (defun unix-execve (program &optional arg-list
1832                              (environment *environment-list*))                              (environment *environment-list*))
1833    "Executes the Unix execve system call.  If the system call suceeds, lisp    _N"Executes the Unix execve system call.  If the system call suceeds, lisp
1834     will no longer be running in this process.  If the system call fails this     will no longer be running in this process.  If the system call fails this
1835     function returns two values: NIL and an error code.  Arg-list should be a     function returns two values: NIL and an error code.  Arg-list should be a
1836     list of simple-strings which are passed as arguments to the exec'ed program.     list of simple-strings which are passed as arguments to the exec'ed program.
# Line 1813  length LEN and type TYPE." Line 1846  length LEN and type TYPE."
1846                                  (car cons))                                  (car cons))
1847                              envlist))                              envlist))
1848                      envlist)))                      envlist)))
1849      (sub-unix-execve program arg-list env-list)))      (sub-unix-execve (%name->file program) arg-list env-list)))
1850    
1851    
1852  (defmacro round-bytes-to-words (n)  (defmacro round-bytes-to-words (n)
# Line 1826  length LEN and type TYPE." Line 1859  length LEN and type TYPE."
1859  ;;; only has meaning in the second case and is the unix errno value.  ;;; only has meaning in the second case and is the unix errno value.
1860    
1861  (defun unix-access (path mode)  (defun unix-access (path mode)
1862    "Given a file path (a string) and one of four constant modes,    _N"Given a file path (a string) and one of four constant modes,
1863     unix-access returns T if the file is accessible with that     unix-access returns T if the file is accessible with that
1864     mode and NIL if not.  It also returns an errno value with     mode and NIL if not.  It also returns an errno value with
1865     NIL which determines why the file was not accessible.     NIL which determines why the file was not accessible.
# Line 1838  length LEN and type TYPE." Line 1871  length LEN and type TYPE."
1871          f_ok     Presence of file."          f_ok     Presence of file."
1872    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1873             (type (mod 8) mode))             (type (mod 8) mode))
1874    (void-syscall ("access" c-string int) path mode))    (void-syscall ("access" c-string int) (%name->file path) mode))
1875    
1876  (defconstant l_set 0 "set the file pointer")  (defconstant l_set 0 _N"set the file pointer")
1877  (defconstant l_incr 1 "increment the file pointer")  (defconstant l_incr 1 _N"increment the file pointer")
1878  (defconstant l_xtnd 2 "extend the file size")  (defconstant l_xtnd 2 _N"extend the file size")
1879    
1880  (defun unix-lseek (fd offset whence)  (defun unix-lseek (fd offset whence)
1881    "UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead    _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead
1882     a certain OFFSET for that file.  WHENCE can be any of the following:     a certain OFFSET for that file.  WHENCE can be any of the following:
1883    
1884     l_set        Set the file pointer.     l_set        Set the file pointer.
# Line 1869  length LEN and type TYPE." Line 1902  length LEN and type TYPE."
1902  ;;; bytes read.  ;;; bytes read.
1903    
1904  (defun unix-read (fd buf len)  (defun unix-read (fd buf len)
1905    "UNIX-READ attempts to read from the file described by fd into    _N"UNIX-READ attempts to read from the file described by fd into
1906     the buffer buf until it is full.  Len is the length of the buffer.     the buffer buf until it is full.  Len is the length of the buffer.
1907     The number of bytes actually read is returned or NIL and an error     The number of bytes actually read is returned or NIL and an error
1908     number if an error occured."     number if an error occured."
# Line 1908  length LEN and type TYPE." Line 1941  length LEN and type TYPE."
1941  ;;; the actual number of bytes written.  ;;; the actual number of bytes written.
1942    
1943  (defun unix-write (fd buf offset len)  (defun unix-write (fd buf offset len)
1944    "Unix-write attempts to write a character buffer (buf) of length    _N"Unix-write attempts to write a character buffer (buf) of length
1945     len to the file described by the file descriptor fd.  NIL and an     len to the file described by the file descriptor fd.  NIL and an
1946     error is returned if the call is unsuccessful."     error is returned if the call is unsuccessful."
1947    (declare (type unix-fd fd)    (declare (type unix-fd fd)
# Line 1924  length LEN and type TYPE." Line 1957  length LEN and type TYPE."
1957                 len))                 len))
1958    
1959  (defun unix-pipe ()  (defun unix-pipe ()
1960    "Unix-pipe sets up a unix-piping mechanism consisting of    _N"Unix-pipe sets up a unix-piping mechanism consisting of
1961    an input pipe and an output pipe.  Unix-Pipe returns two    an input pipe and an output pipe.  Unix-Pipe returns two
1962    values: if no error occurred the first value is the pipe    values: if no error occurred the first value is the pipe
1963    to be read from and the second is can be written to.  If    to be read from and the second is can be written to.  If
# Line 1937  length LEN and type TYPE." Line 1970  length LEN and type TYPE."
1970    
1971    
1972  (defun unix-chown (path uid gid)  (defun unix-chown (path uid gid)
1973    "Given a file path, an integer user-id, and an integer group-id,    _N"Given a file path, an integer user-id, and an integer group-id,
1974     unix-chown changes the owner of the file and the group of the     unix-chown changes the owner of the file and the group of the
1975     file to those specified.  Either the owner or the group may be     file to those specified.  Either the owner or the group may be
1976     left unchanged by specifying them as -1.  Note: Permission will     left unchanged by specifying them as -1.  Note: Permission will
# Line 1945  length LEN and type TYPE." Line 1978  length LEN and type TYPE."
1978    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1979             (type (or unix-uid (integer -1 -1)) uid)             (type (or unix-uid (integer -1 -1)) uid)
1980             (type (or unix-gid (integer -1 -1)) gid))             (type (or unix-gid (integer -1 -1)) gid))
1981    (void-syscall ("chown" c-string int int) path uid gid))    (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
1982    
1983  ;;; Unix-fchown is exactly the same as unix-chown except that the file  ;;; Unix-fchown is exactly the same as unix-chown except that the file
1984  ;;; is specified by a file-descriptor ("fd") instead of a pathname.  ;;; is specified by a file-descriptor ("fd") instead of a pathname.
1985    
1986  (defun unix-fchown (fd uid gid)  (defun unix-fchown (fd uid gid)
1987    "Unix-fchown is like unix-chown, except that it accepts an integer    _N"Unix-fchown is like unix-chown, except that it accepts an integer
1988     file descriptor instead of a file path name."     file descriptor instead of a file path name."
1989    (declare (type unix-fd fd)    (declare (type unix-fd fd)
1990             (type (or unix-uid (integer -1 -1)) uid)             (type (or unix-uid (integer -1 -1)) uid)
# Line 1962  length LEN and type TYPE." Line 1995  length LEN and type TYPE."
1995  ;;; current working directory.  ;;; current working directory.
1996    
1997  (defun unix-chdir (path)  (defun unix-chdir (path)
1998    "Given a file path string, unix-chdir changes the current working    _N"Given a file path string, unix-chdir changes the current working
1999     directory to the one specified."     directory to the one specified."
2000    (declare (type unix-pathname path))    (declare (type unix-pathname path))
2001    (void-syscall ("chdir" c-string) path))    (void-syscall ("chdir" c-string) (%name->file path)))
2002    
2003  (defun unix-current-directory ()  (defun unix-current-directory ()
2004    "Put the absolute pathname of the current working directory in BUF.    _N"Put the absolute pathname of the current working directory in BUF.
2005     If successful, return BUF.  If not, put an error message in     If successful, return BUF.  If not, put an error message in
2006     BUF and return NULL.  BUF should be at least PATH_MAX bytes long."     BUF and return NULL.  BUF should be at least PATH_MAX bytes long."
2007    ;; 5120 is some randomly selected maximum size for the buffer for getcwd.    ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
# Line 1981  length LEN and type TYPE." Line 2014  length LEN and type TYPE."
2014                      5120)))                      5120)))
2015    
2016        (values (not (zerop (sap-int (alien-sap result))))        (values (not (zerop (sap-int (alien-sap result))))
2017                (cast buf c-call:c-string)))))                (%file->name (cast buf c-call:c-string))))))
2018    
2019    
2020  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor
2021  ;;; passed as an argument.  ;;; passed as an argument.
2022    
2023  (defun unix-dup (fd)  (defun unix-dup (fd)
2024    "Unix-dup duplicates an existing file descriptor (given as the    _N"Unix-dup duplicates an existing file descriptor (given as the
2025     argument) and return it.  If FD is not a valid file descriptor, NIL     argument) and return it.  If FD is not a valid file descriptor, NIL
2026     and an error number are returned."     and an error number are returned."
2027    (declare (type unix-fd fd))    (declare (type unix-fd fd))
# Line 2000  length LEN and type TYPE." Line 2033  length LEN and type TYPE."
2033  ;;; value which is a valid file-descriptor.  ;;; value which is a valid file-descriptor.
2034    
2035  (defun unix-dup2 (fd1 fd2)  (defun unix-dup2 (fd1 fd2)
2036    "Unix-dup2 duplicates an existing file descriptor just as unix-dup    _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup
2037     does only the new value of the duplicate descriptor may be requested     does only the new value of the duplicate descriptor may be requested
2038     through the second argument.  If a file already exists with the     through the second argument.  If a file already exists with the
2039     requested descriptor number, it will be closed and the number     requested descriptor number, it will be closed and the number
# Line 2011  length LEN and type TYPE." Line 2044  length LEN and type TYPE."
2044  ;;; Unix-exit terminates a program.  ;;; Unix-exit terminates a program.
2045    
2046  (defun unix-exit (&optional (code 0))  (defun unix-exit (&optional (code 0))
2047    "Unix-exit terminates the current process with an optional    _N"Unix-exit terminates the current process with an optional
2048     error code.  If successful, the call doesn't return.  If     error code.  If successful, the call doesn't return.  If
2049     unsuccessful, the call returns NIL and an error number."     unsuccessful, the call returns NIL and an error number."
2050    (declare (type (signed-byte 32) code))    (declare (type (signed-byte 32) code))
# Line 2019  length LEN and type TYPE." Line 2052  length LEN and type TYPE."
2052    
2053  #+(or)  #+(or)
2054  (defun unix-pathconf (path name)  (defun unix-pathconf (path name)
2055    "Get file-specific configuration information about PATH."    _N"Get file-specific configuration information about PATH."
2056    (int-syscall ("pathconf" c-string int) path name))    (int-syscall ("pathconf" c-string int) (%name->file path) name))
2057    
2058  #+(or)  #+(or)
2059  (defun unix-sysconf (name)  (defun unix-sysconf (name)
2060    "Get the value of the system variable NAME."    _N"Get the value of the system variable NAME."
2061    (int-syscall ("sysconf" c-string) name))    (int-syscall ("sysconf" int) name))
2062    
2063  #+(or)  #+(or)
2064  (defun unix-confstr (name)  (defun unix-confstr (name)
2065    "Get the value of the string-valued system variable NAME."    _N"Get the value of the string-valued system variable NAME."
2066    (with-alien ((buf (array char 1024)))    (with-alien ((buf (array char 1024)))
2067      (values (not (zerop (alien-funcall (extern-alien "confstr"      (values (not (zerop (alien-funcall (extern-alien "confstr"
2068                                                       (function int                                                       (function int
# Line 2040  length LEN and type TYPE." Line 2073  length LEN and type TYPE."
2073    
2074    
2075  (def-alien-routine ("getpid" unix-getpid) int  (def-alien-routine ("getpid" unix-getpid) int
2076    "Unix-getpid returns the process-id of the current process.")    _N"Unix-getpid returns the process-id of the current process.")
2077    
2078  (def-alien-routine ("getppid" unix-getppid) int  (def-alien-routine ("getppid" unix-getppid) int
2079    "Unix-getppid returns the process-id of the parent of the current process.")    _N"Unix-getppid returns the process-id of the parent of the current process.")
2080    
2081  ;;; Unix-getpgrp returns the group-id associated with the  ;;; Unix-getpgrp returns the group-id associated with the
2082  ;;; current process.  ;;; current process.
2083    
2084  (defun unix-getpgrp ()  (defun unix-getpgrp ()
2085    "Unix-getpgrp returns the group-id of the calling process."    _N"Unix-getpgrp returns the group-id of the calling process."
2086    (int-syscall ("getpgrp")))    (int-syscall ("getpgrp")))
2087    
2088  ;;; Unix-setpgid sets the group-id of the process specified by  ;;; Unix-setpgid sets the group-id of the process specified by
# Line 2061  length LEN and type TYPE." Line 2094  length LEN and type TYPE."
2094  ;;; out in favor of setsid().  ;;; out in favor of setsid().
2095    
2096  (defun unix-setpgrp (pid pgrp)  (defun unix-setpgrp (pid pgrp)
2097    "Unix-setpgrp sets the process group on the process pid to    _N"Unix-setpgrp sets the process group on the process pid to
2098     pgrp.  NIL and an error number are returned upon failure."     pgrp.  NIL and an error number are returned upon failure."
2099    (void-syscall ("setpgid" int int) pid pgrp))    (void-syscall ("setpgid" int int) pid pgrp))
2100    
2101  (defun unix-setpgid (pid pgrp)  (defun unix-setpgid (pid pgrp)
2102    "Unix-setpgid sets the process group of the process pid to    _N"Unix-setpgid sets the process group of the process pid to
2103     pgrp. If pgid is equal to pid, the process becomes a process     pgrp. If pgid is equal to pid, the process becomes a process
2104     group leader. NIL and an error number are returned upon failure."     group leader. NIL and an error number are returned upon failure."
2105    (void-syscall ("setpgid" int int) pid pgrp))    (void-syscall ("setpgid" int int) pid pgrp))
2106    
2107  #+(or)  #+(or)
2108  (defun unix-setsid ()  (defun unix-setsid ()
2109    "Create a new session with the calling process as its leader.    _N"Create a new session with the calling process as its leader.
2110     The process group IDs of the session and the calling process     The process group IDs of the session and the calling process
2111     are set to the process ID of the calling process, which is returned."     are set to the process ID of the calling process, which is returned."
2112    (void-syscall ( "setsid")))    (void-syscall ( "setsid")))
2113    
2114  #+(or)  #+(or)
2115  (defun unix-getsid ()  (defun unix-getsid ()
2116    "Return the session ID of the given process."    _N"Return the session ID of the given process."
2117    (int-syscall ( "getsid")))    (int-syscall ( "getsid")))
2118    
2119  (def-alien-routine ("getuid" unix-getuid) int  (def-alien-routine ("getuid" unix-getuid) int
2120    "Unix-getuid returns the real user-id associated with the    _N"Unix-getuid returns the real user-id associated with the
2121     current process.")     current process.")
2122    
2123  #+(or)  #+(or)
2124  (def-alien-routine ("geteuid" unix-getuid) int  (def-alien-routine ("geteuid" unix-getuid) int
2125    "Get the effective user ID of the calling process.")    _N"Get the effective user ID of the calling process.")
2126    
2127  (def-alien-routine ("getgid" unix-getgid) int  (def-alien-routine ("getgid" unix-getgid) int
2128    "Unix-getgid returns the real group-id of the current process.")    _N"Unix-getgid returns the real group-id of the current process.")
2129    
2130  (def-alien-routine ("getegid" unix-getegid) int  (def-alien-routine ("getegid" unix-getegid) int
2131    "Unix-getegid returns the effective group-id of the current process.")    _N"Unix-getegid returns the effective group-id of the current process.")
2132    
2133  ;/* If SIZE is zero, return the number of supplementary groups  ;/* If SIZE is zero, return the number of supplementary groups
2134  ;   the calling process is in.  Otherwise, fill in the group IDs  ;   the calling process is in.  Otherwise, fill in the group IDs
# Line 2104  length LEN and type TYPE." Line 2137  length LEN and type TYPE."
2137    
2138  #+(or)  #+(or)
2139  (defun unix-group-member (gid)  (defun unix-group-member (gid)
2140    "Return nonzero iff the calling process is in group GID."    _N"Return nonzero iff the calling process is in group GID."
2141    (int-syscall ( "group-member" gid-t) gid))    (int-syscall ( "group-member" gid-t) gid))
2142    
2143    
2144  (defun unix-setuid (uid)  (defun unix-setuid (uid)
2145    "Set the user ID of the calling process to UID.    _N"Set the user ID of the calling process to UID.
2146     If the calling process is the super-user, set the real     If the calling process is the super-user, set the real
2147     and effective user IDs, and the saved set-user-ID to UID;     and effective user IDs, and the saved set-user-ID to UID;
2148     if not, the effective user ID is set to UID."     if not, the effective user ID is set to UID."
# Line 2121  length LEN and type TYPE." Line 2154  length LEN and type TYPE."
2154  ;;; "euid" to -1 makes the system use the current id instead.  ;;; "euid" to -1 makes the system use the current id instead.
2155    
2156  (defun unix-setreuid (ruid euid)  (defun unix-setreuid (ruid euid)
2157    "Unix-setreuid sets the real and effective user-id's of the current    _N"Unix-setreuid sets the real and effective user-id's of the current
2158     process to the specified ones.  NIL and an error number is returned     process to the specified ones.  NIL and an error number is returned
2159     if the call fails."     if the call fails."
2160    (void-syscall ("setreuid" int int) ruid euid))    (void-syscall ("setreuid" int int) ruid euid))
2161    
2162  (defun unix-setgid (gid)  (defun unix-setgid (gid)
2163    "Set the group ID of the calling process to GID.    _N"Set the group ID of the calling process to GID.
2164     If the calling process is the super-user, set the real     If the calling process is the super-user, set the real
2165     and effective group IDs, and the saved set-group-ID to GID;     and effective group IDs, and the saved set-group-ID to GID;
2166     if not, the effective group ID is set to GID."     if not, the effective group ID is set to GID."
# Line 2140  length LEN and type TYPE." Line 2173  length LEN and type TYPE."
2173  ;;; "egid" to -1 makes the system use the current id instead.  ;;; "egid" to -1 makes the system use the current id instead.
2174    
2175  (defun unix-setregid (rgid egid)  (defun unix-setregid (rgid egid)
2176    "Unix-setregid sets the real and effective group-id's of the current    _N"Unix-setregid sets the real and effective group-id's of the current
2177     process process to the specified ones.  NIL and an error number is     process process to the specified ones.  NIL and an error number is
2178     returned if the call fails."     returned if the call fails."
2179    (void-syscall ("setregid" int int) rgid egid))    (void-syscall ("setregid" int int) rgid egid))
2180    
2181  (defun unix-fork ()  (defun unix-fork ()
2182    "Executes the unix fork system call.  Returns 0 in the child and the pid    _N"Executes the unix fork system call.  Returns 0 in the child and the pid
2183     of the child in the parent if it works, or NIL and an error number if it     of the child in the parent if it works, or NIL and an error number if it
2184     doesn't work."     doesn't work."
2185    (int-syscall ("fork")))    (int-syscall ("fork")))
2186    
2187    ;; Environment maninpulation; man getenv(3)
2188    (def-alien-routine ("getenv" unix-getenv) c-call:c-string
2189      (name c-call:c-string)
2190      _N"Get the value of the environment variable named Name.  If no such
2191      variable exists, Nil is returned.")
2192    
2193    (def-alien-routine ("setenv" unix-setenv) c-call:int
2194      (name c-call:c-string)
2195      (value c-call:c-string)
2196      (overwrite c-call:int)
2197      _N"Adds the environment variable named Name to the environment with
2198      the given Value if Name does not already exist. If Name does exist,
2199      the value is changed to Value if Overwrite is non-zero.  Otherwise,
2200      the value is not changed.")
2201    
2202    (def-alien-routine ("putenv" unix-putenv) c-call:int
2203      (name c-call:c-string)
2204      _N"Adds or changes the environment.  Name-value must be a string of
2205      the form \"name=value\".  If the name does not exist, it is added.
2206      If name does exist, the value is updated to the given value.")
2207    
2208    (def-alien-routine ("unsetenv" unix-unsetenv) c-call:int
2209      (name c-call:c-string)
2210      _N"Removes the variable Name from the environment")
2211    
2212  (def-alien-routine ("ttyname" unix-ttyname) c-string  (def-alien-routine ("ttyname" unix-ttyname) c-string
2213    (fd int))    (fd int))
2214    
2215  (def-alien-routine ("isatty" unix-isatty) boolean  (def-alien-routine ("isatty" unix-isatty) boolean
2216    "Accepts a Unix file descriptor and returns T if the device    _N"Accepts a Unix file descriptor and returns T if the device
2217    associated with it is a terminal."    associated with it is a terminal."
2218    (fd int))    (fd int))
2219    
2220  ;;; Unix-link creates a hard link from name2 to name1.  ;;; Unix-link creates a hard link from name2 to name1.
2221    
2222  (defun unix-link (name1 name2)  (defun unix-link (name1 name2)
2223    "Unix-link creates a hard link from the file with name1 to the    _N"Unix-link creates a hard link from the file with name1 to the
2224     file with name2."     file with name2."
2225    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2226    (void-syscall ("link" c-string c-string) name1 name2))    (void-syscall ("link" c-string c-string)
2227                    (%name->file name1) (%name->file name2)))
2228    
2229  (defun unix-symlink (name1 name2)  (defun unix-symlink (name1 name2)
2230    "Unix-symlink creates a symbolic link named name2 to the file    _N"Unix-symlink creates a symbolic link named name2 to the file
2231     named name1.  NIL and an error number is returned if the call     named name1.  NIL and an error number is returned if the call
2232     is unsuccessful."     is unsuccessful."
2233    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2234    (void-syscall ("symlink" c-string c-string) name1 name2))    (void-syscall ("symlink" c-string c-string)
2235                    (%name->file name1) (%name->file name2)))
2236    
2237  (defun unix-readlink (path)  (defun unix-readlink (path)
2238    "Unix-readlink invokes the readlink system call on the file name    _N"Unix-readlink invokes the readlink system call on the file name
2239    specified by the simple string path.  It returns up to two values:    specified by the simple string path.  It returns up to two values:
2240    the contents of the symbolic link if the call is successful, or    the contents of the symbolic link if the call is successful, or
2241    NIL and the Unix error number."    NIL and the Unix error number."
# Line 2183  length LEN and type TYPE." Line 2243  length LEN and type TYPE."
2243    (with-alien ((buf (array char 1024)))    (with-alien ((buf (array char 1024)))
2244      (syscall ("readlink" c-string (* char) int)      (syscall ("readlink" c-string (* char) int)
2245               (let ((string (make-string result)))               (let ((string (make-string result)))
2246                   #-unicode
2247                 (kernel:copy-from-system-area                 (kernel:copy-from-system-area
2248                  (alien-sap buf) 0                  (alien-sap buf) 0
2249                  string (* vm:vector-data-offset vm:word-bits)                  string (* vm:vector-data-offset vm:word-bits)
2250                  (* result vm:byte-bits))                  (* result vm:byte-bits))
2251                 string)                 #+unicode
2252               path (cast buf (* char)) 1024)))                 (let ((sap (alien-sap buf)))
2253                     (dotimes (k result)
2254                       (setf (aref string k) (code-char (sap-ref-8 sap k)))))
2255                   (%file->name string))
2256                 (%name->file path) (cast buf (* char)) 1024)))
2257    
2258  ;;; Unix-unlink accepts a name and deletes the directory entry for that  ;;; Unix-unlink accepts a name and deletes the directory entry for that
2259  ;;; name and the file if this is the last link.  ;;; name and the file if this is the last link.
2260    
2261  (defun unix-unlink (name)  (defun unix-unlink (name)
2262    "Unix-unlink removes the directory entry for the named file.    _N"Unix-unlink removes the directory entry for the named file.
2263     NIL and an error code is returned if the call fails."     NIL and an error code is returned if the call fails."
2264    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2265    (void-syscall ("unlink" c-string) name))    (void-syscall ("unlink" c-string) (%name->file name)))
2266    
2267  ;;; Unix-rmdir accepts a name and removes the associated directory.  ;;; Unix-rmdir accepts a name and removes the associated directory.
2268    
2269  (defun unix-rmdir (name)  (defun unix-rmdir (name)
2270    "Unix-rmdir attempts to remove the directory name.  NIL and    _N"Unix-rmdir attempts to remove the directory name.  NIL and
2271     an error number is returned if an error occured."     an error number is returned if an error occured."
2272    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2273    (void-syscall ("rmdir" c-string) name))    (void-syscall ("rmdir" c-string) (%name->file name)))
2274    
2275  (defun tcgetpgrp (fd)  (defun tcgetpgrp (fd)
2276    "Get the tty-process-group for the unix file-descriptor FD."    _N"Get the tty-process-group for the unix file-descriptor FD."
2277    (alien:with-alien ((alien-pgrp c-call:int))    (alien:with-alien ((alien-pgrp c-call:int))
2278      (multiple-value-bind (ok err)      (multiple-value-bind (ok err)
2279          (unix-ioctl fd          (unix-ioctl fd
# Line 2219  length LEN and type TYPE." Line 2284  length LEN and type TYPE."
2284            (values nil err)))))            (values nil err)))))
2285    
2286  (defun tty-process-group (&optional fd)  (defun tty-process-group (&optional fd)
2287    "Get the tty-process-group for the unix file-descriptor FD.  If not supplied,    _N"Get the tty-process-group for the unix file-descriptor FD.  If not supplied,
2288    FD defaults to /dev/tty."    FD defaults to /dev/tty."
2289    (if fd    (if fd
2290        (tcgetpgrp fd)        (tcgetpgrp fd)
# Line 2233  length LEN and type TYPE." Line 2298  length LEN and type TYPE."
2298                 (values nil errno))))))                 (values nil errno))))))
2299    
2300  (defun tcsetpgrp (fd pgrp)  (defun tcsetpgrp (fd pgrp)
2301    "Set the tty-process-group for the unix file-descriptor FD to PGRP."    _N"Set the tty-process-group for the unix file-descriptor FD to PGRP."
2302    (alien:with-alien ((alien-pgrp c-call:int pgrp))    (alien:with-alien ((alien-pgrp c-call:int pgrp))
2303      (unix-ioctl fd      (unix-ioctl fd
2304                  tiocspgrp                  tiocspgrp
2305                  (alien:alien-sap (alien:addr alien-pgrp)))))                  (alien:alien-sap (alien:addr alien-pgrp)))))
2306    
2307  (defun %set-tty-process-group (pgrp &optional fd)  (defun %set-tty-process-group (pgrp &optional fd)
2308    "Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not    _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
2309    supplied, FD defaults to /dev/tty."    supplied, FD defaults to /dev/tty."
2310    (let ((old-sigs    (let ((old-sigs
2311           (unix-sigblock           (unix-sigblock
# Line 2260  length LEN and type TYPE." Line 2325  length LEN and type TYPE."
2325        (unix-sigsetmask old-sigs))))        (unix-sigsetmask old-sigs))))
2326    
2327  (defsetf tty-process-group (&optional fd) (pgrp)  (defsetf tty-process-group (&optional fd) (pgrp)
2328    "Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not    _N"Set the tty-process-group for the unix file-descriptor FD to PGRP.  If not
2329    supplied, FD defaults to /dev/tty."    supplied, FD defaults to /dev/tty."
2330    `(%set-tty-process-group ,pgrp ,fd))    `(%set-tty-process-group ,pgrp ,fd))
2331    
2332  #+(or)  #+(or)
2333  (defun unix-getlogin ()  (defun unix-getlogin ()
2334    "Return the login name of the user."    _N"Return the login name of the user."
2335      (let ((result (alien-funcall (extern-alien "getlogin"      (let ((result (alien-funcall (extern-alien "getlogin"
2336                                               (function c-string)))))                                               (function c-string)))))
2337      (declare (type system-area-pointer result))      (declare (type system-area-pointer result))
# Line 2284  length LEN and type TYPE." Line 2349  length LEN and type TYPE."
2349      (domainname (array char 65))))      (domainname (array char 65))))
2350    
2351  (defun unix-uname ()  (defun unix-uname ()
2352    "Unix-uname returns the name and information about the current kernel. The    _N"Unix-uname returns the name and information about the current kernel. The
2353    values returned upon success are: sysname, nodename, release, version,    values returned upon success are: sysname, nodename, release, version,
2354    machine, and domainname. Upon failure, 'nil and the 'errno are returned."    machine, and domainname. Upon failure, 'nil and the 'errno are returned."
2355    (with-alien ((utsname (struct utsname)))    (with-alien ((utsname (struct utsname)))
# Line 2298  length LEN and type TYPE." Line 2363  length LEN and type TYPE."
2363                (addr utsname))))                (addr utsname))))
2364    
2365  (defun unix-gethostname ()  (defun unix-gethostname ()
2366    "Unix-gethostname returns the name of the host machine as a string."    _N"Unix-gethostname returns the name of the host machine as a string."
2367    (with-alien ((buf (array char 256)))    (with-alien ((buf (array char 256)))
2368      (syscall* ("gethostname" (* char) int)      (syscall* ("gethostname" (* char) int)
2369                (cast buf c-string)                (cast buf c-string)
# Line 2324  length LEN and type TYPE." Line 2389  length LEN and type TYPE."
2389  ;;; permanent storage (i.e. disk).  ;;; permanent storage (i.e. disk).
2390    
2391  (defun unix-fsync (fd)  (defun unix-fsync (fd)
2392    "Unix-fsync writes the core image of the file described by    _N"Unix-fsync writes the core image of the file described by
2393     fd to disk."     fd to disk."
2394    (declare (type unix-fd fd))    (declare (type unix-fd fd))
2395    (void-syscall ("fsync" int) fd))    (void-syscall ("fsync" int) fd))
# Line 2332  length LEN and type TYPE." Line 2397  length LEN and type TYPE."
2397    
2398  #+(or)  #+(or)
2399  (defun unix-vhangup ()  (defun unix-vhangup ()
2400   "Revoke access permissions to all processes currently communicating   _N"Revoke access permissions to all processes currently communicating
2401    with the control terminal, and then send a SIGHUP signal to the process    with the control terminal, and then send a SIGHUP signal to the process
2402    group of the control terminal."    group of the control terminal."
2403   (int-syscall ("vhangup")))   (int-syscall ("vhangup")))
2404    
2405  #+(or)  #+(or)
2406  (defun unix-revoke (file)  (defun unix-revoke (file)
2407   "Revoke the access of all descriptors currently open on FILE."   _N"Revoke the access of all descriptors currently open on FILE."
2408   (int-syscall ("revoke" c-string) file))   (int-syscall ("revoke" c-string) (%name->file file)))
2409    
2410    
2411  #+(or)  #+(or)
2412  (defun unix-chroot (path)  (defun unix-chroot (path)
2413   "Make PATH be the root directory (the starting point for absolute paths).   _N"Make PATH be the root directory (the starting point for absolute paths).
2414     This call is restricted to the super-user."     This call is restricted to the super-user."
2415   (int-syscall ("chroot" c-string) path))   (int-syscall ("chroot" c-string) (%name->file path)))
2416    
2417  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long
2418    "Unix-gethostid returns a 32-bit integer which provides unique    _N"Unix-gethostid returns a 32-bit integer which provides unique
2419     identification for the host machine.")     identification for the host machine.")
2420    
2421  ;;; Unix-sync writes all information in core memory which has been modified  ;;; Unix-sync writes all information in core memory which has been modified
2422  ;;; to permanent storage (i.e. disk).  ;;; to permanent storage (i.e. disk).
2423    
2424  (defun unix-sync ()  (defun unix-sync ()
2425    "Unix-sync writes all information in core memory which has been    _N"Unix-sync writes all information in core memory which has been
2426     modified to disk.  It returns NIL and an error code if an error     modified to disk.  It returns NIL and an error code if an error
2427     occured."     occured."
2428    (void-syscall ("sync")))    (void-syscall ("sync")))
# Line 2365  length LEN and type TYPE." Line 2430  length LEN and type TYPE."
2430  ;;; Unix-getpagesize returns the number of bytes in the system page.  ;;; Unix-getpagesize returns the number of bytes in the system page.
2431    
2432  (defun unix-getpagesize ()  (defun unix-getpagesize ()
2433    "Unix-getpagesize returns the number of bytes in a system page."    _N"Unix-getpagesize returns the number of bytes in a system page."
2434    (int-syscall ("getpagesize")))    (int-syscall ("getpagesize")))
2435    
2436  ;;; Unix-truncate accepts a file name and a new length.  The file is  ;;; Unix-truncate accepts a file name and a new length.  The file is
2437  ;;; truncated to the new length.  ;;; truncated to the new length.
2438    
2439  (defun unix-truncate (name length)  (defun unix-truncate (name length)
2440    "Unix-truncate truncates the named file to the length (in    _N"Unix-truncate truncates the named file to the length (in
2441     bytes) specified by LENGTH.  NIL and an error number is returned     bytes) specified by LENGTH.  NIL and an error number is returned
2442     if the call is unsuccessful."     if the call is unsuccessful."
2443    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2444             (type (unsigned-byte 64) length))             (type (unsigned-byte 64) length))
2445    (void-syscall ("truncate64" c-string off-t) name length))    (void-syscall ("truncate64" c-string off-t) (%name->file name) length))
2446    
2447  (defun unix-ftruncate (fd length)  (defun unix-ftruncate (fd length)
2448    "Unix-ftruncate is similar to unix-truncate except that the first    _N"Unix-ftruncate is similar to unix-truncate except that the first
2449     argument is a file descriptor rather than a file name."     argument is a file descriptor rather than a file name."
2450    (declare (type unix-fd fd)    (declare (type unix-fd fd)
2451             (type (unsigned-byte 64) length))             (type (unsigned-byte 64) length))
# Line 2388  length LEN and type TYPE." Line 2453  length LEN and type TYPE."
2453    
2454  #+(or)  #+(or)
2455  (defun unix-getdtablesize ()  (defun unix-getdtablesize ()
2456    "Return the maximum number of file descriptors    _N"Return the maximum number of file descriptors
2457     the current process could possibly have."     the current process could possibly have."
2458    (int-syscall ("getdtablesize")))    (int-syscall ("getdtablesize")))
2459    
2460  (defconstant f_ulock 0 "Unlock a locked region")  (defconstant f_ulock 0 _N"Unlock a locked region")
2461  (defconstant f_lock 1 "Lock a region for exclusive use")  (defconstant f_lock 1 _N"Lock a region for exclusive use")
2462  (defconstant f_tlock 2 "Test and lock a region for exclusive use")  (defconstant f_tlock 2 _N"Test and lock a region for exclusive use")
2463  (defconstant f_test 3 "Test a region for othwer processes locks")  (defconstant f_test 3 _N"Test a region for othwer processes locks")
2464    
2465  (defun unix-lockf (fd cmd length)  (defun unix-lockf (fd cmd length)
2466    "Unix-locks can lock, unlock and test files according to the cmd    _N"Unix-locks can lock, unlock and test files according to the cmd
2467     which can be one of the following:     which can be one of the following:
2468    
2469     f_ulock  Unlock a locked region     f_ulock  Unlock a locked region
# Line 2431  length LEN and type TYPE." Line 2496  length LEN and type TYPE."
2496  ;;; updated seconds and microseconds.  ;;; updated seconds and microseconds.
2497    
2498  (defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)  (defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
2499    "Unix-utimes sets the 'last-accessed' and 'last-updated'    _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
2500     times on a specified file.  NIL and an error number is     times on a specified file.  NIL and an error number is
2501     returned if the call is unsuccessful."     returned if the call is unsuccessful."
2502    (declare (type unix-pathname file)    (declare (type unix-pathname file)
# Line 2450  length LEN and type TYPE." Line 2515  length LEN and type TYPE."
2515    
2516  ;; Bits in the third argument to `waitpid'.  ;; Bits in the third argument to `waitpid'.
2517    
2518  (defconstant waitpid-wnohang 1 "Don't block waiting.")  (defconstant waitpid-wnohang 1 _N"Don't block waiting.")
2519  (defconstant waitpid-wuntranced 2 "Report status of stopped children.")  (defconstant waitpid-wuntranced 2 _N"Report status of stopped children.")
2520    
2521  (defconstant waitpid-wclone #x80000000 "Wait for cloned process.")  (defconstant waitpid-wclone #x80000000 _N"Wait for cloned process.")
2522    
2523  ;;; sys/ioctl.h  ;;; sys/ioctl.h
2524    
2525  (defun unix-ioctl (fd cmd arg)  (defun unix-ioctl (fd cmd arg)
2526    "Unix-ioctl performs a variety of operations on open i/o    _N"Unix-ioctl performs a variety of operations on open i/o
2527     descriptors.  See the UNIX Programmer's Manual for more     descriptors.  See the UNIX Programmer's Manual for more
2528     information."     information."
2529    (declare (type unix-fd fd)    (declare (type unix-fd fd)
2530             (type (unsigned-byte 32) cmd))             (type (unsigned-byte 32) cmd))
2531    (void-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))    (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))
2532    
2533    
2534  ;;; sys/fsuid.h  ;;; sys/fsuid.h
2535    
2536  #+(or)  #+(or)
2537  (defun unix-setfsuid (uid)  (defun unix-setfsuid (uid)
2538    "Change uid used for file access control to UID, without affecting    _N"Change uid used for file access control to UID, without affecting
2539     other priveledges (such as who can send signals at the process)."     other priveledges (such as who can send signals at the process)."
2540    (int-syscall ("setfsuid" uid-t) uid))    (int-syscall ("setfsuid" uid-t) uid))
2541    
2542  #+(or)  #+(or)
2543  (defun unix-setfsgid (gid)  (defun unix-setfsgid (gid)
2544    "Change gid used for file access control to GID, without affecting    _N"Change gid used for file access control to GID, without affecting
2545     other priveledges (such as who can send signals at the process)."     other priveledges (such as who can send signals at the process)."
2546    (int-syscall ("setfsgid" gid-t) gid))    (int-syscall ("setfsgid" gid-t) gid))
2547    
# Line 2494  length LEN and type TYPE." Line 2559  length LEN and type TYPE."
2559  ;; to indicate the interesting event types; they will appear in `revents'  ;; to indicate the interesting event types; they will appear in `revents'
2560  ;; to indicate the status of the file descriptor.  ;; to indicate the status of the file descriptor.
2561    
2562  (defconstant POLLIN  #o1 "There is data to read.")  (defconstant POLLIN  #o1 _N"There is data to read.")
2563  (defconstant POLLPRI #o2 "There is urgent data to read.")  (defconstant POLLPRI #o2 _N"There is urgent data to read.")
2564  (defconstant POLLOUT #o4 "Writing now will not block.")  (defconstant POLLOUT #o4 _N"Writing now will not block.")
2565    
2566  ;; Event types always implicitly polled for.  These bits need not be set in  ;; Event types always implicitly polled for.  These bits need not be set in
2567  ;;`events', but they will appear in `revents' to indicate the status of  ;;`events', but they will appear in `revents' to indicate the status of
2568  ;; the file descriptor.  */  ;; the file descriptor.  */
2569    
2570    
2571  (defconstant POLLERR  #o10 "Error condition.")  (defconstant POLLERR  #o10 _N"Error condition.")
2572  (defconstant POLLHUP  #o20 "Hung up.")  (defconstant POLLHUP  #o20 _N"Hung up.")
2573  (defconstant POLLNVAL #o40 "Invalid polling request.")  (defconstant POLLNVAL #o40 _N"Invalid polling request.")
2574    
2575    
2576  (defconstant +npollfile+ 30 "Canonical number of polling requests to read  (defconstant +npollfile+ 30 _N"Canonical number of polling requests to read
2577  in at a time in poll.")  in at a time in poll.")
2578    
2579  #+(or)  #+(or)
2580  (defun unix-poll (fds nfds timeout)  (defun unix-poll (fds nfds timeout)
2581   " Poll the file descriptors described by the NFDS structures starting at   _N" Poll the file descriptors described by the NFDS structures starting at
2582     FDS.  If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for     FDS.  If TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for
2583     an event to occur; if TIMEOUT is -1, block until an event occurs.     an event to occur; if TIMEOUT is -1, block until an event occurs.
2584     Returns the number of file descriptors with events, zero if timed out,     Returns the number of file descriptors with events, zero if timed out,
# Line 2524  in at a time in poll.") Line 2589  in at a time in poll.")
2589  ;;; sys/resource.h  ;;; sys/resource.h
2590    
2591  (defun unix-getrlimit (resource)  (defun unix-getrlimit (resource)
2592    "Get the soft and hard limits for RESOURCE."    _N"Get the soft and hard limits for RESOURCE."
2593    (with-alien ((rlimits (struct rlimit)))    (with-alien ((rlimits (struct rlimit)))
2594      (syscall ("getrlimit" int (* (struct rlimit)))      (syscall ("getrlimit" int (* (struct rlimit)))
2595               (values t               (values t
# Line 2533  in at a time in poll.") Line 2598  in at a time in poll.")
2598               resource (addr rlimits))))               resource (addr rlimits))))
2599    
2600  (defun unix-setrlimit (resource current maximum)  (defun unix-setrlimit (resource current maximum)
2601    "Set the current soft and hard maximum limits for RESOURCE.    _N"Set the current soft and hard maximum limits for RESOURCE.
2602     Only the super-user can increase hard limits."     Only the super-user can increase hard limits."
2603    (with-alien ((rlimits (struct rlimit)))    (with-alien ((rlimits (struct rlimit)))
2604      (setf (slot rlimits 'rlim-cur) current)      (setf (slot rlimits 'rlim-cur) current)
# Line 2543  in at a time in poll.") Line 2608  in at a time in poll.")
2608    
2609  (declaim (inline unix-fast-getrusage))  (declaim (inline unix-fast-getrusage))
2610  (defun unix-fast-getrusage (who)  (defun unix-fast-getrusage (who)
2611    "Like call getrusage, but return only the system and user time, and returns    _N"Like call getrusage, but return only the system and user time, and returns
2612     the seconds and microseconds as separate values."     the seconds and microseconds as separate values."
2613    (declare (values (member t)    (declare (values (member t)
2614                     (unsigned-byte 31) (mod 1000000)                     (unsigned-byte 31) (mod 1000000)
# Line 2558  in at a time in poll.") Line 2623  in at a time in poll.")
2623                who (addr usage))))                who (addr usage))))
2624    
2625  (defun unix-getrusage (who)  (defun unix-getrusage (who)
2626    "Unix-getrusage returns information about the resource usage    _N"Unix-getrusage returns information about the resource usage
2627     of the process specified by who.  Who can be either the     of the process specified by who.  Who can be either the
2628     current process (rusage_self) or all of the terminated     current process (rusage_self) or all of the terminated
2629     child processes (rusage_children).  NIL and an error number     child processes (rusage_children).  NIL and an error number
# Line 2588  in at a time in poll.") Line 2653  in at a time in poll.")
2653    
2654  #+(or)  #+(or)
2655  (defun unix-ulimit (cmd newlimit)  (defun unix-ulimit (cmd newlimit)
2656   "Function depends on CMD:   _N"Function depends on CMD:
2657    1 = Return the limit on the size of a file, in units of 512 bytes.    1 = Return the limit on the size of a file, in units of 512 bytes.
2658    2 = Set the limit on the size of a file to NEWLIMIT.  Only the    2 = Set the limit on the size of a file to NEWLIMIT.  Only the
2659        super-user can increase the limit.        super-user can increase the limit.
# Line 2599  in at a time in poll.") Line 2664  in at a time in poll.")
2664    
2665  #+(or)  #+(or)
2666  (defun unix-getpriority (which who)  (defun unix-getpriority (which who)
2667    "Return the highest priority of any process specified by WHICH and WHO    _N"Return the highest priority of any process specified by WHICH and WHO
2668     (see above); if WHO is zero, the current process, process group, or user     (see above); if WHO is zero, the current process, process group, or user
2669     (as specified by WHO) is used.  A lower priority number means higher     (as specified by WHO) is used.  A lower priority number means higher
2670     priority.  Priorities range from PRIO_MIN to PRIO_MAX (above)."     priority.  Priorities range from PRIO_MIN to PRIO_MAX (above)."
# Line 2608  in at a time in poll.") Line 2673  in at a time in poll.")
2673    
2674  #+(or)  #+(or)
2675  (defun unix-setpriority (which who)  (defun unix-setpriority (which who)
2676    "Set the priority of all processes specified by WHICH and WHO (see above)    _N"Set the priority of all processes specified by WHICH and WHO (see above)
2677     to PRIO.  Returns 0 on success, -1 on errors."     to PRIO.  Returns 0 on success, -1 on errors."
2678    (int-syscall ("setpriority" int int)    (int-syscall ("setpriority" int int)
2679                 which who))                 which who))
# Line 2708  in at a time in poll.") Line 2773  in at a time in poll.")
2773  (defmacro unix-fast-select (num-descriptors  (defmacro unix-fast-select (num-descriptors
2774                              read-fds write-fds exception-fds                              read-fds write-fds exception-fds
2775                              timeout-secs &optional (timeout-usecs 0))                              timeout-secs &optional (timeout-usecs 0))
2776    "Perform the UNIX select(2) system call."    _N"Perform the UNIX select(2) system call."
2777    (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)    (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)
2778             (type (or (alien (* (struct fd-set))) null)             (type (or (alien (* (struct fd-set))) null)
2779                   read-fds write-fds exception-fds)                   read-fds write-fds exception-fds)
# Line 2748  in at a time in poll.") Line 2813  in at a time in poll.")
2813                              ,(* index nfdbits))))))                              ,(* index nfdbits))))))
2814    
2815  (defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))  (defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
2816    "Unix-select examines the sets of descriptors passed as arguments    _N"Unix-select examines the sets of descriptors passed as arguments
2817     to see if they are ready for reading and writing.  See the UNIX     to see if they are ready for reading and writing.  See the UNIX
2818     Programmers Manual for more information."     Programmers Manual for more information."
2819    (declare (type (integer 0 #.FD-SETSIZE) nfds)    (declare (type (integer 0 #.FD-SETSIZE) nfds)
# Line 2808  in at a time in poll.") Line 2873  in at a time in poll.")
2873             (slot ,buf 'st-blocks)))             (slot ,buf 'st-blocks)))
2874    
2875  (defun unix-stat (name)  (defun unix-stat (name)
2876    "UNIX-STAT retrieves information about the specified    _N"UNIX-STAT retrieves information about the specified
2877     file returning them in the form of multiple values.     file returning them in the form of multiple values.
2878     See the UNIX Programmer's Manual for a description     See the UNIX Programmer's Manual for a description
2879     of the values returned.  If the call fails, then NIL     of the values returned.  If the call fails, then NIL
# Line 2819  in at a time in poll.") Line 2884  in at a time in poll.")
2884    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
2885      (syscall ("stat64" c-string (* (struct stat)))      (syscall ("stat64" c-string (* (struct stat)))
2886               (extract-stat-results buf)               (extract-stat-results buf)
2887               name (addr buf))))               (%name->file name) (addr buf))))
2888    
2889  (defun unix-fstat (fd)  (defun unix-fstat (fd)
2890    "UNIX-FSTAT is similar to UNIX-STAT except the file is specified    _N"UNIX-FSTAT is similar to UNIX-STAT except the file is specified
2891     by the file descriptor FD."     by the file descriptor FD."
2892    (declare (type unix-fd fd))    (declare (type unix-fd fd))
2893    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
# Line 2831  in at a time in poll.") Line 2896  in at a time in poll.")
2896               fd (addr buf))))               fd (addr buf))))
2897    
2898  (defun unix-lstat (name)  (defun unix-lstat (name)
2899    "UNIX-LSTAT is similar to UNIX-STAT except the specified    _N"UNIX-LSTAT is similar to UNIX-STAT except the specified
2900     file must be a symbolic link."     file must be a symbolic link."
2901    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2902    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
2903      (syscall ("lstat64" c-string (* (struct stat)))      (syscall ("lstat64" c-string (* (struct stat)))
2904               (extract-stat-results buf)               (extract-stat-results buf)
2905               name (addr buf))))               (%name->file name) (addr buf))))
2906    
2907  ;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.  ;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
2908    
2909  (defun unix-chmod (path mode)  (defun unix-chmod (path mode)
2910    "Given a file path string and a constant mode, unix-chmod changes the    _N"Given a file path string and a constant mode, unix-chmod changes the
2911     permission mode for that file to the one specified. The new mode     permission mode for that file to the one specified. The new mode
2912     can be created by logically OR'ing the following:     can be created by logically OR'ing the following:
2913    
# Line 2858  in at a time in poll.") Line 2923  in at a time in poll.")
2923        readoth           Read by others.        readoth           Read by others.
2924        writeoth          Write by others.        writeoth          Write by others.
2925        execoth           Execute (search directory) by others.        execoth           Execute (search directory) by others.
2926    
2927      Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
2928      are equivalent for 'mode.  The octal-base is familar to Unix users.
2929    
2930    It returns T on successfully completion; NIL and an error number    It returns T on successfully completion; NIL and an error number
2931    otherwise."    otherwise."
2932    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2933             (type unix-file-mode mode))             (type unix-file-mode mode))
2934    (void-syscall ("chmod" c-string int) path mode))    (void-syscall ("chmod" c-string int) (%name->file path) mode))
2935    
2936  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
2937  ;;; ("mode") and changes the protection of the file described by "fd" to  ;;; ("mode") and changes the protection of the file described by "fd" to
2938  ;;; "mode".  ;;; "mode".
2939    
2940  (defun unix-fchmod (fd mode)  (defun unix-fchmod (fd mode)
2941    "Given an integer file descriptor and a mode (the same as those    _N"Given an integer file descriptor and a mode (the same as those
2942     used for unix-chmod), unix-fchmod changes the permission mode     used for unix-chmod), unix-fchmod changes the permission mode
2943     for that file to the one specified. T is returned if the call     for that file to the one specified. T is returned if the call
2944     was successful."     was successful."
# Line 2880  in at a time in poll.") Line 2948  in at a time in poll.")
2948    
2949    
2950  (defun unix-umask (mask)  (defun unix-umask (mask)
2951    "Set the file creation mask of the current process to MASK,    _N"Set the file creation mask of the current process to MASK,
2952     and return the old creation mask."     and return the old creation mask."
2953    (int-syscall ("umask" mode-t) mask))    (int-syscall ("umask" mode-t) mask))
2954    
# Line 2888  in at a time in poll.") Line 2956  in at a time in poll.")
2956  ;;; corresponding directory with mode mode.  ;;; corresponding directory with mode mode.
2957    
2958  (defun unix-mkdir (name mode)  (defun unix-mkdir (name mode)
2959    "Unix-mkdir creates a new directory with the specified name and mode.    _N"Unix-mkdir creates a new directory with the specified name and mode.
2960     (Same as those for unix-fchmod.)  It returns T upon success, otherwise     (Same as those for unix-chmod.)  It returns T upon success, otherwise
2961     NIL and an error number."     NIL and an error number."
2962    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2963             (type unix-file-mode mode))             (type unix-file-mode mode))
2964    (void-syscall ("mkdir" c-string int) name mode))    (void-syscall ("mkdir" c-string int) (%name->file name) mode))
2965    
2966  #+(or)  #+(or)
2967  (defun unix-makedev (path mode dev)  (defun unix-makedev (path mode dev)
2968   "Create a device file named PATH, with permission and special bits MODE   _N"Create a device file named PATH, with permission and special bits MODE
2969    and device number DEV (which can be constructed from major and minor    and device number DEV (which can be constructed from major and minor
2970    device numbers with the `makedev' macro above)."    device numbers with the `makedev' macro above)."
2971    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2972             (type unix-file-mode mode))             (type unix-file-mode mode))
2973    (void-syscall ("makedev" c-string mode-t dev-t) name mode dev))    (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev))
2974    
2975    
2976  #+(or)  #+(or)
2977  (defun unix-fifo (name mode)  (defun unix-fifo (name mode)
2978    "Create a new FIFO named PATH, with permission bits MODE."    _N"Create a new FIFO named PATH, with permission bits MODE."
2979    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2980             (type unix-file-mode mode))             (type unix-file-mode mode))
2981    (void-syscall ("mkfifo" c-string int) name mode))    (void-syscall ("mkfifo" c-string int) (%name->file name) mode))
2982    
2983  ;;; sys/statfs.h  ;;; sys/statfs.h
2984    
2985  #+(or)  #+(or)
2986  (defun unix-statfs (file buf)  (defun unix-statfs (file buf)
2987    "Return information about the filesystem on which FILE resides."    _N"Return information about the filesystem on which FILE resides."
2988    (int-syscall ("statfs64" c-string (* (struct statfs)))    (int-syscall ("statfs64" c-string (* (struct statfs)))
2989                 file buf))                 (%name->file file) buf))
2990    
2991  ;;; sys/swap.h  ;;; sys/swap.h
2992    
2993  #+(or)  #+(or)
2994  (defun unix-swapon (path flags)  (defun unix-swapon (path flags)
2995   "Make the block special device PATH available to the system for swapping.   _N"Make the block special device PATH available to the system for swapping.
2996    This call is restricted to the super-user."    This call is restricted to the super-user."
2997   (int-syscall ("swapon" c-string int) path flags))   (int-syscall ("swapon" c-string int) (%name->file path) flags))
2998    
2999  #+(or)  #+(or)
3000  (defun unix-swapoff (path)  (defun unix-swapoff (path)
3001   "Make the block special device PATH available to the system for swapping.   _N"Make the block special device PATH unavailable to the system for swapping.
3002    This call is restricted to the super-user."    This call is restricted to the super-user."
3003   (int-syscall ("swapon" c-string) path))   (int-syscall ("swapoff" c-string) (%name->file path)))
3004    
3005  ;;; sys/sysctl.h  ;;; sys/sysctl.h
3006    
3007  #+(or)  #+(or)
3008  (defun unix-sysctl (name nlen oldval oldlenp newval newlen)  (defun unix-sysctl (name nlen oldval oldlenp newval newlen)
3009    "Read or write system parameters."    _N"Read or write system parameters."
3010    (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t)    (int-syscall ("sysctl" int int (* void) (* void) (* void) size-t)
3011                 name nlen oldval oldlenp newval newlen))                 name nlen oldval oldlenp newval newlen))
3012    
# Line 2970  in at a time in poll.") Line 3038  in at a time in poll.")
3038    
3039  #+(or)  #+(or)
3040  (defun unix-clock ()  (defun unix-clock ()
3041    "Time used by the program so far (user time + system time).    _N"Time used by the program so far (user time + system time).
3042     The result / CLOCKS_PER_SECOND is program time in seconds."     The result / CLOCKS_PER_SECOND is program time in seconds."
3043    (int-syscall ("clock")))    (int-syscall ("clock")))
3044    
3045  #+(or)  #+(or)
3046  (defun unix-time (timer)  (defun unix-time (timer)
3047    "Return the current time and put it in *TIMER if TIMER is not NULL."    _N"Return the current time and put it in *TIMER if TIMER is not NULL."
3048    (int-syscall ("time" time-t) timer))    (int-syscall ("time" time-t) timer))
3049    
3050  ;; Requires call to tzset() in main.  ;; Requires call to tzset() in main.
# Line 3013  in at a time in poll.") Line 3081  in at a time in poll.")
3081    
3082  (declaim (inline unix-gettimeofday))  (declaim (inline unix-gettimeofday))
3083  (defun unix-gettimeofday ()  (defun unix-gettimeofday ()
3084    "If it works, unix-gettimeofday returns 5 values: T, the seconds and    _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and
3085     microseconds of the current time of day, the timezone (in minutes west     microseconds of the current time of day, the timezone (in minutes west
3086     of Greenwich), and a daylight-savings flag.  If it doesn't work, it     of Greenwich), and a daylight-savings flag.  If it doesn't work, it
3087     returns NIL and the errno."     returns NIL and the errno."
# Line 3058  in at a time in poll.") Line 3126  in at a time in poll.")
3126  (defconstant ITIMER-VIRTUAL 1)  (defconstant ITIMER-VIRTUAL 1)
3127  (defconstant ITIMER-PROF 2)  (defconstant ITIMER-PROF 2)
3128    
3129  (defun unix-getitimer(which)  (defun unix-getitimer (which)
3130    "Unix-getitimer returns the INTERVAL and VALUE slots of one of    _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of
3131     three system timers (:real :virtual or :profile). On success,     three system timers (:real :virtual or :profile). On success,
3132     unix-getitimer returns 5 values,     unix-getitimer returns 5 values,
3133     T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."     T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
# Line 3081  in at a time in poll.") Line 3149  in at a time in poll.")
3149                  which (alien-sap (addr itv))))))                  which (alien-sap (addr itv))))))
3150    
3151  (defun unix-setitimer (which int-secs int-usec val-secs val-usec)  (defun unix-setitimer (which int-secs int-usec val-secs val-usec)
3152    " Unix-setitimer sets the INTERVAL and VALUE slots of one of    _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of
3153     three system timers (:real :virtual or :profile). A SIGALRM signal     three system timers (:real :virtual or :profile). A SIGALRM signal
3154     will be delivered VALUE <seconds+microseconds> from now. INTERVAL,     will be delivered VALUE <seconds+microseconds> from now. INTERVAL,
3155     when non-zero, is <seconds+microseconds> to be loaded each time     when non-zero, is <seconds+microseconds> to be loaded each time
# Line 3126  in at a time in poll.") Line 3194  in at a time in poll.")
3194    
3195  #+(or)  #+(or)
3196  (defun unix-fstime (timebuf)  (defun unix-fstime (timebuf)
3197    "Fill in TIMEBUF with information about the current time."    _N"Fill in TIMEBUF with information about the current time."
3198    (int-syscall ("ftime" (* (struct timeb))) timebuf))    (int-syscall ("ftime" (* (struct timeb))) timebuf))
3199    
3200    
# Line 3143  in at a time in poll.") Line 3211  in at a time in poll.")
3211    
3212  #+(or)  #+(or)
3213  (defun unix-times (buffer)  (defun unix-times (buffer)
3214    "Store the CPU time used by this process and all its    _N"Store the CPU time used by this process and all its
3215     dead children (and their dead children) in BUFFER.     dead children (and their dead children) in BUFFER.
3216     Return the elapsed real time, or (clock_t) -1 for errors.     Return the elapsed real time, or (clock_t) -1 for errors.
3217     All times are in CLK_TCKths of a second."     All times are in CLK_TCKths of a second."
# Line 3153  in at a time in poll.") Line 3221  in at a time in poll.")
3221    
3222  #+(or)  #+(or)
3223  (defun unix-wait (status)  (defun unix-wait (status)
3224    "Wait for a child to die.  When one does, put its status in *STAT_LOC    _N"Wait for a child to die.  When one does, put its status in *STAT_LOC
3225     and return its process ID.  For errors, return (pid_t) -1."     and return its process ID.  For errors, return (pid_t) -1."
3226    (int-syscall ("wait" (* int)) status))    (int-syscall ("wait" (* int)) status))
3227    
3228  #+(or)  #+(or)
3229  (defun unix-waitpid (pid status options)  (defun unix-waitpid (pid status options)
3230    "Wait for a child matching PID to die.    _N"Wait for a child matching PID to die.
3231     If PID is greater than 0, match any process whose process ID is PID.     If PID is greater than 0, match any process whose process ID is PID.
3232     If PID is (pid_t) -1, match any process.     If PID is (pid_t) -1, match any process.
3233     If PID is (pid_t) 0, match any process with the     If PID is (pid_t) 0, match any process with the
# Line 3176  in at a time in poll.") Line 3244  in at a time in poll.")
3244    
3245  ;;; asm/errno.h  ;;; asm/errno.h
3246    
3247  (def-unix-error ESUCCESS 0 "Successful")  (def-unix-error ESUCCESS 0 _N"Successful")
3248  (def-unix-error EPERM 1 "Operation not permitted")  (def-unix-error EPERM 1 _N"Operation not permitted")
3249  (def-unix-error ENOENT 2 "No such file or directory")  (def-unix-error ENOENT 2 _N"No such file or directory")
3250  (def-unix-error ESRCH 3 "No such process")  (def-unix-error ESRCH 3 _N"No such process")
3251  (def-unix-error EINTR 4 "Interrupted system call")  (def-unix-error EINTR 4 _N"Interrupted system call")
3252  (def-unix-error EIO 5 "I/O error")  (def-unix-error EIO 5 _N"I/O error")
3253  (def-unix-error ENXIO 6 "No such device or address")  (def-unix-error ENXIO 6 _N"No such device or address")
3254  (def-unix-error E2BIG 7 "Arg list too long")  (def-unix-error E2BIG 7 _N"Arg list too long")
3255  (def-unix-error ENOEXEC 8 "Exec format error")  (def-unix-error ENOEXEC 8 _N"Exec format error")
3256  (def-unix-error EBADF 9 "Bad file number")  (def-unix-error EBADF 9 _N"Bad file number")
3257  (def-unix-error ECHILD 10 "No children")  (def-unix-error ECHILD 10 _N"No children")
3258  (def-unix-error EAGAIN 11 "Try again")  (def-unix-error EAGAIN 11 _N"Try again")
3259  (def-unix-error ENOMEM 12 "Out of memory")  (def-unix-error ENOMEM 12 _N"Out of memory")
3260  (def-unix-error EACCES 13 "Permission denied")  (def-unix-error EACCES 13 _N"Permission denied")
3261  (def-unix-error EFAULT 14 "Bad address")  (def-unix-error EFAULT 14 _N"Bad address")
3262  (def-unix-error ENOTBLK 15 "Block device required")  (def-unix-error ENOTBLK 15 _N"Block device required")
3263  (def-unix-error EBUSY 16 "Device or resource busy")  (def-unix-error EBUSY 16 _N"Device or resource busy")
3264  (def-unix-error EEXIST 17 "File exists")  (def-unix-error EEXIST 17 _N"File exists")
3265  (def-unix-error EXDEV 18 "Cross-device link")  (def-unix-error EXDEV 18 _N"Cross-device link")
3266  (def-unix-error ENODEV 19 "No such device")  (def-unix-error ENODEV 19 _N"No such device")
3267  (def-unix-error ENOTDIR 20 "Not a director")  (def-unix-error ENOTDIR 20 _N"Not a director")
3268  (def-unix-error EISDIR 21 "Is a directory")  (def-unix-error EISDIR 21 _N"Is a directory")
3269  (def-unix-error EINVAL 22 "Invalid argument")  (def-unix-error EINVAL 22 _N"Invalid argument")
3270  (def-unix-error ENFILE 23 "File table overflow")  (def-unix-error ENFILE 23 _N"File table overflow")
3271  (def-unix-error EMFILE 24 "Too many open files")  (def-unix-error EMFILE 24 _N"Too many open files")
3272  (def-unix-error ENOTTY 25 "Not a typewriter")  (def-unix-error ENOTTY 25 _N"Not a typewriter")
3273  (def-unix-error ETXTBSY 26 "Text file busy")  (def-unix-error ETXTBSY 26 _N"Text file busy")
3274  (def-unix-error EFBIG 27 "File too large")  (def-unix-error EFBIG 27 _N"File too large")
3275  (def-unix-error ENOSPC 28 "No space left on device")  (def-unix-error ENOSPC 28 _N"No space left on device")
3276  (def-unix-error ESPIPE 29 "Illegal seek")  (def-unix-error ESPIPE 29 _N"Illegal seek")
3277  (def-unix-error EROFS 30 "Read-only file system")  (def-unix-error EROFS 30 _N"Read-only file system")
3278  (def-unix-error EMLINK 31 "Too many links")  (def-unix-error EMLINK 31 _N"Too many links")
3279  (def-unix-error EPIPE 32 "Broken pipe")  (def-unix-error EPIPE 32 _N"Broken pipe")
3280  ;;;  ;;;
3281  ;;; Math  ;;; Math
3282  (def-unix-error EDOM 33 "Math argument out of domain")  (def-unix-error EDOM 33 _N"Math argument out of domain")
3283  (def-unix-error ERANGE 34 "Math result not representable")  (def-unix-error ERANGE 34 _N"Math result not representable")
3284  ;;;  ;;;
3285  (def-unix-error  EDEADLK         35     "Resource deadlock would occur")  (def-unix-error  EDEADLK         35     _N"Resource deadlock would occur")
3286  (def-unix-error  ENAMETOOLONG    36     "File name too long")  (def-unix-error  ENAMETOOLONG    36     _N"File name too long")
3287  (def-unix-error  ENOLCK          37     "No record locks available")  (def-unix-error  ENOLCK          37     _N"No record locks available")
3288  (def-unix-error  ENOSYS          38     "Function not implemented")  (def-unix-error  ENOSYS          38     _N"Function not implemented")
3289  (def-unix-error  ENOTEMPTY       39     "Directory not empty")  (def-unix-error  ENOTEMPTY       39     _N"Directory not empty")
3290  (def-unix-error  ELOOP           40     "Too many symbolic links encountered")  (def-unix-error  ELOOP           40     _N"Too many symbolic links encountered")
3291  (def-unix-error  EWOULDBLOCK     11     "Operation would block")  (def-unix-error  EWOULDBLOCK     11     _N"Operation would block")
3292  (def-unix-error  ENOMSG          42     "No message of desired type")  (def-unix-error  ENOMSG          42     _N"No message of desired type")
3293  (def-unix-error  EIDRM           43     "Identifier removed")  (def-unix-error  EIDRM           43     _N"Identifier removed")
3294  (def-unix-error  ECHRNG          44     "Channel number out of range")  (def-unix-error  ECHRNG          44     _N"Channel number out of range")
3295  (def-unix-error  EL2NSYNC        45     "Level 2 not synchronized")  (def-unix-error  EL2NSYNC        45     _N"Level 2 not synchronized")
3296  (def-unix-error  EL3HLT          46     "Level 3 halted")  (def-unix-error  EL3HLT          46     _N"Level 3 halted")
3297  (def-unix-error  EL3RST          47     "Level 3 reset")  (def-unix-error  EL3RST          47     _N"Level 3 reset")
3298  (def-unix-error  ELNRNG          48     "Link number out of range")  (def-unix-error  ELNRNG          48     _N"Link number out of range")
3299  (def-unix-error  EUNATCH         49     "Protocol driver not attached")  (def-unix-error  EUNATCH         49     _N"Protocol driver not attached")
3300  (def-unix-error  ENOCSI          50     "No CSI structure available")  (def-unix-error  ENOCSI          50     _N"No CSI structure available")
3301  (def-unix-error  EL2HLT          51     "Level 2 halted")  (def-unix-error  EL2HLT          51     _N"Level 2 halted")
3302  (def-unix-error  EBADE           52     "Invalid exchange")  (def-unix-error  EBADE           52     _N"Invalid exchange")
3303  (def-unix-error  EBADR           53     "Invalid request descriptor")  (def-unix-error  EBADR           53     _N"Invalid request descriptor")
3304  (def-unix-error  EXFULL          54     "Exchange full")  (def-unix-error  EXFULL          54     _N"Exchange full")
3305  (def-unix-error  ENOANO          55     "No anode")  (def-unix-error  ENOANO          55     _N"No anode")
3306  (def-unix-error  EBADRQC         56     "Invalid request code")  (def-unix-error  EBADRQC         56     _N"Invalid request code")
3307  (def-unix-error  EBADSLT         57     "Invalid slot")  (def-unix-error  EBADSLT         57     _N"Invalid slot")
3308  (def-unix-error  EDEADLOCK       EDEADLK     "File locking deadlock error")  (def-unix-error  EDEADLOCK       EDEADLK     _N"File locking deadlock error")
3309  (def-unix-error  EBFONT          59     "Bad font file format")  (def-unix-error  EBFONT          59     _N"Bad font file format")
3310  (def-unix-error  ENOSTR          60     "Device not a stream")  (def-unix-error  ENOSTR          60     _N"Device not a stream")
3311  (def-unix-error  ENODATA         61     "No data available")  (def-unix-error  ENODATA         61     _N"No data available")
3312  (def-unix-error  ETIME           62     "Timer expired")  (def-unix-error  ETIME           62     _N"Timer expired")
3313  (def-unix-error  ENOSR           63     "Out of streams resources")  (def-unix-error  ENOSR           63     _N"Out of streams resources")
3314  (def-unix-error  ENONET          64     "Machine is not on the network")  (def-unix-error  ENONET          64     _N"Machine is not on the network")
3315  (def-unix-error  ENOPKG          65     "Package not installed")  (def-unix-error  ENOPKG          65     _N"Package not installed")
3316  (def-unix-error  EREMOTE         66     "Object is remote")  (def-unix-error  EREMOTE         66     _N"Object is remote")
3317  (def-unix-error  ENOLINK         67     "Link has been severed")  (def-unix-error  ENOLINK         67     _N"Link has been severed")
3318  (def-unix-error  EADV            68     "Advertise error")  (def-unix-error  EADV            68     _N"Advertise error")
3319  (def-unix-error  ESRMNT          69     "Srmount error")  (def-unix-error  ESRMNT          69     _N"Srmount error")
3320  (def-unix-error  ECOMM           70     "Communication error on send")  (def-unix-error  ECOMM           70     _N"Communication error on send")
3321  (def-unix-error  EPROTO          71     "Protocol error")  (def-unix-error  EPROTO          71     _N"Protocol error")
3322  (def-unix-error  EMULTIHOP       72     "Multihop attempted")  (def-unix-error  EMULTIHOP       72     _N"Multihop attempted")
3323  (def-unix-error  EDOTDOT         73     "RFS specific error")  (def-unix-error  EDOTDOT         73     _N"RFS specific error")
3324  (def-unix-error  EBADMSG         74     "Not a data message")  (def-unix-error  EBADMSG         74     _N"Not a data message")
3325  (def-unix-error  EOVERFLOW       75     "Value too large for defined data type")  (def-unix-error  EOVERFLOW       75     _N"Value too large for defined data type")
3326  (def-unix-error  ENOTUNIQ        76     "Name not unique on network")  (def-unix-error  ENOTUNIQ        76     _N"Name not unique on network")
3327  (def-unix-error  EBADFD          77     "File descriptor in bad state")  (def-unix-error  EBADFD          77     _N"File descriptor in bad state")
3328  (def-unix-error  EREMCHG         78     "Remote address changed")  (def-unix-error  EREMCHG         78     _N"Remote address changed")
3329  (def-unix-error  ELIBACC         79     "Can not access a needed shared library")  (def-unix-error  ELIBACC         79     _N"Can not access a needed shared library")
3330  (def-unix-error  ELIBBAD         80     "Accessing a corrupted shared library")  (def-unix-error  ELIBBAD         80     _N"Accessing a corrupted shared library")
3331  (def-unix-error  ELIBSCN         81     ".lib section in a.out corrupted")  (def-unix-error  ELIBSCN         81     _N".lib section in a.out corrupted")
3332  (def-unix-error  ELIBMAX         82     "Attempting to link in too many shared libraries")  (def-unix-error  ELIBMAX         82     _N"Attempting to link in too many shared libraries")
3333  (def-unix-error  ELIBEXEC        83     "Cannot exec a shared library directly")  (def-unix-error  ELIBEXEC        83     _N"Cannot exec a shared library directly")
3334  (def-unix-error  EILSEQ          84     "Illegal byte sequence")  (def-unix-error  EILSEQ          84     _N"Illegal byte sequence")
3335  (def-unix-error  ERESTART        85     "Interrupted system call should be restarted ")  (def-unix-error  ERESTART        85     _N"Interrupted system call should be restarted _N")
3336  (def-unix-error  ESTRPIPE        86     "Streams pipe error")  (def-unix-error  ESTRPIPE        86     _N"Streams pipe error")
3337  (def-unix-error  EUSERS          87     "Too many users")  (def-unix-error  EUSERS          87     _N"Too many users")
3338  (def-unix-error  ENOTSOCK        88     "Socket operation on non-socket")  (def-unix-error  ENOTSOCK        88     _N"Socket operation on non-socket")
3339  (def-unix-error  EDESTADDRREQ    89     "Destination address required")  (def-unix-error  EDESTADDRREQ    89     _N"Destination address required")
3340  (def-unix-error  EMSGSIZE        90     "Message too long")  (def-unix-error  EMSGSIZE        90     _N"Message too long")
3341  (def-unix-error  EPROTOTYPE      91     "Protocol wrong type for socket")  (def-unix-error  EPROTOTYPE      91     _N"Protocol wrong type for socket")
3342  (def-unix-error  ENOPROTOOPT     92     "Protocol not available")  (def-unix-error  ENOPROTOOPT     92     _N"Protocol not available")
3343  (def-unix-error  EPROTONOSUPPORT 93     "Protocol not supported")  (def-unix-error  EPROTONOSUPPORT 93     _N"Protocol not supported")
3344  (def-unix-error  ESOCKTNOSUPPORT 94     "Socket type not supported")  (def-unix-error  ESOCKTNOSUPPORT 94     _N"Socket type not supported")
3345  (def-unix-error  EOPNOTSUPP      95     "Operation not supported on transport endpoint")  (def-unix-error  EOPNOTSUPP      95     _N"Operation not supported on transport endpoint")
3346  (def-unix-error  EPFNOSUPPORT    96     "Protocol family not supported")  (def-unix-error  EPFNOSUPPORT    96     _N"Protocol family not supported")
3347  (def-unix-error  EAFNOSUPPORT    97     "Address family not supported by protocol")  (def-unix-error  EAFNOSUPPORT    97     _N"Address family not supported by protocol")
3348  (def-unix-error  EADDRINUSE      98     "Address already in use")  (def-unix-error  EADDRINUSE      98     _N"Address already in use")
3349  (def-unix-error  EADDRNOTAVAIL   99     "Cannot assign requested address")  (def-unix-error  EADDRNOTAVAIL   99     _N"Cannot assign requested address")
3350  (def-unix-error  ENETDOWN        100    "Network is down")  (def-unix-error  ENETDOWN        100    _N"Network is down")
3351  (def-unix-error  ENETUNREACH     101    "Network is unreachable")  (def-unix-error  ENETUNREACH     101    _N"Network is unreachable")
3352  (def-unix-error  ENETRESET       102    "Network dropped connection because of reset")  (def-unix-error  ENETRESET       102    _N"Network dropped connection because of reset")
3353  (def-unix-error  ECONNABORTED    103    "Software caused connection abort")  (def-unix-error  ECONNABORTED    103    _N"Software caused connection abort")
3354  (def-unix-error  ECONNRESET      104    "Connection reset by peer")  (def-unix-error  ECONNRESET      104    _N"Connection reset by peer")
3355  (def-unix-error  ENOBUFS         105    "No buffer space available")  (def-unix-error  ENOBUFS         105    _N"No buffer space available")
3356  (def-unix-error  EISCONN         106    "Transport endpoint is already connected")  (def-unix-error  EISCONN         106    _N"Transport endpoint is already connected")
3357  (def-unix-error  ENOTCONN        107    "Transport endpoint is not connected")  (def-unix-error  ENOTCONN        107    _N"Transport endpoint is not connected")
3358  (def-unix-error  ESHUTDOWN       108    "Cannot send after transport endpoint shutdown")  (def-unix-error  ESHUTDOWN       108    _N"Cannot send after transport endpoint shutdown")
3359  (def-unix-error  ETOOMANYREFS    109    "Too many references: cannot splice")  (def-unix-error  ETOOMANYREFS    109    _N"Too many references: cannot splice")
3360  (def-unix-error  ETIMEDOUT       110    "Connection timed out")  (def-unix-error  ETIMEDOUT       110    _N"Connection timed out")
3361  (def-unix-error  ECONNREFUSED    111    "Connection refused")  (def-unix-error  ECONNREFUSED    111    _N"Connection refused")
3362  (def-unix-error  EHOSTDOWN       112    "Host is down")  (def-unix-error  EHOSTDOWN       112    _N"Host is down")
3363  (def-unix-error  EHOSTUNREACH    113    "No route to host")  (def-unix-error  EHOSTUNREACH    113    _N"No route to host")
3364  (def-unix-error  EALREADY        114    "Operation already in progress")  (def-unix-error  EALREADY        114    _N"Operation already in progress")
3365  (def-unix-error  EINPROGRESS     115    "Operation now in progress")  (def-unix-error  EINPROGRESS     115    _N"Operation now in progress")
3366  (def-unix-error  ESTALE          116    "Stale NFS file handle")  (def-unix-error  ESTALE          116    _N"Stale NFS file handle")
3367  (def-unix-error  EUCLEAN         117    "Structure needs cleaning")  (def-unix-error  EUCLEAN         117    _N"Structure needs cleaning")
3368  (def-unix-error  ENOTNAM         118    "Not a XENIX named type file")  (def-unix-error  ENOTNAM         118    _N"Not a XENIX named type file")
3369  (def-unix-error  ENAVAIL         119    "No XENIX semaphores available")  (def-unix-error  ENAVAIL         119    _N"No XENIX semaphores available")
3370  (def-unix-error  EISNAM          120    "Is a named type file")  (def-unix-error  EISNAM          120    _N"Is a named type file")
3371  (def-unix-error  EREMOTEIO       121    "Remote I/O error")  (def-unix-error  EREMOTEIO       121    _N"Remote I/O error")
3372  (def-unix-error  EDQUOT          122    "Quota exceeded")  (def-unix-error  EDQUOT          122    _N"Quota exceeded")
3373    
3374  ;;; And now for something completely different ...  ;;; And now for something completely different ...
3375  (emit-unix-errors)  (emit-unix-errors)
# Line 3322  in at a time in poll.") Line 3390  in at a time in poll.")
3390  (defconstant ioc_inout (logior ioc_in ioc_out))  (defconstant ioc_inout (logior ioc_in ioc_out))
3391    
3392  (defmacro define-ioctl-command (name dev cmd &optional arg parm-type)  (defmacro define-ioctl-command (name dev cmd &optional arg parm-type)
3393    "Define an ioctl command. If the optional ARG and PARM-TYPE are given    _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given
3394    then ioctl argument size and direction are included as for ioctls defined    then ioctl argument size and direction are included as for ioctls defined
3395    by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type    by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type
3396    is the characters code, else DEV may be an integer giving the type."    is the characters code, else DEV may be an integer giving the type."
# Line 3364  in at a time in poll.") Line 3432  in at a time in poll.")
3432  (define-ioctl-command SIOCSPGRP #x89 #x02)  (define-ioctl-command SIOCSPGRP #x89 #x02)
3433    
3434  (defun siocspgrp (fd pgrp)  (defun siocspgrp (fd pgrp)
3435    "Set the socket process-group for the unix file-descriptor FD to PGRP."    _N"Set the socket process-group for the unix file-descriptor FD to PGRP."
3436    (alien:with-alien ((alien-pgrp c-call:int pgrp))    (alien:with-alien ((alien-pgrp c-call:int pgrp))
3437      (unix-ioctl fd      (unix-ioctl fd
3438                  siocspgrp                  siocspgrp
# Line 3372  in at a time in poll.") Line 3440  in at a time in poll.")
3440    
3441  ;;; A few random constants and functions  ;;; A few random constants and functions
3442    
3443  (defconstant setuidexec #o4000 "Set user ID on execution")  (defconstant setuidexec #o4000 _N"Set user ID on execution")
3444  (defconstant setgidexec #o2000 "Set group ID on execution")  (defconstant setgidexec #o2000 _N"Set group ID on execution")
3445  (defconstant savetext #o1000 "Save text image after execution")  (defconstant savetext #o1000 _N"Save text image after execution")
3446  (defconstant readown #o400 "Read by owner")  (defconstant readown #o400 _N"Read by owner")
3447  (defconstant writeown #o200 "Write by owner")  (defconstant writeown #o200 _N"Write by owner")
3448  (defconstant execown #o100 "Execute (search directory) by owner")  (defconstant execown #o100 _N"Execute (search directory) by owner")
3449  (defconstant readgrp #o40 "Read by group")  (defconstant readgrp #o40 _N"Read by group")
3450  (defconstant writegrp #o20 "Write by group")  (defconstant writegrp #o20 _N"Write by group")
3451  (defconstant execgrp #o10 "Execute (search directory) by group")  (defconstant execgrp #o10 _N"Execute (search directory) by group")
3452  (defconstant readoth #o4 "Read by others")  (defconstant readoth #o4 _N"Read by others")
3453  (defconstant writeoth #o2 "Write by others")  (defconstant writeoth #o2 _N"Write by others")
3454  (defconstant execoth #o1 "Execute (search directory) by others")  (defconstant execoth #o1 _N"Execute (search directory) by others")
3455    
3456  (defconstant terminal-speeds  (defconstant terminal-speeds
3457    '#(0 50 75 110 134 150 200 300 600 1200 1800 2400    '#(0 50 75 110 134 150 200 300 600 1200 1800 2400
# Line 3395  in at a time in poll.") Line 3463  in at a time in poll.")
3463            unix-resolve-links unix-simplify-pathname))            unix-resolve-links unix-simplify-pathname))
3464    
3465  (defun unix-file-kind (name &optional check-for-links)  (defun unix-file-kind (name &optional check-for-links)
3466    "Returns either :file, :directory, :link, :special, or NIL."    _N"Returns either :file, :directory, :link, :special, or NIL."
3467    (declare (simple-string name))    (declare (simple-string name))
3468    (multiple-value-bind (res dev ino mode)    (multiple-value-bind (res dev ino mode)
3469                         (if check-for-links                         (if check-for-links
# Line 3420  in at a time in poll.") Line 3488  in at a time in poll.")
3488              name))))              name))))
3489    
3490  (defun unix-resolve-links (pathname)  (defun unix-resolve-links (pathname)
3491    "Returns the pathname with all symbolic links resolved."    _N"Returns the pathname with all symbolic links resolved."
3492    (declare (simple-string pathname))    (declare (simple-string pathname))
3493    (let ((len (length pathname))    (let ((len (length pathname))
3494          (pending pathname))          (pending pathname))
# Line 3451  in at a time in poll.") Line 3519  in at a time in poll.")
3519                  (cond ((eq kind :link)                  (cond ((eq kind :link)
3520                         (multiple-value-bind (link err) (unix-readlink result)                         (multiple-value-bind (link err) (unix-readlink result)
3521                           (unless link                           (unless link
3522                             (error "Error reading link ~S: ~S"                             (error (intl:gettext "Error reading link ~S: ~S")
3523                                    (subseq result 0 fill-ptr)                                    (subseq result 0 fill-ptr)
3524                                    (get-unix-error-msg err)))                                    (get-unix-error-msg err)))
3525                           (cond ((or (zerop (length link))                           (cond ((or (zerop (length link))
# Line 3612  in at a time in poll.") Line 3680  in at a time in poll.")
3680          (let ((n (length s)))          (let ((n (length s)))
3681            ;;            ;;
3682            ;; Blast the string into place            ;; Blast the string into place
3683              #-unicode
3684            (kernel:copy-to-system-area (the simple-string s)            (kernel:copy-to-system-area (the simple-string s)
3685                                        (* vm:vector-data-offset vm:word-bits)                                        (* vm:vector-data-offset vm:word-bits)
3686                                        string-sap 0                                        string-sap 0
3687                                        (* (1+ n) vm:byte-bits))                                        (* (1+ n) vm:byte-bits))
3688              #+unicode
3689              (progn
3690                ;; FIXME: Do we need to apply some kind of transformation
3691                ;; to convert Lisp unicode strings to C strings?  Utf-8?
3692                (dotimes (k n)
3693                  (setf (sap-ref-8 string-sap k)
3694                        (logand #xff (char-code (aref s k)))))
3695                (setf (sap-ref-8 string-sap n) 0))
3696            ;;            ;;
3697            ;; Blast the pointer to the string into place            ;; Blast the pointer to the string into place
3698            (setf (sap-ref-sap vec-sap i) string-sap)            (setf (sap-ref-sap vec-sap i) string-sap)
# Line 3675  in at a time in poll.") Line 3752  in at a time in poll.")
3752  ;;;; User and group database access, POSIX Standard 9.2.2  ;;;; User and group database access, POSIX Standard 9.2.2
3753    
3754  (defun unix-getpwnam (login)  (defun unix-getpwnam (login)
3755    "Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."    _N"Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
3756    (declare (type simple-string login))    (declare (type simple-string login))
3757    (with-alien ((buf (array c-call:char 1024))    (with-alien ((buf (array c-call:char 1024))
3758                 (user-info (struct passwd))                 (user-info (struct passwd))
# Line 3705  in at a time in poll.") Line 3782  in at a time in poll.")
3782           :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))           :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
3783    
3784  (defun unix-getpwuid (uid)  (defun unix-getpwuid (uid)
3785    "Return a USER-INFO structure for the user identified by UID, or NIL if not found."    _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
3786    (declare (type unix-uid uid))    (declare (type unix-uid uid))
3787    (with-alien ((buf (array c-call:char 1024))    (with-alien ((buf (array c-call:char 1024))
3788                 (user-info (struct passwd))                 (user-info (struct passwd))
# Line 3735  in at a time in poll.") Line 3812  in at a time in poll.")
3812           :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))           :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
3813    
3814  (defun unix-getgrnam (name)  (defun unix-getgrnam (name)
3815    "Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."    _N"Return a GROUP-INFO structure for the group identified by NAME, or NIL if not found."
3816    (declare (type simple-string name))    (declare (type simple-string name))
3817    (with-alien ((buf (array c-call:char 2048))    (with-alien ((buf (array c-call:char 2048))
3818                 (group-info (struct group))                 (group-info (struct group))
# Line 3766  in at a time in poll.") Line 3843  in at a time in poll.")
3843                          :collect (string (cast member c-call:c-string))))))))                          :collect (string (cast member c-call:c-string))))))))
3844    
3845  (defun unix-getgrgid (gid)  (defun unix-getgrgid (gid)
3846    "Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."    _N"Return a GROUP-INFO structure for the group identified by GID, or NIL if not found."
3847    (declare (type unix-gid gid))    (declare (type unix-gid gid))
3848    (with-alien ((buf (array c-call:char 2048))    (with-alien ((buf (array c-call:char 2048))
3849                 (group-info (struct group))                 (group-info (struct group))

Legend:
Removed from v.1.35.2.1  
changed lines
  Added in v.1.54

  ViewVC Help
Powered by ViewVC 1.1.5