[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-unix-core updated. snapshot-2014-11-17-g11ecbb8

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, rtoy-unix-core has been updated
       via  11ecbb802bbf4758df3e4f0e45faeb912bcc1e72 (commit)
      from  a71198af3e574a22d6698870bd6f5755449c39cd (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 11ecbb802bbf4758df3e4f0e45faeb912bcc1e72
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sun Nov 16 21:14:42 2014 -0800

    More support for hemlock.

diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index 3c2e492..197af66 100644
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -290,6 +290,10 @@
 	   "TERMIOS"
 	   "UNIX-TCGETATTR"
 	   "UNIX-TCSETATTR"
+	   "UNIX-CFGETOSPEED"
+	   "UNIX-FCHMOD"
+	   "UNIX-CREAT"
+	   "UNIX-UTIMES"
 	   ))
   
 (defpackage "FORMAT")
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index e314960..968194c 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -437,6 +437,19 @@
 	   (type unix-file-mode mode))
   (void-syscall ("chmod" c-string int) (%name->file path) mode))
 
+;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode
+;;; ("mode") and changes the protection of the file described by "fd" to 
+;;; "mode".
+
+(defun unix-fchmod (fd mode)
+  _N"Given an integer file descriptor and a mode (the same as those
+   used for unix-chmod), unix-fchmod changes the permission mode
+   for that file to the one specified. T is returned if the call
+   was successful."
+  (declare (type unix-fd fd)
+	   (type unix-file-mode mode))
+  (void-syscall ("fchmod" int int) fd mode))
+
 ;;; Unix-lseek accepts a file descriptor, an offset, and whence value.
 
 (defconstant l_set 0 _N"set the file pointer")
@@ -538,6 +551,22 @@
   (declare (type unix-fd fd))
   (void-syscall ("close" int) fd))
 
+;;; Unix-creat accepts a file name and a mode.  It creates a new file
+;;; with name and sets it mode to mode (as for chmod).
+
+(defun unix-creat (name mode)
+  _N"Unix-creat accepts a file name and a mode (same as those for
+   unix-chmod) and creates a file by that name with the specified
+   permission mode.  It returns a file descriptor on success,
+   or NIL and an error  number otherwise.
+
+   This interface is made obsolete by UNIX-OPEN."
+  
+  (declare (type unix-pathname name)
+	   (type unix-file-mode mode))
+  (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int)
+	       (%name->file name) mode))
+
 ;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
 ;;; It attempts to read len bytes from the device associated with fd
 ;;; and store them into the buffer.  It returns the actual number of
@@ -955,6 +984,22 @@
   (declare (type unix-fd fd))
   (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
 
+;; XXX rest of functions in this progn probably are present in linux, but
+;; not verified.
+#-bsd
+(defun unix-cfgetospeed (termios)
+  _N"Get terminal output speed."
+  (multiple-value-bind (speed errno)
+      (int-syscall ("cfgetospeed" (* (struct termios))) termios)
+    (if speed
+        (values (svref terminal-speeds speed) 0)
+        (values speed errno))))
+
+#+bsd
+(defun unix-cfgetospeed (termios)
+  _N"Get terminal output speed."
+  (int-syscall ("cfgetospeed" (* (struct termios))) termios))
+
 (def-alien-routine ("getuid" unix-getuid) int
   _N"Unix-getuid returns the real user-id associated with the
    current process.")
@@ -1873,6 +1918,29 @@
 	      (addr tv)
 	      #-(or svr4 netbsd) (addr tz) #+netbsd nil)))
 
+;;; Unix-utimes changes the accessed and updated times on UNIX
+;;; files.  The first argument is the filename (a string) and
+;;; the second argument is a list of the 4 times- accessed and
+;;; updated seconds and microseconds.
+
+#-hpux
+(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec)
+  _N"Unix-utimes sets the 'last-accessed' and 'last-updated'
+   times on a specified file.  NIL and an error number is
+   returned if the call is unsuccessful."
+  (declare (type unix-pathname file)
+	   (type (alien unsigned-long)
+		 atime-sec atime-usec
+		 mtime-sec mtime-usec))
+  (with-alien ((tvp (array (struct timeval) 2)))
+    (setf (slot (deref tvp 0) 'tv-sec) atime-sec)
+    (setf (slot (deref tvp 0) 'tv-usec) atime-usec)
+    (setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
+    (setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
+    (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval)))
+		  file
+		  (cast tvp (* (struct timeval))))))
+
 (def-alien-routine ("getpid" unix-getpid) int
   _N"Unix-getpid returns the process-id of the current process.")
 

-----------------------------------------------------------------------

Summary of changes:
 src/code/exports.lisp |  4 +++
 src/code/unix.lisp    | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)


hooks/post-receive
-- 
CMU Common Lisp