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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Tue Mar 3 12:20:32 1998 UTC (16 years, 1 month ago) by pw
Branch: MAIN
Changes since 1.1: +5 -6 lines
Fix (software-version) to return just the version string, and
(software-type) to return "FreeBSD" if appropriate.
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 pw 1.2 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/bsd-os.lisp,v 1.2 1998/03/03 12:20:32 pw Exp $")
9 ram 1.1 ;;;
10     ;;; **********************************************************************
11     ;;;
12 pw 1.2 ;;; OS interface functions for CMU CL under BSD Unix.
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 pw 1.2 ;;; Hacked into (Free)bsd-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     (pushnew :bsd *features*)
24     (pushnew :freebsd *features*)
25    
26 pw 1.2 (setq *software-type* #+FreeBSD "FreeBSD" #-FreeBSD "BSD")
27 ram 1.1
28     (defun software-version ()
29     "Returns a string describing version of the supporting software."
30     (string-trim '(#\newline)
31     (with-output-to-string (stream)
32 pw 1.2 (run-program "/usr/bin/uname" '("-r") :output stream))))
33 ram 1.1
34    
35     ;;; OS-Init initializes our operating-system interface. It sets the values
36     ;;; of the global port variables to what they should be and calls the functions
37     ;;; that set up the argument blocks for the server interfaces.
38    
39     (defun os-init ()
40     nil)
41    
42    
43     ;;; GET-SYSTEM-INFO -- Interface
44     ;;;
45     ;;; Return system time, user time and number of page faults.
46     ;;;
47     (defun get-system-info ()
48     (multiple-value-bind (err? utime stime maxrss ixrss idrss
49     isrss minflt majflt)
50     (unix:unix-getrusage unix:rusage_self)
51     (declare (ignore maxrss ixrss idrss isrss minflt))
52     (unless err?
53     (error "Unix system call getrusage failed: ~A."
54     (unix:get-unix-error-msg utime)))
55    
56     (values utime stime majflt)))
57    
58    
59     ;;; GET-PAGE-SIZE -- Interface
60     ;;;
61     ;;; Return the system page size.
62     ;;;
63     (defun get-page-size ()
64     ;; probably should call getpagesize()
65     4096)

  ViewVC Help
Powered by ViewVC 1.1.5