<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/e79435f693c03d5d9ca512d6b10d4eaa2407cf72">e79435f6</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-05-13T20:29:36Z</i>
</div>
<pre class='commit-message'>Add support for solaris/sparc.
Includes
* support for large files
* unix-times
* unix-get-minutes-west and friends
* unix-uname</pre>
</li>
</ul>
<h4>1 changed file:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/unix.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/e79435f693c03d5d9ca512d6b10d4eaa2407cf72#diff-0'>
<strong>
src/code/unix.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/unix.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/unix.lisp
</span><span style="color: #aaaaaa">@@ -1109,6 +1109,27 @@
</span> (d-type unsigned-char)
(d-name (array char 512))))
<span style="color: #000000;background-color: #ddffdd">+;;; Large file support for Solaris. Define some of the 64-bit types
+;;; we need. Unlike unix-glibc's large file support, Solaris's
+;;; version is a little simpler because all of the 64-bit versions of
+;;; the functions actually exist as functions. So instead of calling
+;;; the 32-bit versions of the functions, we call the 64-bit versions.
+;;;
+;;; These functions are: creat64, open64, truncate64, ftruncate64,
+;;; stat64, lstat64, fstat64, readdir64.
+;;;
+;;; There are also some new structures for large file support:
+;;; dirent64, stat64.
+;;;
+;;; FIXME: We should abstract this better, but I (rtoy) don't have any
+;;; other system to test this out on, so it's a Solaris hack for now.
+#+solaris
+(progn
+ (deftype file-offset64 () '(signed-byte 64))
+ (def-alien-type off64-t int64-t)
+ (def-alien-type ino64-t u-int64-t)
+ (def-alien-type blkcnt64-t u-int64-t))
+
</span> ;;; The 64-bit version of struct dirent.
#+solaris
(def-alien-type nil
<span style="color: #aaaaaa">@@ -1140,6 +1161,61 @@
</span> (st-lspare long)
(st-qspare (array long 4))))
<span style="color: #000000;background-color: #ddffdd">+#+(or linux svr4)
+(def-alien-type nil
+ (struct stat
+ (st-dev dev-t)
+ (st-pad1 #-linux (array long 3) #+linux unsigned-short)
+ (st-ino ino-t)
+ (st-mode #-linux unsigned-long #+linux unsigned-short)
+ (st-nlink #-linux short #+linux unsigned-short)
+ (st-uid #-linux uid-t #+linux unsigned-short)
+ (st-gid #-linux gid-t #+linux unsigned-short)
+ (st-rdev dev-t)
+ (st-pad2 #-linux (array long 2) #+linux unsigned-short)
+ (st-size off-t)
+ #-linux (st-pad3 long)
+ #+linux (st-blksize unsigned-long)
+ #+linux (st-blocks unsigned-long)
+ #-linux (st-atime (struct timestruc-t))
+ #+linux (st-atime unsigned-long)
+ #+linux (unused-1 unsigned-long)
+ #-linux (st-mtime (struct timestruc-t))
+ #+linux (st-mtime unsigned-long)
+ #+linux (unused-2 unsigned-long)
+ #-linux (st-ctime (struct timestruc-t))
+ #+linux (st-ctime unsigned-long)
+ #+linux (unused-3 unsigned-long)
+ #+linux (unused-4 unsigned-long)
+ #+linux (unused-5 unsigned-long)
+ #-linux(st-blksize long)
+ #-linux (st-blocks long)
+ #-linux (st-fstype (array char 16))
+ #-linux (st-pad4 (array long 8))))
+
+;;; 64-bit stat for Solaris
+#+solaris
+(def-alien-type nil
+ (struct stat64
+ (st-dev dev-t)
+ (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned
+ (st-ino ino64-t)
+ (st-mode unsigned-long)
+ (st-nlink short)
+ (st-uid uid-t)
+ (st-gid gid-t)
+ (st-rdev dev-t)
+ (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned
+ (st-size off64-t)
+ (st-atime (struct timestruc-t))
+ (st-mtime (struct timestruc-t))
+ (st-ctime (struct timestruc-t))
+ (st-blksize long)
+ (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned
+ (st-blocks blkcnt64-t)
+ (st-fstype (array char 16))
+ (st-pad4 (array long 8))))
+
</span> (defmacro extract-stat-results (buf)
`(values T
(slot ,buf 'st-dev)
<span style="color: #aaaaaa">@@ -2289,3 +2365,73 @@
</span> :dir (string (cast (slot result 'pw-dir) c-call:c-string))
:shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
<span style="color: #000000;background-color: #ddffdd">+#+(and sparc svr4)
+(progn
+(def-alien-type nil
+ (struct tms
+ (tms-utime #-alpha long #+alpha int) ; user time used
+ (tms-stime #-alpha long #+alpha int) ; system time used.
+ (tms-cutime #-alpha long #+alpha int) ; user time, children
+ (tms-cstime #-alpha long #+alpha int))) ; system time, children
+
+(declaim (inline unix-times))
+(defun unix-times ()
+ _N"Unix-times returns information about the cpu time usage of the process
+ and its children."
+ (with-alien ((usage (struct tms)))
+ (alien-funcall (extern-alien "times" (function int (* (struct tms))))
+ (addr usage))
+ (values t
+ (slot usage 'tms-utime)
+ (slot usage 'tms-stime)
+ (slot usage 'tms-cutime)
+ (slot usage 'tms-cstime))))
+) ; end progn
+
+#+(or linux svr4)
+(progn
+ (def-alien-variable ("daylight" unix-daylight) int)
+ (def-alien-variable ("timezone" unix-timezone) time-t)
+ (def-alien-variable ("altzone" unix-altzone) time-t)
+ #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2))
+ #+irix (defvar unix-tzname-addr nil)
+ #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil))
+ ext:*after-save-initializations*)
+ #+irix (declaim (notinline fakeout-compiler))
+ #+irix (defun fakeout-compiler (name dst)
+ (unless unix-tzname-addr
+ (setf unix-tzname-addr (system:foreign-symbol-address
+ name
+ :flavor :data)))
+ (deref (sap-alien unix-tzname-addr (array c-string 2)) dst))
+ (def-alien-routine get-timezone c-call:void
+ (when c-call:long :in)
+ (minutes-west c-call:int :out)
+ (daylight-savings-p alien:boolean :out))
+ (defun unix-get-minutes-west (secs)
+ (multiple-value-bind (ignore minutes dst) (get-timezone secs)
+ (declare (ignore ignore) (ignore dst))
+ (values minutes))
+ )
+ (defun unix-get-timezone (secs)
+ (multiple-value-bind (ignore minutes dst) (get-timezone secs)
+ (declare (ignore ignore) (ignore minutes))
+ (values #-irix (deref unix-tzname (if dst 1 0))
+ #+irix (fakeout-compiler "tzname" (if dst 1 0)))
+ ) )
+)
+
+(defun unix-uname ()
+ (with-alien ((names (struct utsname)))
+ (syscall* (#-(or freebsd (and x86 solaris)) "uname"
+ #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h
+ #+freebsd "__xuname" #+freebsd int
+ (* (struct utsname)))
+ (values (cast (slot names 'sysname) c-string)
+ (cast (slot names 'nodename) c-string)
+ (cast (slot names 'release) c-string)
+ (cast (slot names 'version) c-string)
+ (cast (slot names 'machine) c-string))
+ #+freebsd 256
+ (addr names))))
+
</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/e79435f693c03d5d9ca512d6b10d4eaa2407cf72">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/e79435f693c03d5d9ca512d6b10d4eaa2407cf72"}}</script>
</p>
</div>
</body>
</html>