Skip to content
Snippets Groups Projects
os.lisp 1.78 KiB
Newer Older
;;; -*- Package: SYSTEM -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project and
;;; has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: src/code/os.lisp $")
;;;
;;; **********************************************************************
;;;
;;; OS interface functions for CMUCL.
;;;
;;; The code here is for OS functions that don't depend on the OS.

(in-package "SYSTEM")
(use-package "EXTENSIONS")
(intl:textdomain "cmucl-os")

(export '(get-page-size))

;;; GET-PAGE-SIZE  --  Interface
;;;
;;;    Return the system page size.
;;;
(defun get-page-size ()
  _N"Return the system page size"
  (let ((maybe-page-size (alien:alien-funcall
			  (alien:extern-alien "os_get_page_size"
					      (function c-call:long)))))
    (when (minusp maybe-page-size)
      (error (intl:gettext "get-page-size failed: ~A") (get-unix-error-msg err)))
    maybe-page-size))


;;; GET-SYSTEM-INFO  --  Interface
;;;
;;;    Return system time, user time (in usec) and number of page
;;;    faults.
;;;
(defun get-system-info ()
  _N"Get system information consisting of the user time (in usec), the
  system time (in usec) and the number of major page faults."
  (alien:with-alien ((utime unix:int64-t 0)
		     (stime unix:int64-t 0)
		     (major-fault c-call:long 0))
    (let ((rc (alien:alien-funcall
	       (alien:extern-alien "os_get_system_info"
				   (function c-call:int
					     (* unix:int64-t)
					     (* unix:int64-t)
					     (* c-call:long)))
	       (alien:addr utime)
	       (alien:addr stime)
	       (alien:addr major-fault))))
      (when (minusp rc)
	(error (intl:gettext "Unix system call getrusage failed: ~A.")
	       (unix:get-unix-error-msg utime)))
      (values utime stime major-fault))))