/[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.43.4.4 by rtoy, Sun May 25 13:57:00 2008 UTC revision 1.43.4.4.2.1 by rtoy, Wed Jul 2 01:22:07 2008 UTC
# Line 59  Line 59 
59  (use-package "SYSTEM")  (use-package "SYSTEM")
60  (use-package "EXT")  (use-package "EXT")
61    
62    ;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding
63    ;; is locale-dependent...else use :utf-8 on Unicode Lisps.  On 8 bit Lisps
64    ;; it must be set to :iso8859-1 (or left as NIL), making files with
65    ;; non-Latin-1 characters "mojibake", but otherwise they'll be inaccessible.
66    ;; Must be set to NIL initially to enable building Lisp!
67    (defvar *filename-encoding* nil)
68    
69  (export '(  (export '(
70            daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t            daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
71            blkcnt-t fsblkcnt-t fsfilcnt-t            blkcnt-t fsblkcnt-t fsfilcnt-t
# Line 197  Line 204 
204  (pushnew :unix *features*)  (pushnew :unix *features*)
205  (pushnew :glibc2 *features*)  (pushnew :glibc2 *features*)
206    
207    ;; needed for bootstrap
208    (eval-when (:compile-toplevel)
209      (defmacro %name->file (string)
210        `(if *filename-encoding*
211             (string-encode ,string *filename-encoding*)
212             ,string))
213      (defmacro %file->name (string)
214        `(if *filename-encoding*
215             (string-decode ,string *filename-encoding*)
216             ,string)))
217    
218  ;;;; Common machine independent structures.  ;;;; Common machine independent structures.
219    
220  (eval-when (compile eval)  (eval-when (compile eval)
# Line 381  Line 399 
399    "Unix-rename renames the file with string name1 to the string    "Unix-rename renames the file with string name1 to the string
400     name2.  NIL and an error code is returned if an error occured."     name2.  NIL and an error code is returned if an error occured."
401    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
402    (void-syscall ("rename" c-string c-string) name1 name2))    (void-syscall ("rename" c-string c-string)
403                    (%name->file name1) (%name->file name2)))
404    
405  ;;; From sys/types.h  ;;; From sys/types.h
406  ;;;         and  ;;;         and
# Line 482  Line 501 
501                (alien-funcall (extern-alien "opendir"                (alien-funcall (extern-alien "opendir"
502                                             (function system-area-pointer                                             (function system-area-pointer
503                                                       c-string))                                                       c-string))
504                               pathname)))                               (%name->file pathname))))
505           (if (zerop (sap-int dir-struct))           (if (zerop (sap-int dir-struct))
506               (values nil (unix-errno))               (values nil (unix-errno))
507               (make-directory :name pathname :dir-struct dir-struct))))               (make-directory :name pathname :dir-struct dir-struct))))
# Line 501  Line 520 
520      (if (zerop (sap-int daddr))      (if (zerop (sap-int daddr))
521          nil          nil
522          (with-alien ((dirent (* (struct dirent)) daddr))          (with-alien ((dirent (* (struct dirent)) daddr))
523            (values (cast (slot dirent 'd-name) c-string)            (values (%file->name (cast (slot dirent 'd-name) c-string))
524                    (slot dirent 'd-ino))))))                    (slot dirent 'd-ino))))))
525    
526  (defun close-dir (dir)  (defun close-dir (dir)
# Line 571  Line 590 
590    (declare (type unix-pathname path)    (declare (type unix-pathname path)
591             (type fixnum flags)             (type fixnum flags)
592             (type unix-file-mode mode))             (type unix-file-mode mode))
593    (int-syscall ("open64" c-string int int) path flags mode))    (int-syscall ("open64" c-string int int) (%name->file path) flags mode))
594    
595  (defun unix-getdtablesize ()  (defun unix-getdtablesize ()
596    "Unix-getdtablesize returns the maximum size of the file descriptor    "Unix-getdtablesize returns the maximum size of the file descriptor
# Line 602  Line 621 
621    
622    (declare (type unix-pathname name)    (declare (type unix-pathname name)
623             (type unix-file-mode mode))             (type unix-file-mode mode))
624    (int-syscall ("creat64" c-string int) name mode))    (int-syscall ("creat64" c-string int) (%name->file name) mode))
625    
626  ;;; fcntlbits.h  ;;; fcntlbits.h
627    
# Line 1822  length LEN and type TYPE." Line 1841  length LEN and type TYPE."
1841                                  (car cons))                                  (car cons))
1842                              envlist))                              envlist))
1843                      envlist)))                      envlist)))
1844      (sub-unix-execve program arg-list env-list)))      (sub-unix-execve (%name->file program) arg-list env-list)))
1845    
1846    
1847  (defmacro round-bytes-to-words (n)  (defmacro round-bytes-to-words (n)
# Line 1847  length LEN and type TYPE." Line 1866  length LEN and type TYPE."
1866          f_ok     Presence of file."          f_ok     Presence of file."
1867    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1868             (type (mod 8) mode))             (type (mod 8) mode))
1869    (void-syscall ("access" c-string int) path mode))    (void-syscall ("access" c-string int) (%name->file path) mode))
1870    
1871  (defconstant l_set 0 "set the file pointer")  (defconstant l_set 0 "set the file pointer")
1872  (defconstant l_incr 1 "increment the file pointer")  (defconstant l_incr 1 "increment the file pointer")
# Line 1954  length LEN and type TYPE." Line 1973  length LEN and type TYPE."
1973    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1974             (type (or unix-uid (integer -1 -1)) uid)             (type (or unix-uid (integer -1 -1)) uid)
1975             (type (or unix-gid (integer -1 -1)) gid))             (type (or unix-gid (integer -1 -1)) gid))
1976    (void-syscall ("chown" c-string int int) path uid gid))    (void-syscall ("chown" c-string int int) (%name->file path) uid gid))
1977    
1978  ;;; Unix-fchown is exactly the same as unix-chown except that the file  ;;; Unix-fchown is exactly the same as unix-chown except that the file
1979  ;;; is specified by a file-descriptor ("fd") instead of a pathname.  ;;; is specified by a file-descriptor ("fd") instead of a pathname.
# Line 1974  length LEN and type TYPE." Line 1993  length LEN and type TYPE."
1993    "Given a file path string, unix-chdir changes the current working    "Given a file path string, unix-chdir changes the current working
1994     directory to the one specified."     directory to the one specified."
1995    (declare (type unix-pathname path))    (declare (type unix-pathname path))
1996    (void-syscall ("chdir" c-string) path))    (void-syscall ("chdir" c-string) (%name->file path)))
1997    
1998  (defun unix-current-directory ()  (defun unix-current-directory ()
1999    "Put the absolute pathname of the current working directory in BUF.    "Put the absolute pathname of the current working directory in BUF.
# Line 1990  length LEN and type TYPE." Line 2009  length LEN and type TYPE."
2009                      5120)))                      5120)))
2010    
2011        (values (not (zerop (sap-int (alien-sap result))))        (values (not (zerop (sap-int (alien-sap result))))
2012                (cast buf c-call:c-string)))))                (%file->name (cast buf c-call:c-string))))))
2013    
2014    
2015  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor
# Line 2029  length LEN and type TYPE." Line 2048  length LEN and type TYPE."
2048  #+(or)  #+(or)
2049  (defun unix-pathconf (path name)  (defun unix-pathconf (path name)
2050    "Get file-specific configuration information about PATH."    "Get file-specific configuration information about PATH."
2051    (int-syscall ("pathconf" c-string int) path name))    (int-syscall ("pathconf" c-string int) (%name->file path) name))
2052    
2053  #+(or)  #+(or)
2054  (defun unix-sysconf (name)  (defun unix-sysconf (name)
2055    "Get the value of the system variable NAME."    "Get the value of the system variable NAME."
2056    (int-syscall ("sysconf" c-string) name))    (int-syscall ("sysconf" int) name))
2057    
2058  #+(or)  #+(or)
2059  (defun unix-confstr (name)  (defun unix-confstr (name)
# Line 2174  length LEN and type TYPE." Line 2193  length LEN and type TYPE."
2193    "Unix-link creates a hard link from the file with name1 to the    "Unix-link creates a hard link from the file with name1 to the
2194     file with name2."     file with name2."
2195    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2196    (void-syscall ("link" c-string c-string) name1 name2))    (void-syscall ("link" c-string c-string)
2197                    (%name->file name1) (%name->file name2)))
2198    
2199  (defun unix-symlink (name1 name2)  (defun unix-symlink (name1 name2)
2200    "Unix-symlink creates a symbolic link named name2 to the file    "Unix-symlink creates a symbolic link named name2 to the file
2201     named name1.  NIL and an error number is returned if the call     named name1.  NIL and an error number is returned if the call
2202     is unsuccessful."     is unsuccessful."
2203    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2204    (void-syscall ("symlink" c-string c-string) name1 name2))    (void-syscall ("symlink" c-string c-string)
2205                    (%name->file name1) (%name->file name2)))
2206    
2207  (defun unix-readlink (path)  (defun unix-readlink (path)
2208    "Unix-readlink invokes the readlink system call on the file name    "Unix-readlink invokes the readlink system call on the file name
# Line 2201  length LEN and type TYPE." Line 2222  length LEN and type TYPE."
2222                 (let ((sap (alien-sap buf)))                 (let ((sap (alien-sap buf)))
2223                   (dotimes (k result)                   (dotimes (k result)
2224                     (setf (aref string k) (code-char (sap-ref-8 sap k)))))                     (setf (aref string k) (code-char (sap-ref-8 sap k)))))
2225                 string)                 (%file->name string))
2226               path (cast buf (* char)) 1024)))               (%name->file path) (cast buf (* char)) 1024)))
2227    
2228  ;;; Unix-unlink accepts a name and deletes the directory entry for that  ;;; Unix-unlink accepts a name and deletes the directory entry for that
2229  ;;; name and the file if this is the last link.  ;;; name and the file if this is the last link.
# Line 2211  length LEN and type TYPE." Line 2232  length LEN and type TYPE."
2232    "Unix-unlink removes the directory entry for the named file.    "Unix-unlink removes the directory entry for the named file.
2233     NIL and an error code is returned if the call fails."     NIL and an error code is returned if the call fails."
2234    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2235    (void-syscall ("unlink" c-string) name))    (void-syscall ("unlink" c-string) (%name->file name)))
2236    
2237  ;;; Unix-rmdir accepts a name and removes the associated directory.  ;;; Unix-rmdir accepts a name and removes the associated directory.
2238    
# Line 2219  length LEN and type TYPE." Line 2240  length LEN and type TYPE."
2240    "Unix-rmdir attempts to remove the directory name.  NIL and    "Unix-rmdir attempts to remove the directory name.  NIL and
2241     an error number is returned if an error occured."     an error number is returned if an error occured."
2242    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2243    (void-syscall ("rmdir" c-string) name))    (void-syscall ("rmdir" c-string) (%name->file name)))
2244    
2245  (defun tcgetpgrp (fd)  (defun tcgetpgrp (fd)
2246    "Get the tty-process-group for the unix file-descriptor FD."    "Get the tty-process-group for the unix file-descriptor FD."
# Line 2354  length LEN and type TYPE." Line 2375  length LEN and type TYPE."
2375  #+(or)  #+(or)
2376  (defun unix-revoke (file)  (defun unix-revoke (file)
2377   "Revoke the access of all descriptors currently open on FILE."   "Revoke the access of all descriptors currently open on FILE."
2378   (int-syscall ("revoke" c-string) file))   (int-syscall ("revoke" c-string) (%name->file file)))
2379    
2380    
2381  #+(or)  #+(or)
2382  (defun unix-chroot (path)  (defun unix-chroot (path)
2383   "Make PATH be the root directory (the starting point for absolute paths).   "Make PATH be the root directory (the starting point for absolute paths).
2384     This call is restricted to the super-user."     This call is restricted to the super-user."
2385   (int-syscall ("chroot" c-string) path))   (int-syscall ("chroot" c-string) (%name->file path)))
2386    
2387  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long
2388    "Unix-gethostid returns a 32-bit integer which provides unique    "Unix-gethostid returns a 32-bit integer which provides unique
# Line 2391  length LEN and type TYPE." Line 2412  length LEN and type TYPE."
2412     if the call is unsuccessful."     if the call is unsuccessful."
2413    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2414             (type (unsigned-byte 64) length))             (type (unsigned-byte 64) length))
2415    (void-syscall ("truncate64" c-string off-t) name length))    (void-syscall ("truncate64" c-string off-t) (%name->file name) length))
2416    
2417  (defun unix-ftruncate (fd length)  (defun unix-ftruncate (fd length)
2418    "Unix-ftruncate is similar to unix-truncate except that the first    "Unix-ftruncate is similar to unix-truncate except that the first
# Line 2833  in at a time in poll.") Line 2854  in at a time in poll.")
2854    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
2855      (syscall ("stat64" c-string (* (struct stat)))      (syscall ("stat64" c-string (* (struct stat)))
2856               (extract-stat-results buf)               (extract-stat-results buf)
2857               name (addr buf))))               (%name->file name) (addr buf))))
2858    
2859  (defun unix-fstat (fd)  (defun unix-fstat (fd)
2860    "UNIX-FSTAT is similar to UNIX-STAT except the file is specified    "UNIX-FSTAT is similar to UNIX-STAT except the file is specified
# Line 2851  in at a time in poll.") Line 2872  in at a time in poll.")
2872    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
2873      (syscall ("lstat64" c-string (* (struct stat)))      (syscall ("lstat64" c-string (* (struct stat)))
2874               (extract-stat-results buf)               (extract-stat-results buf)
2875               name (addr buf))))               (%name->file name) (addr buf))))
2876    
2877  ;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.  ;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode.
2878    
# Line 2877  in at a time in poll.") Line 2898  in at a time in poll.")
2898    otherwise."    otherwise."
2899    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2900             (type unix-file-mode mode))             (type unix-file-mode mode))
2901    (void-syscall ("chmod" c-string int) path mode))    (void-syscall ("chmod" c-string int) (%name->file path) mode))
2902    
2903  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
2904  ;;; ("mode") and changes the protection of the file described by "fd" to  ;;; ("mode") and changes the protection of the file described by "fd" to
# Line 2907  in at a time in poll.") Line 2928  in at a time in poll.")
2928     NIL and an error number."     NIL and an error number."
2929    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2930             (type unix-file-mode mode))             (type unix-file-mode mode))
2931    (void-syscall ("mkdir" c-string int) name mode))    (void-syscall ("mkdir" c-string int) (%name->file name) mode))
2932    
2933  #+(or)  #+(or)
2934  (defun unix-makedev (path mode dev)  (defun unix-makedev (path mode dev)
# Line 2916  in at a time in poll.") Line 2937  in at a time in poll.")
2937    device numbers with the `makedev' macro above)."    device numbers with the `makedev' macro above)."
2938    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2939             (type unix-file-mode mode))             (type unix-file-mode mode))
2940    (void-syscall ("makedev" c-string mode-t dev-t) name mode dev))    (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev))
2941    
2942    
2943  #+(or)  #+(or)
# Line 2924  in at a time in poll.") Line 2945  in at a time in poll.")
2945    "Create a new FIFO named PATH, with permission bits MODE."    "Create a new FIFO named PATH, with permission bits MODE."
2946    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2947             (type unix-file-mode mode))             (type unix-file-mode mode))
2948    (void-syscall ("mkfifo" c-string int) name mode))    (void-syscall ("mkfifo" c-string int) (%name->file name) mode))
2949    
2950  ;;; sys/statfs.h  ;;; sys/statfs.h
2951    
# Line 2932  in at a time in poll.") Line 2953  in at a time in poll.")
2953  (defun unix-statfs (file buf)  (defun unix-statfs (file buf)
2954    "Return information about the filesystem on which FILE resides."    "Return information about the filesystem on which FILE resides."
2955    (int-syscall ("statfs64" c-string (* (struct statfs)))    (int-syscall ("statfs64" c-string (* (struct statfs)))
2956                 file buf))                 (%name->file file) buf))
2957    
2958  ;;; sys/swap.h  ;;; sys/swap.h
2959    
# Line 2940  in at a time in poll.") Line 2961  in at a time in poll.")
2961  (defun unix-swapon (path flags)  (defun unix-swapon (path flags)
2962   "Make the block special device PATH available to the system for swapping.   "Make the block special device PATH available to the system for swapping.
2963    This call is restricted to the super-user."    This call is restricted to the super-user."
2964   (int-syscall ("swapon" c-string int) path flags))   (int-syscall ("swapon" c-string int) (%name->file path) flags))
2965    
2966  #+(or)  #+(or)
2967  (defun unix-swapoff (path)  (defun unix-swapoff (path)
2968   "Make the block special device PATH available to the system for swapping.   "Make the block special device PATH unavailable to the system for swapping.
2969    This call is restricted to the super-user."    This call is restricted to the super-user."
2970   (int-syscall ("swapon" c-string) path))   (int-syscall ("swapoff" c-string) (%name->file path)))
2971    
2972  ;;; sys/sysctl.h  ;;; sys/sysctl.h
2973    
# Line 3072  in at a time in poll.") Line 3093  in at a time in poll.")
3093  (defconstant ITIMER-VIRTUAL 1)  (defconstant ITIMER-VIRTUAL 1)
3094  (defconstant ITIMER-PROF 2)  (defconstant ITIMER-PROF 2)
3095    
3096  (defun unix-getitimer(which)  (defun unix-getitimer (which)
3097    "Unix-getitimer returns the INTERVAL and VALUE slots of one of    "Unix-getitimer returns the INTERVAL and VALUE slots of one of
3098     three system timers (:real :virtual or :profile). On success,     three system timers (:real :virtual or :profile). On success,
3099     unix-getitimer returns 5 values,     unix-getitimer returns 5 values,

Legend:
Removed from v.1.43.4.4  
changed lines
  Added in v.1.43.4.4.2.1

  ViewVC Help
Powered by ViewVC 1.1.5