- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][rtoy-mmap-anon-control-and-binding-stacks] 2 commits: Fix merge mistake: Don't print break as int3.
by Raymond Toy 05 Nov '15

05 Nov '15

Raymond Toy pushed to branch rtoy-mmap-anon-control-and-binding-stacks at cmucl / cmucl Commits: 694331c1 by Raymond Toy at 2015-11-04T19:42:41Z Fix merge mistake: Don't print break as int3. - - - - - 0fb5c699 by Raymond Toy at 2015-11-04T19:44:58Z Define CONTROL_STACK_START and BINDING_STACK_START. ppc currently only supports allocating the control stack and binding stack at fixed addresses. (This used to work, but something broke it recently. Until the ppc machine comes back, we're going to disable that feature there.) - - - - - 2 changed files: - src/compiler/x86/insts.lisp - src/lisp/ppc-validate.h Changes: ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -2105,7 +2105,6 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :print-name 'int3 :control #'break-control) (:emitter (emit-byte segment #b11001100) ===================================== src/lisp/ppc-validate.h ===================================== --- a/src/lisp/ppc-validate.h +++ b/src/lisp/ppc-validate.h @@ -41,19 +41,13 @@ #define STATIC_SPACE_START (0x10000000) #define STATIC_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ -#if 0 #define CONTROL_STACK_START (0x30000000) -#endif #define CONTROL_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ -#if 0 #define CONTROL_STACK_END (CONTROL_STACK_START + control_stack_size) -#endif #define SIGNAL_STACK_SIZE SIGSTKSZ -#if 0 #define BINDING_STACK_START (0x38000000) -#endif #define BINDING_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ #if 0 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/138310f93edc558e3166c1a1…

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2015-11
by Raymond Toy 01 Nov '15

01 Nov '15

Raymond Toy pushed new tag snapshot-2015-11 at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] Update from commit logs.
by Raymond Toy 01 Nov '15

01 Nov '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0889dbb8 by Raymond Toy at 2015-10-31T17:48:50Z Update from commit logs. - - - - - 1 changed file: - src/general-info/release-21b.txt Changes: ===================================== src/general-info/release-21b.txt ===================================== --- a/src/general-info/release-21b.txt +++ b/src/general-info/release-21b.txt @@ -22,6 +22,26 @@ New in this release: * Feature enhancements * Changes + * Update to ASDF 3.1.6 + * Add support for asdf's static-image-op + * This mostly entails internal changes in how executables are + handled. lisp.a is not complete; it must be linked with + either exec-init.o or exec-final.o. + * If the linker fails to link an image, the exit code is + returned to indicate failure. + * When printing the process structure (from run-program), include + the exit code to make it easier to see if the the process exited + cleanly or not. The printed representation is also changed + slightly to use pprint-unreadable-object. + * Executable images on OSX no longer support running on other + versions of the OS. Previously, -mmacosx-version-min=10.5 was + used to specify the executable would run on OSX versions >= + 10.5. This, however, requires the 10.5DK be available. Thus, + no longer require that. + * Disassembly of bytes and words now use .BYTE and .WORD instead + of BYTE and WORD. + * Unix support on Linux has been unified with all other OSes. + Thus, src/code/unix-glibc2.lisp is no longer used. * ANSI compliance fixes: @@ -30,6 +50,9 @@ New in this release: * Trac Tickets: * Gitlab tickets: + * Ticket #10 fixed: setting an element of a 1, 2, or 4-bit array + with a constant index did not always set the element + appropriately. * Other changes: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0889dbb8326a45e530cf035d0…

1 0

[Git][cmucl/cmucl][master] lisp.a, exec-init.o, and exec-final.o aren't executable.
by Raymond Toy 01 Nov '15

01 Nov '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4038f7b0 by Raymond Toy at 2015-10-31T17:45:58Z lisp.a, exec-init.o, and exec-final.o aren't executable. Remove the execute bits from these files because they're not executables. - - - - - 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 @@ -96,9 +96,9 @@ install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/${MANDIR} install ${GROUP} ${OWNER} -m 0755 $TARGET/lisp/lisp $DESTDIR/bin/ if [ "$EXECUTABLE" = "true" ] then - install ${GROUP} ${OWNER} -m 0555 $TARGET/lisp/lisp.a $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0555 $TARGET/lisp/exec-init.o $DESTDIR/lib/cmucl/lib/ - install ${GROUP} ${OWNER} -m 0555 $TARGET/lisp/exec-final.o $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/lisp.a $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-init.o $DESTDIR/lib/cmucl/lib/ + install ${GROUP} ${OWNER} -m 0644 $TARGET/lisp/exec-final.o $DESTDIR/lib/cmucl/lib/ install ${GROUP} ${OWNER} -m 0755 src/tools/linker.sh $DESTDIR/lib/cmucl/lib/ if [ -f src/tools/$SCRIPT-cmucl-linker-script ]; then install ${GROUP} ${OWNER} -m 0755 src/tools/$SCRIPT-cmucl-linker-script $DESTDIR/lib/cmucl/lib/ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4038f7b0f9217e42a3f75391e…

1 0

[Git][cmucl/cmucl][master] Revert e15cd9fa
by Raymond Toy 31 Oct '15

31 Oct '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a1582607 by Raymond Toy at 2015-10-31T12:57:07Z Revert e15cd9fa Don't print BREAK as INT3 because it looks funny. The disassembly looks like INT3 <code> instead of BREAK <code> To do this properly requires a lot more work to get the code printed on the next line and also getting the disassembler to recognize the break case. - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -2105,7 +2105,6 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :print-name 'int3 :control #'break-control) (:emitter (emit-byte segment #b11001100) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/a15826079090bccf6eb48cb11…

1 0

[Git][cmucl/cmucl][master] 8 commits: First cut at merging unix-glibc2.lisp into unix.lisp.
by Raymond Toy 31 Oct '15

31 Oct '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ce8ced74 by Raymond Toy at 2015-10-17T19:38:01Z First cut at merging unix-glibc2.lisp into unix.lisp. WIP; many items have been moved, but not all, and not all things have been checked. This current code doesn't succeed in building itself. The second build crashes with a type error coming from unexpected-eof-error. - - - - - 91b7fea4 by Raymond Toy at 2015-10-18T00:18:17Z Add more missing things from unix-glibc2. In particular, use the 64-bit versions of most functions. - - - - - e0835904 by Raymond Toy at 2015-10-18T00:19:24Z Need to export some symbols for linux. This allows us to build all of cmucl, but the utilities don't yet build completely. - - - - - dcb8aafc by Raymond Toy at 2015-10-18T12:53:17Z More changes for linux. o Add :glibc2 to *features*. (Need to simplify that.) o Add define-ioctl-command and constants for linux. - - - - - 95279cab by Raymond Toy at 2015-10-19T22:02:24Z Move over more items from unix-glibc2.lisp. These should be the last things that need to be moved. - - - - - 6c6f37cb by Raymond Toy at 2015-10-31T10:13:04Z Fix typo: "o_asyn" -> "o_async" - - - - - 3dd45a3a by Raymond Toy at 2015-10-31T10:26:48Z Regenerated. - - - - - f87fe0bd by Raymond Toy at 2015-10-31T10:43:57Z Merge branch 'rtoy-grand-unix-unification' - - - - - 5 changed files: - src/code/exports.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/tools/worldbuild.lisp - src/tools/worldcom.lisp Changes: ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -394,6 +394,9 @@ "LTCHARS" "D-NAMLEN" + ;; run-program.lisp + "SGTTYB" + ;; Other symbols "BLKCNT-T" "D-INO" "D-OFF" "EADV" "EBADE" "EBADFD" "EBADMSG" "EBADR" "EBADRQC" "EBADSLT" "EBFONT" "ECHRNG" "ECOMM" "EDEADLOCK" "EDOTDOT" @@ -402,7 +405,11 @@ "ENOANO" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" "ENOPKG" "ENOSR" "ENOSTR" "ENOSYS" "ENOTNAM" "ENOTUNIQ" "EOVERFLOW" "EPROTO" "EREMCHG" "EREMOTEIO" "ERESTART" "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" - "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" "TTY-IUCLC" + "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" + "SG-FLAGS" + "TIOCGETP" + "TIOCSETP" + "TTY-IUCLC" "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" "UTSNAME" ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -17,6 +17,8 @@ (intl:textdomain "cmucl-unix") (pushnew :unix *features*) +#+linux +(pushnew :glibc2 *features*) ;; 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 @@ -37,16 +39,27 @@ ;;;; Common machine independent structures. +#+linux +(defconstant +max-u-long+ 4294967295) (def-alien-type int64-t (signed 64)) (def-alien-type u-int64-t (unsigned 64)) +(def-alien-type uquad-t + #+alpha unsigned-long + #-alpha (array unsigned-long 2)) + +(def-alien-type u-int32-t unsigned-int) + (def-alien-type ino-t #+netbsd u-int64-t #+alpha unsigned-int #-(or alpha netbsd) unsigned-long) +#+linux +(def-alien-type ino64-t u-int64-t) + (def-alien-type size-t #-(or linux alpha) long #+linux unsigned-int @@ -61,7 +74,8 @@ (def-alien-type dev-t #-(or alpha svr4 bsd linux) short - #+linux unsigned-short + #+(and linux (not amd64)) uquad-t + #+(and linux amd64) u-int64-t #+netbsd u-int64-t #+alpha int #+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long) @@ -70,16 +84,22 @@ (progn (deftype file-offset () '(signed-byte 32)) (def-alien-type off-t - #-alpha long - #+alpha unsigned-long) ;??? very dubious + #-(or alpha linux) long + #+linux int64-t + #+alpha unsigned-long) (def-alien-type uid-t - #-(or alpha svr4) unsigned-short + #-(or alpha svr4 linux) unsigned-short #+alpha unsigned-int + #+linux unsigned-int #+svr4 long) (def-alien-type gid-t - #-(or alpha svr4) unsigned-short + #-(or alpha svr4 linux) unsigned-short #+alpha unsigned-int - #+svr4 long)) + #+linux unsigned-int + #+svr4 long) + #+linux + (def-alien-type blkcnt-t u-int64-t) +) #+BSD (progn @@ -89,8 +109,9 @@ (def-alien-type gid-t unsigned-long)) (def-alien-type mode-t - #-(or alpha svr4) unsigned-short + #-(or alpha svr4 linux) unsigned-short #+alpha unsigned-int + #+linux u-int32-t #+svr4 unsigned-long) ;; not checked for linux... @@ -111,9 +132,11 @@ (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) (def-alien-type nlink-t - #-(or svr4 netbsd) unsigned-short + #-(or svr4 netbsd linux) unsigned-short #+netbsd unsigned-long - #+svr4 unsigned-long) + #+svr4 unsigned-long + #+(and linux (not amd64)) unsigned-int + #+(and linux amd64) u-int64-t) (defconstant fd-setsize #-(or hpux alpha linux FreeBSD) 256 @@ -246,7 +269,7 @@ (t (values nil enotdir))))) -#-(and bsd (not solaris)) +#-(or solaris (and bsd (not solaris)) linux) (defun read-dir (dir) (declare (type %directory dir)) (let ((daddr (alien-funcall (extern-alien "readdir" @@ -337,6 +360,20 @@ (code-char (sap-ref-8 sap k))))) (values (%file->name string) fino))))))) +#+linux +(defun read-dir (dir) + (declare (type %directory dir)) + (let ((daddr (alien-funcall (extern-alien "readdir64" + (function system-area-pointer + system-area-pointer)) + (directory-dir-struct dir)))) + (declare (type system-area-pointer daddr)) + (if (zerop (sap-int daddr)) + nil + (with-alien ((dirent (* (struct dirent)) daddr)) + (values (%file->name (cast (slot dirent 'd-name) c-string)) + (slot dirent 'd-ino)))))) + (defun close-dir (dir) (declare (type %directory dir)) @@ -458,6 +495,7 @@ (defconstant l_incr 1 _N"increment the file pointer") (defconstant l_xtnd 2 _N"extend the file size") +#-linux (defun unix-lseek (fd offset whence) _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead a certain offset for that file. Whence can be any of the following: @@ -471,6 +509,24 @@ (type (integer 0 2) whence)) (off-t-syscall ("lseek" (int off-t int)) fd offset whence)) +#+linux +(defun unix-lseek (fd offset whence) + _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead + a certain OFFSET for that file. WHENCE can be any of the following: + + l_set Set the file pointer. + l_incr Increment the file pointer. + l_xtnd Extend the file size. + " + (declare (type unix-fd fd) + (type (signed-byte 64) offset) + (type (integer 0 2) whence)) + (let ((result (alien-funcall + (extern-alien "lseek64" (function off-t int off-t int)) + fd offset whence))) + (if (minusp result) + (values nil (unix-errno)) + (values result 0)))) ;;; Unix-mkdir accepts a name and a mode and attempts to create the ;;; corresponding directory with mode mode. @@ -498,7 +554,10 @@ (defconstant o_wronly 1 _N"Write-only flag.") (defconstant o_rdwr 2 _N"Read-write flag.") #+(or hpux linux svr4) -(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O") +(defconstant o_ndelay + #+linux o_nonblock + #-linux 4 + _N"Non-blocking I/O") (defconstant o_append #-linux #o10 #+linux #o2000 _N"Append flag.") #+(or hpux svr4 linux) (progn @@ -507,14 +566,20 @@ (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.") (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800 _N"Don't assign controlling tty")) -#+(or hpux svr4 BSD) -(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04 +#+(or hpux linux svr4 BSD) +(defconstant o_nonblock + #+hpux #o200000 + #+(or irix solaris) #x80 + #+BSD #x04 + #+linux #o4000 _N"Non-blocking mode") #+BSD (defconstant o_ndelay o_nonblock) ; compatibility #+linux (progn - (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)")) + (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)") + (defconstant o_fsync o_sync) + (defconstant o_async #o20000 _N"Asynchronous I/O")) #-(or hpux svr4 linux) (progn @@ -540,7 +605,8 @@ (declare (type unix-pathname path) (type fixnum flags) (type unix-file-mode mode)) - (int-syscall (#+solaris "open64" #-solaris "open" c-string int int) + (int-syscall (#+(or linux solaris) "open64" #-(or linux solaris) "open" + c-string int int) (%name->file path) flags mode)) ;;; Unix-close accepts a file descriptor and attempts to close the file @@ -566,7 +632,7 @@ (declare (type unix-pathname name) (type unix-file-mode mode)) - (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int) + (int-syscall (#+(or linux solaris) "creat64" #-(or linux solaris) "creat" c-string int) (%name->file name) mode)) ;;; Unix-read accepts a file descriptor, a buffer, and the length to read. @@ -584,6 +650,20 @@ (declare (type unix-fd fd)) (int-syscall ("dup" int) fd)) +;;; Unix-dup2 makes the second file-descriptor describe the same file +;;; as the first. If the second file-descriptor points to an open +;;; file, it is first closed. In any case, the second should have a +;;; value which is a valid file-descriptor. + +(defun unix-dup2 (fd1 fd2) + _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup + does only the new value of the duplicate descriptor may be requested + through the second argument. If a file already exists with the + requested descriptor number, it will be closed and the number + assigned to the duplicate." + (declare (type unix-fd fd1 fd2)) + (void-syscall ("dup2" int int) fd1 fd2)) + ;;; Unix-fcntl takes a file descriptor, an integer command ;;; number, and optional command arguments. It performs ;;; operations on the associated file and/or returns inform- @@ -615,9 +695,13 @@ ;;; File flags for F-GETFL and F-SETFL: -(defconstant FNDELAY #-osf1 #o0004 #+osf1 #o100000 _N"Non-blocking reads") -(defconstant FAPPEND #-linux #o0010 #+linux #o2000 _N"Append on each write") -(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux #o20000 +(defconstant FNDELAY + #+linux o_ndelay + #+osf1 #o100000 + #-(or linux osf1) #o0004 + _N"Non-blocking reads") +(defconstant FAPPEND #-linux #o0010 #+linux o_append _N"Append on each write") +(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux o_async _N"Signal pgrp when data ready") ;; doesn't exist in Linux ;-( #-linux (defconstant FCREAT #-(or hpux svr4) #o1000 #+(or hpux svr4) #o0400 @@ -665,6 +749,7 @@ (values (deref fds 0) (deref fds 1)) (cast fds (* int))))) +#-linux (defun unix-read (fd buf len) _N"Unix-read attempts to read from the file described by fd into the buffer buf until it is full. Len is the length of the buffer. @@ -706,6 +791,40 @@ (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0))))) (int-syscall ("read" int (* char) int) fd buf len)) +#+linux +(defun unix-read (fd buf len) + _N"UNIX-READ attempts to read from the file described by fd into + the buffer buf until it is full. Len is the length of the buffer. + The number of bytes actually read is returned or NIL and an error + number if an error occured." + (declare (type unix-fd fd) + (type (unsigned-byte 32) len)) + #+gencgc + ;; With gencgc, the collector tries to keep raw objects like strings + ;; in separate pages that are not write-protected. However, this + ;; isn't always true. Thus, BUF will sometimes be write-protected + ;; and the kernel doesn't like writing to write-protected pages. So + ;; go through and touch each page to give the segv handler a chance + ;; to unprotect the pages. (This is taken from unix.lisp.) + (without-gcing + (let* ((page-size (get-page-size)) + (1-page-size (1- page-size)) + (sap (etypecase buf + (system-area-pointer buf) + (vector (vector-sap buf)))) + (end (sap+ sap len))) + (declare (type (and fixnum unsigned-byte) page-size 1-page-size) + (type system-area-pointer sap end) + (optimize (speed 3) (safety 0))) + ;; Touch the beginning of every page + (do ((sap (int-sap (logand (sap-int sap) + (logxor 1-page-size (ldb (byte 32 0) -1)))) + (sap+ sap page-size))) + ((sap>= sap end)) + (declare (type system-area-pointer sap)) + (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0))))) + (int-syscall ("read" int (* char) int) fd buf len)) + (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: @@ -802,16 +921,22 @@ ;; output modes #-bsd (def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr - tty-onlret tty-ofill tty-ofdel) + tty-onlret tty-ofill tty-ofdel #+linux tty-nldly) #+bsd (def-enum ash 1 tty-opost tty-onlcr) ;; local modes - #-bsd (def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe + #-(or bsd linux) (def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe tty-echok tty-echonl tty-noflsh #+irix tty-iexten #+(or sunos linux) tty-tostop tty-echoctl tty-echoprt tty-echoke #+(or sunos svr4) tty-defecho tty-flusho #+linux nil tty-pendin #+irix tty-tostop - #+(or sunos linux) tty-iexten) + #+(or sunos linux) tty-iexten) + #+linux + (def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe + tty-echok tty-echonl tty-noflsh + tty-tostop tty-echoctl tty-echoprt + tty-echoke tty-flusho + tty-pendin tty-iexten) #+bsd (def-enum ash 1 tty-echoke tty-echoe tty-echok tty-echo tty-echonl tty-echoprt tty-echoctl tty-isig tty-icanon nil tty-iexten) @@ -930,27 +1055,55 @@ (defconstant ,name ,(logior (ash (char-code #\t) 8) cmd)))) #+linux -(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) - (declare (ignore arg parm-type)) - `(eval-when (eval load compile) - (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd)))) +(progn + (defconstant iocparm-mask #x3fff) + (defconstant ioc_void #x00000000) + (defconstant ioc_out #x40000000) + (defconstant ioc_in #x80000000) + (defconstant ioc_inout (logior ioc_in ioc_out))) + +#+linux +(defmacro define-ioctl-command (name dev cmd &optional arg parm-type) + _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given + then ioctl argument size and direction are included as for ioctls defined + by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type + is the characters code, else DEV may be an integer giving the type." + (let* ((type (if (characterp dev) + (char-code dev) + dev)) + (code (logior (ash type 8) cmd))) + (when arg + (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask) + 16) + ,code))) + (when parm-type + (let ((dir (ecase parm-type + (:void ioc_void) + (:in ioc_in) + (:out ioc_out) + (:inout ioc_inout)))) + (setf code `(logior ,dir ,code)))) + `(eval-when (eval load compile) + (defconstant ,name ,code)))) ) ;;; TTY ioctl commands. -(define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) -(define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) -(define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) -(define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) -(define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) -(define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) - :out) -(define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) - :in) - -(define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void) -#-hpux +#-linux +(progn + (define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) + (define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) + (define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) + (define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) + (define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) + (define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) + :out) + (define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) + :in) + + (define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void)) +#-(or hpux linux) (progn (define-ioctl-command TIOCSLTC #\t #-linux 117 #+linux #x84 (struct ltchars) :in) (define-ioctl-command TIOCGLTC #\t #-linux 116 #+linux #x85 (struct ltchars) :out) @@ -963,9 +1116,19 @@ (define-ioctl-command TIOCSPGRP #\T 29 int :in) (define-ioctl-command TIOCGPGRP #\T 30 int :out) (define-ioctl-command TIOCSIGSEND #\t 93 nil)) +#+linux +(progn + (define-ioctl-command TIOCGWINSZ #\T #x13) + (define-ioctl-command TIOCSWINSZ #\T #x14) + (define-ioctl-command TIOCNOTTY #\T #x22) + (define-ioctl-command TIOCSPGRP #\T #x10) + (define-ioctl-command TIOCGPGRP #\T #x0F)) ;;; File ioctl commands. +#-linux (define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x1B int :out) +#+linux +(define-ioctl-command FIONREAD #\T #x1B) (defun unix-ioctl (fd cmd arg) @@ -1061,11 +1224,13 @@ (defconstant +NCCS+ #+hpux 16 #+irix 23 - #+(or linux solaris) 19 + #+solaris 19 #+(or bsd osf1) 20 + #+linux 32 #+(and sunos (not svr4)) 17 _N"Size of control character vector.") +#-linux (def-alien-type nil (struct termios (c-iflag unsigned-int) @@ -1079,10 +1244,29 @@ #+(or bsd osf1) (c-ispeed unsigned-int) #+(or bsd osf1) (c-ospeed unsigned-int))) +#+linux +(progn + (def-alien-type cc-t unsigned-char) + (def-alien-type speed-t unsigned-int) + (def-alien-type tcflag-t unsigned-int)) + +#+linux +(def-alien-type nil + (struct termios + (c-iflag tcflag-t) + (c-oflag tcflag-t) + (c-cflag tcflag-t) + (c-lflag tcflag-t) + (c-line cc-t) + (c-cc (array cc-t #.+NCCS+)) + (c-ispeed speed-t) + (c-ospeed speed-t))) + + ;;; From sys/dir.h ;;; ;;; (For Solaris, this is not struct direct, but struct dirent!) -#-bsd +#-(or bsd linux netbsd) (def-alien-type nil (struct direct #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry @@ -1111,6 +1295,19 @@ (d-type unsigned-char) (d-name (array char 512)))) +#+linux +(def-alien-type nil + (struct dirent + #+glibc2.1 + (d-ino ino-t) ; inode number of entry + #-glibc2.1 + (d-ino ino64-t) ; inode number of entry + (d-off off-t) ; offset of next disk directory entry + (d-reclen unsigned-short) ; length of this record + (d_type unsigned-char) + (d-name (array char 256)))) ; name must be no longer than this + + #+(or linux svr4) ; High-res time. Actually posix definition under svr4 name. (def-alien-type nil @@ -1171,7 +1368,7 @@ (st-lspare long) (st-qspare (array long 4)))) -#+(or linux svr4) +#+svr4 (def-alien-type nil (struct stat (st-dev dev-t) @@ -1203,6 +1400,40 @@ #-linux (st-fstype (array char 16)) #-linux (st-pad4 (array long 8)))) +#+linux +(def-alien-type nil + (struct stat + (st-dev dev-t) + #-(or alpha amd64) (st-pad1 unsigned-short) + (st-ino ino-t) + #+alpha (st-pad1 unsigned-int) + #-amd64 (st-mode mode-t) + (st-nlink nlink-t) + #+amd64 (st-mode mode-t) + (st-uid uid-t) + (st-gid gid-t) + (st-rdev dev-t) + #-alpha (st-pad2 unsigned-short) + (st-size off-t) + #-alpha (st-blksize unsigned-long) + #-alpha (st-blocks blkcnt-t) + (st-atime time-t) + #-alpha (unused-1 unsigned-long) + (st-mtime time-t) + #-alpha (unused-2 unsigned-long) + (st-ctime time-t) + #+alpha (st-blocks int) + #+alpha (st-pad2 unsigned-int) + #+alpha (st-blksize unsigned-int) + #+alpha (st-flags unsigned-int) + #+alpha (st-gen unsigned-int) + #+alpha (st-pad3 unsigned-int) + #+alpha (unused-1 unsigned-long) + #+alpha (unused-2 unsigned-long) + (unused-3 unsigned-long) + (unused-4 unsigned-long) + #-alpha (unused-5 unsigned-long))) + ;;; 64-bit stat for Solaris #+solaris (def-alien-type nil @@ -1247,6 +1478,7 @@ (st-gen unsigned-long) (st-spare (array unsigned-long 2)))) +#-linux (defmacro extract-stat-results (buf) `(values T (slot ,buf 'st-dev) @@ -1270,6 +1502,33 @@ (slot ,buf 'st-blksize) (slot ,buf 'st-blocks))) +#+linux +(defmacro extract-stat-results (buf) + `(values T + #+(or alpha amd64) + (slot ,buf 'st-dev) + #-(or alpha amd64) + (+ (deref (slot ,buf 'st-dev) 0) + (* (+ +max-u-long+ 1) + (deref (slot ,buf 'st-dev) 1))) ;;; let's hope this works.. + (slot ,buf 'st-ino) + (slot ,buf 'st-mode) + (slot ,buf 'st-nlink) + (slot ,buf 'st-uid) + (slot ,buf 'st-gid) + #+(or alpha amd64) + (slot ,buf 'st-rdev) + #-(or alpha amd64) + (+ (deref (slot ,buf 'st-rdev) 0) + (* (+ +max-u-long+ 1) + (deref (slot ,buf 'st-rdev) 1))) ;;; let's hope this works.. + (slot ,buf 'st-size) + (slot ,buf 'st-atime) + (slot ,buf 'st-mtime) + (slot ,buf 'st-ctime) + (slot ,buf 'st-blksize) + (slot ,buf 'st-blocks))) + #-solaris (progn (defun unix-stat (name) @@ -1282,7 +1541,8 @@ (when (string= name "") (setf name ".")) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat))) + (syscall (#+linux "stat64" #+netbsd "__stat50" #-(or linux netbsd) "stat" + c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf)))) @@ -1291,7 +1551,8 @@ file must be a symbolic link." (declare (type unix-pathname name)) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat))) + (syscall (#+linux "lstat64" #+netbsd "__lstat50" #-(or linux netbsd) "lstat" + c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf)))) @@ -1300,7 +1561,8 @@ by the file descriptor fd." (declare (type unix-fd fd)) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat))) + (syscall (#+linux "fstat64" #+netbsd "__fstat50" #-(or linux netbsd) "fstat" + int (* (struct stat))) (extract-stat-results buf) fd (addr buf)))) ) @@ -1410,14 +1672,15 @@ ;;;; Support routines for dealing with unix pathnames. -(defconstant s-ifmt #o0170000) -(defconstant s-ifdir #o0040000) -(defconstant s-ifchr #o0020000) -#+linux (defconstant s-ififo #x0010000) -(defconstant s-ifblk #o0060000) -(defconstant s-ifreg #o0100000) -(defconstant s-iflnk #o0120000) -(defconstant s-ifsock #o0140000) +(defconstant s-ifmt #o0170000 _N"These bits determine file type.") +(defconstant s-ifdir #o0040000 _N"Directory") +(defconstant s-ifchr #o0020000 _N"Character device") +#+linux +(defconstant s-ififo #o0010000 _N"FIFO") +(defconstant s-ifblk #o0060000 _N"Block device") +(defconstant s-ifreg #o0100000 _N"Regular file") +(defconstant s-iflnk #o0120000 _N"Symbolic link.") +(defconstant s-ifsock #o0140000 _N"Socket.") (defconstant s-isuid #o0004000) (defconstant s-isgid #o0002000) (defconstant s-isvtx #o0001000) @@ -1918,6 +2181,8 @@ (def-alien-routine ("os_get_errno" unix-get-errno) int) (def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int)) (defun unix-errno () (unix-get-errno)) +#+linux +(defun (setf unix-errno) (newvalue) (unix-set-errno newvalue)) ;;; GET-UNIX-ERROR-MSG -- public. ;;; @@ -2040,8 +2305,9 @@ (def-alien-type nil (struct timeval - (tv-sec #-linux time-t #+linux int) ; seconds - (tv-usec int))) ; and microseconds + (tv-sec time-t) ; seconds + (tv-usec #-linux int + #+linux time-t))) ; and microseconds (def-alien-type nil (struct timezone @@ -2318,6 +2584,17 @@ (pw-expire int) ; account expiration #+(or freebsd darwin) (pw-fields int))) ; internal +#+linux +(def-alien-type nil + (struct passwd + (pw-name (* char)) ; user's login name + (pw-passwd (* char)) ; no longer used + (pw-uid uid-t) ; user id + (pw-gid gid-t) ; group id + (pw-gecos (* char)) ; typically user's full name + (pw-dir (* char)) ; user's home directory + (pw-shell (* char)))) ; user's login shell + ;;;; Other random routines. (def-alien-routine ("isatty" unix-isatty) boolean @@ -2347,6 +2624,7 @@ (defconstant ITIMER-VIRTUAL 1) (defconstant ITIMER-PROF 2) +#-linux (defun unix-setitimer (which int-secs int-usec val-secs val-usec) _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of three system timers (:real :virtual or :profile). A SIGALRM signal @@ -2382,6 +2660,28 @@ (slot (slot itvo 'it-value) 'tv-usec)) which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) +#+linux +(defun unix-getitimer (which) + _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). On success, + unix-getitimer returns 5 values, + T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." + (declare (type (member :real :virtual :profile) which) + (values t + (unsigned-byte 29)(mod 1000000) + (unsigned-byte 29)(mod 1000000))) + (let ((which (ecase which + (:real ITIMER-REAL) + (:virtual ITIMER-VIRTUAL) + (:profile ITIMER-PROF)))) + (with-alien ((itv (struct itimerval))) + (syscall* ("getitimer" int (* (struct itimerval))) + (values T + (slot (slot itv 'it-interval) 'tv-sec) + (slot (slot itv 'it-interval) 'tv-usec) + (slot (slot itv 'it-value) 'tv-sec) + (slot (slot itv 'it-value) 'tv-usec)) + which (alien-sap (addr itv)))))) ;;;; User and group database access, POSIX Standard 9.2.2 @@ -2435,6 +2735,37 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) +#+linux +(defun unix-getpwuid (uid) + _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." + (declare (type unix-uid uid)) + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd)) + (result (* (struct passwd)))) + (let ((returned + (alien-funcall + (extern-alien "getpwuid_r" + (function c-call:int + c-call:unsigned-int + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct passwd))))) + uid + (addr user-info) + (cast buf (* c-call:char)) + 1024 + (addr result)))) + (when (zerop returned) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :dir (string (cast (slot result 'pw-dir) c-call:c-string)) + :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) + ;;; Getrusage is not provided in the C library on Solaris 2.4, and is ;;; rather slow on later versions so the "times" system call is ;;; provided. @@ -2496,6 +2827,7 @@ ) ) ) +#-linux (def-alien-type nil (struct utsname (sysname (array char #+svr4 257 #+bsd 256)) @@ -2504,6 +2836,16 @@ (version (array char #+svr4 257 #+bsd 256)) (machine (array char #+svr4 257 #+bsd 256)))) +#+linux +(def-alien-type nil + (struct utsname + (sysname (array char 65)) + (nodename (array char 65)) + (release (array char 65)) + (version (array char 65)) + (machine (array char 65)) + (domainname (array char 65)))) + (defun unix-uname () (with-alien ((names (struct utsname))) (syscall* (#-(or freebsd (and x86 solaris)) "uname" ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -166,6 +166,17 @@ msgstr "" #: src/code/unix.lisp msgid "" +"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead\n" +" a certain OFFSET for that file. WHENCE can be any of the following:\n" +"\n" +" l_set Set the file pointer.\n" +" l_incr Increment the file pointer.\n" +" l_xtnd Extend the file size.\n" +" " +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-mkdir creates a new directory with the specified name and mode.\n" " (Same as those for unix-chmod.) It returns T upon success, otherwise\n" " NIL and an error number." @@ -222,6 +233,10 @@ msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix.lisp +msgid "Asynchronous I/O" +msgstr "" + +#: src/code/unix.lisp msgid "" "Unix-open opens the file whose pathname is specified by path\n" " for reading and/or writing as specified by the flags argument.\n" @@ -264,6 +279,15 @@ msgid "" msgstr "" #: src/code/unix.lisp +msgid "" +"Unix-dup2 duplicates an existing file descriptor just as unix-dup\n" +" does only the new value of the duplicate descriptor may be requested\n" +" through the second argument. If a file already exists with the\n" +" requested descriptor number, it will be closed and the number\n" +" assigned to the duplicate." +msgstr "" + +#: src/code/unix.lisp msgid "Duplicate a file descriptor" msgstr "" @@ -371,6 +395,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"UNIX-READ attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-readlink invokes the readlink system call on the file name\n" " specified by the simple string path. It returns up to two values:\n" " the contents of the symbolic link if the call is successful, or\n" @@ -398,6 +430,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" +" then ioctl argument size and direction are included as for ioctls defined\n" +" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" +" is the characters code, else DEV may be an integer giving the type." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-ioctl performs a variety of operations on open i/o\n" " descriptors. See the UNIX Programmer's Manual for more\n" " information." @@ -491,6 +531,38 @@ msgid "" msgstr "" #: src/code/unix.lisp +msgid "These bits determine file type." +msgstr "" + +#: src/code/unix.lisp +msgid "Directory" +msgstr "" + +#: src/code/unix.lisp +msgid "Character device" +msgstr "" + +#: src/code/unix.lisp +msgid "FIFO" +msgstr "" + +#: src/code/unix.lisp +msgid "Block device" +msgstr "" + +#: src/code/unix.lisp +msgid "Regular file" +msgstr "" + +#: src/code/unix.lisp +msgid "Symbolic link." +msgstr "" + +#: src/code/unix.lisp +msgid "Socket." +msgstr "" + +#: src/code/unix.lisp msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" @@ -1226,6 +1298,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). On success,\n" +" unix-getitimer returns 5 values,\n" +" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Return a USER-INFO structure for the user identified by UID, or NIL if not " "found." msgstr "" ===================================== src/tools/worldbuild.lisp ===================================== --- a/src/tools/worldbuild.lisp +++ b/src/tools/worldbuild.lisp @@ -127,9 +127,7 @@ "target:code/alieneval" "target:code/c-call" "target:code/sap" - ,@(if (c:backend-featurep :glibc2) - '("target:code/unix-glibc2") - '("target:code/unix")) + "target:code/unix" ,@(when (c:backend-featurep :mach) '("target:code/mach" "target:code/mach-os")) ===================================== src/tools/worldcom.lisp ===================================== --- a/src/tools/worldcom.lisp +++ b/src/tools/worldcom.lisp @@ -156,9 +156,7 @@ (comf "target:code/string") (comf "target:code/mipsstrops") -(if (c:backend-featurep :glibc2) - (comf "target:code/unix-glibc2" :proceed t) - (comf "target:code/unix" :proceed t)) +(comf "target:code/unix" :proceed t) (when (c:backend-featurep :mach) (comf "target:code/mach") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/1d034d24f6c87575de73422e…

1 0

[Git][cmucl/cmucl][rtoy-grand-unix-unification] Regenerated.
by Raymond Toy 31 Oct '15

31 Oct '15

Raymond Toy pushed to branch rtoy-grand-unix-unification at cmucl / cmucl Commits: 3dd45a3a by Raymond Toy at 2015-10-31T10:26:48Z Regenerated. - - - - - 1 changed file: - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -166,6 +166,17 @@ msgstr "" #: src/code/unix.lisp msgid "" +"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead\n" +" a certain OFFSET for that file. WHENCE can be any of the following:\n" +"\n" +" l_set Set the file pointer.\n" +" l_incr Increment the file pointer.\n" +" l_xtnd Extend the file size.\n" +" " +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-mkdir creates a new directory with the specified name and mode.\n" " (Same as those for unix-chmod.) It returns T upon success, otherwise\n" " NIL and an error number." @@ -222,6 +233,10 @@ msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix.lisp +msgid "Asynchronous I/O" +msgstr "" + +#: src/code/unix.lisp msgid "" "Unix-open opens the file whose pathname is specified by path\n" " for reading and/or writing as specified by the flags argument.\n" @@ -264,6 +279,15 @@ msgid "" msgstr "" #: src/code/unix.lisp +msgid "" +"Unix-dup2 duplicates an existing file descriptor just as unix-dup\n" +" does only the new value of the duplicate descriptor may be requested\n" +" through the second argument. If a file already exists with the\n" +" requested descriptor number, it will be closed and the number\n" +" assigned to the duplicate." +msgstr "" + +#: src/code/unix.lisp msgid "Duplicate a file descriptor" msgstr "" @@ -371,6 +395,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"UNIX-READ attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-readlink invokes the readlink system call on the file name\n" " specified by the simple string path. It returns up to two values:\n" " the contents of the symbolic link if the call is successful, or\n" @@ -398,6 +430,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"Define an ioctl command. If the optional ARG and PARM-TYPE are given\n" +" then ioctl argument size and direction are included as for ioctls defined\n" +" by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type\n" +" is the characters code, else DEV may be an integer giving the type." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Unix-ioctl performs a variety of operations on open i/o\n" " descriptors. See the UNIX Programmer's Manual for more\n" " information." @@ -491,6 +531,38 @@ msgid "" msgstr "" #: src/code/unix.lisp +msgid "These bits determine file type." +msgstr "" + +#: src/code/unix.lisp +msgid "Directory" +msgstr "" + +#: src/code/unix.lisp +msgid "Character device" +msgstr "" + +#: src/code/unix.lisp +msgid "FIFO" +msgstr "" + +#: src/code/unix.lisp +msgid "Block device" +msgstr "" + +#: src/code/unix.lisp +msgid "Regular file" +msgstr "" + +#: src/code/unix.lisp +msgid "Symbolic link." +msgstr "" + +#: src/code/unix.lisp +msgid "Socket." +msgstr "" + +#: src/code/unix.lisp msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" @@ -1226,6 +1298,14 @@ msgstr "" #: src/code/unix.lisp msgid "" +"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). On success,\n" +" unix-getitimer returns 5 values,\n" +" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." +msgstr "" + +#: src/code/unix.lisp +msgid "" "Return a USER-INFO structure for the user identified by UID, or NIL if not " "found." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/3dd45a3a9e0d1cc1c6c2a7dff…

1 0

[Git][cmucl/cmucl][rtoy-grand-unix-unification] Fix typo: "o_asyn" -> "o_async"
by Raymond Toy 31 Oct '15

31 Oct '15

Raymond Toy pushed to branch rtoy-grand-unix-unification at cmucl / cmucl Commits: 6c6f37cb by Raymond Toy at 2015-10-31T10:13:04Z Fix typo: "o_asyn" -> "o_async" - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -701,7 +701,7 @@ #-(or linux osf1) #o0004 _N"Non-blocking reads") (defconstant FAPPEND #-linux #o0010 #+linux o_append _N"Append on each write") -(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux o_asyn +(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux o_async _N"Signal pgrp when data ready") ;; doesn't exist in Linux ;-( #-linux (defconstant FCREAT #-(or hpux svr4) #o1000 #+(or hpux svr4) #o0400 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/6c6f37cb662d646b113ca2e43…

1 0

[Git][cmucl/cmucl][rtoy-grand-unix-unification] Move over more items from unix-glibc2.lisp.
by Raymond Toy 20 Oct '15

20 Oct '15

Raymond Toy pushed to branch rtoy-grand-unix-unification at cmucl / cmucl Commits: 95279cab by Raymond Toy at 2015-10-19T22:02:24Z Move over more items from unix-glibc2.lisp. These should be the last things that need to be moved. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -650,6 +650,20 @@ (declare (type unix-fd fd)) (int-syscall ("dup" int) fd)) +;;; Unix-dup2 makes the second file-descriptor describe the same file +;;; as the first. If the second file-descriptor points to an open +;;; file, it is first closed. In any case, the second should have a +;;; value which is a valid file-descriptor. + +(defun unix-dup2 (fd1 fd2) + _N"Unix-dup2 duplicates an existing file descriptor just as unix-dup + does only the new value of the duplicate descriptor may be requested + through the second argument. If a file already exists with the + requested descriptor number, it will be closed and the number + assigned to the duplicate." + (declare (type unix-fd fd1 fd2)) + (void-syscall ("dup2" int int) fd1 fd2)) + ;;; Unix-fcntl takes a file descriptor, an integer command ;;; number, and optional command arguments. It performs ;;; operations on the associated file and/or returns inform- @@ -686,8 +700,8 @@ #+osf1 #o100000 #-(or linux osf1) #o0004 _N"Non-blocking reads") -(defconstant FAPPEND #-linux #o0010 #+linux #o2000 _N"Append on each write") -(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux #o20000 +(defconstant FAPPEND #-linux #o0010 #+linux o_append _N"Append on each write") +(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux o_asyn _N"Signal pgrp when data ready") ;; doesn't exist in Linux ;-( #-linux (defconstant FCREAT #-(or hpux svr4) #o1000 #+(or hpux svr4) #o0400 @@ -907,7 +921,7 @@ ;; output modes #-bsd (def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr - tty-onlret tty-ofill tty-ofdel) + tty-onlret tty-ofill tty-ofdel #+linux tty-nldly) #+bsd (def-enum ash 1 tty-opost tty-onlcr) ;; local modes @@ -1658,15 +1672,15 @@ ;;;; Support routines for dealing with unix pathnames. -(defconstant s-ifmt #o0170000) -(defconstant s-ifdir #o0040000) -(defconstant s-ifchr #o0020000) +(defconstant s-ifmt #o0170000 _N"These bits determine file type.") +(defconstant s-ifdir #o0040000 _N"Directory") +(defconstant s-ifchr #o0020000 _N"Character device") #+linux (defconstant s-ififo #o0010000 _N"FIFO") -(defconstant s-ifblk #o0060000) -(defconstant s-ifreg #o0100000) -(defconstant s-iflnk #o0120000) -(defconstant s-ifsock #o0140000) +(defconstant s-ifblk #o0060000 _N"Block device") +(defconstant s-ifreg #o0100000 _N"Regular file") +(defconstant s-iflnk #o0120000 _N"Symbolic link.") +(defconstant s-ifsock #o0140000 _N"Socket.") (defconstant s-isuid #o0004000) (defconstant s-isgid #o0002000) (defconstant s-isvtx #o0001000) @@ -2291,8 +2305,9 @@ (def-alien-type nil (struct timeval - (tv-sec #-linux time-t #+linux int) ; seconds - (tv-usec int))) ; and microseconds + (tv-sec time-t) ; seconds + (tv-usec #-linux int + #+linux time-t))) ; and microseconds (def-alien-type nil (struct timezone @@ -2609,6 +2624,7 @@ (defconstant ITIMER-VIRTUAL 1) (defconstant ITIMER-PROF 2) +#-linux (defun unix-setitimer (which int-secs int-usec val-secs val-usec) _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of three system timers (:real :virtual or :profile). A SIGALRM signal @@ -2644,6 +2660,28 @@ (slot (slot itvo 'it-value) 'tv-usec)) which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) +#+linux +(defun unix-getitimer (which) + _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of + three system timers (:real :virtual or :profile). On success, + unix-getitimer returns 5 values, + T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." + (declare (type (member :real :virtual :profile) which) + (values t + (unsigned-byte 29)(mod 1000000) + (unsigned-byte 29)(mod 1000000))) + (let ((which (ecase which + (:real ITIMER-REAL) + (:virtual ITIMER-VIRTUAL) + (:profile ITIMER-PROF)))) + (with-alien ((itv (struct itimerval))) + (syscall* ("getitimer" int (* (struct itimerval))) + (values T + (slot (slot itv 'it-interval) 'tv-sec) + (slot (slot itv 'it-interval) 'tv-usec) + (slot (slot itv 'it-value) 'tv-sec) + (slot (slot itv 'it-value) 'tv-usec)) + which (alien-sap (addr itv)))))) ;;;; User and group database access, POSIX Standard 9.2.2 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/95279cabd8a73af41a1f2c246…

1 0

[Git][cmucl/cmucl][rtoy-mmap-anon-control-and-binding-stacks] Fix for FreeBSD: Use control_stack/binding_stack instead of
by Raymond Toy 20 Oct '15

20 Oct '15

Raymond Toy pushed to branch rtoy-mmap-anon-control-and-binding-stacks at cmucl / cmucl Commits: 20f530c4 by Raymond Toy at 2015-10-19T21:13:12Z Fix for FreeBSD: Use control_stack/binding_stack instead of CONTROL_STACK_START and BINDING_STACK_START. Fred Gilham says the same fix is needed for FreeBSD as for NetBSD. - - - - - 1 changed file: - src/lisp/FreeBSD-os.c Changes: ===================================== src/lisp/FreeBSD-os.c ===================================== --- a/src/lisp/FreeBSD-os.c +++ b/src/lisp/FreeBSD-os.c @@ -224,8 +224,8 @@ valid_addr(os_vm_address_t addr) #ifndef GENCGC || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) #endif - || in_range_p(addr, CONTROL_STACK_START, control_stack_size) - || in_range_p(addr, BINDING_STACK_START, binding_stack_size)) + || in_range_p(addr, control_stack, control_stack_size) + || in_range_p(addr, binding_stack, binding_stack_size)) return TRUE; return FALSE; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/20f530c4388452cf3f9f66ee1…

1 0