Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl
Commits:
16f35f1a by Raymond Toy at 2015-05-09T15:15:11Z
Add UNIX functions that were previously missed.
- - - - -
1 changed file:
- src/code/unix-glibc2.lisp
Changes:
=====================================
src/code/unix-glibc2.lisp
=====================================
--- a/src/code/unix-glibc2.lisp
+++ b/src/code/unix-glibc2.lisp
@@ -667,6 +667,21 @@
(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 ("creat64" c-string int) (%name->file name) mode))
+
(defun unix-resolve-links (pathname)
_N"Returns the pathname with all symbolic links resolved."
(declare (simple-string pathname))
@@ -907,6 +922,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))
+
(defun unix-readlink (path)
_N"Unix-readlink invokes the readlink system call on the file name
specified by the simple string path. It returns up to two values:
@@ -1023,6 +1051,14 @@
(void-syscall ("rename" c-string c-string)
(%name->file name1) (%name->file name2)))
+;;; Unix-rmdir accepts a name and removes the associated directory.
+
+(defun unix-rmdir (name)
+ _N"Unix-rmdir attempts to remove the directory name. NIL and
+ an error number is returned if an error occured."
+ (declare (type unix-pathname name))
+ (void-syscall ("rmdir" c-string) (%name->file name)))
+
(def-alien-type fd-mask #-alpha unsigned-long #+alpha unsigned-int)
(defconstant fd-setsize 1024)
@@ -1101,6 +1137,9 @@
(define-ioctl-command TIOCSPGRP #\T #x10)
(define-ioctl-command TIOCGPGRP #\T #x0F)
+;;; File ioctl commands.
+(define-ioctl-command FIONREAD #\T #x1B)
+
;;; ioctl-types.h
(def-alien-type nil
@@ -1503,6 +1542,28 @@
(addr tv)
(addr tz))))
+;;; 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.
+
+(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 ("utimes" c-string (* (struct timeval)))
+ file
+ (cast tvp (* (struct timeval))))))
+
(def-alien-routine ("ttyname" unix-ttyname) c-string
(fd int))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/16f35f1a83c093309b7d4486d…
Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl
Commits:
6b33a1f0 by Raymond Toy at 2015-05-07T22:43:06Z
Install the appropriate compiled unix file.
- - - - -
1 changed file:
- bin/make-main-dist.sh
Changes:
=====================================
bin/make-main-dist.sh
=====================================
--- a/bin/make-main-dist.sh
+++ b/bin/make-main-dist.sh
@@ -127,12 +127,21 @@ do
done
# Create the directories and install the fasl files for asdf and defsystem
-for f in asdf defsystem unix
+for f in asdf defsystem
do
install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f
install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f
done
+set -x
+case `uname -s` in
+ Linux*) UCONTRIB="unix-glibc2" ;;
+ *) UCONTRIB="unix" ;;
+esac
+
+install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/unix
+install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/unix/$UCONTRIB.$FASL $DESTDIR/lib/cmucl/lib/contrib/unix
+
# Copy the source files for asdf and defsystem
for f in `(cd src; find contrib/asdf contrib/defsystem -type f -print | grep -v CVS)`
do
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/6b33a1f0851c69ee404d2a5dd…
Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl
Commits:
e549b338 by Raymond Toy at 2015-05-07T22:39:30Z
Don't pass in the command line args to lisp when building asdf and
friends.
The command line args aren't relevant to lisp.
- - - - -
1 changed file:
- bin/build.sh
Changes:
=====================================
bin/build.sh
=====================================
--- a/bin/build.sh
+++ b/bin/build.sh
@@ -251,7 +251,7 @@ buildit
# Asdf and friends are part of the base install, so we need to build
# them now.
-$TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3
+$TARGET/lisp/lisp -noinit -nositeinit -batch << EOF || exit 3
(in-package :cl-user)
(setf (ext:search-list "target:")
'("$TARGET/" "src/"))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e549b338970eee4cef8403651…
Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl
Commits:
3191f538 by Raymond Toy at 2015-05-06T21:07:00Z
For linux, Load unix-glibc2.lisp instead of unix.lisp.
- - - - -
1 changed file:
- src/contrib/load-unix.lisp
Changes:
=====================================
src/contrib/load-unix.lisp
=====================================
--- a/src/contrib/load-unix.lisp
+++ b/src/contrib/load-unix.lisp
@@ -1,6 +1,7 @@
;; Load extra functionality in the UNIX package.
(ext:without-package-locks
- (load "modules:unix/unix"))
+ (load #-linux "modules:unix/unix"
+ #+linux "modules:unix/unix-glibc2"))
(provide 'unix)
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/3191f538dd21d8656e4d79fbf…