/[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.2 by dtc, Tue Jun 16 06:58:54 1998 UTC revision 1.2.2.2 by pw, Tue May 23 16:36:53 2000 UTC
# Line 10  Line 10 
10  ;;; **********************************************************************  ;;; **********************************************************************
11  ;;;  ;;;
12  ;;; This file contains the UNIX low-level support for glibc2.  Based  ;;; This file contains the UNIX low-level support for glibc2.  Based
13  ;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998)  ;;; on unix.lisp 1.56, converted for glibc2 by Peter Van Eynde (1998).
14    ;;; Alpha support by Julian Dolby, 1999.
15  ;;;  ;;;
16  ;;; All the functions with #+nil in front are work in progress,  ;;; All the functions with #+nil in front are work in progress,
17  ;;; and mostly don't work.  ;;; and mostly don't work.
# Line 134  Line 135 
135            KBDSCLICK FIONREAD      unix-exit unix-stat unix-lstat unix-fstat            KBDSCLICK FIONREAD      unix-exit unix-stat unix-lstat unix-fstat
136            unix-getrusage unix-fast-getrusage rusage_self rusage_children            unix-getrusage unix-fast-getrusage rusage_self rusage_children
137            unix-gettimeofday            unix-gettimeofday
138            unix-utimes unix-setreuid            unix-utimes unix-sched-yield unix-setreuid
139            unix-setregid            unix-setregid
140            unix-getpid unix-getppid            unix-getpid unix-getppid
141            unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid            unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
# Line 257  Line 258 
258  (def-alien-type daddr-t int)  (def-alien-type daddr-t int)
259  (def-alien-type caddr-t (* char))  (def-alien-type caddr-t (* char))
260  (def-alien-type swblk-t long)  (def-alien-type swblk-t long)
261  (def-alien-type size-t unsigned-int)  (def-alien-type size-t #-alpha unsigned-int #+alpha long)
262  (def-alien-type time-t long)  (def-alien-type time-t long)
263  (def-alien-type clock-t long)  (def-alien-type clock-t long)
264  (def-alien-type uid-t unsigned-int)  (def-alien-type uid-t unsigned-int)
265  (def-alien-type ssize-t int)  (def-alien-type ssize-t #-alpha int #+alpha long)
 (def-alien-type fd-mask unsigned-long)  
266  (def-alien-type key-t int)  (def-alien-type key-t int)
267  (def-alien-type int8-t char)  (def-alien-type int8-t char)
268  (def-alien-type u-int8-t unsigned-char)  (def-alien-type u-int8-t unsigned-char)
# Line 272  Line 272 
272  (def-alien-type u-int32-t unsigned-int)  (def-alien-type u-int32-t unsigned-int)
273  (def-alien-type int64-t #+nil long-long #-nil (array long 2))  (def-alien-type int64-t #+nil long-long #-nil (array long 2))
274  (def-alien-type u-int64-t #+nil unsigned-long-long #-nil (array unsigned-long 2))  (def-alien-type u-int64-t #+nil unsigned-long-long #-nil (array unsigned-long 2))
275  (def-alien-type register-t int)  (def-alien-type register-t #-alpha int #+alpha long)
276    
277    
278  (def-alien-type dev-t uquad-t)  (def-alien-type dev-t #-alpha uquad-t #+alpha unsigned-long)
279  (def-alien-type uid-t unsigned-int)  (def-alien-type uid-t unsigned-int)
280  (def-alien-type gid-t unsigned-int)  (def-alien-type gid-t unsigned-int)
281  (def-alien-type ino-t unsigned-long)  (def-alien-type ino-t #-alpha unsigned-long #+alpha unsigned-int)
282  (def-alien-type mode-t unsigned-int)  (def-alien-type mode-t unsigned-int)
283  (def-alien-type nlink-t unsigned-int)  (def-alien-type nlink-t unsigned-int)
284  (def-alien-type off-t long)  (def-alien-type off-t long)
285  (def-alien-type loff-t quad-t)  (def-alien-type loff-t quad-t)
286  (def-alien-type pid-t int)  (def-alien-type pid-t int)
287  (def-alien-type ssize-t int)  (def-alien-type ssize-t #-alpha int #+alpha long)
288    
289  (def-alien-type fsid-t (array int 2))  (def-alien-type fsid-t (array int 2))
290    
291  (defconstant fd-setsize 1024)  (def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int)
292    
293    (defconstant fd-setsize 1024)
294    (defconstant nfdbits 32)
295    
296  (def-alien-type nil  (def-alien-type nil
297    (struct fd-set    (struct fd-set
298            (fds-bits (array fd-mask #.(/ fd-setsize 32)))))            (fds-bits (array fd-mask #.(/ fd-setsize nfdbits)))))
299    
300  (def-alien-type key-t int)  (def-alien-type key-t int)
301    
# Line 465  Line 468 
468  (defconstant o_wronly  1 "Write-only flag.")  (defconstant o_wronly  1 "Write-only flag.")
469  (defconstant o_rdwr    2 "Read-write flag.")  (defconstant o_rdwr    2 "Read-write flag.")
470  (defconstant o_accmode 3 "Access mode mask.")  (defconstant o_accmode 3 "Access mode mask.")
471  (defconstant o_creat   #o100 "Create if nonexistant flag. (not fcntl)")  
472  (defconstant o_excl    #o200 "Error if already exists. (not fcntl)")  #-alpha
473  (defconstant o_noctty  #o400 "Don't assign controlling tty. (not fcntl)")  (progn
474  (defconstant o_trunc   #o1000 "Truncate flag. (not fcntl)")    (defconstant o_creat   #o100 "Create if nonexistant flag. (not fcntl)")
475  (defconstant o_append  #o2000 "Append flag.")    (defconstant o_excl    #o200 "Error if already exists. (not fcntl)")
476  (defconstant o_ndelay  #o4000 "Non-blocking I/O")    (defconstant o_noctty  #o400 "Don't assign controlling tty. (not fcntl)")
477  (defconstant o_nonblock #o4000 "Non-blocking I/O")    (defconstant o_trunc   #o1000 "Truncate flag. (not fcntl)")
478  (defconstant o_ndelay  o_nonblock)    (defconstant o_append  #o2000 "Append flag.")
479  (defconstant o_sync    #o10000 "Synchronous writes (on ext2)")    (defconstant o_ndelay  #o4000 "Non-blocking I/O")
480  (defconstant o_fsync    o_sync)    (defconstant o_nonblock #o4000 "Non-blocking I/O")
481  (defconstant o_async   #o20000 "Asynchronous I/O")    (defconstant o_ndelay  o_nonblock)
482      (defconstant o_sync    #o10000 "Synchronous writes (on ext2)")
483      (defconstant o_fsync    o_sync)
484      (defconstant o_async   #o20000 "Asynchronous I/O"))
485    #+alpha
486    (progn
487      (defconstant o_creat   #o1000 "Create if nonexistant flag. (not fcntl)")
488      (defconstant o_trunc   #o2000 "Truncate flag. (not fcntl)")
489      (defconstant o_excl    #o4000 "Error if already exists. (not fcntl)")
490      (defconstant o_noctty  #o10000 "Don't assign controlling tty. (not fcntl)")
491      (defconstant o_nonblock #o4 "Non-blocking I/O")
492      (defconstant o_append  #o10 "Append flag.")
493      (defconstant o_ndelay  o_nonblock)
494      (defconstant o_sync    #o40000 "Synchronous writes (on ext2)")
495      (defconstant o_fsync    o_sync)
496      (defconstant o_async   #o20000 "Asynchronous I/O"))
497    
498  (defconstant f-dupfd    0  "Duplicate a file descriptor")  (defconstant f-dupfd    0  "Duplicate a file descriptor")
499  (defconstant f-getfd    1  "Get file desc. flags")  (defconstant f-getfd    1  "Get file desc. flags")
500  (defconstant f-setfd    2  "Set file desc. flags")  (defconstant f-setfd    2  "Set file desc. flags")
501  (defconstant f-getfl    3  "Get file flags")  (defconstant f-getfl    3  "Get file flags")
502  (defconstant f-setfl    4  "Set file flags")  (defconstant f-setfl    4  "Set file flags")
503  (defconstant f-getlk    5   "Get lock")  
504  (defconstant f-setlk    6   "Set lock")  #-alpha
505  (defconstant f-setlkw   7   "Set lock, wait for release")  (progn
506  (defconstant f-setown   8  "Set owner (for sockets)")    (defconstant f-getlk    5   "Get lock")
507  (defconstant f-getown   9  "Get owner (for sockets)")    (defconstant f-setlk    6   "Set lock")
508      (defconstant f-setlkw   7   "Set lock, wait for release")
509      (defconstant f-setown   8  "Set owner (for sockets)")
510      (defconstant f-getown   9  "Get owner (for sockets)"))
511    #+alpha
512    (progn
513      (defconstant f-getlk    7   "Get lock")
514      (defconstant f-setlk    8   "Set lock")
515      (defconstant f-setlkw   9   "Set lock, wait for release")
516      (defconstant f-setown   5  "Set owner (for sockets)")
517      (defconstant f-getown   6  "Get owner (for sockets)"))
518    
519    
520    
521  (defconstant F-CLOEXEC 1 "for f-getfl and f-setfl")  (defconstant F-CLOEXEC 1 "for f-getfl and f-setfl")
522    
523  (defconstant F-RDLCK 0 "for fcntl and lockf")  #-alpha
524  (defconstant F-WDLCK 1 "for fcntl and lockf")  (progn
525  (defconstant F-UNLCK 2 "for fcntl and lockf")    (defconstant F-RDLCK 0 "for fcntl and lockf")
526  (defconstant F-EXLCK 4 "old bsd flock (depricated)")    (defconstant F-WDLCK 1 "for fcntl and lockf")
527  (defconstant F-SHLCK 8 "old bsd flock (depricated)")    (defconstant F-UNLCK 2 "for fcntl and lockf")
528      (defconstant F-EXLCK 4 "old bsd flock (depricated)")
529      (defconstant F-SHLCK 8 "old bsd flock (depricated)"))
530    #+alpha
531    (progn
532      (defconstant F-RDLCK 1 "for fcntl and lockf")
533      (defconstant F-WDLCK 2 "for fcntl and lockf")
534      (defconstant F-UNLCK 8 "for fcntl and lockf")
535      (defconstant F-EXLCK 16 "old bsd flock (depricated)")
536      (defconstant F-SHLCK 32 "old bsd flock (depricated)"))
537    
538  (defconstant F-LOCK-SH 1 "Shared lock for bsd flock")  (defconstant F-LOCK-SH 1 "Shared lock for bsd flock")
539  (defconstant F-LOCK-EX 2 "Exclusive lock for bsd flock")  (defconstant F-LOCK-EX 2 "Exclusive lock for bsd flock")
# Line 1172  length LEN and type TYPE." Line 1211  length LEN and type TYPE."
1211      (declare (type system-area-pointer result))      (declare (type system-area-pointer result))
1212      (if (zerop (sap-int result))      (if (zerop (sap-int result))
1213          nil          nil
1214        result)))          result)))
1215    
1216  ;;; resourcebits.h  ;;; resourcebits.h
1217    
   
1218  (def-alien-type nil  (def-alien-type nil
1219    (struct rlimit    (struct rlimit
1220      (rlim-cur long)      ; current (soft) limit      (rlim-cur long)      ; current (soft) limit
# Line 1245  length LEN and type TYPE." Line 1283  length LEN and type TYPE."
1283    (int-syscall ("sched_getscheduler" pid-t)    (int-syscall ("sched_getscheduler" pid-t)
1284                  pid))                  pid))
1285    
1286  #+nil  (defun unix-sched-yield ()
 (defun unix-sched_yield ()  
1287    "Retrieve scheduling algorithm for a particular purpose."    "Retrieve scheduling algorithm for a particular purpose."
1288    (int-syscall ("sched_yield")))    (int-syscall ("sched_yield")))
1289    
# Line 1370  length LEN and type TYPE." Line 1407  length LEN and type TYPE."
1407  (def-alien-type nil  (def-alien-type nil
1408    (struct stat    (struct stat
1409      (st-dev dev-t)      (st-dev dev-t)
1410      (st-pad1 unsigned-short)      #-alpha (st-pad1 unsigned-short)
1411      (st-ino ino-t)      (st-ino ino-t)
1412      (st-mode mode-t)      (st-mode mode-t)
1413      (st-nlink  nlink-t)      (st-nlink  nlink-t)
1414      (st-uid  uid-t)      (st-uid  uid-t)
1415      (st-gid  gid-t)      (st-gid  gid-t)
1416      (st-rdev dev-t)      (st-rdev dev-t)
1417      (st-pad2  unsigned-short)      #-alpha (st-pad2  unsigned-short)
1418        #+alpha (st-pad2  unsigned-int)
1419      (st-size off-t)      (st-size off-t)
1420      (st-blksize unsigned-long)      #-alpha (st-blksize unsigned-long)
1421      (st-blocks unsigned-long)      #-alpha (st-blocks unsigned-long)
1422      (st-atime time-t)      (st-atime time-t)
1423      (unused-1 unsigned-long)      #-alpha (unused-1 unsigned-long)
1424      (st-mtime time-t)      (st-mtime time-t)
1425      (unused-2 unsigned-long)      #-alpha (unused-2 unsigned-long)
1426      (st-ctime time-t)      (st-ctime time-t)
1427      (unused-3 unsigned-long)      #+alpha (st-blksize unsigned-int)
1428      (unused-4 unsigned-long)      #+alpha (st-blocks int)
1429      (unused-5 unsigned-long)))      #+alpha (st-flags unsigned-int)
1430        #+alpha (st-gen unsigned-int)
1431        #-alpha (unused-3 unsigned-long)
1432        #-alpha (unused-4 unsigned-long)
1433        #-alpha (unused-5 unsigned-long)))
1434    
1435  ;; Encoding of the file mode.  ;; Encoding of the file mode.
1436    
# Line 1424  length LEN and type TYPE." Line 1466  length LEN and type TYPE."
1466              (f-bsize int)              (f-bsize int)
1467              (f-blocks int)              (f-blocks int)
1468              (f-bfree int)              (f-bfree int)
1469              (f-babail int)              (f-bavail int)
1470              (f-files int)              (f-files int)
1471              (f-ffree int)              (f-ffree int)
1472              (f-fsid fsid-t)              (f-fsid fsid-t)
# Line 1621  length LEN and type TYPE." Line 1663  length LEN and type TYPE."
1663  ;; microsecond but also has a range of years.  ;; microsecond but also has a range of years.
1664  (def-alien-type nil  (def-alien-type nil
1665    (struct timeval    (struct timeval
1666            (tv-sec time-t)               ; seconds            (tv-sec #-alpha time-t #+alpha int)           ; seconds
1667            (tv-usec time-t)))            ; and microseconds            (tv-usec #-alpha time-t #+alpha int)))        ; and microseconds
1668    
1669  ;;; unistd.h  ;;; unistd.h
1670    
# Line 1875  length LEN and type TYPE." Line 1917  length LEN and type TYPE."
1917    "Unix-getppid returns the process-id of the parent of the current process.")    "Unix-getppid returns the process-id of the parent of the current process.")
1918    
1919  ;;; Unix-getpgrp returns the group-id associated with the  ;;; Unix-getpgrp returns the group-id associated with the
1920  ;;; process whose process-id is specified as an argument.  ;;; current process.
1921  ;;; As usual, if the process-id is 0, it refers to the current  
1922  ;;; process.  (defun unix-getpgrp ()
1923      "Unix-getpgrp returns the group-id of the calling process."
1924  (defun unix-getpgrp (pid)    (int-syscall ("getpgrp")))
   "Unix-getpgrp returns the group-id of the process associated  
    with pid."  
   (int-syscall ("getpgrp" int) pid))  
1925    
1926  ;;; Unix-setpgrp sets the group-id of the process specified by  ;;; Unix-setpgid sets the group-id of the process specified by
1927  ;;; "pid" to the value of "pgrp".  The process must either have  ;;; "pid" to the value of "pgrp".  The process must either have
1928  ;;; the same effective user-id or be a super-user process.  ;;; the same effective user-id or be a super-user process.
1929    
1930    ;;; setpgrp(int int)[freebsd] is identical to setpgid and is retained
1931    ;;; for backward compatibility. setpgrp(void)[solaris] is being phased
1932    ;;; out in favor of setsid().
1933    
1934  (defun unix-setpgrp (pid pgrp)  (defun unix-setpgrp (pid pgrp)
1935    "Unix-setpgrp sets the process group on the process pid to    "Unix-setpgrp sets the process group on the process pid to
1936     pgrp.  NIL and an error number is returned upon failure."     pgrp.  NIL and an error number are returned upon failure."
1937    (void-syscall ( "setpgrp" int int) pid pgrp))    (void-syscall ("setpgid" int int) pid pgrp))
1938    
1939    (defun unix-setpgid (pid pgrp)
1940      "Unix-setpgid sets the process group of the process pid to
1941       pgrp. If pgid is equal to pid, the process becomes a process
1942       group leader. NIL and an error number are returned upon failure."
1943      (void-syscall ("setpgid" int int) pid pgrp))
1944    
1945  #+nil  #+nil
1946  (defun unix-setsid ()  (defun unix-setsid ()
# Line 2334  in at a time in poll.") Line 2383  in at a time in poll.")
2383    
2384  ;;; sys/resource.h  ;;; sys/resource.h
2385    
2386  #+nil  (defun unix-getrlimit (resource)
2387  (defun unix-getrlimit (resource rlimits)    "Get the soft and hard limits for RESOURCE."
2388    "Put the soft and hard limits for RESOURCE in *RLIMITS.    (with-alien ((rlimits (struct rlimit)))
2389     Returns 0 if successful, -1 if not (and sets errno)."      (syscall ("getrlimit" int (* (struct rlimit)))
2390    (int-syscall ("getrlimit" int (* (struct rlimit)))               (values t
2391                 resource rlimits))                       (slot rlimits 'rlim-cur)
2392                         (slot rlimits 'rlim-max))
2393  #+nil               resource (addr rlimits))))
2394  (defun unix-setrlimit (resource rlimits)  
2395    "Set the soft and hard limits for RESOURCE to *RLIMITS.  (defun unix-setrlimit (resource current maximum)
2396     Only the super-user can increase hard limits.    "Set the current soft and hard maximum limits for RESOURCE.
2397     Return 0 if successful, -1 if not (and sets errno)."     Only the super-user can increase hard limits."
2398    (int-syscall ("setrlimit" int (* (struct rlimit)))    (with-alien ((rlimits (struct rlimit)))
2399                 resource rlimits))      (setf (slot rlimits 'rlim-cur) current)
2400        (setf (slot rlimits 'rlim-max) maximum)
2401        (void-syscall ("setrlimit" int (* (struct rlimit)))
2402                      resource (addr rlimits))))
2403    
2404  (declaim (inline unix-fast-getrusage))  (declaim (inline unix-fast-getrusage))
2405  (defun unix-fast-getrusage (who)  (defun unix-fast-getrusage (who)
# Line 2505  in at a time in poll.") Line 2557  in at a time in poll.")
2557    `(if (fixnump ,num)    `(if (fixnump ,num)
2558         (progn         (progn
2559           (setf (deref (slot ,fdset 'fds-bits) 0) ,num)           (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
2560           ,@(loop for index upfrom 1 below (/ fd-setsize 32)           ,@(loop for index upfrom 1 below (/ fd-setsize nfdbits)
2561               collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))               collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
2562         (progn         (progn
2563           ,@(loop for index upfrom 0 below (/ fd-setsize 32)           ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
2564               collect `(setf (deref (slot ,fdset 'fds-bits) ,index)               collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
2565                              (ldb (byte 32 ,(* index 32)) ,num))))))                              (ldb (byte nfdbits ,(* index nfdbits)) ,num))))))
2566    
2567  (defmacro fd-set-to-num (nfds fdset)  (defmacro fd-set-to-num (nfds fdset)
2568    `(if (<= ,nfds 32)    `(if (<= ,nfds nfdbits)
2569         (deref (slot ,fdset 'fds-bits) 0)         (deref (slot ,fdset 'fds-bits) 0)
2570         (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32)         (+ ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
2571                collect `(ash (deref (slot ,fdset 'fds-bits) ,index)                collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
2572                              ,(* index 32))))))                              ,(* index nfdbits))))))
2573    
2574  (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))
2575    "Unix-select examines the sets of descriptors passed as arguments    "Unix-select examines the sets of descriptors passed as arguments
# Line 2555  in at a time in poll.") Line 2607  in at a time in poll.")
2607    
2608  (defmacro extract-stat-results (buf)  (defmacro extract-stat-results (buf)
2609    `(values T    `(values T
2610             #+nil             #+alpha
2611             (slot ,buf 'st-dev)             (slot ,buf 'st-dev)
2612             #-nil             #-alpha
2613             (+ (deref (slot ,buf 'st-dev) 0)             (+ (deref (slot ,buf 'st-dev) 0)
2614                (* (+ +max-u-long+  1)                (* (+ +max-u-long+  1)
2615                   (deref (slot ,buf 'st-dev) 1)))   ;;; let's hope this works..                   (deref (slot ,buf 'st-dev) 1)))   ;;; let's hope this works..
# Line 2566  in at a time in poll.") Line 2618  in at a time in poll.")
2618             (slot ,buf 'st-nlink)             (slot ,buf 'st-nlink)
2619             (slot ,buf 'st-uid)             (slot ,buf 'st-uid)
2620             (slot ,buf 'st-gid)             (slot ,buf 'st-gid)
2621             #+nil             #+alpha
2622             (slot ,buf 'st-rdev)             (slot ,buf 'st-rdev)
2623             #-nil             #-alpha
2624             (+ (deref (slot ,buf 'st-rdev) 0)             (+ (deref (slot ,buf 'st-rdev) 0)
2625                (* (+ +max-u-long+  1)                (* (+ +max-u-long+  1)
2626                   (deref (slot ,buf 'st-rdev) 1)))   ;;; let's hope this works..                   (deref (slot ,buf 'st-rdev) 1)))   ;;; let's hope this works..
# Line 3088  in at a time in poll.") Line 3140  in at a time in poll.")
3140    
3141  (eval-when (compile load eval)  (eval-when (compile load eval)
3142    
3143  (defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void))  (defconstant iocparm-mask #x3fff)
3144    (declare (ignore arg parm-type))  (defconstant ioc_void #x00000000)
3145    `(eval-when (eval load compile)  (defconstant ioc_out #x40000000)
3146       (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd)))))  (defconstant ioc_in #x80000000)
3147    (defconstant ioc_inout (logior ioc_in ioc_out))
3148    
3149    (defmacro define-ioctl-command (name dev cmd &optional arg parm-type)
3150      "Define an ioctl command. If the optional ARG and PARM-TYPE are given
3151      then ioctl argument size and direction are included as for ioctls defined
3152      by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type
3153      is the characters code, else DEV may be an integer giving the type."
3154      (let* ((type (if (characterp dev)
3155                       (char-code dev)
3156                       dev))
3157             (code (logior (ash type 8) cmd)))
3158        (when arg
3159          (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask)
3160                                   16)
3161                              ,code)))
3162        (when parm-type
3163          (let ((dir (ecase parm-type
3164                       (:void ioc_void)
3165                       (:in ioc_in)
3166                       (:out ioc_out)
3167                       (:inout ioc_inout))))
3168            (setf code `(logior ,dir ,code))))
3169        `(eval-when (eval load compile)
3170           (defconstant ,name ,code))))
3171    
3172    )
3173    
3174  ;;; TTY ioctl commands.  ;;; TTY ioctl commands.
3175    
3176  (define-ioctl-command TIOCGWINSZ #\t #x13 (struct winsize) :out)  (define-ioctl-command TIOCGWINSZ #\T #x13)
3177  (define-ioctl-command TIOCSWINSZ #\t #x14 (struct winsize) :in)  (define-ioctl-command TIOCSWINSZ #\T #x14)
3178  (define-ioctl-command TIOCNOTTY  #\t #x22 nil :void)  (define-ioctl-command TIOCNOTTY  #\T #x22)
3179  (define-ioctl-command TIOCSPGRP  #\t #x10 int :in)  (define-ioctl-command TIOCSPGRP  #\T #x10)
3180  (define-ioctl-command TIOCGPGRP  #\t #x0F int :out)  (define-ioctl-command TIOCGPGRP  #\T #x0F)
3181    
3182  ;;; File ioctl commands.  ;;; File ioctl commands.
3183  (define-ioctl-command FIONREAD #\t #x1B int :out)  (define-ioctl-command FIONREAD #\T #x1B)
3184    
3185  ;;; asm/sockios.h  ;;; asm/sockios.h
3186    
3187  ;;; Socket options.  ;;; Socket options.
3188    
3189  ;;; should be #x8902  (define-ioctl-command SIOCSPGRP #x89 #x02)
 (define-ioctl-command SIOCSPGRP #.(code-char #x89) #x02 int :in)  
3190    
3191  (defun siocspgrp (fd pgrp)  (defun siocspgrp (fd pgrp)
3192    "Set the socket process-group for the unix file-descriptor FD to PGRP."    "Set the socket process-group for the unix file-descriptor FD to PGRP."
# Line 3378  in at a time in poll.") Line 3455  in at a time in poll.")
3455  (defmacro fd-set (offset fd-set)  (defmacro fd-set (offset fd-set)
3456    (let ((word (gensym))    (let ((word (gensym))
3457          (bit (gensym)))          (bit (gensym)))
3458      `(multiple-value-bind (,word ,bit) (floor ,offset 32)      `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
3459         (setf (deref (slot ,fd-set 'fds-bits) ,word)         (setf (deref (slot ,fd-set 'fds-bits) ,word)
3460               (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))               (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
3461                       (deref (slot ,fd-set 'fds-bits) ,word))))))                       (deref (slot ,fd-set 'fds-bits) ,word))))))
# Line 3387  in at a time in poll.") Line 3464  in at a time in poll.")
3464  (defmacro fd-clr (offset fd-set)  (defmacro fd-clr (offset fd-set)
3465    (let ((word (gensym))    (let ((word (gensym))
3466          (bit (gensym)))          (bit (gensym)))
3467      `(multiple-value-bind (,word ,bit) (floor ,offset 32)      `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
3468         (setf (deref (slot ,fd-set 'fds-bits) ,word)         (setf (deref (slot ,fd-set 'fds-bits) ,word)
3469               (logand (deref (slot ,fd-set 'fds-bits) ,word)               (logand (deref (slot ,fd-set 'fds-bits) ,word)
3470                       (32bit-logical-not                       (32bit-logical-not
# Line 3397  in at a time in poll.") Line 3474  in at a time in poll.")
3474  (defmacro fd-isset (offset fd-set)  (defmacro fd-isset (offset fd-set)
3475    (let ((word (gensym))    (let ((word (gensym))
3476          (bit (gensym)))          (bit (gensym)))
3477      `(multiple-value-bind (,word ,bit) (floor ,offset 32)      `(multiple-value-bind (,word ,bit) (floor ,offset nfdbits)
3478         (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))         (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
3479    
3480  ;; not checked for linux...  ;; not checked for linux...
3481  (defmacro fd-zero (fd-set)  (defmacro fd-zero (fd-set)
3482    `(progn    `(progn
3483       ,@(loop for index upfrom 0 below (/ fd-setsize 32)       ,@(loop for index upfrom 0 below (/ fd-setsize nfdbits)
3484           collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))           collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
3485    
3486    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.2.2.2

  ViewVC Help
Powered by ViewVC 1.1.5