From e15bebf73925a2414ce2bb5f0f0486c68324d368 Mon Sep 17 00:00:00 2001 From: hallgren <hallgren> Date: Mon, 26 Jul 1993 20:10:18 +0000 Subject: [PATCH] Initial revision --- code/hpux-os.lisp | 74 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) create mode 100644 code/hpux-os.lisp diff --git a/code/hpux-os.lisp b/code/hpux-os.lisp new file mode 100644 index 000000000..c232429ad --- /dev/null +++ b/code/hpux-os.lisp @@ -0,0 +1,74 @@ +;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*- +;;; +;;; ********************************************************************** +;;; 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/hpux-os.lisp,v 1.1 1993/07/26 20:10:18 hallgren Exp $") +;;; +;;; ********************************************************************** +;;; +;;; OS interface functions for CMU CL under Mach. From Miles Bader and David +;;; Axmark. +;;; +(in-package "SYSTEM") +(use-package "EXTENSIONS") +(export '(get-system-info get-page-size os-init)) + +(pushnew :hpux *features*) +(setq *software-type* "HPUX") + +(defvar *software-version* nil "Version string for supporting software") + +(defun software-version () + "Returns a string describing version of the supporting software." + (unless *software-version* + (setf *software-version* + (let ((version-line + (with-output-to-string (stream) + (run-program "/usr/bin/uname" + '("-r" ) + :output stream + :pty nil + :error nil)))) + (subseq version-line 0 (1- (length version-line)))))) + *software-version*) + + +;;; OS-INIT -- interface. +;;; +;;; Other OS dependent initializations. +;;; +(defun os-init () + ;; Decache version on save, because it might not be the same when we restart. + (setf *software-version* nil)) + +;;; GET-SYSTEM-INFO -- Interface +;;; +;;; Return system time, user time and number of page 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)) + (cond ((null err?) + (error "Unix system call getrusage failed: ~A." + (unix:get-unix-error-msg utime))) + (T + (values utime stime majflt))))) + + +;;; 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