Skip to content
Snippets Groups Projects
mach.lisp 2.55 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: MACH -*-
;;;
;;; **********************************************************************
;;; 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/mach.lisp,v 1.1 1992/01/24 04:31:37 wlott Exp $")
;;;
;;; **********************************************************************
;;;
;;; This file contains the low-level support for MACH features not found
;;; in UNIX.
;;;

(in-package "MACH")
(use-package "ALIEN")
(use-package "C-CALL")
(use-package "SYSTEM")

(export '(
	  port mach-task_self mach-task_data mach-task_notify
	  vm_allocate vm_copy vm_deallocate vm_statistics))

(def-alien-type port int)


;;;; Standard ports.

(def-alien-routine ("task_self" mach-task_self) int)
(def-alien-routine ("thread_reply" mach-task_data) int)
(def-alien-routine ("task_notify" mach-task_notify) int)



;;;; VM routines.

(export '(vm_allocate vm_copy vm_deallocate vm_statistics))

(def-alien-routine ("vm_allocate" vm_allocate) int
  (task port)
  (address system-area-pointer :in-out)
  (size unsigned-long)
  (anywhere boolean))

(def-alien-routine ("vm_copy" vm_copy) int
  (task port)
  (source system-area-pointer)
  (count unsigned-long)
  (dest system-area-pointer))

(def-alien-routine ("vm_deallocate" vm_deallocate) int
  (task port)
  (address system-area-pointer)
  (size unsigned-long))


(def-alien-type nil
  (struct vm_statistics
    (pagesize long)
    (free_count long)
    (active_count long)
    (inactive_count long)
    (wire_count long)
    (zero_fill_count long)
    (reactivations long)
    (pageins long)
    (pageouts long)
    (faults long)
    (cow_faults long)
    (lookups long)
    (hits long)))

(defun vm_statistics (task)
  (with-alien ((vm_stats (struct vm_statistics)))
    (values
     (alien-funcall (extern-alien "vm_statistics"
				  (function int
					    port
					    (* (struct vm_statistics))))
		    task (alien-sap vm_stats))
     (slot vm_stats 'pagesize)
     (slot vm_stats 'free_count)
     (slot vm_stats 'active_count)
     (slot vm_stats 'inactive_count)
     (slot vm_stats 'wire_count)
     (slot vm_stats 'zero_fill_count)
     (slot vm_stats 'reactivations)
     (slot vm_stats 'pageins)
     (slot vm_stats 'pageouts)
     (slot vm_stats 'faults)
     (slot vm_stats 'cow_faults)
     (slot vm_stats 'lookups)
     (slot vm_stats 'hits))))