/[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.3.14.1 - (show annotations)
Mon Jun 14 14:42:49 2004 UTC (9 years, 10 months ago) by rtoy
Branch: release-19a-branch
CVS Tags: release-19a-pre3, release-19a
Changes since 1.3: +14 -2 lines
Merge in HEAD fix for SOFTWARE-VERSION hanging on Linux 2.6 kernels
due to broken select on some /proc files.
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.3.14.1 2004/06/14 14:42:49 rtoy 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