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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Sat Feb 15 12:47:59 1992 UTC (22 years, 2 months ago) by wlott
Branch: MAIN
Changes since 1.3: +2 -2 lines
Changed ``mach:rusage_self" to ``unix:rusage_self''.
1 ram 1.1 ;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
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     ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7     ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8     ;;;
9     (ext:file-comment
10 wlott 1.4 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/mach-os.lisp,v 1.4 1992/02/15 12:47:59 wlott Exp $")
11 ram 1.1 ;;;
12     ;;; **********************************************************************
13     ;;;
14     ;;; OS interface functions for CMU CL under Mach.
15     ;;;
16     ;;; Written and maintained mostly by Skef Wholey and Rob MacLachlan.
17     ;;; Scott Fahlman, Dan Aronson, and Steve Handerson did stuff here, too.
18     ;;;
19     (in-package "SYSTEM")
20 ram 1.2 (use-package "EXTENSIONS")
21 ram 1.1 (export '(get-system-info get-page-size))
22    
23     (pushnew :mach *features*)
24     (setq *software-type* "MACH/4.3BSD")
25    
26     (defconstant foreign-segment-start #x00C00000)
27     (defconstant foreign-segment-size #x00400000)
28    
29     (defun software-version ()
30     "Returns a string describing version of the supporting software."
31     (string-trim '(#\newline)
32     (with-output-to-string (stream)
33     (run-program "/usr/cs/etc/version" ; Site dependent???
34     nil :output stream))))
35    
36     ;;; GET-SYSTEM-INFO -- Interface
37     ;;;
38     ;;; Return system time, user time and number of page faults. For
39     ;;; page-faults, we add pagein and pageout, since that is a somewhat more
40     ;;; interesting number than the total faults.
41     ;;;
42     (defun get-system-info ()
43 wlott 1.3 (multiple-value-bind (err? utime stime maxrss ixrss idrss
44     isrss minflt majflt)
45 wlott 1.4 (unix:unix-getrusage unix:rusage_self)
46 wlott 1.3 (declare (ignore maxrss ixrss idrss isrss minflt majflt))
47     (unless err?
48     (error "Unix system call getrusage failed: ~A."
49     (unix:get-unix-error-msg utime)))
50    
51     (multiple-value-bind (gr ps fc ac ic wc zf ra in ot)
52     (mach:vm_statistics *task-self*)
53     (declare (ignore ps fc ac ic wc zf ra))
54     (gr-error 'mach:vm_statistics gr)
55    
56     (values utime stime (+ in ot)))))
57 ram 1.1
58    
59     ;;; GET-PAGE-SIZE -- Interface
60     ;;;
61     ;;; Return the system page size.
62     ;;;
63     (defun get-page-size ()
64     (gr-call* mach:vm_statistics *task-self*))
65 wlott 1.3

  ViewVC Help
Powered by ViewVC 1.1.5