Skip to content
Snippets Groups Projects
Commit 72053d92 authored by hallgren's avatar hallgren
Browse files

Initial revision

parent be072b7d
No related branches found
No related tags found
No related merge requests found
;;; -*- Package: SYSTEM -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/osf1-os.lisp,v 1.1 1994/04/06 17:05:22 hallgren Exp $")
;;;
;;; **********************************************************************
;;;
;;; OS interface functions for CMU CL under Mach.
;;;
;;; Written and maintained mostly by Skef Wholey and Rob MacLachlan.
;;; Scott Fahlman, Dan Aronson, and Steve Handerson did stuff here, too.
;;;
(in-package "SYSTEM")
(use-package "EXTENSIONS")
(export '(get-system-info get-page-size os-init))
(export '(*task-self* *task-data* *task-notify*))
(pushnew :osf1 *features*)
(setq *software-type* "OSF1")
(defun software-version ()
"Returns a string describing version of the supporting software."
(string-trim '(#\newline)
(with-output-to-string (stream)
(run-program "/usr/cs/etc/version" ; Site dependent???
nil :output stream))))
;;; OS-Init initializes our operating-system interface. It sets the values
;;; of the global port variables to what they should be and calls the functions
;;; that set up the argument blocks for the server interfaces.
(defvar *task-self*)
(defun os-init ()
(setf *software-version* nil))
;;; GET-SYSTEM-INFO -- Interface
;;;
;;; Return system time, user time and number of page faults. For
;;; page-faults, we add pagein and pageout, since that is a somewhat more
;;; interesting number than the total faults.
;;;
(defun get-system-info ()
(multiple-value-bind (err? utime stime maxrss ixrss idrss
isrss minflt majflt)
(unix:unix-getrusage unix:rusage_self)
(declare (ignore maxrss ixrss idrss isrss minflt majflt))
(unless err?
(error "Unix system call getrusage failed: ~A."
(unix:get-unix-error-msg utime)))
#+nil
(multiple-value-bind (gr ps fc ac ic wc zf ra in ot)
(mach:vm_statistics *task-self*)
(declare (ignore ps fc ac ic wc zf ra))
(mach:gr-error 'mach:vm_statistics gr)
(values utime stime (+ in ot)))))
;;; GET-PAGE-SIZE -- Interface
;;;
;;; Return the system page size.
;;;
(defun get-page-size ()
(multiple-value-bind (val err)
(unix:unix-getpagesize)
(unless val
(error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
val))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment