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

Initial revision

parent e7792a94
No related branches found
No related tags found
No related merge requests found
;;; -*- 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))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment