From 72053d924882d32068147b9aedb2569b14f6cc1e Mon Sep 17 00:00:00 2001 From: hallgren <hallgren> Date: Wed, 6 Apr 1994 17:05:22 +0000 Subject: [PATCH] Initial revision --- code/osf1-os.lisp | 78 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 code/osf1-os.lisp diff --git a/code/osf1-os.lisp b/code/osf1-os.lisp new file mode 100644 index 000000000..6229a11b4 --- /dev/null +++ b/code/osf1-os.lisp @@ -0,0 +1,78 @@ +;;; -*- 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)) + -- GitLab