Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
;;; -*- 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))))