<html lang='en'>
<head>
<meta content='text/html; charset=utf-8' http-equiv='Content-Type'>
<title>
GitLab
</title>
</meta>
</head>
<style>
img {
max-width: 100%;
height: auto;
}
p.details {
font-style:italic;
color:#777
}
.footer p {
font-size:small;
color:#777
}
pre.commit-message {
white-space: pre-wrap;
}
.file-stats a {
text-decoration: none;
}
.file-stats .new-file {
color: #090;
}
.file-stats .deleted-file {
color: #B00;
}}
</style>
<body>
<div class='content'>
<h3>Raymond Toy pushed to branch rtoy-unix-core at <a href="https://gitlab.common-lisp.net/cmucl/cmucl">cmucl / cmucl</a></h3>
<h4>
Commits:
</h4>
<ul>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/3a837db16fced7579d6cf12d492fb60ec0e5326b">3a837db1</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-05-06T21:01:31Z</i>
</div>
<pre class='commit-message'>Add support for hemlock.
With these additions, hemlock builds now and runs. (I only tested that
hemlock starts and that text can be entered.)</pre>
</li>
</ul>
<h4>1 changed file:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/unix-glibc2.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/3a837db16fced7579d6cf12d492fb60ec0e5326b#diff-0'>
<strong>
src/code/unix-glibc2.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/unix-glibc2.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/unix-glibc2.lisp
</span><span style="color: #aaaaaa">@@ -1001,6 +1001,10 @@
</span> (declare (type (signed-byte 32) code))
(void-syscall ("exit" int) code))
<span style="color: #000000;background-color: #ddffdd">+(def-alien-routine ("getuid" unix-getuid) int
+ _N"Unix-getuid returns the real user-id associated with the
+ current process.")
+
</span> ;;; Unix-chdir accepts a directory name and makes that the
;;; current working directory.
<span style="color: #aaaaaa">@@ -1109,6 +1113,43 @@
</span> (defconstant prot_exec 4)
(defconstant prot_none 0)
<span style="color: #000000;background-color: #ddffdd">+(defconstant map_shared 1)
+(defconstant map_private 2)
+(defconstant map_fixed 16)
+(defconstant map_anonymous 32)
+
+(defconstant ms_async 1)
+(defconstant ms_sync 4)
+(defconstant ms_invalidate 2)
+
+;; The return value from mmap that means mmap failed.
+(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
+
+(defun unix-mmap (addr length prot flags fd offset)
+ (declare (type (or null system-area-pointer) addr)
+ (type (unsigned-byte 32) length)
+ (type (integer 1 7) prot)
+ (type (unsigned-byte 32) flags)
+ (type (or null unix-fd) fd)
+ (type (signed-byte 32) offset))
+ ;; Can't use syscall, because the address that is returned could be
+ ;; "negative". Hence we explicitly check for mmap returning
+ ;; MAP_FAILED.
+ (let ((result
+ (alien-funcall (extern-alien "mmap" (function system-area-pointer
+ system-area-pointer
+ size-t int int int off-t))
+ (or addr +null+) length prot flags (or fd -1) offset)))
+ (if (sap= result map_failed)
+ (values nil (unix-errno))
+ (values result 0))))
+
+(defun unix-msync (addr length flags)
+ (declare (type system-area-pointer addr)
+ (type (unsigned-byte 32) length)
+ (type (signed-byte 32) flags))
+ (syscall ("msync" system-area-pointer size-t int) t addr length flags))
+
</span> ;;; Unix-rename accepts two files names and renames the first to the second.
(defun unix-rename (name1 name2)
<span style="color: #aaaaaa">@@ -1196,6 +1237,15 @@
</span> (define-ioctl-command TIOCSPGRP #\T #x10)
(define-ioctl-command TIOCGPGRP #\T #x0F)
<span style="color: #000000;background-color: #ddffdd">+;;; ioctl-types.h
+
+(def-alien-type nil
+ (struct winsize
+ (ws-row unsigned-short) ; rows, in characters
+ (ws-col unsigned-short) ; columns, in characters
+ (ws-xpixel unsigned-short) ; horizontal size, pixels
+ (ws-ypixel unsigned-short))) ; veritical size, pixels
+
</span> (defconstant f-getfl 3 _N"Get file flags")
(defconstant f-setfl 4 _N"Set file flags")
<span style="color: #aaaaaa">@@ -1736,3 +1786,68 @@
</span> (slot (slot itvo 'it-value) 'tv-usec))
which (alien-sap (addr itvn))(alien-sap (addr itvo))))))
<span style="color: #000000;background-color: #ddffdd">+
+(def-alien-type cc-t unsigned-char)
+(def-alien-type speed-t unsigned-int)
+(def-alien-type tcflag-t unsigned-int)
+
+(defconstant +NCCS+ 32
+ _N"Size of control character vector.")
+
+(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)))
+
+;; c_cc characters
+
+(defmacro def-enum (inc cur &rest names)
+ (flet ((defform (name)
+ (prog1 (when name `(defconstant ,name ,cur))
+ (setf cur (funcall inc cur 1)))))
+ `(progn ,@(mapcar #'defform names))))
+
+(def-enum + 0 vintr vquit verase
+ vkill veof vtime
+ vmin vswtc vstart
+ vstop vsusp veol
+ vreprint vdiscard vwerase
+ vlnext veol2)
+(defvar vdsusp vsusp)
+
+(def-enum + 0 tcsanow tcsadrain tcsaflush)
+
+;; c_iflag bits
+(def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck
+ tty-istrip tty-inlcr tty-igncr tty-icrnl tty-iuclc
+ tty-ixon tty-ixany tty-ixoff
+ tty-imaxbel)
+
+;; c_oflag bits
+(def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr
+ tty-onlret tty-ofill tty-ofdel tty-nldly)
+
+;; c_lflag bits
+(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)
+
+(defun unix-tcgetattr (fd termios)
+ _N"Get terminal attributes."
+ (declare (type unix-fd fd))
+ (void-syscall ("tcgetattr" int (* (struct termios))) fd termios))
+
+(defun unix-tcsetattr (fd opt termios)
+ _N"Set terminal attributes."
+ (declare (type unix-fd fd))
+ (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios))
+
+(defconstant writeown #o200 _N"Write by owner")
</span></code></pre>
<br>
</li>
</div>
<div class='footer' style='margin-top: 10px;'>
<p>
—
<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/3a837db16fced7579d6cf12d492fb60ec0e5326b">View it on GitLab</a>
<script type="application/ld+json">{"@context":"http://schema.org","@type":"EmailMessage","action":{"@type":"ViewAction","name":"View Commit","url":"https://gitlab.common-lisp.net/cmucl/cmucl/commit/3a837db16fced7579d6cf12d492fb60ec0e5326b"}}</script>
</p>
</div>
</body>
</html>