/[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.5 - (show annotations)
Thu Jul 12 04:58:08 2007 UTC (6 years, 9 months ago) by fgilham
Branch: MAIN
Changes since 1.4: +4 -2 lines
Add elf and executable features to linux-os.lisp.
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.5 2007/07/12 04:58:08 fgilham 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 (register-lisp-feature :linux)
24 (register-lisp-feature :elf)
25 (register-runtime-lisp-feature :executable)
26
27 (setq *software-type* "Linux")
28
29 ;;; We use READ-SEQUENCE instead of READ-LINE to work around a bug in
30 ;;; the proc file system on Linux kernel 2.6.x. The select() system
31 ;;; call does not work correctly on certain files; it never reports
32 ;;; that data is available for reading. Since CMUCL's fd-streams use
33 ;;; select(), as a part of the SERVE-EVENT mechanism, normal I/O (for
34 ;;; instance with READ-CHAR or READ-LINE) will fail on these files.
35 ;;; Luckily READ-SEQUENCE does not suffer from this problem.
36 ;;;
37 ;;; We could also call "uname -r" here, but using the filesystem-based
38 ;;; interface seems cleaner.
39 (defun software-version ()
40 "Returns a string describing version of the supporting software."
41 (when (probe-file "/proc/version")
42 (with-open-file (f "/proc/version")
43 (let* ((buf (make-string 1024))
44 (count (read-sequence buf f :end 1024)))
45 (subseq buf 0 (1- count))))))
46
47
48 ;;; OS-Init initializes our operating-system interface.
49 ;;;
50 (defun os-init () nil)
51
52
53 ;;; GET-SYSTEM-INFO -- Interface
54 ;;;
55 ;;; Return system time, user time and number of page faults.
56 ;;;
57 (defun get-system-info ()
58 (multiple-value-bind (err? utime stime maxrss ixrss idrss
59 isrss minflt majflt)
60 (unix:unix-getrusage unix:rusage_self)
61 (declare (ignore maxrss ixrss idrss isrss minflt))
62 (unless err?
63 (error "Unix system call getrusage failed: ~A."
64 (unix:get-unix-error-msg utime)))
65
66 (values utime stime majflt)))
67
68
69 ;;; GET-PAGE-SIZE -- Interface
70 ;;;
71 ;;; Return the system page size.
72 ;;;
73 (defun get-page-size ()
74 (multiple-value-bind (val err)
75 (unix:unix-getpagesize)
76 (unless val
77 (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
78 val))
79

  ViewVC Help
Powered by ViewVC 1.1.5