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