/[cmucl]/src/code/linux-os.lisp
ViewVC logotype

Contents of /src/code/linux-os.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Sun Jun 13 09:53:09 2004 UTC (9 years, 10 months ago) by emarsden
Branch: MAIN
CVS Tags: double-double-array-base, release-19b-pre1, release-19b-pre2, double-double-init-sparc-2, double-double-base, ppc_gencgc_snap_2006-01-06, snapshot-2007-05, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, snapshot-2004-10, snapshot-2004-08, snapshot-2004-09, snapshot-2007-01, snapshot-2007-02, snapshot-2004-07, release-19d, double-double-init-ppc, release-19c, release-19c-base, snapshot-2004-12, snapshot-2004-11, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, prm-before-macosx-merge-tag, snapshot-2005-07, snapshot-2007-03, snapshot-2007-04, snapshot-2007-07, snapshot-2007-06, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, double-double-irrat-end, release-19d-pre2, release-19d-pre1, double-double-init-checkpoint-1, double-double-reader-base, snapshot-2005-03, release-19b-base, double-double-init-x86, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2005-10, snapshot-2005-12, snapshot-2005-01, release-19c-pre1, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, snapshot-2005-09, snapshot-2005-08, snapshot-2006-02, snapshot-2006-03, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, snapshot-2006-08, snapshot-2006-09
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, release-19d-branch, ppc_gencgc_branch, double-double-branch, release-19c-branch
Changes since 1.3: +14 -2 lines
Avoid a hang when calling SOFTWARE-VERSION on Linux kernel version 2.6.x.
The hang is due to a bug in certain files in the proc filesystem, where the
select() system call does not work correctly.
1 ;;; -*- Package: SYSTEM -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/linux-os.lisp,v 1.4 2004/06/13 09:53:09 emarsden Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; OS interface functions for CMUCL under Linux.
13 ;;;
14 ;;; Written and maintained mostly by Skef Wholey and Rob MacLachlan.
15 ;;; Scott Fahlman, Dan Aronson, and Steve Handerson did stuff here, too.
16 ;;;
17 ;;; Derived from mach-os.lisp by Paul Werkowski
18
19 (in-package "SYSTEM")
20 (use-package "EXTENSIONS")
21 (export '(get-system-info get-page-size os-init))
22
23 (pushnew :linux *features*)
24
25 (setq *software-type* "Linux")
26
27 ;;; We use READ-SEQUENCE instead of READ-LINE to work around a bug in
28 ;;; the proc file system on Linux kernel 2.6.x. The select() system
29 ;;; call does not work correctly on certain files; it never reports
30 ;;; that data is available for reading. Since CMUCL's fd-streams use
31 ;;; select(), as a part of the SERVE-EVENT mechanism, normal I/O (for
32 ;;; instance with READ-CHAR or READ-LINE) will fail on these files.
33 ;;; Luckily READ-SEQUENCE does not suffer from this problem.
34 ;;;
35 ;;; We could also call "uname -r" here, but using the filesystem-based
36 ;;; interface seems cleaner.
37 (defun software-version ()
38 "Returns a string describing version of the supporting software."
39 (when (probe-file "/proc/version")
40 (with-open-file (f "/proc/version")
41 (let* ((buf (make-string 1024))
42 (count (read-sequence buf f :end 1024)))
43 (subseq buf 0 (1- count))))))
44
45
46 ;;; OS-Init initializes our operating-system interface.
47 ;;;
48 (defun os-init () nil)
49
50
51 ;;; GET-SYSTEM-INFO -- Interface
52 ;;;
53 ;;; Return system time, user time and number of page faults.
54 ;;;
55 (defun get-system-info ()
56 (multiple-value-bind (err? utime stime maxrss ixrss idrss
57 isrss minflt majflt)
58 (unix:unix-getrusage unix:rusage_self)
59 (declare (ignore maxrss ixrss idrss isrss minflt))
60 (unless err?
61 (error "Unix system call getrusage failed: ~A."
62 (unix:get-unix-error-msg utime)))
63
64 (values utime stime majflt)))
65
66
67 ;;; GET-PAGE-SIZE -- Interface
68 ;;;
69 ;;; Return the system page size.
70 ;;;
71 (defun get-page-size ()
72 (multiple-value-bind (val err)
73 (unix:unix-getpagesize)
74 (unless val
75 (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
76 val))
77

  ViewVC Help
Powered by ViewVC 1.1.5