/[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 - (hide 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 ram 1.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 rtoy 1.6.6.1 "$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 ram 1.1 ;;;
10     ;;; **********************************************************************
11     ;;;
12 toy 1.3 ;;; OS interface functions for CMUCL under Linux.
13 ram 1.1 ;;;
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 toy 1.3 ;;; Derived from mach-os.lisp by Paul Werkowski
18 ram 1.1
19     (in-package "SYSTEM")
20     (use-package "EXTENSIONS")
21     (export '(get-system-info get-page-size os-init))
22    
23 fgilham 1.5 (register-lisp-feature :linux)
24     (register-lisp-feature :elf)
25 cshapiro 1.6 (register-lisp-runtime-feature :executable)
26 ram 1.1
27     (setq *software-type* "Linux")
28    
29 rtoy 1.6.6.1 ;;; 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 ram 1.1 (defun software-version ()
33     "Returns a string describing version of the supporting software."
34 rtoy 1.6.6.1 (multiple-value-bind (sysname nodename release version)
35     (unix:unix-uname)
36     (declare (ignore sysname nodename))
37     (concatenate 'string release " " version)))
38    
39 toy 1.3
40    
41     ;;; OS-Init initializes our operating-system interface.
42     ;;;
43     (defun os-init () nil)
44 ram 1.1
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 toy 1.3 (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 ram 1.1

  ViewVC Help
Powered by ViewVC 1.1.5