/[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.2 - (hide annotations)
Mon Oct 7 14:31:04 2002 UTC (11 years, 6 months ago) by toy
Branch: MAIN
Changes since 1.1: +1 -5 lines
o Correct some spelling mistakes
o Fix a few typos in code.
o Delete a few unused symbols from various places
o Use something better than %%RWSEQ-EOF%% for the eof marker.
o Add target-foreign-linkage vars for the PPC and HPPA ports to aid
  cross-compilation.  (The values are very likely wrong, but they're
  not used yet.)

Based on a larger patch from Eric Marsden.
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 toy 1.2 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/linux-os.lisp,v 1.2 2002/10/07 14:31:04 toy Exp $")
9 ram 1.1 ;;;
10     ;;; **********************************************************************
11     ;;;
12     ;;; OS interface functions for CMU CL under Mach.
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     ;;; Hacked into Linux-os.lisp /Werkowski
18    
19     (in-package "SYSTEM")
20     (use-package "EXTENSIONS")
21     (export '(get-system-info get-page-size os-init))
22    
23     (pushnew :linux *features*)
24    
25     (setq *software-type* "Linux")
26    
27     (defun software-version ()
28     "Returns a string describing version of the supporting software."
29     #+nil
30     (string-trim '(#\newline)
31     (with-output-to-string (stream)
32     (run-program "/usr/cs/etc/version" ; Site dependent???
33     nil :output stream)))
34     "n/a")
35    
36    
37     ;;; OS-Init initializes our operating-system interface. It sets the values
38     ;;; of the global port variables to what they should be and calls the functions
39     ;;; that set up the argument blocks for the server interfaces.
40    
41     (defvar *task-self*)
42    
43     (defun os-init () ; don't know what to do here
44     #+sparc ;; Can't use #x20000000 thru #xDFFFFFFF, but mach tries to let us.
45     (system:allocate-system-memory-at (system:int-sap #x20000000) #xc0000000))
46    
47    
48     ;;; GET-SYSTEM-INFO -- Interface
49     ;;;
50     ;;; Return system time, user time and number of page faults.
51     ;;;
52     (defun get-system-info ()
53     (multiple-value-bind (err? utime stime maxrss ixrss idrss
54     isrss minflt majflt)
55     (unix:unix-getrusage unix:rusage_self)
56     (declare (ignore maxrss ixrss idrss isrss minflt))
57     (unless err?
58     (error "Unix system call getrusage failed: ~A."
59     (unix:get-unix-error-msg utime)))
60    
61     (values utime stime majflt)))
62    
63    
64     ;;; GET-PAGE-SIZE -- Interface
65     ;;;
66     ;;; Return the system page size.
67     ;;;
68     (defun get-page-size ()
69     ;; probably should call getpagesize()
70     4096)
71    

  ViewVC Help
Powered by ViewVC 1.1.5