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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (hide annotations)
Tue Nov 19 13:17:14 2002 UTC (11 years, 5 months ago) by toy
Branch: MAIN
Changes since 1.17: +31 -21 lines
Alpha Linux support from Brian.
1 dtc 1.1 ;;; -*- Package: UNIX -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 toy 1.18 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/unix-glibc2.lisp,v 1.18 2002/11/19 13:17:14 toy Exp $")
9 dtc 1.1 ;;;
10     ;;; **********************************************************************
11     ;;;
12     ;;; This file contains the UNIX low-level support for glibc2. Based
13 dtc 1.5 ;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998).
14     ;;; Alpha support by Julian Dolby, 1999.
15 dtc 1.1 ;;;
16 dtc 1.2 ;;; All the functions with #+nil in front are work in progress,
17     ;;; and mostly don't work.
18     ;;;
19     ;; Todo: #+nil'ed stuff and ioctl's
20     ;;
21 dtc 1.1 (in-package "UNIX")
22     (use-package "ALIEN")
23     (use-package "C-CALL")
24     (use-package "SYSTEM")
25     (use-package "EXT")
26    
27     (export '(
28     daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
29     timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
30     itimerval it-interval it-value tchars t-intrc t-quitc t-startc
31     t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
32     t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
33     sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
34     direct d-off d-ino d-reclen d-name
35     stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
36     st-atime st-mtime st-ctime st-blksize st-blocks
37     s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
38     s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
39     ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
40     ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
41     ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
42     rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
43     unix-errno get-unix-error-msg
44     unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
45     unix-setitimer unix-getitimer
46     unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
47     setgidexec savetext readown writeown execown readgrp writegrp
48     execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
49     unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
50     unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
51     fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
52     l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
53     o_ndelay
54     o_noctty
55     o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
56     unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
57     fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
58     unix-ftruncate unix-symlink unix-unlink unix-write unix-ioctl
59 dtc 1.13 unix-uname utsname
60 dtc 1.1 tcsetpgrp tcgetpgrp tty-process-group
61     terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
62     tty-cbreak
63     termios
64     c-lflag
65     c-iflag
66     c-oflag
67     tty-icrnl
68     tty-ocrnl
69     veof
70     vintr
71     vquit
72     vstart
73     vstop
74     vsusp
75     c-cflag
76     c-cc
77     tty-icanon
78     vmin
79     vtime
80     tty-ixon
81     tcsanow
82     tcsadrain
83     tciflush
84     tcoflush
85     tcioflush
86     tcsaflush
87     unix-tcgetattr
88     unix-tcsetattr
89     tty-ignbrk
90     tty-brkint
91     tty-ignpar
92     tty-parmrk
93     tty-inpck
94     tty-istrip
95     tty-inlcr
96     tty-igncr
97     tty-iuclc
98     tty-ixany
99     tty-ixoff
100     tty-imaxbel
101     tty-opost
102     tty-olcuc
103     tty-onlcr
104     tty-onocr
105     tty-onlret
106     tty-ofill
107     tty-ofdel
108     tty-isig
109     tty-xcase
110     tty-echoe
111     tty-echok
112     tty-echonl
113     tty-noflsh
114     tty-iexten
115     tty-tostop
116     tty-echoctl
117     tty-echoprt
118     tty-echoke
119     tty-pendin
120     tty-cstopb
121     tty-cread
122     tty-parenb
123     tty-parodd
124     tty-hupcl
125     tty-clocal
126     vintr
127     verase
128     vkill
129     veol
130     veol2
131     TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
132     TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
133     TIOCSIGSEND
134    
135     KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
136     KBDSCLICK FIONREAD unix-exit unix-stat unix-lstat unix-fstat
137     unix-getrusage unix-fast-getrusage rusage_self rusage_children
138     unix-gettimeofday
139 dtc 1.8 unix-utimes unix-sched-yield unix-setreuid
140 dtc 1.1 unix-setregid
141     unix-getpid unix-getppid
142     unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
143     unix-getpagesize unix-gethostname unix-gethostid unix-fork
144     unix-current-directory unix-isatty unix-ttyname unix-execve
145     unix-socket unix-connect unix-bind unix-listen unix-accept
146 dtc 1.9 unix-recv unix-send unix-getpeername unix-getsockname
147 toy 1.17 unix-getsockopt unix-setsockopt
148    
149     unix-getpwnam unix-getpwuid unix-getgrnam unix-getgrgid
150     user-info user-info-name user-info-password user-info-uid
151     user-info-gid user-info-gecos user-info-dir user-info-shell
152     group-info group-info-name group-info-gid group-info-members))
153 dtc 1.1
154     (pushnew :unix *features*)
155 dtc 1.2 (pushnew :glibc2 *features*)
156 dtc 1.1
157     ;;;; Common machine independent structures.
158    
159 dtc 1.2 (eval-when (compile eval)
160 dtc 1.1
161 dtc 1.2 (defparameter *compiler-unix-errors* nil)
162 dtc 1.1
163 dtc 1.2 (defmacro def-unix-error (name number description)
164     `(progn
165     (eval-when (compile eval)
166     (push (cons ,number ,description) *compiler-unix-errors*))
167     (defconstant ,name ,number ,description)
168     (export ',name)))
169 dtc 1.1
170 dtc 1.2 (defmacro emit-unix-errors ()
171     (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*)))
172     (array (make-array (1+ max) :initial-element nil)))
173     (dolist (error *compiler-unix-errors*)
174     (setf (svref array (car error)) (cdr error)))
175     `(progn
176     (defvar *unix-errors* ',array)
177 pw 1.15 (declaim (simple-vector *unix-errors*)))))
178 dtc 1.1
179 dtc 1.2 )
180 dtc 1.1
181 dtc 1.2 (defmacro def-enum (inc cur &rest names)
182     (flet ((defform (name)
183     (prog1 (when name `(defconstant ,name ,cur))
184     (setf cur (funcall inc cur 1)))))
185     `(progn ,@(mapcar #'defform names))))
186 dtc 1.1
187 dtc 1.2 ;;;; Lisp types used by syscalls.
188 dtc 1.1
189 dtc 1.2 (deftype unix-pathname () 'simple-string)
190     (deftype unix-fd () `(integer 0 ,most-positive-fixnum))
191 dtc 1.1
192 dtc 1.2 (deftype unix-file-mode () '(unsigned-byte 32))
193     (deftype unix-pid () '(unsigned-byte 32))
194     (deftype unix-uid () '(unsigned-byte 32))
195     (deftype unix-gid () '(unsigned-byte 32))
196 dtc 1.1
197 toy 1.17
198     ;;;; User and group database structures: <pwd.h> and <grp.h>
199    
200     (defstruct user-info
201     (name "" :type string)
202     (password "" :type string)
203     (uid 0 :type unix-uid)
204     (gid 0 :type unix-gid)
205     (gecos "" :type string)
206     (dir "" :type string)
207     (shell "" :type string))
208    
209     (defstruct group-info
210     (name "" :type string)
211     (password "" :type string)
212     (gid 0 :type unix-gid)
213     (members nil :type list)) ; list of logins as strings
214    
215     (def-alien-type nil
216     (struct passwd
217     (pw-name (* char)) ; user's login name
218     (pw-passwd (* char)) ; no longer used
219     (pw-uid uid-t) ; user id
220     (pw-gid gid-t) ; group id
221     (pw-gecos (* char)) ; typically user's full name
222     (pw-dir (* char)) ; user's home directory
223     (pw-shell (* char)))) ; user's login shell
224    
225     (def-alien-type nil
226     (struct group
227     (gr-name (* char)) ; name of the group
228     (gr-passwd (* char)) ; encrypted group password
229     (gr-gid gid-t) ; numerical group ID
230     (gr-mem (* (* char))))) ; vector of pointers to member names
231    
232    
233 dtc 1.2 ;;;; System calls.
234     (def-alien-variable ("errno" unix-errno) int)
235 dtc 1.1
236 dtc 1.2 ;;; later...
237     (defun unix-get-errno ())
238 dtc 1.1
239 dtc 1.2 ;;; GET-UNIX-ERROR-MSG -- public.
240     ;;;
241     (defun get-unix-error-msg (&optional (error-number unix-errno))
242     "Returns a string describing the error number which was returned by a
243     UNIX system call."
244     (declare (type integer error-number))
245    
246     (unix-get-errno)
247     (if (array-in-bounds-p *unix-errors* error-number)
248     (svref *unix-errors* error-number)
249     (format nil "Unknown error [~d]" error-number)))
250 dtc 1.1
251 dtc 1.2 (defmacro syscall ((name &rest arg-types) success-form &rest args)
252     `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
253     ,@args)))
254     (if (minusp result)
255     (progn
256     (unix-get-errno)
257     (values nil unix-errno))
258     ,success-form)))
259 dtc 1.1
260 toy 1.17 ;;; Like syscall, but if it fails, signal an error instead of returning error
261 dtc 1.2 ;;; codes. Should only be used for syscalls that will never really get an
262     ;;; error.
263     ;;;
264     (defmacro syscall* ((name &rest arg-types) success-form &rest args)
265     `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
266     ,@args)))
267     (if (minusp result)
268     (error "Syscall ~A failed: ~A" ,name (get-unix-error-msg))
269     ,success-form)))
270 dtc 1.1
271 dtc 1.2 (defmacro void-syscall ((name &rest arg-types) &rest args)
272     `(syscall (,name ,@arg-types) (values t 0) ,@args))
273 dtc 1.1
274 dtc 1.2 (defmacro int-syscall ((name &rest arg-types) &rest args)
275     `(syscall (,name ,@arg-types) (values result 0) ,@args))
276 dtc 1.1
277 dtc 1.2 (defun unix-get-errno ()
278     "Get the unix errno value in errno..."
279     (void-syscall ("update_errno")))
280     ;;; From stdio.h
281 dtc 1.1
282 dtc 1.2 ;;; Unix-rename accepts two files names and renames the first to the second.
283 dtc 1.1
284 dtc 1.2 (defun unix-rename (name1 name2)
285     "Unix-rename renames the file with string name1 to the string
286     name2. NIL and an error code is returned if an error occured."
287     (declare (type unix-pathname name1 name2))
288     (void-syscall ("rename" c-string c-string) name1 name2))
289 dtc 1.1
290 dtc 1.2 ;;; From sys/types.h
291     ;;; and
292     ;;; gnu/types.h
293 dtc 1.1
294 dtc 1.2 (defconstant +max-s-long+ 2147483647)
295     (defconstant +max-u-long+ 4294967295)
296 dtc 1.1
297 toy 1.18 (def-alien-type quad-t #+alpha long #-alpha (array long 2))
298     (def-alien-type uquad-t #+alpha unsigned-long
299     #-alpha (array unsigned-long 2))
300 dtc 1.2 (def-alien-type qaddr-t (* quad-t))
301     (def-alien-type daddr-t int)
302     (def-alien-type caddr-t (* char))
303     (def-alien-type swblk-t long)
304 pw 1.4 (def-alien-type size-t #-alpha unsigned-int #+alpha long)
305 dtc 1.2 (def-alien-type time-t long)
306     (def-alien-type clock-t long)
307     (def-alien-type uid-t unsigned-int)
308 pw 1.4 (def-alien-type ssize-t #-alpha int #+alpha long)
309 dtc 1.2 (def-alien-type key-t int)
310     (def-alien-type int8-t char)
311     (def-alien-type u-int8-t unsigned-char)
312     (def-alien-type int16-t short)
313     (def-alien-type u-int16-t unsigned-short)
314     (def-alien-type int32-t int)
315     (def-alien-type u-int32-t unsigned-int)
316 toy 1.18 (def-alien-type int64-t #+alpha long #-alpha (array long 2))
317     (def-alien-type u-int64-t #+alpha unsigned-long #-alpha (array unsigned-long 2))
318 pw 1.4 (def-alien-type register-t #-alpha int #+alpha long)
319 dtc 1.1
320    
321 toy 1.18 (def-alien-type dev-t u-int64-t)
322 dtc 1.2 (def-alien-type uid-t unsigned-int)
323     (def-alien-type gid-t unsigned-int)
324 toy 1.18 (def-alien-type ino-t u-int32-t)
325 dtc 1.2 (def-alien-type mode-t unsigned-int)
326     (def-alien-type nlink-t unsigned-int)
327     (def-alien-type off-t long)
328     (def-alien-type loff-t quad-t)
329     (def-alien-type pid-t int)
330 toy 1.18 ;(def-alien-type ssize-t #-alpha int #+alpha long)
331 dtc 1.1
332 dtc 1.2 (def-alien-type fsid-t (array int 2))
333 dtc 1.1
334 pw 1.4 (def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int)
335    
336 dtc 1.2 (defconstant fd-setsize 1024)
337 pw 1.4 (defconstant nfdbits 32)
338    
339 dtc 1.2 (def-alien-type nil
340     (struct fd-set
341 pw 1.4 (fds-bits (array fd-mask #.(/ fd-setsize nfdbits)))))
342 dtc 1.1
343 dtc 1.2 (def-alien-type key-t int)
344 dtc 1.1
345 dtc 1.2 (def-alien-type ipc-pid-t unsigned-short)
346 dtc 1.1
347 dtc 1.2 ;;; direntry.h
348 dtc 1.1
349     (def-alien-type nil
350     (struct direct
351 dtc 1.2 (d-ino long); inode number of entry
352     (d-off off-t) ; offset of next disk directory entry
353 dtc 1.1 (d-reclen unsigned-short) ; length of this record
354 dtc 1.2 (d_type unsigned-char)
355 dtc 1.1 (d-name (array char 256)))) ; name must be no longer than this
356 dtc 1.2 ;;; dirent.h
357 dtc 1.1
358 dtc 1.2 ;;; Operations on Unix Directories.
359 dtc 1.1
360 dtc 1.2 (export '(open-dir read-dir close-dir))
361 dtc 1.1
362 dtc 1.2 (defstruct (directory
363     (:print-function %print-directory))
364     name
365     (dir-struct (required-argument) :type system-area-pointer))
366 dtc 1.1
367 dtc 1.2 (defun %print-directory (dir stream depth)
368     (declare (ignore depth))
369     (format stream "#<Directory ~S>" (directory-name dir)))
370 dtc 1.1
371 dtc 1.2 (defun open-dir (pathname)
372     (declare (type unix-pathname pathname))
373     (when (string= pathname "")
374     (setf pathname "."))
375     (let ((kind (unix-file-kind pathname)))
376     (case kind
377     (:directory
378     (let ((dir-struct
379     (alien-funcall (extern-alien "opendir"
380     (function system-area-pointer
381     c-string))
382     pathname)))
383     (if (zerop (sap-int dir-struct))
384     (progn (unix-get-errno)
385     (values nil unix-errno))
386     (make-directory :name pathname :dir-struct dir-struct))))
387     ((nil)
388     (values nil enoent))
389     (t
390     (values nil enotdir)))))
391 dtc 1.1
392 dtc 1.2 (defun read-dir (dir)
393     (declare (type directory dir))
394     (let ((daddr (alien-funcall (extern-alien "readdir"
395     (function system-area-pointer
396     system-area-pointer))
397     (directory-dir-struct dir))))
398     (declare (type system-area-pointer daddr))
399     (if (zerop (sap-int daddr))
400     nil
401     (with-alien ((direct (* (struct direct)) daddr))
402     (values (cast (slot direct 'd-name) c-string)
403     (slot direct 'd-ino))))))
404 dtc 1.1
405 dtc 1.2 (defun close-dir (dir)
406     (declare (type directory dir))
407     (alien-funcall (extern-alien "closedir"
408     (function void system-area-pointer))
409     (directory-dir-struct dir))
410     nil)
411 dtc 1.1
412 dtc 1.2 ;;; dlfcn.h -> in foreign.lisp
413 dtc 1.1
414 dtc 1.2 ;;; fcntl.h
415     ;;;
416     ;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
417 dtc 1.1
418 dtc 1.2 (defconstant r_ok 4 "Test for read permission")
419     (defconstant w_ok 2 "Test for write permission")
420     (defconstant x_ok 1 "Test for execute permission")
421     (defconstant f_ok 0 "Test for presence of file")
422 dtc 1.1
423 dtc 1.2 (defun unix-fcntl (fd cmd arg)
424     "Unix-fcntl manipulates file descriptors accoridng to the
425     argument CMD which can be one of the following:
426 dtc 1.1
427 dtc 1.2 F-DUPFD Duplicate a file descriptor.
428     F-GETFD Get file descriptor flags.
429     F-SETFD Set file descriptor flags.
430     F-GETFL Get file flags.
431     F-SETFL Set file flags.
432     F-GETOWN Get owner.
433     F-SETOWN Set owner.
434 dtc 1.1
435 dtc 1.2 The flags that can be specified for F-SETFL are:
436 dtc 1.1
437 dtc 1.2 FNDELAY Non-blocking reads.
438     FAPPEND Append on each write.
439     FASYNC Signal pgrp when data ready.
440     FCREAT Create if nonexistant.
441     FTRUNC Truncate to zero length.
442     FEXCL Error if already created.
443     "
444     (declare (type unix-fd fd)
445 pw 1.11 (type (unsigned-byte 32) cmd)
446     (type (unsigned-byte 32) arg))
447 pw 1.12 (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg))
448 dtc 1.1
449 dtc 1.2 (defun unix-open (path flags mode)
450     "Unix-open opens the file whose pathname is specified by path
451     for reading and/or writing as specified by the flags argument.
452     The flags argument can be:
453 dtc 1.1
454 dtc 1.2 o_rdonly Read-only flag.
455     o_wronly Write-only flag.
456     o_rdwr Read-and-write flag.
457     o_append Append flag.
458     o_creat Create-if-nonexistant flag.
459     o_trunc Truncate-to-size-0 flag.
460     o_excl Error if the file allready exists
461     o_noctty Don't assign controlling tty
462     o_ndelay Non-blocking I/O
463     o_sync Synchronous I/O
464     o_async Asynchronous I/O
465 dtc 1.1
466 dtc 1.2 If the o_creat flag is specified, then the file is created with
467     a permission of argument mode if the file doesn't exist. An
468     integer file descriptor is returned by unix-open."
469     (declare (type unix-pathname path)
470     (type fixnum flags)
471     (type unix-file-mode mode))
472     (int-syscall ("open" c-string int int) path flags mode))
473 dtc 1.1
474 dtc 1.2 (defun unix-getdtablesize ()
475     "Unix-getdtablesize returns the maximum size of the file descriptor
476     table. (i.e. the maximum number of descriptors that can exist at
477     one time.)"
478     (int-syscall ("getdtablesize")))
479 dtc 1.1
480 dtc 1.2 ;;; Unix-close accepts a file descriptor and attempts to close the file
481     ;;; associated with it.
482 dtc 1.1
483 dtc 1.2 (defun unix-close (fd)
484     "Unix-close takes an integer file descriptor as an argument and
485     closes the file associated with it. T is returned upon successful
486     completion, otherwise NIL and an error number."
487     (declare (type unix-fd fd))
488     (void-syscall ("close" int) fd))
489 dtc 1.1
490 dtc 1.2 ;;; Unix-creat accepts a file name and a mode. It creates a new file
491     ;;; with name and sets it mode to mode (as for chmod).
492 dtc 1.1
493 dtc 1.2 (defun unix-creat (name mode)
494     "Unix-creat accepts a file name and a mode (same as those for
495     unix-chmod) and creates a file by that name with the specified
496     permission mode. It returns a file descriptor on success,
497     or NIL and an error number otherwise.
498 dtc 1.1
499 dtc 1.2 This interface is made obsolete by UNIX-OPEN."
500 dtc 1.1
501 dtc 1.2 (declare (type unix-pathname name)
502     (type unix-file-mode mode))
503     (int-syscall ("creat" c-string int) name mode))
504    
505     ;;; fcntlbits.h
506 dtc 1.1
507 dtc 1.2 (defconstant o_read o_rdonly "Open for reading")
508     (defconstant o_write o_wronly "Open for writing")
509 dtc 1.1
510 dtc 1.2 (defconstant o_rdonly 0 "Read-only flag.")
511     (defconstant o_wronly 1 "Write-only flag.")
512     (defconstant o_rdwr 2 "Read-write flag.")
513     (defconstant o_accmode 3 "Access mode mask.")
514 pw 1.4
515     #-alpha
516     (progn
517     (defconstant o_creat #o100 "Create if nonexistant flag. (not fcntl)")
518     (defconstant o_excl #o200 "Error if already exists. (not fcntl)")
519     (defconstant o_noctty #o400 "Don't assign controlling tty. (not fcntl)")
520     (defconstant o_trunc #o1000 "Truncate flag. (not fcntl)")
521     (defconstant o_append #o2000 "Append flag.")
522     (defconstant o_ndelay #o4000 "Non-blocking I/O")
523     (defconstant o_nonblock #o4000 "Non-blocking I/O")
524     (defconstant o_ndelay o_nonblock)
525     (defconstant o_sync #o10000 "Synchronous writes (on ext2)")
526     (defconstant o_fsync o_sync)
527     (defconstant o_async #o20000 "Asynchronous I/O"))
528     #+alpha
529     (progn
530     (defconstant o_creat #o1000 "Create if nonexistant flag. (not fcntl)")
531     (defconstant o_trunc #o2000 "Truncate flag. (not fcntl)")
532     (defconstant o_excl #o4000 "Error if already exists. (not fcntl)")
533     (defconstant o_noctty #o10000 "Don't assign controlling tty. (not fcntl)")
534     (defconstant o_nonblock #o4 "Non-blocking I/O")
535     (defconstant o_append #o10 "Append flag.")
536     (defconstant o_ndelay o_nonblock)
537     (defconstant o_sync #o40000 "Synchronous writes (on ext2)")
538     (defconstant o_fsync o_sync)
539     (defconstant o_async #o20000 "Asynchronous I/O"))
540 dtc 1.1
541 dtc 1.2 (defconstant f-dupfd 0 "Duplicate a file descriptor")
542     (defconstant f-getfd 1 "Get file desc. flags")
543     (defconstant f-setfd 2 "Set file desc. flags")
544     (defconstant f-getfl 3 "Get file flags")
545     (defconstant f-setfl 4 "Set file flags")
546 pw 1.4
547     #-alpha
548     (progn
549     (defconstant f-getlk 5 "Get lock")
550     (defconstant f-setlk 6 "Set lock")
551     (defconstant f-setlkw 7 "Set lock, wait for release")
552     (defconstant f-setown 8 "Set owner (for sockets)")
553     (defconstant f-getown 9 "Get owner (for sockets)"))
554     #+alpha
555     (progn
556     (defconstant f-getlk 7 "Get lock")
557     (defconstant f-setlk 8 "Set lock")
558     (defconstant f-setlkw 9 "Set lock, wait for release")
559     (defconstant f-setown 5 "Set owner (for sockets)")
560     (defconstant f-getown 6 "Get owner (for sockets)"))
561    
562    
563 dtc 1.2
564     (defconstant F-CLOEXEC 1 "for f-getfl and f-setfl")
565    
566 pw 1.4 #-alpha
567     (progn
568     (defconstant F-RDLCK 0 "for fcntl and lockf")
569     (defconstant F-WDLCK 1 "for fcntl and lockf")
570     (defconstant F-UNLCK 2 "for fcntl and lockf")
571     (defconstant F-EXLCK 4 "old bsd flock (depricated)")
572     (defconstant F-SHLCK 8 "old bsd flock (depricated)"))
573     #+alpha
574     (progn
575     (defconstant F-RDLCK 1 "for fcntl and lockf")
576     (defconstant F-WDLCK 2 "for fcntl and lockf")
577     (defconstant F-UNLCK 8 "for fcntl and lockf")
578     (defconstant F-EXLCK 16 "old bsd flock (depricated)")
579     (defconstant F-SHLCK 32 "old bsd flock (depricated)"))
580 dtc 1.1
581 dtc 1.2 (defconstant F-LOCK-SH 1 "Shared lock for bsd flock")
582     (defconstant F-LOCK-EX 2 "Exclusive lock for bsd flock")
583     (defconstant F-LOCK-NB 4 "Don't block. Combine with F-LOCK-SH or F-LOCK-EX")
584     (defconstant F-LOCK-UN 8 "Remove lock for bsd flock")
585 dtc 1.1
586 dtc 1.2 (def-alien-type nil
587     (struct flock
588     (l-type short)
589     (l-whence short)
590     (l-start off-t)
591     (l-len off-t)
592     (l-pid pid-t)))
593 dtc 1.1
594 dtc 1.2 ;;; Define some more compatibility macros to be backward compatible with
595     ;;; BSD systems which did not managed to hide these kernel macros.
596 dtc 1.1
597 dtc 1.2 (defconstant FAPPEND o_append "depricated stuff")
598     (defconstant FFSYNC o_fsync "depricated stuff")
599     (defconstant FASYNC o_async "depricated stuff")
600     (defconstant FNONBLOCK o_nonblock "depricated stuff")
601     (defconstant FNDELAY o_ndelay "depricated stuff")
602 dtc 1.1
603    
604 dtc 1.2 ;;; grp.h
605 dtc 1.1
606 dtc 1.2 ;;; POSIX Standard: 9.2.1 Group Database Access <grp.h>
607 dtc 1.1
608 dtc 1.2 #+nil
609     (defun unix-setgrend ()
610     "Rewind the group-file stream."
611     (void-syscall ("setgrend")))
612 dtc 1.1
613 dtc 1.2 #+nil
614     (defun unix-endgrent ()
615     "Close the group-file stream."
616     (void-syscall ("endgrent")))
617 dtc 1.1
618 dtc 1.2 #+nil
619     (defun unix-getgrent ()
620     "Read an entry from the group-file stream, opening it if necessary."
621    
622     (let ((result (alien-funcall (extern-alien "getgrent"
623     (function (* (struct group)))))))
624     (declare (type system-area-pointer result))
625     (if (zerop (sap-int result))
626     nil
627     result)))
628 dtc 1.1
629 dtc 1.2 ;;; ioctl-types.h
630 dtc 1.1
631 dtc 1.2 (def-alien-type nil
632     (struct winsize
633     (ws-row unsigned-short) ; rows, in characters
634     (ws-col unsigned-short) ; columns, in characters
635     (ws-xpixel unsigned-short) ; horizontal size, pixels
636     (ws-ypixel unsigned-short))) ; veritical size, pixels
637 dtc 1.1
638 dtc 1.2 (defconstant +NCC+ 8
639     "Size of control character vector.")
640 dtc 1.1
641 dtc 1.2 (def-alien-type nil
642     (struct termio
643     (c-iflag unsigned-int) ; input mode flags
644     (c-oflag unsigned-int) ; output mode flags
645     (c-cflag unsigned-int) ; control mode flags
646     (c-lflag unsigned-int) ; local mode flags
647     (c-line unsigned-char) ; line discipline
648     (c-cc (array unsigned-char #.+NCC+)))) ; control characters
649 dtc 1.1
650 dtc 1.2 ;;; modem lines
651     (defconstant tiocm-le 1)
652     (defconstant tiocm-dtr 2)
653     (defconstant tiocm-rts 4)
654     (defconstant tiocm-st 8)
655     (defconstant tiocm-sr #x10)
656     (defconstant tiocm-cts #x20)
657     (defconstant tiocm-car #x40)
658     (defconstant tiocm-rng #x80)
659     (defconstant tiocm-dsr #x100)
660     (defconstant tiocm-cd tiocm-car)
661     (defconstant tiocm-ri #x80)
662 dtc 1.1
663 dtc 1.2 ;;; ioctl (fd, TIOCSERGETLSR, &result) where result may be as below
664 dtc 1.1
665 dtc 1.2 ;;; line disciplines
666     (defconstant N-TTY 0)
667     (defconstant N-SLIP 1)
668     (defconstant N-MOUSE 2)
669     (defconstant N-PPP 3)
670     (defconstant N-STRIP 4)
671     (defconstant N-AX25 5)
672    
673    
674     ;;; ioctls.h
675    
676     ;;; Routing table calls.
677     (defconstant siocaddrt #x890B) ;; add routing table entry
678     (defconstant siocdelrt #x890C) ;; delete routing table entry
679     (defconstant siocrtmsg #x890D) ;; call to routing system
680    
681     ;;; Socket configuration controls.
682     (defconstant siocgifname #x8910) ;; get iface name
683     (defconstant siocsiflink #x8911) ;; set iface channel
684     (defconstant siocgifconf #x8912) ;; get iface list
685     (defconstant siocgifflags #x8913) ;; get flags
686     (defconstant siocsifflags #x8914) ;; set flags
687     (defconstant siocgifaddr #x8915) ;; get PA address
688     (defconstant siocsifaddr #x8916) ;; set PA address
689     (defconstant siocgifdstaddr #x8917 ) ;; get remote PA address
690     (defconstant siocsifdstaddr #x8918 ) ;; set remote PA address
691     (defconstant siocgifbrdaddr #x8919 ) ;; get broadcast PA address
692     (defconstant siocsifbrdaddr #x891a ) ;; set broadcast PA address
693     (defconstant siocgifnetmask #x891b ) ;; get network PA mask
694     (defconstant siocsifnetmask #x891c ) ;; set network PA mask
695     (defconstant siocgifmetric #x891d ) ;; get metric
696     (defconstant siocsifmetric #x891e ) ;; set metric
697     (defconstant siocgifmem #x891f ) ;; get memory address (BSD)
698     (defconstant siocsifmem #x8920 ) ;; set memory address (BSD)
699     (defconstant siocgifmtu #x8921 ) ;; get MTU size
700     (defconstant siocsifmtu #x8922 ) ;; set MTU size
701     (defconstant siocsifhwaddr #x8924 ) ;; set hardware address
702     (defconstant siocgifencap #x8925 ) ;; get/set encapsulations
703     (defconstant siocsifencap #x8926)
704     (defconstant siocgifhwaddr #x8927 ) ;; Get hardware address
705     (defconstant siocgifslave #x8929 ) ;; Driver slaving support
706     (defconstant siocsifslave #x8930)
707     (defconstant siocaddmulti #x8931 ) ;; Multicast address lists
708     (defconstant siocdelmulti #x8932)
709     (defconstant siocgifindex #x8933 ) ;; name -> if_index mapping
710     (defconstant siogifindex SIOCGIFINDEX ) ;; misprint compatibility :-)
711     (defconstant siocsifpflags #x8934 ) ;; set/get extended flags set
712     (defconstant siocgifpflags #x8935)
713     (defconstant siocdifaddr #x8936 ) ;; delete PA address
714     (defconstant siocsifhwbroadcast #x8937 ) ;; set hardware broadcast addr
715     (defconstant siocgifcount #x8938 ) ;; get number of devices
716    
717     (defconstant siocgifbr #x8940 ) ;; Bridging support
718     (defconstant siocsifbr #x8941 ) ;; Set bridging options
719    
720     (defconstant siocgiftxqlen #x8942 ) ;; Get the tx queue length
721     (defconstant siocsiftxqlen #x8943 ) ;; Set the tx queue length
722    
723    
724     ;;; ARP cache control calls.
725     ;; 0x8950 - 0x8952 * obsolete calls, don't re-use
726     (defconstant siocdarp #x8953 ) ;; delete ARP table entry
727     (defconstant siocgarp #x8954 ) ;; get ARP table entry
728     (defconstant siocsarp #x8955 ) ;; set ARP table entry
729    
730     ;;; RARP cache control calls.
731     (defconstant siocdrarp #x8960 ) ;; delete RARP table entry
732     (defconstant siocgrarp #x8961 ) ;; get RARP table entry
733     (defconstant siocsrarp #x8962 ) ;; set RARP table entry
734    
735     ;;; Driver configuration calls
736    
737     (defconstant siocgifmap #x8970 ) ;; Get device parameters
738     (defconstant siocsifmap #x8971 ) ;; Set device parameters
739    
740     ;;; DLCI configuration calls
741    
742     (defconstant siocadddlci #x8980 ) ;; Create new DLCI device
743     (defconstant siocdeldlci #x8981 ) ;; Delete DLCI device
744    
745     ;;; Device private ioctl calls.
746    
747     ;; These 16 ioctls are available to devices via the do_ioctl() device
748     ;; vector. Each device should include this file and redefine these
749     ;; names as their own. Because these are device dependent it is a good
750     ;; idea _NOT_ to issue them to random objects and hope.
751 dtc 1.1
752 dtc 1.2 (defconstant siocdevprivate #x89F0 ) ;; to 89FF
753 dtc 1.1
754    
755 dtc 1.2 ;;; mathcalls.h
756 dtc 1.1
757 dtc 1.2 #+nil
758     (defmacro def-math-rtn (name num-args)
759     (let ((function (intern (concatenate 'simple-string
760     "%"
761     (string-upcase name)))))
762     `(progn
763 pw 1.15 (declaim (inline ,function))
764 dtc 1.2 (export ',function)
765     (alien:def-alien-routine (,name ,function) double-float
766     ,@(let ((results nil))
767     (dotimes (i num-args (nreverse results))
768     (push (list (intern (format nil "ARG-~D" i))
769     'double-float)
770     results)))))))
771 dtc 1.1
772 dtc 1.2 #+nil
773     (defmacro def-math-rtn-int-double (name num-args)
774     (let ((function (intern (concatenate 'simple-string
775     "%"
776     (string-upcase name)))))
777     `(progn
778 pw 1.15 (declaim (inline ,function))
779 dtc 1.2 (export ',function)
780     (alien:def-alien-routine (,name ,function) double-float
781     (ARG-1 'integer)
782     (ARG-2 'double)))))
783 dtc 1.1
784 dtc 1.2 #+nil
785     (def-math-rtn "expm1" 1) ;Return exp(X) - 1.
786 dtc 1.1
787 dtc 1.2 #+nil
788     (def-math-rtn "log1p" 1) ;Return log(1 + X).
789 dtc 1.1
790    
791 dtc 1.2 #+nil
792     (def-math-rtn "logb" 1) ;Return the base 2 signed integral exponent of X.
793 dtc 1.1
794 dtc 1.2 #+nil
795     (def-math-rtn "cbrt" 1) ; returns cuberoot
796 dtc 1.1
797 dtc 1.2 #+nil
798     (def-math-rtn "copysign" 2) ;Return X with its signed changed to Y's.
799 dtc 1.1
800 dtc 1.2 #+nil
801     (def-math-rtn "cabs" 2) ;Return `sqrt(X*X + Y*Y)'.
802 dtc 1.1
803 dtc 1.2 #+nil
804     (def-math-rtn "erf" 1)
805 dtc 1.1
806 dtc 1.2 #+nil
807     (def-math-rtn "erfc" 1)
808 dtc 1.1
809 dtc 1.2 #+nil
810     (def-math-rtn "gamma" 1)
811 dtc 1.1
812 dtc 1.2 #+nil
813     (def-math-rtn "j0" 1)
814 dtc 1.1
815 dtc 1.2 #+nil
816     (def-math-rtn "j1" 1)
817 dtc 1.1
818 dtc 1.2 #+nil
819     (def-math-rtn-int-double "jn")
820 dtc 1.1
821 dtc 1.2 #+nil
822     (def-math-rtn "lgamma" 1)
823 dtc 1.1
824 dtc 1.2 #+nil
825     (def-math-rtn "y0" 1)
826 dtc 1.1
827 dtc 1.2 #+nil
828     (def-math-rtn "y1" 1)
829 dtc 1.1
830 dtc 1.2 #+nil
831     (def-math-rtn-int-double "yn")
832 dtc 1.1
833 dtc 1.2 ;;; netdb.h
834 dtc 1.1
835 dtc 1.2 ;; All data returned by the network data base library are supplied in
836     ;; host order and returned in network order (suitable for use in
837     ;; system calls).
838    
839     ;;; Absolute file name for network data base files.
840     (defconstant path-hequiv "/etc/hosts.equiv")
841     (defconstant path-hosts "/etc/hosts")
842     (defconstant path-networks "/etc/networks")
843     (defconstant path-nsswitch_conf "/etc/nsswitch.conf")
844     (defconstant path-protocols "/etc/protocols")
845     (defconstant path-services "/etc/services")
846    
847    
848     ;;; Possible values left in `h_errno'.
849     (defconstant netdb-internal -1 "See errno.")
850     (defconstant netdb-success 0 "No problem.")
851     (defconstant host-not-found 1 "Authoritative Answer Host not found.")
852     (defconstant try-again 2 "Non-Authoritative Host not found,or SERVERFAIL.")
853     (defconstant no-recovery 3 "Non recoverable errors, FORMERR, REFUSED, NOTIMP.")
854     (defconstant no-data 4 "Valid name, no data record of requested type.")
855     (defconstant no-address no-data "No address, look for MX record.")
856 dtc 1.1
857 dtc 1.2 ;;; Description of data base entry for a single host.
858 dtc 1.1
859 dtc 1.2 (def-alien-type nil
860     (struct hostent
861     (h-name c-string) ; Official name of host.
862     (h-aliases (* c-string)) ; Alias list.
863     (h-addrtype int) ; Host address type.
864     (h_length int) ; Length of address.
865     (h-addr-list (* c-string)))) ; List of addresses from name server.
866 dtc 1.1
867 dtc 1.2 #+nil
868     (defun unix-sethostent (stay-open)
869     "Open host data base files and mark them as staying open even after
870     a later search if STAY_OPEN is non-zero."
871     (void-syscall ("sethostent" int) stay-open))
872 dtc 1.1
873 dtc 1.2 #+nil
874     (defun unix-endhostent ()
875     "Close host data base files and clear `stay open' flag."
876     (void-syscall ("endhostent")))
877 dtc 1.1
878 dtc 1.2 #+nil
879     (defun unix-gethostent ()
880     "Get next entry from host data base file. Open data base if
881     necessary."
882     (let ((result (alien-funcall (extern-alien "gethostent"
883     (function (* (struct hostent)))))))
884     (declare (type system-area-pointer result))
885     (if (zerop (sap-int result))
886     nil
887     result)))
888 dtc 1.1
889 dtc 1.2 #+nil
890     (defun unix-gethostbyaddr(addr length type)
891     "Return entry from host data base which address match ADDR with
892     length LEN and type TYPE."
893     (let ((result (alien-funcall (extern-alien "gethostbyaddr"
894     (function (* (struct hostent))
895     c-string int int))
896     addr len type)))
897     (declare (type system-area-pointer result))
898     (if (zerop (sap-int result))
899     nil
900     result)))
901 dtc 1.1
902 dtc 1.2 #+nil
903     (defun unix-gethostbyname (name)
904     "Return entry from host data base for host with NAME."
905     (let ((result (alien-funcall (extern-alien "gethostbyname"
906     (function (* (struct hostent))
907     c-string))
908     name)))
909     (declare (type system-area-pointer result))
910     (if (zerop (sap-int result))
911     nil
912     result)))
913 dtc 1.1
914 dtc 1.2 #+nil
915     (defun unix-gethostbyname2 (name af)
916     "Return entry from host data base for host with NAME. AF must be
917     set to the address type which as `AF_INET' for IPv4 or `AF_INET6'
918     for IPv6."
919     (let ((result (alien-funcall (extern-alien "gethostbyname2"
920     (function (* (struct hostent))
921     c-string int))
922     name af)))
923     (declare (type system-area-pointer result))
924     (if (zerop (sap-int result))
925     nil
926     result)))
927 dtc 1.1
928 dtc 1.2 ;; Description of data base entry for a single network. NOTE: here a
929     ;; poor assumption is made. The network number is expected to fit
930     ;; into an unsigned long int variable.
931 dtc 1.1
932 dtc 1.2 (def-alien-type nil
933     (struct netent
934     (n-name c-string) ; Official name of network.
935     (n-aliases (* c-string)) ; Alias list.
936     (n-addrtype int) ; Net address type.
937     (n-net unsigned-long))) ; Network number.
938 dtc 1.1
939 dtc 1.2 #+nil
940     (defun unix-setnetent (stay-open)
941     "Open network data base files and mark them as staying open even
942     after a later search if STAY_OPEN is non-zero."
943     (void-syscall ("setnetent" int) stay-open))
944 dtc 1.1
945    
946 dtc 1.2 #+nil
947     (defun unix-endnetent ()
948     "Close network data base files and clear `stay open' flag."
949     (void-syscall ("endnetent")))
950 dtc 1.1
951    
952 dtc 1.2 #+nil
953     (defun unix-getnetent ()
954     "Get next entry from network data base file. Open data base if
955     necessary."
956     (let ((result (alien-funcall (extern-alien "getnetent"
957     (function (* (struct netent)))))))
958     (declare (type system-area-pointer result))
959     (if (zerop (sap-int result))
960     nil
961     result)))
962 dtc 1.1
963    
964 dtc 1.2 #+nil
965     (defun unix-getnetbyaddr (net type)
966     "Return entry from network data base which address match NET and
967     type TYPE."
968     (let ((result (alien-funcall (extern-alien "getnetbyaddr"
969     (function (* (struct netent))
970     unsigned-long int))
971     net type)))
972     (declare (type system-area-pointer result))
973     (if (zerop (sap-int result))
974     nil
975     result)))
976 dtc 1.1
977 dtc 1.2 #+nil
978     (defun unix-getnetbyname (name)
979     "Return entry from network data base for network with NAME."
980     (let ((result (alien-funcall (extern-alien "getnetbyname"
981     (function (* (struct netent))
982     c-string))
983     name)))
984     (declare (type system-area-pointer result))
985     (if (zerop (sap-int result))
986     nil
987     result)))
988 dtc 1.1
989 dtc 1.2 ;; Description of data base entry for a single service.
990     (def-alien-type nil
991     (struct servent
992     (s-name c-string) ; Official service name.
993     (s-aliases (* c-string)) ; Alias list.
994     (s-port int) ; Port number.
995     (s-proto c-string))) ; Protocol to use.
996 dtc 1.1
997 dtc 1.2 #+nil
998     (defun unix-setservent (stay-open)
999     "Open service data base files and mark them as staying open even
1000     after a later search if STAY_OPEN is non-zero."
1001     (void-syscall ("setservent" int) stay-open))
1002 dtc 1.1
1003 dtc 1.2 #+nil
1004     (defun unix-endservent (stay-open)
1005     "Close service data base files and clear `stay open' flag."
1006     (void-syscall ("endservent")))
1007 dtc 1.1
1008    
1009 dtc 1.2 #+nil
1010     (defun unix-getservent ()
1011     "Get next entry from service data base file. Open data base if
1012     necessary."
1013     (let ((result (alien-funcall (extern-alien "getservent"
1014     (function (* (struct servent)))))))
1015     (declare (type system-area-pointer result))
1016     (if (zerop (sap-int result))
1017     nil
1018     result)))
1019 dtc 1.1
1020 dtc 1.2 #+nil
1021     (defun unix-getservbyname (name proto)
1022     "Return entry from network data base for network with NAME and
1023     protocol PROTO."
1024     (let ((result (alien-funcall (extern-alien "getservbyname"
1025     (function (* (struct netent))
1026     c-string (* char)))
1027     name proto)))
1028     (declare (type system-area-pointer result))
1029     (if (zerop (sap-int result))
1030     nil
1031     result)))
1032 dtc 1.1
1033 dtc 1.2 #+nil
1034     (defun unix-getservbyport (port proto)
1035     "Return entry from service data base which matches port PORT and
1036     protocol PROTO."
1037     (let ((result (alien-funcall (extern-alien "getservbyport"
1038     (function (* (struct netent))
1039     int (* char)))
1040     port proto)))
1041     (declare (type system-area-pointer result))
1042     (if (zerop (sap-int result))
1043     nil
1044     result)))
1045 dtc 1.1
1046 dtc 1.2 ;; Description of data base entry for a single service.
1047 dtc 1.1
1048 dtc 1.2 (def-alien-type nil
1049     (struct protoent
1050     (p-name c-string) ; Official protocol name.
1051     (p-aliases (* c-string)) ; Alias list.
1052     (p-proto int))) ; Protocol number.
1053 dtc 1.1
1054 dtc 1.2 #+nil
1055     (defun unix-setprotoent (stay-open)
1056     "Open protocol data base files and mark them as staying open even
1057     after a later search if STAY_OPEN is non-zero."
1058     (void-syscall ("setprotoent" int) stay-open))
1059 dtc 1.1
1060 dtc 1.2 #+nil
1061     (defun unix-endprotoent ()
1062     "Close protocol data base files and clear `stay open' flag."
1063     (void-syscall ("endprotoent")))
1064 dtc 1.1
1065 dtc 1.2 #+nil
1066     (defun unix-getprotoent ()
1067     "Get next entry from protocol data base file. Open data base if
1068     necessary."
1069     (let ((result (alien-funcall (extern-alien "getprotoent"
1070     (function (* (struct protoent)))))))
1071     (declare (type system-area-pointer result))
1072     (if (zerop (sap-int result))
1073     nil
1074     result)))
1075 dtc 1.1
1076 dtc 1.2 #+nil
1077     (defun unix-getprotobyname (name)
1078     "Return entry from protocol data base for network with NAME."
1079     (let ((result (alien-funcall (extern-alien "getprotobyname"
1080     (function (* (struct protoent))
1081     c-string))
1082     name)))
1083     (declare (type system-area-pointer result))
1084     (if (zerop (sap-int result))
1085     nil
1086     result)))
1087 dtc 1.1
1088 dtc 1.2 #+nil
1089     (defun unix-getprotobynumber (proto)
1090     "Return entry from protocol data base which number is PROTO."
1091     (let ((result (alien-funcall (extern-alien "getprotobynumber"
1092     (function (* (struct protoent))
1093     int))
1094     proto)))
1095     (declare (type system-area-pointer result))
1096     (if (zerop (sap-int result))
1097     nil
1098     result)))
1099 dtc 1.1
1100 dtc 1.2 #+nil
1101     (defun unix-setnetgrent (netgroup)
1102     "Establish network group NETGROUP for enumeration."
1103     (int-syscall ("setservent" c-string) netgroup))
1104 dtc 1.1
1105 dtc 1.2 #+nil
1106     (defun unix-endnetgrent ()
1107     "Free all space allocated by previous `setnetgrent' call."
1108     (void-syscall ("endnetgrent")))
1109 dtc 1.1
1110 dtc 1.2 #+nil
1111     (defun unix-getnetgrent (hostp userp domainp)
1112     "Get next member of netgroup established by last `setnetgrent' call
1113     and return pointers to elements in HOSTP, USERP, and DOMAINP."
1114     (int-syscall ("getnetgrent" (* c-string) (* c-string) (* c-string))
1115     hostp userp domainp))
1116 dtc 1.1
1117 dtc 1.2 #+nil
1118     (defun unix-innetgr (netgroup host user domain)
1119     "Test whether NETGROUP contains the triple (HOST,USER,DOMAIN)."
1120     (int-syscall ("innetgr" c-string c-string c-string c-string)
1121     netgroup host user domain))
1122 dtc 1.1
1123 dtc 1.2 (def-alien-type nil
1124     (struct addrinfo
1125     (ai-flags int) ; Input flags.
1126     (ai-family int) ; Protocol family for socket.
1127     (ai-socktype int) ; Socket type.
1128     (ai-protocol int) ; Protocol for socket.
1129     (ai-addrlen int) ; Length of socket address.
1130     (ai-addr (* (struct sockaddr)))
1131     ; Socket address for socket.
1132     (ai-cononname c-string)
1133     ; Canonical name for service location.
1134     (ai-net (* (struct addrinfo))))) ; Pointer to next in list.
1135    
1136     ;; Possible values for `ai_flags' field in `addrinfo' structure.
1137    
1138     (defconstant ai_passive 1 "Socket address is intended for `bind'.")
1139     (defconstant ai_canonname 2 "Request for canonical name.")
1140    
1141     ;; Error values for `getaddrinfo' function.
1142     (defconstant eai_badflags -1 "Invalid value for `ai_flags' field.")
1143     (defconstant eai_noname -2 "NAME or SERVICE is unknown.")
1144     (defconstant eai_again -3 "Temporary failure in name resolution.")
1145     (defconstant eai_fail -4 "Non-recoverable failure in name res.")
1146     (defconstant eai_nodata -5 "No address associated with NAME.")
1147     (defconstant eai_family -6 "ai_family not supported.")
1148     (defconstant eai_socktype -7 "ai_socktype not supported.")
1149     (defconstant eai_service -8 "SERVICE not supported for ai_socktype.")
1150     (defconstant eai_addrfamily -9 "Address family for NAME not supported.")
1151     (defconstant eai_memory -10 "Memory allocation failure.")
1152     (defconstant eai_system -11 "System error returned in errno.")
1153 dtc 1.1
1154    
1155 dtc 1.2 #+nil
1156     (defun unix-getaddrinfo (name service req pai)
1157     "Translate name of a service location and/or a service name to set of
1158     socket addresses."
1159     (int-syscall ("getaddrinfo" c-string c-string (* (struct addrinfo))
1160     (* (* struct addrinfo)))
1161     name service req pai))
1162 dtc 1.1
1163    
1164 dtc 1.2 #+nil
1165     (defun unix-freeaddrinfo (ai)
1166     "Free `addrinfo' structure AI including associated storage."
1167     (void-syscall ("freeaddrinfo" (* struct addrinfo))
1168     ai))
1169 dtc 1.1
1170    
1171 dtc 1.2 ;;; pty.h
1172 dtc 1.1
1173 dtc 1.2 #+nil
1174     (defun unix-openpty (amaster aslave name termp winp)
1175     "Create pseudo tty master slave pair with NAME and set terminal
1176     attributes according to TERMP and WINP and return handles for both
1177     ends in AMASTER and ASLAVE."
1178     (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))
1179     (* (struct winsize)))
1180     amaster aslave name termp winp))
1181 dtc 1.1
1182 dtc 1.2 #+nil
1183     (defun unix-forkpty (amaster name termp winp)
1184     "Create child process and establish the slave pseudo terminal as the
1185     child's controlling terminal."
1186     (int-syscall ("forkpty" (* int) c-string (* (struct termios))
1187     (* (struct winsize)))
1188     amaster name termp winp))
1189 dtc 1.1
1190 toy 1.17
1191 dtc 1.2 ;; POSIX Standard: 9.2.2 User Database Access <pwd.h>
1192 dtc 1.1
1193 dtc 1.2 #+nil
1194     (defun unix-setpwent ()
1195     "Rewind the password-file stream."
1196     (void-syscall ("setpwent")))
1197 dtc 1.1
1198 dtc 1.2 #+nil
1199     (defun unix-endpwent ()
1200     "Close the password-file stream."
1201     (void-syscall ("endpwent")))
1202 dtc 1.1
1203 dtc 1.2 #+nil
1204     (defun unix-getpwent ()
1205     "Read an entry from the password-file stream, opening it if necessary."
1206     (let ((result (alien-funcall (extern-alien "getpwent"
1207     (function (* (struct passwd)))))))
1208     (declare (type system-area-pointer result))
1209     (if (zerop (sap-int result))
1210     nil
1211 dtc 1.7 result)))
1212 dtc 1.1
1213 dtc 1.2 ;;; resourcebits.h
1214 dtc 1.1
1215 dtc 1.2 (def-alien-type nil
1216     (struct rlimit
1217     (rlim-cur long) ; current (soft) limit
1218     (rlim-max long))); maximum value for rlim-cur
1219 dtc 1.1
1220 dtc 1.2 (defconstant rusage_self 0 "The calling process.")
1221     (defconstant rusage_children -1 "Terminated child processes.")
1222     (defconstant rusage_both -2)
1223 dtc 1.1
1224 dtc 1.2 (def-alien-type nil
1225     (struct rusage
1226     (ru-utime (struct timeval)) ; user time used
1227     (ru-stime (struct timeval)) ; system time used.
1228     (ru-maxrss long) ; Maximum resident set size (in kilobytes)
1229     (ru-ixrss long) ; integral shared memory size
1230     (ru-idrss long) ; integral unshared data "
1231     (ru-isrss long) ; integral unshared stack "
1232     (ru-minflt long) ; page reclaims
1233     (ru-majflt long) ; page faults
1234     (ru-nswap long) ; swaps
1235     (ru-inblock long) ; block input operations
1236     (ru-oublock long) ; block output operations
1237     (ru-msgsnd long) ; messages sent
1238     (ru-msgrcv long) ; messages received
1239     (ru-nsignals long) ; signals received
1240     (ru-nvcsw long) ; voluntary context switches
1241     (ru-nivcsw long))) ; involuntary "
1242 dtc 1.1
1243 dtc 1.2 ;; Priority limits.
1244 dtc 1.1
1245 dtc 1.2 (defconstant prio-min -20 "Minimum priority a process can have")
1246     (defconstant prio-max 20 "Maximum priority a process can have")
1247 dtc 1.1
1248    
1249 dtc 1.2 ;;; The type of the WHICH argument to `getpriority' and `setpriority',
1250     ;;; indicating what flavor of entity the WHO argument specifies.
1251 dtc 1.1
1252 dtc 1.2 (defconstant priority-process 0 "WHO is a process ID")
1253     (defconstant priority-pgrp 1 "WHO is a process group ID")
1254     (defconstant priority-user 2 "WHO is a user ID")
1255 dtc 1.1
1256 dtc 1.2 ;;; sched.h
1257 dtc 1.1
1258 dtc 1.2 #+nil
1259     (defun unix-sched_setparam (pid param)
1260     "Rewind the password-file stream."
1261     (int-syscall ("sched_setparam" pid-t (struct psched-param))
1262     pid param))
1263 dtc 1.1
1264 dtc 1.2 #+nil
1265     (defun unix-sched_getparam (pid param)
1266     "Rewind the password-file stream."
1267     (int-syscall ("sched_getparam" pid-t (struct psched-param))
1268     pid param))
1269 dtc 1.1
1270    
1271 dtc 1.2 #+nil
1272     (defun unix-sched_setscheduler (pid policy param)
1273     "Set scheduling algorithm and/or parameters for a process."
1274     (int-syscall ("sched_setscheduler" pid-t int (struct psched-param))
1275     pid policy param))
1276 dtc 1.1
1277 dtc 1.2 #+nil
1278     (defun unix-sched_getscheduler (pid)
1279     "Retrieve scheduling algorithm for a particular purpose."
1280     (int-syscall ("sched_getscheduler" pid-t)
1281     pid))
1282 dtc 1.1
1283 dtc 1.8 (defun unix-sched-yield ()
1284 dtc 1.2 "Retrieve scheduling algorithm for a particular purpose."
1285     (int-syscall ("sched_yield")))
1286 dtc 1.1
1287 dtc 1.2 #+nil
1288     (defun unix-sched_get_priority_max (algorithm)
1289     "Get maximum priority value for a scheduler."
1290     (int-syscall ("sched_get_priority_max" int)
1291     algorithm))
1292 dtc 1.1
1293 dtc 1.2 #+nil
1294     (defun unix-sched_get_priority_min (algorithm)
1295     "Get minimum priority value for a scheduler."
1296     (int-syscall ("sched_get_priority_min" int)
1297     algorithm))
1298 dtc 1.1
1299    
1300    
1301 dtc 1.2 #+nil
1302     (defun unix-sched_rr_get_interval (pid t)
1303     "Get the SCHED_RR interval for the named process."
1304     (int-syscall ("sched_rr_get_interval" pid-t (* (struct timespec)))
1305     pid t))
1306 dtc 1.1
1307 dtc 1.2 ;;; schedbits.h
1308 dtc 1.1
1309 dtc 1.2 (defconstant scheduler-other 0)
1310     (defconstant scheduler-fifo 1)
1311     (defconstant scheduler-rr 2)
1312 dtc 1.1
1313    
1314 dtc 1.2 ;; Data structure to describe a process' schedulability.
1315 dtc 1.1
1316 dtc 1.2 (def-alien-type nil
1317     (struct sched_param
1318     (sched-priority int)))
1319 dtc 1.1
1320 dtc 1.2 ;; Cloning flags.
1321     (defconstant csignal #x000000ff "Signal mask to be sent at exit.")
1322     (defconstant clone_vm #x00000100 "Set if VM shared between processes.")
1323     (defconstant clone_fs #x00000200 "Set if fs info shared between processes")
1324     (defconstant clone_files #x00000400 "Set if open files shared between processe")
1325     (defconstant clone_sighand #x00000800 "Set if signal handlers shared.")
1326     (defconstant clone_pid #x00001000 "Set if pid shared.")
1327 dtc 1.1
1328    
1329 dtc 1.2 ;;; shadow.h
1330 dtc 1.1
1331 dtc 1.2 ;; Structure of the password file.
1332 dtc 1.1
1333 dtc 1.2 (def-alien-type nil
1334     (struct spwd
1335     (sp-namp c-string) ; Login name.
1336     (sp-pwdp c-string) ; Encrypted password.
1337     (sp-lstchg long) ; Date of last change.
1338     (sp-min long) ; Minimum number of days between changes.
1339     (sp-max long) ; Maximum number of days between changes.
1340     (sp-warn long) ; Number of days to warn user to change the password.
1341     (sp-inact long) ; Number of days the account may be inactive.
1342     (sp-expire long) ; Number of days since 1970-01-01 until account expires.
1343     (sp-flags long))) ; Reserved.
1344 dtc 1.1
1345 dtc 1.2 #+nil
1346     (defun unix-setspent ()
1347     "Open database for reading."
1348     (void-syscall ("setspent")))
1349 dtc 1.1
1350 dtc 1.2 #+nil
1351     (defun unix-endspent ()
1352     "Close database."
1353     (void-syscall ("endspent")))
1354 dtc 1.1
1355 dtc 1.2 #+nil
1356     (defun unix-getspent ()
1357     "Get next entry from database, perhaps after opening the file."
1358     (let ((result (alien-funcall (extern-alien "getspent"
1359     (function (* (struct spwd)))))))
1360     (declare (type system-area-pointer result))
1361     (if (zerop (sap-int result))
1362     nil
1363     result)))
1364 dtc 1.1
1365 dtc 1.2 #+nil
1366     (defun unix-getspnam (name)
1367     "Get shadow entry matching NAME."
1368     (let ((result (alien-funcall (extern-alien "getspnam"
1369     (function (* (struct spwd))
1370     c-string))
1371     name)))
1372     (declare (type system-area-pointer result))
1373     (if (zerop (sap-int result))
1374     nil
1375     result)))
1376 dtc 1.1
1377 dtc 1.2 #+nil
1378     (defun unix-sgetspent (string)
1379     "Read shadow entry from STRING."
1380     (let ((result (alien-funcall (extern-alien "sgetspent"
1381     (function (* (struct spwd))
1382     c-string))
1383     string)))
1384     (declare (type system-area-pointer result))
1385     (if (zerop (sap-int result))
1386     nil
1387     result)))
1388 dtc 1.1
1389 dtc 1.2 ;;
1390 dtc 1.1
1391 dtc 1.2 #+nil
1392     (defun unix-lckpwdf ()
1393     "Protect password file against multi writers."
1394     (void-syscall ("lckpwdf")))
1395 dtc 1.1
1396    
1397 dtc 1.2 #+nil
1398     (defun unix-ulckpwdf ()
1399     "Unlock password file."
1400     (void-syscall ("ulckpwdf")))
1401 dtc 1.1
1402 toy 1.18 ;;; bits/stat.h
1403 dtc 1.1
1404 dtc 1.2 (def-alien-type nil
1405     (struct stat
1406     (st-dev dev-t)
1407 pw 1.4 #-alpha (st-pad1 unsigned-short)
1408 dtc 1.2 (st-ino ino-t)
1409 toy 1.18 #+alpha (st-pad1 unsigned-int)
1410 dtc 1.2 (st-mode mode-t)
1411     (st-nlink nlink-t)
1412     (st-uid uid-t)
1413     (st-gid gid-t)
1414     (st-rdev dev-t)
1415 pw 1.4 #-alpha (st-pad2 unsigned-short)
1416 dtc 1.2 (st-size off-t)
1417 pw 1.4 #-alpha (st-blksize unsigned-long)
1418     #-alpha (st-blocks unsigned-long)
1419 dtc 1.2 (st-atime time-t)
1420 pw 1.4 #-alpha (unused-1 unsigned-long)
1421 dtc 1.2 (st-mtime time-t)
1422 pw 1.4 #-alpha (unused-2 unsigned-long)
1423 dtc 1.2 (st-ctime time-t)
1424 toy 1.18 #+alpha (st-blocks int)
1425     #+alpha (st-pad2 unsigned-int)
1426 pw 1.4 #+alpha (st-blksize unsigned-int)
1427     #+alpha (st-flags unsigned-int)
1428     #+alpha (st-gen unsigned-int)
1429 toy 1.18 #+alpha (st-pad3 unsigned-int)
1430     #+alpha (unused-1 unsigned-long)
1431     #+alpha (unused-2 unsigned-long)
1432     (unused-3 unsigned-long)
1433     (unused-4 unsigned-long)
1434 pw 1.4 #-alpha (unused-5 unsigned-long)))
1435 dtc 1.2
1436     ;; Encoding of the file mode.
1437    
1438     (defconstant s-ifmt #o0170000 "These bits determine file type.")
1439    
1440     ;; File types.
1441    
1442     (defconstant s-ififo #o0010000 "FIFO")
1443     (defconstant s-ifchr #o0020000 "Character device")
1444     (defconstant s-ifdir #o0040000 "Directory")
1445     (defconstant s-ifblk #o0060000 "Block device")
1446     (defconstant s-ifreg #o0100000 "Regular file")
1447    
1448     ;; These don't actually exist on System V, but having them doesn't hurt.
1449    
1450     (defconstant s-iflnk #o0120000 "Symbolic link.")
1451     (defconstant s-ifsock #o0140000 "Socket.")
1452    
1453     ;; Protection bits.
1454 dtc 1.1
1455 dtc 1.2 (defconstant s-isuid #o0004000 "Set user ID on execution.")
1456     (defconstant s-isgid #o0002000 "Set group ID on execution.")
1457     (defconstant s-isvtx #o0001000 "Save swapped text after use (sticky).")
1458     (defconstant s-iread #o0000400 "Read by owner")
1459     (defconstant s-iwrite #o0000200 "Write by owner.")
1460     (defconstant s-iexec #o0000100 "Execute by owner.")
1461 dtc 1.1
1462 dtc 1.2 ;;; statfsbuf.h
1463 dtc 1.1
1464 dtc 1.2 (def-alien-type nil
1465     (struct statfs
1466     (f-type int)
1467     (f-bsize int)
1468     (f-blocks int)
1469     (f-bfree int)
1470 pw 1.4 (f-bavail int)
1471 dtc 1.2 (f-files int)
1472     (f-ffree int)
1473     (f-fsid fsid-t)
1474     (f-namelen int)
1475     (f-spare (array int 6))))
1476    
1477    
1478     ;;; termbits.h
1479    
1480     (def-alien-type cc-t unsigned-char)
1481     (def-alien-type speed-t unsigned-int)
1482     (def-alien-type tcflag-t unsigned-int)
1483 dtc 1.1
1484 dtc 1.2 (defconstant +NCCS+ 32
1485     "Size of control character vector.")
1486 dtc 1.1
1487 dtc 1.2 (def-alien-type nil
1488     (struct termios
1489     (c-iflag tcflag-t)
1490     (c-oflag tcflag-t)
1491     (c-cflag tcflag-t)
1492     (c-lflag tcflag-t)
1493     (c-line cc-t)
1494     (c-cc (array cc-t #.+NCCS+))
1495     (c-ispeed speed-t)
1496     (c-ospeed speed-t)))
1497    
1498     ;; c_cc characters
1499    
1500     (def-enum + 0 vintr vquit verase
1501     vkill veof vtime
1502     vmin vswtc vstart
1503     vstop vsusp veol
1504     vreprint vdiscard vwerase
1505     vlnext veol2)
1506     (defvar vdsusp vsusp)
1507 dtc 1.1
1508 dtc 1.2 (def-enum + 0 tciflush tcoflush tcioflush)
1509 dtc 1.1
1510 dtc 1.2 (def-enum + 0 tcsanow tcsadrain tcsaflush)
1511 dtc 1.1
1512 dtc 1.2 ;; c_iflag bits
1513     (def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck
1514     tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc
1515     tty-ixon tty-ixany tty-ixoff
1516     tty-imaxbel)
1517 dtc 1.1
1518 dtc 1.2 ;; c_oflag bits
1519     (def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr
1520     tty-onlret tty-ofill tty-ofdel tty-nldly)
1521 dtc 1.1
1522 dtc 1.2 (defconstant tty-nl0 0)
1523     (defconstant tty-nl1 #o400)
1524 dtc 1.1
1525 dtc 1.2 (defconstant tty-crdly #o0003000)
1526     (defconstant tty-cr0 #o0000000)
1527     (defconstant tty-cr1 #o0001000)
1528     (defconstant tty-cr2 #o0002000)
1529     (defconstant tty-cr3 #o0003000)
1530     (defconstant tty-tabdly #o0014000)
1531     (defconstant tty-tab0 #o0000000)
1532     (defconstant tty-tab1 #o0004000)
1533     (defconstant tty-tab2 #o0010000)
1534     (defconstant tty-tab3 #o0014000)
1535     (defconstant tty-xtabs #o0014000)
1536     (defconstant tty-bsdly #o0020000)
1537     (defconstant tty-bs0 #o0000000)
1538     (defconstant tty-bs1 #o0020000)
1539     (defconstant tty-vtdly #o0040000)
1540     (defconstant tty-vt0 #o0000000)
1541     (defconstant tty-vt1 #o0040000)
1542     (defconstant tty-ffdly #o0100000)
1543     (defconstant tty-ff0 #o0000000)
1544     (defconstant tty-ff1 #o0100000)
1545    
1546     ;; c-cflag bit meaning
1547     (defconstant tty-cbaud #o0010017)
1548     (defconstant tty-b0 #o0000000) ;; hang up
1549     (defconstant tty-b50 #o0000001)
1550     (defconstant tty-b75 #o0000002)
1551     (defconstant tty-b110 #o0000003)
1552     (defconstant tty-b134 #o0000004)
1553     (defconstant tty-b150 #o0000005)
1554     (defconstant tty-b200 #o0000006)
1555     (defconstant tty-b300 #o0000007)
1556     (defconstant tty-b600 #o0000010)
1557     (defconstant tty-b1200 #o0000011)
1558     (defconstant tty-b1800 #o0000012)
1559     (defconstant tty-b2400 #o0000013)
1560     (defconstant tty-b4800 #o0000014)
1561     (defconstant tty-b9600 #o0000015)
1562     (defconstant tty-b19200 #o0000016)
1563     (defconstant tty-b38400 #o0000017)
1564     (defconstant tty-exta tty-b19200)
1565     (defconstant tty-extb tty-b38400)
1566     (defconstant tty-csize #o0000060)
1567     (defconstant tty-cs5 #o0000000)
1568     (defconstant tty-cs6 #o0000020)
1569     (defconstant tty-cs7 #o0000040)
1570     (defconstant tty-cs8 #o0000060)
1571     (defconstant tty-cstopb #o0000100)
1572     (defconstant tty-cread #o0000200)
1573     (defconstant tty-parenb #o0000400)
1574     (defconstant tty-parodd #o0001000)
1575     (defconstant tty-hupcl #o0002000)
1576     (defconstant tty-clocal #o0004000)
1577     (defconstant tty-cbaudex #o0010000)
1578     (defconstant tty-b57600 #o0010001)
1579     (defconstant tty-b115200 #o0010002)
1580     (defconstant tty-b230400 #o0010003)
1581     (defconstant tty-b460800 #o0010004)
1582     (defconstant tty-cibaud #o002003600000) ; input baud rate (not used)
1583     (defconstant tty-crtscts #o020000000000) ;flow control
1584 dtc 1.1
1585 dtc 1.2 ;; c_lflag bits
1586     (def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe
1587     tty-echok tty-echonl tty-noflsh
1588     tty-tostop tty-echoctl tty-echoprt
1589     tty-echoke tty-flusho
1590     tty-pendin tty-iexten)
1591 dtc 1.1
1592 dtc 1.2 ;;; tcflow() and TCXONC use these
1593     (def-enum + 0 tty-tcooff tty-tcoon tty-tcioff tty-tcion)
1594 dtc 1.1
1595 dtc 1.2 ;; tcflush() and TCFLSH use these */
1596     (def-enum + 0 tty-tciflush tty-tcoflush tty-tcioflush)
1597 dtc 1.1
1598 dtc 1.2 ;; tcsetattr uses these
1599     (def-enum + 0 tty-tcsanow tty-tcsadrain tty-tcsaflush)
1600 dtc 1.1
1601 dtc 1.2 ;;; termios.h
1602 dtc 1.1
1603 dtc 1.2 (defun unix-cfgetospeed (termios)
1604     "Get terminal output speed."
1605     (multiple-value-bind (speed errno)
1606     (int-syscall ("cfgetospeed" (* (struct termios))) termios)
1607     (if speed
1608     (values (svref terminal-speeds speed) 0)
1609     (values speed errno))))
1610 dtc 1.1
1611 dtc 1.2 (defun unix-cfsetospeed (termios speed)
1612     "Set terminal output speed."
1613     (let ((baud (or (position speed terminal-speeds)
1614     (error "Bogus baud rate ~S" speed))))
1615     (void-syscall ("cfsetospeed" (* (struct termios)) int) termios baud)))
1616 dtc 1.1
1617 dtc 1.2 (defun unix-cfgetispeed (termios)
1618     "Get terminal input speed."
1619     (multiple-value-bind (speed errno)
1620     (int-syscall ("cfgetispeed" (* (struct termios))) termios)
1621     (if speed
1622     (values (svref terminal-speeds speed) 0)
1623     (values speed errno))))
1624 dtc 1.1
1625 dtc 1.2 (defun unix-cfsetispeed (termios speed)
1626     "Set terminal input speed."
1627     (let ((baud (or (position speed terminal-speeds)
1628     (error "Bogus baud rate ~S" speed))))
1629     (void-syscall ("cfsetispeed" (* (struct termios)) int) termios baud)))
1630 dtc 1.1
1631 dtc 1.2 (defun unix-tcgetattr (fd termios)
1632     "Get terminal attributes."
1633     (declare (type unix-fd fd))
1634     (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
1635 dtc 1.1
1636 dtc 1.2 (defun unix-tcsetattr (fd opt termios)
1637     "Set terminal attributes."
1638     (declare (type unix-fd fd))
1639     (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
1640 dtc 1.1
1641 dtc 1.2 (defun unix-tcsendbreak (fd duration)
1642     "Send break"
1643     (declare (type unix-fd fd))
1644     (void-syscall ("tcsendbreak" int int) fd duration))
1645 dtc 1.1
1646 dtc 1.2 (defun unix-tcdrain (fd)
1647     "Wait for output for finish"
1648     (declare (type unix-fd fd))
1649     (void-syscall ("tcdrain" int) fd))
1650 dtc 1.1
1651 dtc 1.2 (defun unix-tcflush (fd selector)
1652     "See tcflush(3)"
1653     (declare (type unix-fd fd))
1654     (void-syscall ("tcflush" int int) fd selector))
1655 dtc 1.1
1656 dtc 1.2 (defun unix-tcflow (fd action)
1657     "Flow control"
1658     (declare (type unix-fd fd))
1659     (void-syscall ("tcflow" int int) fd action))
1660 dtc 1.1
1661 dtc 1.2 ;;; timebits.h
1662 dtc 1.1
1663 dtc 1.2 ;; A time value that is accurate to the nearest
1664     ;; microsecond but also has a range of years.
1665     (def-alien-type nil
1666     (struct timeval
1667 toy 1.18 (tv-sec time-t) ; seconds
1668     (tv-usec time-t))) ; and microseconds
1669 dtc 1.1
1670 dtc 1.2 ;;; unistd.h
1671 dtc 1.1
1672 dtc 1.2 (defun sub-unix-execve (program arg-list env-list)
1673     (let ((argv nil)
1674     (argv-bytes 0)
1675     (envp nil)
1676     (envp-bytes 0)
1677     result error-code)
1678     (unwind-protect
1679     (progn
1680     ;; Blast the stuff into the proper format
1681     (multiple-value-setq
1682     (argv argv-bytes)
1683     (string-list-to-c-strvec arg-list))
1684     (multiple-value-setq
1685     (envp envp-bytes)
1686     (string-list-to-c-strvec env-list))
1687     ;;
1688     ;; Now do the system call
1689     (multiple-value-setq
1690     (result error-code)
1691     (int-syscall ("execve"
1692     (* char) system-area-pointer system-area-pointer)
1693     (vector-sap program) argv envp)))
1694     ;;
1695     ;; Deallocate memory
1696     (when argv
1697     (system:deallocate-system-memory argv argv-bytes))
1698     (when envp
1699     (system:deallocate-system-memory envp envp-bytes)))
1700     (values result error-code)))
1701 dtc 1.1
1702 dtc 1.2 ;;;; UNIX-EXECVE
1703 dtc 1.1
1704 dtc 1.2 (defun unix-execve (program &optional arg-list
1705     (environment *environment-list*))
1706     "Executes the Unix execve system call. If the system call suceeds, lisp
1707 dtc 1.1 will no longer be running in this process. If the system call fails this
1708     function returns two values: NIL and an error code. Arg-list should be a
1709     list of simple-strings which are passed as arguments to the exec'ed program.
1710     Environment should be an a-list mapping symbols to simple-strings which this
1711     function bashes together to form the environment for the exec'ed program."
1712     (check-type program simple-string)
1713     (let ((env-list (let ((envlist nil))
1714     (dolist (cons environment)
1715     (push (if (cdr cons)
1716     (concatenate 'simple-string
1717     (string (car cons)) "="
1718     (cdr cons))
1719     (car cons))
1720     envlist))
1721     envlist)))
1722     (sub-unix-execve program arg-list env-list)))
1723    
1724    
1725     (defmacro round-bytes-to-words (n)
1726     `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
1727    
1728 dtc 1.2 ;; Values for the second argument to access.
1729 dtc 1.1
1730 dtc 1.2 ;;; Unix-access accepts a path and a mode. It returns two values the
1731     ;;; first is T if the file is accessible and NIL otherwise. The second
1732     ;;; only has meaning in the second case and is the unix errno value.
1733 dtc 1.1
1734 dtc 1.2 (defun unix-access (path mode)
1735     "Given a file path (a string) and one of four constant modes,
1736     unix-access returns T if the file is accessible with that
1737     mode and NIL if not. It also returns an errno value with
1738     NIL which determines why the file was not accessible.
1739 dtc 1.1
1740 dtc 1.2 The access modes are:
1741     r_ok Read permission.
1742     w_ok Write permission.
1743     x_ok Execute permission.
1744     f_ok Presence of file."
1745     (declare (type unix-pathname path)
1746     (type (mod 8) mode))
1747     (void-syscall ("access" c-string int) path mode))
1748    
1749     (defconstant l_set 0 "set the file pointer")
1750     (defconstant l_incr 1 "increment the file pointer")
1751     (defconstant l_xtnd 2 "extend the file size")
1752    
1753     (defun unix-lseek (fd offset whence)
1754     "Unix-lseek accepts a file descriptor and moves the file pointer ahead
1755     a certain offset for that file. Whence can be any of the following:
1756    
1757     l_set Set the file pointer.
1758     l_incr Increment the file pointer.
1759     l_xtnd Extend the file size.
1760     "
1761     (declare (type unix-fd fd)
1762     (type (unsigned-byte 32) offset)
1763     (type (integer 0 2) whence))
1764     (int-syscall ("lseek" int off-t int) fd offset whence))
1765 dtc 1.1
1766    
1767 dtc 1.2 ;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
1768     ;;; It attempts to read len bytes from the device associated with fd
1769     ;;; and store them into the buffer. It returns the actual number of
1770     ;;; bytes read.
1771 dtc 1.1
1772 dtc 1.2 (defun unix-read (fd buf len)
1773     "Unix-read attempts to read from the file described by fd into
1774     the buffer buf until it is full. Len is the length of the buffer.
1775     The number of bytes actually read is returned or NIL and an error
1776     number if an error occured."
1777     (declare (type unix-fd fd)
1778     (type (unsigned-byte 32) len))
1779 dtc 1.1
1780 dtc 1.2 (int-syscall ("read" int (* char) int) fd buf len))
1781 dtc 1.1
1782    
1783 dtc 1.2 ;;; Unix-write accepts a file descriptor, a buffer, an offset, and the
1784     ;;; length to write. It attempts to write len bytes to the device
1785     ;;; associated with fd from the the buffer starting at offset. It returns
1786     ;;; the actual number of bytes written.
1787 dtc 1.1
1788 dtc 1.2 (defun unix-write (fd buf offset len)
1789     "Unix-write attempts to write a character buffer (buf) of length
1790     len to the file described by the file descriptor fd. NIL and an
1791     error is returned if the call is unsuccessful."
1792     (declare (type unix-fd fd)
1793     (type (unsigned-byte 32) offset len))
1794     (int-syscall ("write" int (* char) int)
1795     fd
1796     (with-alien ((ptr (* char) (etypecase buf
1797     ((simple-array * (*))
1798     (vector-sap buf))
1799     (system-area-pointer
1800     buf))))
1801     (addr (deref ptr offset)))
1802     len))
1803 dtc 1.1
1804 dtc 1.2 (defun unix-pipe ()
1805     "Unix-pipe sets up a unix-piping mechanism consisting of
1806     an input pipe and an output pipe. Unix-Pipe returns two
1807     values: if no error occurred the first value is the pipe
1808     to be read from and the second is can be written to. If
1809     an error occurred the first value is NIL and the second
1810     the unix error code."
1811     (with-alien ((fds (array int 2)))
1812     (syscall ("pipe" (* int))
1813     (values (deref fds 0) (deref fds 1))
1814     (cast fds (* int)))))
1815 dtc 1.1
1816    
1817 dtc 1.2 (defun unix-chown (path uid gid)
1818     "Given a file path, an integer user-id, and an integer group-id,
1819     unix-chown changes the owner of the file and the group of the
1820     file to those specified. Either the owner or the group may be
1821     left unchanged by specifying them as -1. Note: Permission will
1822     fail if the caller is not the superuser."
1823     (declare (type unix-pathname path)
1824     (type (or unix-uid (integer -1 -1)) uid)
1825     (type (or unix-gid (integer -1 -1)) gid))
1826     (void-syscall ("chown" c-string int int) path uid gid))
1827 dtc 1.1
1828 dtc 1.2 ;;; Unix-fchown is exactly the same as unix-chown except that the file
1829     ;;; is specified by a file-descriptor ("fd") instead of a pathname.
1830 dtc 1.1
1831 dtc 1.2 (defun unix-fchown (fd uid gid)
1832     "Unix-fchown is like unix-chown, except that it accepts an integer
1833     file descriptor instead of a file path name."
1834     (declare (type unix-fd fd)
1835     (type (or unix-uid (integer -1 -1)) uid)
1836     (type (or unix-gid (integer -1 -1)) gid))
1837     (void-syscall ("fchown" int int int) fd uid gid))
1838 dtc 1.1
1839 dtc 1.2 ;;; Unix-chdir accepts a directory name and makes that the
1840     ;;; current working directory.
1841 dtc 1.1
1842 dtc 1.2 (defun unix-chdir (path)
1843     "Given a file path string, unix-chdir changes the current working
1844     directory to the one specified."
1845     (declare (type unix-pathname path))
1846     (void-syscall ("chdir" c-string) path))
1847 dtc 1.1
1848 dtc 1.2 (defun unix-current-directory ()
1849     "Put the absolute pathname of the current working directory in BUF.
1850     If successful, return BUF. If not, put an error message in
1851     BUF and return NULL. BUF should be at least PATH_MAX bytes long."
1852 toy 1.18 ;; 5120 is some randomly selected maximum size for the buffer for getcwd.
1853     (with-alien ((buf (array c-call:char 5120)))
1854     (let ((result (alien-funcall
1855     (extern-alien "getcwd"
1856     (function (* c-call:char)
1857     (* c-call:char) c-call:int))
1858     (cast buf (* c-call:char))
1859     5120)))
1860    
1861     (values (not (zerop (sap-int (alien-sap result))))
1862     (cast buf c-call:c-string)))))
1863 dtc 1.1
1864    
1865 dtc 1.2 ;;; Unix-dup returns a duplicate copy of the existing file-descriptor
1866     ;;; passed as an argument.
1867 dtc 1.1
1868 dtc 1.2 (defun unix-dup (fd)
1869     "Unix-dup duplicates an existing file descriptor (given as the
1870     argument) and return it. If FD is not a valid file descriptor, NIL
1871     and an error number are returned."
1872     (declare (type unix-fd fd))
1873     (int-syscall ("dup" int) fd))
1874 dtc 1.1
1875 dtc 1.2 ;;; Unix-dup2 makes the second file-descriptor describe the same file
1876     ;;; as the first. If the second file-descriptor points to an open
1877     ;;; file, it is first closed. In any case, the second should have a
1878     ;;; value which is a valid file-descriptor.
1879 dtc 1.1
1880 dtc 1.2 (defun unix-dup2 (fd1 fd2)
1881     "Unix-dup2 duplicates an existing file descriptor just as unix-dup
1882     does only the new value of the duplicate descriptor may be requested
1883     through the second argument. If a file already exists with the
1884     requested descriptor number, it will be closed and the number
1885     assigned to the duplicate."
1886     (declare (type unix-fd fd1 fd2))
1887     (void-syscall ("dup2" int int) fd1 fd2))
1888 dtc 1.1
1889 dtc 1.2 ;;; Unix-exit terminates a program.
1890 dtc 1.1
1891 dtc 1.2 (defun unix-exit (&optional (code 0))
1892     "Unix-exit terminates the current process with an optional
1893     error code. If successful, the call doesn't return. If
1894     unsuccessful, the call returns NIL and an error number."
1895     (declare (type (signed-byte 32) code))
1896     (void-syscall ("exit" int) code))
1897 dtc 1.1
1898     #+nil
1899 dtc 1.2 (defun unix-pathconf (path name)
1900     "Get file-specific configuration information about PATH."
1901     (int-syscall ("pathconf" c-string int) path name))
1902 dtc 1.1
1903 dtc 1.2 #+nil
1904     (defun unix-sysconf (name)
1905     "Get the value of the system variable NAME."
1906     (int-syscall ("sysconf" c-string) name))
1907 dtc 1.1
1908     #+nil
1909 dtc 1.2 (defun unix-confstr (name)
1910     "Get the value of the string-valued system variable NAME."
1911     (with-alien ((buf (array char 1024)))
1912     (values (not (zerop (alien-funcall (extern-alien "confstr"
1913     (function int
1914     c-string
1915     size-t))
1916     name buf 1024)))
1917     (cast buf c-string))))
1918    
1919    
1920     (def-alien-routine ("getpid" unix-getpid) int
1921     "Unix-getpid returns the process-id of the current process.")
1922    
1923     (def-alien-routine ("getppid" unix-getppid) int
1924     "Unix-getppid returns the process-id of the parent of the current process.")
1925    
1926     ;;; Unix-getpgrp returns the group-id associated with the
1927 dtc 1.6 ;;; current process.
1928 dtc 1.1
1929 dtc 1.6 (defun unix-getpgrp ()
1930     "Unix-getpgrp returns the group-id of the calling process."
1931     (int-syscall ("getpgrp")))
1932    
1933     ;;; Unix-setpgid sets the group-id of the process specified by
1934 dtc 1.2 ;;; "pid" to the value of "pgrp". The process must either have
1935     ;;; the same effective user-id or be a super-user process.
1936 dtc 1.1
1937 dtc 1.6 ;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
1938     ;;; for backward compatibility. setpgrp(void)[solaris] is being phased
1939     ;;; out in favor of setsid().
1940    
1941 dtc 1.2 (defun unix-setpgrp (pid pgrp)
1942     "Unix-setpgrp sets the process group on the process pid to
1943 dtc 1.6 pgrp. NIL and an error number are returned upon failure."
1944     (void-syscall ("setpgid" int int) pid pgrp))
1945    
1946     (defun unix-setpgid (pid pgrp)
1947     "Unix-setpgid sets the process group of the process pid to
1948     pgrp. If pgid is equal to pid, the process becomes a process
1949     group leader. NIL and an error number are returned upon failure."
1950     (void-syscall ("setpgid" int int) pid pgrp))
1951 dtc 1.1
1952     #+nil
1953 dtc 1.2 (defun unix-setsid ()
1954     "Create a new session with the calling process as its leader.
1955     The process group IDs of the session and the calling process
1956     are set to the process ID of the calling process, which is returned."
1957     (void-syscall ( "setsid")))
1958 dtc 1.1
1959     #+nil
1960 dtc 1.2 (defun unix-getsid ()
1961     "Return the session ID of the given process."
1962     (int-syscall ( "getsid")))
1963    
1964     (def-alien-routine ("getuid" unix-getuid) int
1965     "Unix-getuid returns the real user-id associated with the
1966     current process.")
1967 dtc 1.1
1968     #+nil
1969 dtc 1.2 (def-alien-routine ("geteuid" unix-getuid) int
1970     "Get the effective user ID of the calling process.")
1971    
1972     (def-alien-routine ("getgid" unix-getgid) int
1973     "Unix-getgid returns the real group-id of the current process.")
1974    
1975     (def-alien-routine ("getegid" unix-getegid) int
1976     "Unix-getegid returns the effective group-id of the current process.")
1977    
1978     ;/* If SIZE is zero, return the number of supplementary groups
1979     ; the calling process is in. Otherwise, fill in the group IDs
1980     ; of its supplementary groups in LIST and return the number written. */
1981     ;extern int getgroups __P ((int __size, __gid_t __list[]));
1982 dtc 1.1
1983     #+nil
1984 dtc 1.2 (defun unix-group-member (gid)
1985     "Return nonzero iff the calling process is in group GID."
1986     (int-syscall ( "group-member" gid-t) gid))
1987    
1988 dtc 1.1
1989     #+nil
1990 dtc 1.2 (defun unix-setuid (uid)
1991     "Set the user ID of the calling process to UID.
1992     If the calling process is the super-user, set the real
1993     and effective user IDs, and the saved set-user-ID to UID;
1994     if not, the effective user ID is set to UID."
1995     (int-syscall ( "setuid" uid-t) uid))
1996    
1997     ;;; Unix-setreuid sets the real and effective user-id's of the current
1998     ;;; process to the arguments "ruid" and "euid", respectively. Usage is
1999     ;;; restricted for anyone but the super-user. Setting either "ruid" or
2000     ;;; "euid" to -1 makes the system use the current id instead.
2001    
2002     (defun unix-setreuid (ruid euid)
2003     "Unix-setreuid sets the real and effective user-id's of the current
2004     process to the specified ones. NIL and an error number is returned
2005     if the call fails."
2006     (void-syscall ("setreuid" int int) ruid euid))
2007 dtc 1.1
2008     #+nil
2009 dtc 1.2 (defun unix-setgid (gid)
2010     "Set the group ID of the calling process to GID.
2011     If the calling process is the super-user, set the real
2012     and effective group IDs, and the saved set-group-ID to GID;
2013     if not, the effective group ID is set to GID."
2014     (int-syscall ( "setgid" gid-t) gid))
2015    
2016    
2017     ;;; Unix-setregid sets the real and effective group-id's of the current
2018     ;;; process to the arguments "rgid" and "egid", respectively. Usage is
2019     ;;; restricted for anyone but the super-user. Setting either "rgid" or
2020     ;;; "egid" to -1 makes the system use the current id instead.
2021    
2022     (defun unix-setregid (rgid egid)
2023     "Unix-setregid sets the real and effective group-id's of the current
2024     process process to the specified ones. NIL and an error number is
2025     returned if the call fails."
2026     (void-syscall ("setregid" int int) rgid egid))
2027    
2028     (defun unix-fork ()
2029     "Executes the unix fork system call. Returns 0 in the child and the pid
2030     of the child in the parent if it works, or NIL and an error number if it
2031     doesn't work."
2032     (int-syscall ("fork")))
2033    
2034     (def-alien-routine ("ttyname" unix-ttyname) c-string
2035     (fd int))
2036    
2037     (def-alien-routine ("isatty" unix-isatty) boolean
2038     "Accepts a Unix file descriptor and returns T if the device
2039     associated with it is a terminal."
2040     (fd int))
2041    
2042     ;;; Unix-link creates a hard link from name2 to name1.
2043    
2044     (defun unix-link (name1 name2)
2045     "Unix-link creates a hard link from the file with name1 to the
2046     file with name2."
2047     (declare (type unix-pathname name1 name2))
2048     (void-syscall ("link" c-string c-string) name1 name2))
2049    
2050     (defun unix-symlink (name1 name2)
2051     "Unix-symlink creates a symbolic link named name2 to the file
2052     named name1. NIL and an error number is returned if the call
2053     is unsuccessful."
2054     (declare (type unix-pathname name1 name2))
2055     (void-syscall ("symlink" c-string c-string) name1 name2))
2056    
2057     (defun unix-readlink (path)
2058     "Unix-readlink invokes the readlink system call on the file name
2059     specified by the simple string path. It returns up to two values:
2060     the contents of the symbolic link if the call is successful, or
2061     NIL and the Unix error number."
2062     (declare (type unix-pathname path))
2063     (with-alien ((buf (array char 1024)))
2064     (syscall ("readlink" c-string (* char) int)
2065     (let ((string (make-string result)))
2066     (kernel:copy-from-system-area
2067     (alien-sap buf) 0
2068     string (* vm:vector-data-offset vm:word-bits)
2069     (* result vm:byte-bits))
2070     string)
2071     path (cast buf (* char)) 1024)))
2072    
2073     ;;; Unix-unlink accepts a name and deletes the directory entry for that
2074     ;;; name and the file if this is the last link.
2075    
2076     (defun unix-unlink (name)
2077     "Unix-unlink removes the directory entry for the named file.
2078     NIL and an error code is returned if the call fails."
2079     (declare (type unix-pathname name))
2080     (void-syscall ("unlink" c-string) name))
2081    
2082     ;;; Unix-rmdir accepts a name and removes the associated directory.
2083    
2084     (defun unix-rmdir (name)
2085     "Unix-rmdir attempts to remove the directory name. NIL and
2086     an error number is returned if an error occured."
2087     (declare (type unix-pathname name))
2088     (void-syscall ("rmdir" c-string) name))
2089    
2090     (defun tcgetpgrp (fd)
2091     "Get the tty-process-group for the unix file-descriptor FD."
2092     (alien:with-alien ((alien-pgrp c-call:int))
2093     (multiple-value-bind (ok err)
2094     (unix-ioctl fd
2095     tiocgpgrp
2096     (alien:alien-sap (alien:addr alien-pgrp)))
2097     (if ok
2098     (values alien-pgrp nil)
2099     (values nil err)))))
2100    
2101     (defun tty-process-group (&optional fd)
2102     "Get the tty-process-group for the unix file-descriptor FD. If not supplied,
2103     FD defaults to /dev/tty."
2104     (if fd
2105     (tcgetpgrp fd)
2106     (multiple-value-bind (tty-fd errno)
2107     (unix-open "/dev/tty" o_rdwr 0)
2108     (cond (tty-fd
2109     (multiple-value-prog1
2110     (tcgetpgrp tty-fd)
2111     (unix-close tty-fd)))
2112     (t
2113     (values nil errno))))))
2114    
2115     (defun tcsetpgrp (fd pgrp)
2116     "Set the tty-process-group for the unix file-descriptor FD to PGRP."
2117     (alien:with-alien ((alien-pgrp c-call:int pgrp))
2118     (unix-ioctl fd
2119     tiocspgrp
2120     (alien:alien-sap (alien:addr alien-pgrp)))))
2121    
2122     (defun %set-tty-process-group (pgrp &optional fd)
2123     "Set the tty-process-group for the unix file-descriptor FD to PGRP. If not
2124     supplied, FD defaults to /dev/tty."
2125     (let ((old-sigs
2126     (unix-sigblock
2127     (sigmask :sigttou :sigttin :sigtstp :sigchld))))
2128     (declare (type (unsigned-byte 32) old-sigs))
2129     (unwind-protect
2130     (if fd
2131     (tcsetpgrp fd pgrp)
2132     (multiple-value-bind (tty-fd errno)
2133     (unix-open "/dev/tty" o_rdwr 0)
2134     (cond (tty-fd
2135     (multiple-value-prog1
2136     (tcsetpgrp tty-fd pgrp)
2137     (unix-close tty-fd)))
2138     (t
2139     (values nil errno)))))
2140     (unix-sigsetmask old-sigs))))
2141    
2142     (defsetf tty-process-group (&optional fd) (pgrp)
2143     "Set the tty-process-group for the unix file-descriptor FD to PGRP. If not
2144     supplied, FD defaults to /dev/tty."
2145     `(%set-tty-process-group ,pgrp ,fd))
2146 dtc 1.1
2147     #+nil
2148 dtc 1.2 (defun unix-getlogin ()
2149     "Return the login name of the user."
2150     (let ((result (alien-funcall (extern-alien "getlogin"
2151     (function c-string)))))
2152     (declare (type system-area-pointer result))
2153     (if (zerop (sap-int result))
2154     nil
2155     result)))
2156 dtc 1.13
2157     (def-alien-type nil
2158     (struct utsname
2159     (sysname (array char 65))
2160     (nodename (array char 65))
2161     (release (array char 65))
2162     (version (array char 65))
2163     (machine (array char 65))
2164     (domainname (array char 65))))
2165    
2166     (defun unix-uname ()
2167     "Unix-uname returns the name and information about the current kernel. The
2168     values returned upon success are: sysname, nodename, release, version,
2169     machine, and domainname. Upon failure, 'nil and the 'errno are returned."
2170     (with-alien ((utsname (struct utsname)))
2171 dtc 1.14 (syscall* ("uname" (* (struct utsname)))
2172     (values (cast (slot utsname 'sysname) c-string)
2173     (cast (slot utsname 'nodename) c-string)
2174     (cast (slot utsname 'release) c-string)
2175     (cast (slot utsname 'version) c-string)
2176     (cast (slot utsname 'machine) c-string)
2177 dtc 1.13 (cast (slot utsname 'domainname) c-string))
2178 dtc 1.14 (addr utsname))))
2179 dtc 1.2
2180     (defun unix-gethostname ()
2181     "Unix-gethostname returns the name of the host machine as a string."
2182     (with-alien ((buf (array char 256)))
2183 dtc 1.14 (syscall* ("gethostname" (* char) int)
2184     (cast buf c-string)
2185     (cast buf (* char)) 256)))
2186 dtc 1.1
2187     #+nil
2188 dtc 1.2 (defun unix-sethostname (name len)
2189     (int-syscall ("sethostname" c-string size-t) name len))
2190 dtc 1.1
2191     #+nil
2192 dtc 1.2 (defun unix-sethostid (id)
2193     (int-syscall ("sethostid" long) id))
2194 dtc 1.1
2195     #+nil
2196 dtc 1.2 (defun unix-getdomainname (name len)
2197     (int-syscall ("getdomainname" c-string size-t) name len))
2198 dtc 1.1
2199     #+nil
2200 dtc 1.2 (defun unix-setdomainname (name len)
2201     (int-syscall ("setdomainname" c-string size-t) name len))
2202    
2203     ;;; Unix-fsync writes the core-image of the file described by "fd" to
2204     ;;; permanent storage (i.e. disk).
2205    
2206     (defun unix-fsync (fd)
2207     "Unix-fsync writes the core image of the file described by
2208     fd to disk."
2209     (declare (type unix-fd fd))
2210     (void-syscall ("fsync" int) fd))
2211    
2212 dtc 1.1
2213     #+nil
2214 dtc 1.2 (defun unix-vhangup ()
2215     "Revoke access permissions to all processes currently communicating
2216     with the control terminal, and then send a SIGHUP signal to the process
2217     group of the control terminal."
2218     (int-syscall ("vhangup")))
2219 dtc 1.1
2220     #+nil
2221 dtc 1.2 (defun unix-revoke (file)
2222     "Revoke the access of all descriptors currently open on FILE."
2223     (int-syscall ("revoke" c-string) file))
2224    
2225    
2226     #+nil
2227     (defun unix-chroot (path)
2228     "Make PATH be the root directory (the starting point for absolute paths).
2229     This call is restricted to the super-user."
2230     (int-syscall ("chroot" c-string) path))
2231    
2232     (def-alien-routine ("gethostid" unix-gethostid) unsigned-long
2233     "Unix-gethostid returns a 32-bit integer which provides unique
2234     identification for the host machine.")
2235    
2236     ;;; Unix-sync writes all information in core memory which has been modified
2237     ;;; to permanent storage (i.e. disk).
2238    
2239     (defun unix-sync ()
2240     "Unix-sync writes all information in core memory which has been
2241     modified to disk. It returns NIL and an error code if an error
2242     occured."
2243     (void-syscall ("sync")))
2244    
2245     ;;; Unix-getpagesize returns the number of bytes in the system page.
2246    
2247     (defun unix-getpagesize ()
2248     "Unix-getpagesize returns the number of bytes in a system page."
2249     (int-syscall ("getpagesize")))
2250    
2251     ;;; Unix-truncate accepts a file name and a new length. The file is
2252     ;;; truncated to the new length.
2253    
2254     (defun unix-truncate (name len)
2255     "Unix-truncate truncates the named file to the length (in
2256     bytes) specified by len. NIL and an error number is returned
2257     if the call is unsuccessful."
2258     (declare (type unix-pathname name)
2259     (type (unsigned-byte 32) len))
2260     (void-syscall ("truncate" c-string off-t) name len))
2261    
2262     (defun unix-ftruncate (fd len)
2263     "Unix-ftruncate is similar to unix-truncate except that the first
2264     argument is a file descriptor rather than a file name."
2265     (declare (type unix-fd fd)
2266     (type (unsigned-byte 32) len))
2267     (void-syscall ("ftruncate" int off-t) fd len))
2268    
2269     #+nil
2270     (defun unix-getdtablesize ()
2271     "Return the maximum number of file descriptors
2272     the current process could possibly have."
2273     (int-syscall ("getdtablesize")))
2274    
2275     (defconstant f_ulock 0 "Unlock a locked region")
2276     (defconstant f_lock 1 "Lock a region for exclusive use")
2277     (defconstant f_tlock 2 "Test and lock a region for exclusive use")
2278     (defconstant f_test 3 "Test a region for othwer processes locks")
2279    
2280     #+nil
2281     (defun unix-lockf (fd cmd length)
2282     "Unix-locks can lock, unlock and test files according to the cmd
2283     which can be one of the following:
2284    
2285     f_ulock Unlock a locked region
2286     f_lock Lock a region for exclusive use
2287     f_tlock Test and lock a region for exclusive use
2288     f_test Test a region for othwer processes locks
2289    
2290     The lock is for a region from the current location for a length
2291     of length.
2292    
2293     This is a simpler version of the interface provided by unix-fcntl.
2294     "
2295     (declare (type unix-fd fd)
2296     (type (unsigned-byte 32) length)
2297     (type (integer 0 3) cmd))
2298     (int-syscall ("lockf" int int off-t) fd cmd length))
2299    
2300     ;;; ustatbits.h
2301    
2302     (def-alien-type nil
2303     (struct ustat
2304     (f-tfree daddr-t)
2305