/[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.6.6.1 - (show annotations)
Wed Mar 25 21:51:34 2009 UTC (5 years ago) by rtoy
Branch: unicode-utf16-extfmt-branch
CVS Tags: unicode-utf16-extfmt-2009-03-27, unicode-snapshot-2009-05
Changes since 1.6: +9 -16 lines
Merge from unicode-utf16 branch, label
unicode-utf16-char-support-2009-03-25 to get character support.
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.6.6.1 2009/03/25 21:51:34 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 (register-lisp-feature :linux)
24 (register-lisp-feature :elf)
25 (register-lisp-runtime-feature :executable)
26
27 (setq *software-type* "Linux")
28
29 ;;; Instead of reading /proc/version (which has some bugs with
30 ;;; select() in Linux kernel 2.6.x) and instead of running uname -r,
31 ;;; let's just get the info from uname().
32 (defun software-version ()
33 "Returns a string describing version of the supporting software."
34 (multiple-value-bind (sysname nodename release version)
35 (unix:unix-uname)
36 (declare (ignore sysname nodename))
37 (concatenate 'string release " " version)))
38
39
40
41 ;;; OS-Init initializes our operating-system interface.
42 ;;;
43 (defun os-init () nil)
44
45
46 ;;; GET-SYSTEM-INFO -- Interface
47 ;;;
48 ;;; Return system time, user time and number of page faults.
49 ;;;
50 (defun get-system-info ()
51 (multiple-value-bind (err? utime stime maxrss ixrss idrss
52 isrss minflt majflt)
53 (unix:unix-getrusage unix:rusage_self)
54 (declare (ignore maxrss ixrss idrss isrss minflt))
55 (unless err?
56 (error "Unix system call getrusage failed: ~A."
57 (unix:get-unix-error-msg utime)))
58
59 (values utime stime majflt)))
60
61
62 ;;; GET-PAGE-SIZE -- Interface
63 ;;;
64 ;;; Return the system page size.
65 ;;;
66 (defun get-page-size ()
67 (multiple-value-bind (val err)
68 (unix:unix-getpagesize)
69 (unless val
70 (error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
71 val))
72

  ViewVC Help
Powered by ViewVC 1.1.5