/[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.2.3 by rtoy, Wed Mar 18 15:37:28 2009 UTC revision 1.43.4.6 by rtoy, Mon Mar 16 21:10:55 2009 UTC
# Line 59  Line 59 
59  (use-package "SYSTEM")  (use-package "SYSTEM")
60  (use-package "EXT")  (use-package "EXT")
61    
 ;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding  
 ;; is locale-dependent...else use :utf-8 on Unicode Lisps.  On 8 bit Lisps  
 ;; it must be set to :iso8859-1 (or left as NIL), making files with  
 ;; non-Latin-1 characters "mojibake", but otherwise they'll be inaccessible.  
 ;; Must be set to NIL initially to enable building Lisp!  
 (defvar *filename-encoding* nil)  
   
62  (export '(  (export '(
63            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
64            blkcnt-t fsblkcnt-t fsfilcnt-t            blkcnt-t fsblkcnt-t fsfilcnt-t
# Line 204  Line 197 
197  (pushnew :unix *features*)  (pushnew :unix *features*)
198  (pushnew :glibc2 *features*)  (pushnew :glibc2 *features*)
199    
 ;; needed for bootstrap  
 (eval-when (:compile-toplevel)  
   (defmacro %name->file (string)  
     `(if *filename-encoding*  
          (string-encode ,string *filename-encoding*)  
          ,string))  
   (defmacro %file->name (string)  
     `(if *filename-encoding*  
          (string-decode ,string *filename-encoding*)  
          ,string)))  
   
200  ;;;; Common machine independent structures.  ;;;; Common machine independent structures.
201    
202  (eval-when (compile eval)  (eval-when (compile eval)
# Line 399  Line 381 
381    "Unix-rename renames the file with string name1 to the string    "Unix-rename renames the file with string name1 to the string
382     name2.  NIL and an error code is returned if an error occured."     name2.  NIL and an error code is returned if an error occured."
383    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
384    (void-syscall ("rename" c-string c-string)    (void-syscall ("rename" c-string c-string) name1 name2))
                 (%name->file name1) (%name->file name2)))  
385    
386  ;;; From sys/types.h  ;;; From sys/types.h
387  ;;;         and  ;;;         and
# Line 501  Line 482 
482                (alien-funcall (extern-alien "opendir"                (alien-funcall (extern-alien "opendir"
483                                             (function system-area-pointer                                             (function system-area-pointer
484                                                       c-string))                                                       c-string))
485                               (%name->file pathname))))                               pathname)))
486           (if (zerop (sap-int dir-struct))           (if (zerop (sap-int dir-struct))
487               (values nil (unix-errno))               (values nil (unix-errno))
488               (make-directory :name pathname :dir-struct dir-struct))))               (make-directory :name pathname :dir-struct dir-struct))))
# Line 520  Line 501 
501      (if (zerop (sap-int daddr))      (if (zerop (sap-int daddr))
502          nil          nil
503          (with-alien ((dirent (* (struct dirent)) daddr))          (with-alien ((dirent (* (struct dirent)) daddr))
504            (values (%file->name (cast (slot dirent 'd-name) c-string))            (values (cast (slot dirent 'd-name) c-string)
505                    (slot dirent 'd-ino))))))                    (slot dirent 'd-ino))))))
506    
507  (defun close-dir (dir)  (defun close-dir (dir)
# Line 590  Line 571 
571    (declare (type unix-pathname path)    (declare (type unix-pathname path)
572             (type fixnum flags)             (type fixnum flags)
573             (type unix-file-mode mode))             (type unix-file-mode mode))
574    (int-syscall ("open64" c-string int int) (%name->file path) flags mode))    (int-syscall ("open64" c-string int int) path flags mode))
575    
576  (defun unix-getdtablesize ()  (defun unix-getdtablesize ()
577    "Unix-getdtablesize returns the maximum size of the file descriptor    "Unix-getdtablesize returns the maximum size of the file descriptor
# Line 621  Line 602 
602    
603    (declare (type unix-pathname name)    (declare (type unix-pathname name)
604             (type unix-file-mode mode))             (type unix-file-mode mode))
605    (int-syscall ("creat64" c-string int) (%name->file name) mode))    (int-syscall ("creat64" c-string int) name mode))
606    
607  ;;; fcntlbits.h  ;;; fcntlbits.h
608    
# Line 1844  length LEN and type TYPE." Line 1825  length LEN and type TYPE."
1825                                  (car cons))                                  (car cons))
1826                              envlist))                              envlist))
1827                      envlist)))                      envlist)))
1828      (sub-unix-execve (%name->file program) arg-list env-list)))      (sub-unix-execve program arg-list env-list)))
1829    
1830    
1831  (defmacro round-bytes-to-words (n)  (defmacro round-bytes-to-words (n)
# Line 1869  length LEN and type TYPE." Line 1850  length LEN and type TYPE."
1850          f_ok     Presence of file."          f_ok     Presence of file."
1851    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1852             (type (mod 8) mode))             (type (mod 8) mode))
1853    (void-syscall ("access" c-string int) (%name->file path) mode))    (void-syscall ("access" c-string int) path mode))
1854    
1855  (defconstant l_set 0 "set the file pointer")  (defconstant l_set 0 "set the file pointer")
1856  (defconstant l_incr 1 "increment the file pointer")  (defconstant l_incr 1 "increment the file pointer")
# Line 1976  length LEN and type TYPE." Line 1957  length LEN and type TYPE."
1957    (declare (type unix-pathname path)    (declare (type unix-pathname path)
1958             (type (or unix-uid (integer -1 -1)) uid)             (type (or unix-uid (integer -1 -1)) uid)
1959             (type (or unix-gid (integer -1 -1)) gid))             (type (or unix-gid (integer -1 -1)) gid))
1960    (void-syscall ("chown" c-string int int) (%name->file path) uid gid))    (void-syscall ("chown" c-string int int) path uid gid))
1961    
1962  ;;; 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
1963  ;;; is specified by a file-descriptor ("fd") instead of a pathname.  ;;; is specified by a file-descriptor ("fd") instead of a pathname.
# Line 1996  length LEN and type TYPE." Line 1977  length LEN and type TYPE."
1977    "Given a file path string, unix-chdir changes the current working    "Given a file path string, unix-chdir changes the current working
1978     directory to the one specified."     directory to the one specified."
1979    (declare (type unix-pathname path))    (declare (type unix-pathname path))
1980    (void-syscall ("chdir" c-string) (%name->file path)))    (void-syscall ("chdir" c-string) path))
1981    
1982  (defun unix-current-directory ()  (defun unix-current-directory ()
1983    "Put the absolute pathname of the current working directory in BUF.    "Put the absolute pathname of the current working directory in BUF.
# Line 2012  length LEN and type TYPE." Line 1993  length LEN and type TYPE."
1993                      5120)))                      5120)))
1994    
1995        (values (not (zerop (sap-int (alien-sap result))))        (values (not (zerop (sap-int (alien-sap result))))
1996                (%file->name (cast buf c-call:c-string))))))                (cast buf c-call:c-string)))))
1997    
1998    
1999  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor  ;;; Unix-dup returns a duplicate copy of the existing file-descriptor
# Line 2051  length LEN and type TYPE." Line 2032  length LEN and type TYPE."
2032  #+(or)  #+(or)
2033  (defun unix-pathconf (path name)  (defun unix-pathconf (path name)
2034    "Get file-specific configuration information about PATH."    "Get file-specific configuration information about PATH."
2035    (int-syscall ("pathconf" c-string int) (%name->file path) name))    (int-syscall ("pathconf" c-string int) path name))
2036    
2037  #+(or)  #+(or)
2038  (defun unix-sysconf (name)  (defun unix-sysconf (name)
2039    "Get the value of the system variable NAME."    "Get the value of the system variable NAME."
2040    (int-syscall ("sysconf" int) name))    (int-syscall ("sysconf" c-string) name))
2041    
2042  #+(or)  #+(or)
2043  (defun unix-confstr (name)  (defun unix-confstr (name)
# Line 2196  length LEN and type TYPE." Line 2177  length LEN and type TYPE."
2177    "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
2178     file with name2."     file with name2."
2179    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2180    (void-syscall ("link" c-string c-string)    (void-syscall ("link" c-string c-string) name1 name2))
                 (%name->file name1) (%name->file name2)))  
2181    
2182  (defun unix-symlink (name1 name2)  (defun unix-symlink (name1 name2)
2183    "Unix-symlink creates a symbolic link named name2 to the file    "Unix-symlink creates a symbolic link named name2 to the file
2184     named name1.  NIL and an error number is returned if the call     named name1.  NIL and an error number is returned if the call
2185     is unsuccessful."     is unsuccessful."
2186    (declare (type unix-pathname name1 name2))    (declare (type unix-pathname name1 name2))
2187    (void-syscall ("symlink" c-string c-string)    (void-syscall ("symlink" c-string c-string) name1 name2))
                 (%name->file name1) (%name->file name2)))  
2188    
2189  (defun unix-readlink (path)  (defun unix-readlink (path)
2190    "Unix-readlink invokes the readlink system call on the file name    "Unix-readlink invokes the readlink system call on the file name
# Line 2225  length LEN and type TYPE." Line 2204  length LEN and type TYPE."
2204                 (let ((sap (alien-sap buf)))                 (let ((sap (alien-sap buf)))
2205                   (dotimes (k result)                   (dotimes (k result)
2206                     (setf (aref string k) (code-char (sap-ref-8 sap k)))))                     (setf (aref string k) (code-char (sap-ref-8 sap k)))))
2207                 (%file->name string))                 string)
2208               (%name->file path) (cast buf (* char)) 1024)))               path (cast buf (* char)) 1024)))
2209    
2210  ;;; Unix-unlink accepts a name and deletes the directory entry for that  ;;; Unix-unlink accepts a name and deletes the directory entry for that
2211  ;;; name and the file if this is the last link.  ;;; name and the file if this is the last link.
# Line 2235  length LEN and type TYPE." Line 2214  length LEN and type TYPE."
2214    "Unix-unlink removes the directory entry for the named file.    "Unix-unlink removes the directory entry for the named file.
2215     NIL and an error code is returned if the call fails."     NIL and an error code is returned if the call fails."
2216    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2217    (void-syscall ("unlink" c-string) (%name->file name)))    (void-syscall ("unlink" c-string) name))
2218    
2219  ;;; Unix-rmdir accepts a name and removes the associated directory.  ;;; Unix-rmdir accepts a name and removes the associated directory.
2220    
# Line 2243  length LEN and type TYPE." Line 2222  length LEN and type TYPE."
2222    "Unix-rmdir attempts to remove the directory name.  NIL and    "Unix-rmdir attempts to remove the directory name.  NIL and
2223     an error number is returned if an error occured."     an error number is returned if an error occured."
2224    (declare (type unix-pathname name))    (declare (type unix-pathname name))
2225    (void-syscall ("rmdir" c-string) (%name->file name)))    (void-syscall ("rmdir" c-string) name))
2226    
2227  (defun tcgetpgrp (fd)  (defun tcgetpgrp (fd)
2228    "Get the tty-process-group for the unix file-descriptor FD."    "Get the tty-process-group for the unix file-descriptor FD."
# Line 2378  length LEN and type TYPE." Line 2357  length LEN and type TYPE."
2357  #+(or)  #+(or)
2358  (defun unix-revoke (file)  (defun unix-revoke (file)
2359   "Revoke the access of all descriptors currently open on FILE."   "Revoke the access of all descriptors currently open on FILE."
2360   (int-syscall ("revoke" c-string) (%name->file file)))   (int-syscall ("revoke" c-string) file))
2361    
2362    
2363  #+(or)  #+(or)
2364  (defun unix-chroot (path)  (defun unix-chroot (path)
2365   "Make PATH be the root directory (the starting point for absolute paths).   "Make PATH be the root directory (the starting point for absolute paths).
2366     This call is restricted to the super-user."     This call is restricted to the super-user."
2367   (int-syscall ("chroot" c-string) (%name->file path)))   (int-syscall ("chroot" c-string) path))
2368    
2369  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long  (def-alien-routine ("gethostid" unix-gethostid) unsigned-long
2370    "Unix-gethostid returns a 32-bit integer which provides unique    "Unix-gethostid returns a 32-bit integer which provides unique
# Line 2415  length LEN and type TYPE." Line 2394  length LEN and type TYPE."
2394     if the call is unsuccessful."     if the call is unsuccessful."
2395    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2396             (type (unsigned-byte 64) length))             (type (unsigned-byte 64) length))
2397    (void-syscall ("truncate64" c-string off-t) (%name->file name) length))    (void-syscall ("truncate64" c-string off-t) name length))
2398    
2399  (defun unix-ftruncate (fd length)  (defun unix-ftruncate (fd length)
2400    "Unix-ftruncate is similar to unix-truncate except that the first    "Unix-ftruncate is similar to unix-truncate except that the first
# Line 2857  in at a time in poll.") Line 2836  in at a time in poll.")
2836    (with-alien ((buf (struct stat)))    (with-alien ((buf (struct stat)))
2837      (syscall ("stat64" c-string (* (struct stat)))      (syscall ("stat64" c-string (* (struct stat)))
2838               (extract-stat-results buf)               (extract-stat-results buf)
2839               (%name->file name) (addr buf))))               name (addr buf))))
2840    
2841  (defun unix-fstat (fd)  (defun unix-fstat (fd)
2842    "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 2875  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 ("lstat64" c-string (* (struct stat)))      (syscall ("lstat64" c-string (* (struct stat)))
2856               (extract-stat-results buf)               (extract-stat-results buf)
2857               (%name->file name) (addr buf))))               name (addr buf))))
2858    
2859  ;;; 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.
2860    
# Line 2904  in at a time in poll.") Line 2883  in at a time in poll.")
2883    otherwise."    otherwise."
2884    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2885             (type unix-file-mode mode))             (type unix-file-mode mode))
2886    (void-syscall ("chmod" c-string int) (%name->file path) mode))    (void-syscall ("chmod" c-string int) path mode))
2887    
2888  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode  ;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
2889  ;;; ("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 2934  in at a time in poll.") Line 2913  in at a time in poll.")
2913     NIL and an error number."     NIL and an error number."
2914    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2915             (type unix-file-mode mode))             (type unix-file-mode mode))
2916    (void-syscall ("mkdir" c-string int) (%name->file name) mode))    (void-syscall ("mkdir" c-string int) name mode))
2917    
2918  #+(or)  #+(or)
2919  (defun unix-makedev (path mode dev)  (defun unix-makedev (path mode dev)
# Line 2943  in at a time in poll.") Line 2922  in at a time in poll.")
2922    device numbers with the `makedev' macro above)."    device numbers with the `makedev' macro above)."
2923    (declare (type unix-pathname path)    (declare (type unix-pathname path)
2924             (type unix-file-mode mode))             (type unix-file-mode mode))
2925    (void-syscall ("makedev" c-string mode-t dev-t) (%name->file name) mode dev))    (void-syscall ("makedev" c-string mode-t dev-t) name mode dev))
2926    
2927    
2928  #+(or)  #+(or)
# Line 2951  in at a time in poll.") Line 2930  in at a time in poll.")
2930    "Create a new FIFO named PATH, with permission bits MODE."    "Create a new FIFO named PATH, with permission bits MODE."
2931    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2932             (type unix-file-mode mode))             (type unix-file-mode mode))
2933    (void-syscall ("mkfifo" c-string int) (%name->file name) mode))    (void-syscall ("mkfifo" c-string int) name mode))
2934    
2935  ;;; sys/statfs.h  ;;; sys/statfs.h
2936    
# Line 2959  in at a time in poll.") Line 2938  in at a time in poll.")
2938  (defun unix-statfs (file buf)  (defun unix-statfs (file buf)
2939    "Return information about the filesystem on which FILE resides."    "Return information about the filesystem on which FILE resides."
2940    (int-syscall ("statfs64" c-string (* (struct statfs)))    (int-syscall ("statfs64" c-string (* (struct statfs)))
2941                 (%name->file file) buf))                 file buf))
2942    
2943  ;;; sys/swap.h  ;;; sys/swap.h
2944    
# Line 2967  in at a time in poll.") Line 2946  in at a time in poll.")
2946  (defun unix-swapon (path flags)  (defun unix-swapon (path flags)
2947   "Make the block special device PATH available to the system for swapping.   "Make the block special device PATH available to the system for swapping.
2948    This call is restricted to the super-user."    This call is restricted to the super-user."
2949   (int-syscall ("swapon" c-string int) (%name->file path) flags))   (int-syscall ("swapon" c-string int) path flags))
2950    
2951  #+(or)  #+(or)
2952  (defun unix-swapoff (path)  (defun unix-swapoff (path)
2953   "Make the block special device PATH unavailable to the system for swapping.   "Make the block special device PATH available to the system for swapping.
2954    This call is restricted to the super-user."    This call is restricted to the super-user."
2955   (int-syscall ("swapoff" c-string) (%name->file path)))   (int-syscall ("swapon" c-string) path))
2956    
2957  ;;; sys/sysctl.h  ;;; sys/sysctl.h
2958    
# Line 3099  in at a time in poll.") Line 3078  in at a time in poll.")
3078  (defconstant ITIMER-VIRTUAL 1)  (defconstant ITIMER-VIRTUAL 1)
3079  (defconstant ITIMER-PROF 2)  (defconstant ITIMER-PROF 2)
3080    
3081  (defun unix-getitimer (which)  (defun unix-getitimer(which)
3082    "Unix-getitimer returns the INTERVAL and VALUE slots of one of    "Unix-getitimer returns the INTERVAL and VALUE slots of one of
3083     three system timers (:real :virtual or :profile). On success,     three system timers (:real :virtual or :profile). On success,
3084     unix-getitimer returns 5 values,     unix-getitimer returns 5 values,

Legend:
Removed from v.1.43.4.4.2.3  
changed lines
  Added in v.1.43.4.6

  ViewVC Help
Powered by ViewVC 1.1.5