Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
e15bebf7
Commit
e15bebf7
authored
Jul 26, 1993
by
hallgren
Browse files
Initial revision
parent
e7792a94
Changes
1
Hide whitespace changes
Inline
Side-by-side
code/hpux-os.lisp
0 → 100644
View file @
e15bebf7
;;; -*- 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
))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment