xref: /illumos-gate/usr/src/cmd/perl/contrib/Sun/Solaris/Kstat/Kstat.xs (revision cbab2b2687744cbfdc12fae90f8088127a0b266c)
1 /*
2  * CDDL HEADER START
3  *
4  * The contents of this file are subject to the terms of the
5  * Common Development and Distribution License (the "License").
6  * You may not use this file except in compliance with the License.
7  *
8  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9  * or http://www.opensolaris.org/os/licensing.
10  * See the License for the specific language governing permissions
11  * and limitations under the License.
12  *
13  * When distributing Covered Code, include this CDDL HEADER in each
14  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15  * If applicable, add the following below this CDDL HEADER, with the
16  * fields enclosed by brackets "[]" replaced with your own identifying
17  * information: Portions Copyright [yyyy] [name of copyright owner]
18  *
19  * CDDL HEADER END
20  */
21 
22 /*
23  * Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
24  * Use is subject to license terms.
25  */
26 
27 #pragma ident	"%Z%%M%	%I%	%E% SMI"
28 
29 /*
30  * Kstat.xs is a Perl XS (eXStension module) that makes the Solaris
31  * kstat(3KSTAT) facility available to Perl scripts.  Kstat is a general-purpose
32  * mechanism  for  providing kernel statistics to users.  The Solaris API is
33  * function-based (see the manpage for details), but for ease of use in Perl
34  * scripts this module presents the information as a nested hash data structure.
35  * It would be too inefficient to read every kstat in the system, so this module
36  * uses the Perl TIEHASH mechanism to implement a read-on-demand semantic, which
37  * only reads and updates kstats as and when they are actually accessed.
38  */
39 
40 /*
41  * Ignored raw kstats.
42  *
43  * Some raw kstats are ignored by this module, these are listed below.  The
44  * most common reason is that the kstats are stored as arrays and the ks_ndata
45  * and/or ks_data_size fields are invalid.  In this case it is impossible to
46  * know how many records are in the array, so they can't be read.
47  *
48  * unix:*:sfmmu_percpu_stat
49  * This is stored as an array with one entry per cpu.  Each element is of type
50  * struct sfmmu_percpu_stat.  The ks_ndata and ks_data_size fields are bogus.
51  *
52  * ufs directio:*:UFS DirectIO Stats
53  * The structure definition used for these kstats (ufs_directio_kstats) is in a
54  * C file (uts/common/fs/ufs/ufs_directio.c) rather than a header file, so it
55  * isn't accessible.
56  *
57  * qlc:*:statistics
58  * This is a third-party driver for which we don't have source.
59  *
60  * mm:*:phys_installed
61  * This is stored as an array of uint64_t, with each pair of values being the
62  * (address, size) of a memory segment.  The ks_ndata and ks_data_size fields
63  * are both zero.
64  *
65  * sockfs:*:sock_unix_list
66  * This is stored as an array with one entry per active socket.  Each element
67  * is of type struct k_sockinfo.  The ks_ndata and ks_data_size fields are both
68  * zero.
69  *
70  * Note that the ks_ndata and ks_data_size of many non-array raw kstats are
71  * also incorrect.  The relevant assertions are therefore commented out in the
72  * appropriate raw kstat read routines.
73  */
74 
75 /* Kstat related includes */
76 #include <libgen.h>
77 #include <kstat.h>
78 #include <sys/var.h>
79 #include <sys/utsname.h>
80 #include <sys/sysinfo.h>
81 #include <sys/flock.h>
82 #include <sys/dnlc.h>
83 #include <sys/vmmeter.h>
84 #include <nfs/nfs.h>
85 #include <nfs/nfs_clnt.h>
86 
87 /* Ultra-specific kstat includes */
88 #ifdef __sparc
89 #include <vm/hat_sfmmu.h>	/* from /usr/platform/sun4u/include */
90 #include <sys/simmstat.h>	/* from /usr/platform/sun4u/include */
91 #include <sys/sysctrl.h>	/* from /usr/platform/sun4u/include */
92 #include <sys/fhc.h>		/* from /usr/include */
93 #endif
94 
95 /*
96  * Solaris #defines SP, which conflicts with the perl definition of SP
97  * We don't need the Solaris one, so get rid of it to avoid warnings
98  */
99 #undef SP
100 
101 /* Perl XS includes */
102 #include "EXTERN.h"
103 #include "perl.h"
104 #include "XSUB.h"
105 
106 /* Debug macros */
107 #define	DEBUG_ID "Sun::Solaris::Kstat"
108 #ifdef KSTAT_DEBUG
109 #define	PERL_ASSERT(EXP) \
110     ((void)((EXP) || (croak("%s: assertion failed at %s:%d: %s", \
111     DEBUG_ID, __FILE__, __LINE__, #EXP), 0), 0))
112 #define	PERL_ASSERTMSG(EXP, MSG) \
113     ((void)((EXP) || (croak(DEBUG_ID ": " MSG), 0), 0))
114 #else
115 #define	PERL_ASSERT(EXP)		((void)0)
116 #define	PERL_ASSERTMSG(EXP, MSG)	((void)0)
117 #endif
118 
119 /* Macros for saving the contents of KSTAT_RAW structures */
120 #if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
121 #define NEW_IV(V) \
122     (newSViv((IVTYPE) V))
123 #define NEW_UV(V) \
124     (newSVuv((UVTYPE) V))
125 #else
126 #define NEW_IV(V) \
127     (V >= IV_MIN && V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V))
128 #if defined(UVTYPE)
129 #define NEW_UV(V) \
130     (V <= UV_MAX ? newSVuv((UVTYPE) V) : newSVnv((NVTYPE) V))
131 # else
132 #define NEW_UV(V) \
133     (V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V))
134 #endif
135 #endif
136 #define	NEW_HRTIME(V) \
137     newSVnv((NVTYPE) (V / 1000000000.0))
138 
139 #define	SAVE_FNP(H, F, K) \
140     hv_store(H, K, sizeof (K) - 1, newSViv((IVTYPE) &F), 0)
141 #define	SAVE_STRING(H, S, K, SS) \
142     hv_store(H, #K, sizeof (#K) - 1, \
143     newSVpvn(S->K, SS ? strlen(S->K) : sizeof(S->K)), 0)
144 #define	SAVE_INT32(H, S, K) \
145     hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0)
146 #define	SAVE_UINT32(H, S, K) \
147     hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0)
148 #define	SAVE_INT64(H, S, K) \
149     hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0)
150 #define	SAVE_UINT64(H, S, K) \
151     hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0)
152 #define	SAVE_HRTIME(H, S, K) \
153     hv_store(H, #K, sizeof (#K) - 1, NEW_HRTIME(S->K), 0)
154 
155 /* Private structure used for saving kstat info in the tied hashes */
156 typedef struct {
157 	char		read;		/* Kstat block has been read before */
158 	char		valid;		/* Kstat still exists in kstat chain */
159 	char		strip_str;	/* Strip KSTAT_DATA_CHAR fields */
160 	kstat_ctl_t	*kstat_ctl;	/* Handle returned by kstat_open */
161 	kstat_t		*kstat;		/* Handle used by kstat_read */
162 } KstatInfo_t;
163 
164 /* typedef for apply_to_ties callback functions */
165 typedef int (*ATTCb_t)(HV *, void *);
166 
167 /* typedef for raw kstat reader functions */
168 typedef void (*kstat_raw_reader_t)(HV *, kstat_t *, int);
169 
170 /* Hash of "module:name" to KSTAT_RAW read functions */
171 static HV *raw_kstat_lookup;
172 
173 /*
174  * Kstats come in two flavours, named and raw.  Raw kstats are just C structs,
175  * so we need a function per raw kstat to convert the C struct into the
176  * corresponding perl hash.  All such conversion functions are in the following
177  * section.
178  */
179 
180 /*
181  * Definitions in /usr/include/sys/cpuvar.h and /usr/include/sys/sysinfo.h
182  */
183 
184 static void
185 save_cpu_stat(HV *self, kstat_t *kp, int strip_str)
186 {
187 	cpu_stat_t    *statp;
188 	cpu_sysinfo_t *sysinfop;
189 	cpu_syswait_t *syswaitp;
190 	cpu_vminfo_t  *vminfop;
191 
192 	/* PERL_ASSERT(kp->ks_ndata == 1); */
193 	PERL_ASSERT(kp->ks_data_size == sizeof (cpu_stat_t));
194 	statp = (cpu_stat_t *)(kp->ks_data);
195 	sysinfop = &statp->cpu_sysinfo;
196 	syswaitp = &statp->cpu_syswait;
197 	vminfop  = &statp->cpu_vminfo;
198 
199 	hv_store(self, "idle", 4, NEW_UV(sysinfop->cpu[CPU_IDLE]), 0);
200 	hv_store(self, "user", 4, NEW_UV(sysinfop->cpu[CPU_USER]), 0);
201 	hv_store(self, "kernel", 6, NEW_UV(sysinfop->cpu[CPU_KERNEL]), 0);
202 	hv_store(self, "wait", 4, NEW_UV(sysinfop->cpu[CPU_WAIT]), 0);
203 	hv_store(self, "wait_io", 7, NEW_UV(sysinfop->wait[W_IO]), 0);
204 	hv_store(self, "wait_swap", 9, NEW_UV(sysinfop->wait[W_SWAP]), 0);
205 	hv_store(self, "wait_pio",  8, NEW_UV(sysinfop->wait[W_PIO]), 0);
206 	SAVE_UINT32(self, sysinfop, bread);
207 	SAVE_UINT32(self, sysinfop, bwrite);
208 	SAVE_UINT32(self, sysinfop, lread);
209 	SAVE_UINT32(self, sysinfop, lwrite);
210 	SAVE_UINT32(self, sysinfop, phread);
211 	SAVE_UINT32(self, sysinfop, phwrite);
212 	SAVE_UINT32(self, sysinfop, pswitch);
213 	SAVE_UINT32(self, sysinfop, trap);
214 	SAVE_UINT32(self, sysinfop, intr);
215 	SAVE_UINT32(self, sysinfop, syscall);
216 	SAVE_UINT32(self, sysinfop, sysread);
217 	SAVE_UINT32(self, sysinfop, syswrite);
218 	SAVE_UINT32(self, sysinfop, sysfork);
219 	SAVE_UINT32(self, sysinfop, sysvfork);
220 	SAVE_UINT32(self, sysinfop, sysexec);
221 	SAVE_UINT32(self, sysinfop, readch);
222 	SAVE_UINT32(self, sysinfop, writech);
223 	SAVE_UINT32(self, sysinfop, rcvint);
224 	SAVE_UINT32(self, sysinfop, xmtint);
225 	SAVE_UINT32(self, sysinfop, mdmint);
226 	SAVE_UINT32(self, sysinfop, rawch);
227 	SAVE_UINT32(self, sysinfop, canch);
228 	SAVE_UINT32(self, sysinfop, outch);
229 	SAVE_UINT32(self, sysinfop, msg);
230 	SAVE_UINT32(self, sysinfop, sema);
231 	SAVE_UINT32(self, sysinfop, namei);
232 	SAVE_UINT32(self, sysinfop, ufsiget);
233 	SAVE_UINT32(self, sysinfop, ufsdirblk);
234 	SAVE_UINT32(self, sysinfop, ufsipage);
235 	SAVE_UINT32(self, sysinfop, ufsinopage);
236 	SAVE_UINT32(self, sysinfop, inodeovf);
237 	SAVE_UINT32(self, sysinfop, fileovf);
238 	SAVE_UINT32(self, sysinfop, procovf);
239 	SAVE_UINT32(self, sysinfop, intrthread);
240 	SAVE_UINT32(self, sysinfop, intrblk);
241 	SAVE_UINT32(self, sysinfop, idlethread);
242 	SAVE_UINT32(self, sysinfop, inv_swtch);
243 	SAVE_UINT32(self, sysinfop, nthreads);
244 	SAVE_UINT32(self, sysinfop, cpumigrate);
245 	SAVE_UINT32(self, sysinfop, xcalls);
246 	SAVE_UINT32(self, sysinfop, mutex_adenters);
247 	SAVE_UINT32(self, sysinfop, rw_rdfails);
248 	SAVE_UINT32(self, sysinfop, rw_wrfails);
249 	SAVE_UINT32(self, sysinfop, modload);
250 	SAVE_UINT32(self, sysinfop, modunload);
251 	SAVE_UINT32(self, sysinfop, bawrite);
252 #ifdef STATISTICS	/* see header file */
253 	SAVE_UINT32(self, sysinfop, rw_enters);
254 	SAVE_UINT32(self, sysinfop, win_uo_cnt);
255 	SAVE_UINT32(self, sysinfop, win_uu_cnt);
256 	SAVE_UINT32(self, sysinfop, win_so_cnt);
257 	SAVE_UINT32(self, sysinfop, win_su_cnt);
258 	SAVE_UINT32(self, sysinfop, win_suo_cnt);
259 #endif
260 
261 	SAVE_INT32(self, syswaitp, iowait);
262 	SAVE_INT32(self, syswaitp, swap);
263 	SAVE_INT32(self, syswaitp, physio);
264 
265 	SAVE_UINT32(self, vminfop, pgrec);
266 	SAVE_UINT32(self, vminfop, pgfrec);
267 	SAVE_UINT32(self, vminfop, pgin);
268 	SAVE_UINT32(self, vminfop, pgpgin);
269 	SAVE_UINT32(self, vminfop, pgout);
270 	SAVE_UINT32(self, vminfop, pgpgout);
271 	SAVE_UINT32(self, vminfop, swapin);
272 	SAVE_UINT32(self, vminfop, pgswapin);
273 	SAVE_UINT32(self, vminfop, swapout);
274 	SAVE_UINT32(self, vminfop, pgswapout);
275 	SAVE_UINT32(self, vminfop, zfod);
276 	SAVE_UINT32(self, vminfop, dfree);
277 	SAVE_UINT32(self, vminfop, scan);
278 	SAVE_UINT32(self, vminfop, rev);
279 	SAVE_UINT32(self, vminfop, hat_fault);
280 	SAVE_UINT32(self, vminfop, as_fault);
281 	SAVE_UINT32(self, vminfop, maj_fault);
282 	SAVE_UINT32(self, vminfop, cow_fault);
283 	SAVE_UINT32(self, vminfop, prot_fault);
284 	SAVE_UINT32(self, vminfop, softlock);
285 	SAVE_UINT32(self, vminfop, kernel_asflt);
286 	SAVE_UINT32(self, vminfop, pgrrun);
287 	SAVE_UINT32(self, vminfop, execpgin);
288 	SAVE_UINT32(self, vminfop, execpgout);
289 	SAVE_UINT32(self, vminfop, execfree);
290 	SAVE_UINT32(self, vminfop, anonpgin);
291 	SAVE_UINT32(self, vminfop, anonpgout);
292 	SAVE_UINT32(self, vminfop, anonfree);
293 	SAVE_UINT32(self, vminfop, fspgin);
294 	SAVE_UINT32(self, vminfop, fspgout);
295 	SAVE_UINT32(self, vminfop, fsfree);
296 }
297 
298 /*
299  * Definitions in /usr/include/sys/var.h
300  */
301 
302 static void
303 save_var(HV *self, kstat_t *kp, int strip_str)
304 {
305 	struct var *varp;
306 
307 	/* PERL_ASSERT(kp->ks_ndata == 1); */
308 	PERL_ASSERT(kp->ks_data_size == sizeof (struct var));
309 	varp = (struct var *)(kp->ks_data);
310 
311 	SAVE_INT32(self, varp, v_buf);
312 	SAVE_INT32(self, varp, v_call);
313 	SAVE_INT32(self, varp, v_proc);
314 	SAVE_INT32(self, varp, v_maxupttl);
315 	SAVE_INT32(self, varp, v_nglobpris);
316 	SAVE_INT32(self, varp, v_maxsyspri);
317 	SAVE_INT32(self, varp, v_clist);
318 	SAVE_INT32(self, varp, v_maxup);
319 	SAVE_INT32(self, varp, v_hbuf);
320 	SAVE_INT32(self, varp, v_hmask);
321 	SAVE_INT32(self, varp, v_pbuf);
322 	SAVE_INT32(self, varp, v_sptmap);
323 	SAVE_INT32(self, varp, v_maxpmem);
324 	SAVE_INT32(self, varp, v_autoup);
325 	SAVE_INT32(self, varp, v_bufhwm);
326 }
327 
328 /*
329  * Definition in /usr/include/sys/vmmeter.h
330  */
331 
332 static void
333 save_flushmeter(HV *self, kstat_t *kp, int strip_str)
334 {
335 	struct flushmeter *flushmeterp;
336 
337 	/* PERL_ASSERT(kp->ks_ndata == 1); */
338 	PERL_ASSERT(kp->ks_data_size == sizeof (struct flushmeter));
339 	flushmeterp = (struct flushmeter *)(kp->ks_data);
340 
341 	SAVE_UINT32(self, flushmeterp, f_ctx);
342 	SAVE_UINT32(self, flushmeterp, f_segment);
343 	SAVE_UINT32(self, flushmeterp, f_page);
344 	SAVE_UINT32(self, flushmeterp, f_partial);
345 	SAVE_UINT32(self, flushmeterp, f_usr);
346 	SAVE_UINT32(self, flushmeterp, f_region);
347 }
348 
349 /*
350  * Definition in /usr/include/sys/dnlc.h
351  */
352 
353 static void
354 save_ncstats(HV *self, kstat_t *kp, int strip_str)
355 {
356 	struct ncstats *ncstatsp;
357 
358 	/* PERL_ASSERT(kp->ks_ndata == 1); */
359 	PERL_ASSERT(kp->ks_data_size == sizeof (struct ncstats));
360 	ncstatsp = (struct ncstats *)(kp->ks_data);
361 
362 	SAVE_INT32(self, ncstatsp, hits);
363 	SAVE_INT32(self, ncstatsp, misses);
364 	SAVE_INT32(self, ncstatsp, enters);
365 	SAVE_INT32(self, ncstatsp, dbl_enters);
366 	SAVE_INT32(self, ncstatsp, long_enter);
367 	SAVE_INT32(self, ncstatsp, long_look);
368 	SAVE_INT32(self, ncstatsp, move_to_front);
369 	SAVE_INT32(self, ncstatsp, purges);
370 }
371 
372 /*
373  * Definition in  /usr/include/sys/sysinfo.h
374  */
375 
376 static void
377 save_sysinfo(HV *self, kstat_t *kp, int strip_str)
378 {
379 	sysinfo_t *sysinfop;
380 
381 	/* PERL_ASSERT(kp->ks_ndata == 1); */
382 	PERL_ASSERT(kp->ks_data_size == sizeof (sysinfo_t));
383 	sysinfop = (sysinfo_t *)(kp->ks_data);
384 
385 	SAVE_UINT32(self, sysinfop, updates);
386 	SAVE_UINT32(self, sysinfop, runque);
387 	SAVE_UINT32(self, sysinfop, runocc);
388 	SAVE_UINT32(self, sysinfop, swpque);
389 	SAVE_UINT32(self, sysinfop, swpocc);
390 	SAVE_UINT32(self, sysinfop, waiting);
391 }
392 
393 /*
394  * Definition in  /usr/include/sys/sysinfo.h
395  */
396 
397 static void
398 save_vminfo(HV *self, kstat_t *kp, int strip_str)
399 {
400 	vminfo_t *vminfop;
401 
402 	/* PERL_ASSERT(kp->ks_ndata == 1); */
403 	PERL_ASSERT(kp->ks_data_size == sizeof (vminfo_t));
404 	vminfop = (vminfo_t *)(kp->ks_data);
405 
406 	SAVE_UINT64(self, vminfop, freemem);
407 	SAVE_UINT64(self, vminfop, swap_resv);
408 	SAVE_UINT64(self, vminfop, swap_alloc);
409 	SAVE_UINT64(self, vminfop, swap_avail);
410 	SAVE_UINT64(self, vminfop, swap_free);
411 }
412 
413 /*
414  * Definition in /usr/include/nfs/nfs_clnt.h
415  */
416 
417 static void
418 save_nfs(HV *self, kstat_t *kp, int strip_str)
419 {
420 	struct mntinfo_kstat *mntinfop;
421 
422 	/* PERL_ASSERT(kp->ks_ndata == 1); */
423 	PERL_ASSERT(kp->ks_data_size == sizeof (struct mntinfo_kstat));
424 	mntinfop = (struct mntinfo_kstat *)(kp->ks_data);
425 
426 	SAVE_STRING(self, mntinfop, mik_proto, strip_str);
427 	SAVE_UINT32(self, mntinfop, mik_vers);
428 	SAVE_UINT32(self, mntinfop, mik_flags);
429 	SAVE_UINT32(self, mntinfop, mik_secmod);
430 	SAVE_UINT32(self, mntinfop, mik_curread);
431 	SAVE_UINT32(self, mntinfop, mik_curwrite);
432 	SAVE_INT32(self, mntinfop, mik_timeo);
433 	SAVE_INT32(self, mntinfop, mik_retrans);
434 	SAVE_UINT32(self, mntinfop, mik_acregmin);
435 	SAVE_UINT32(self, mntinfop, mik_acregmax);
436 	SAVE_UINT32(self, mntinfop, mik_acdirmin);
437 	SAVE_UINT32(self, mntinfop, mik_acdirmax);
438 	hv_store(self, "lookup_srtt", 11,
439 	    NEW_UV(mntinfop->mik_timers[0].srtt), 0);
440 	hv_store(self, "lookup_deviate", 14,
441 	    NEW_UV(mntinfop->mik_timers[0].deviate), 0);
442 	hv_store(self, "lookup_rtxcur", 13,
443 	    NEW_UV(mntinfop->mik_timers[0].rtxcur), 0);
444 	hv_store(self, "read_srtt", 9,
445 	    NEW_UV(mntinfop->mik_timers[1].srtt), 0);
446 	hv_store(self, "read_deviate", 12,
447 	    NEW_UV(mntinfop->mik_timers[1].deviate), 0);
448 	hv_store(self, "read_rtxcur", 11,
449 	    NEW_UV(mntinfop->mik_timers[1].rtxcur), 0);
450 	hv_store(self, "write_srtt", 10,
451 	    NEW_UV(mntinfop->mik_timers[2].srtt), 0);
452 	hv_store(self, "write_deviate", 13,
453 	    NEW_UV(mntinfop->mik_timers[2].deviate), 0);
454 	hv_store(self, "write_rtxcur", 12,
455 	    NEW_UV(mntinfop->mik_timers[2].rtxcur), 0);
456 	SAVE_UINT32(self, mntinfop, mik_noresponse);
457 	SAVE_UINT32(self, mntinfop, mik_failover);
458 	SAVE_UINT32(self, mntinfop, mik_remap);
459 	SAVE_STRING(self, mntinfop, mik_curserver, strip_str);
460 }
461 
462 /*
463  * The following struct => hash functions are all only present on the sparc
464  * platform, so they are all conditionally compiled depending on __sparc
465  */
466 
467 /*
468  * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h
469  */
470 
471 #ifdef __sparc
472 static void
473 save_sfmmu_global_stat(HV *self, kstat_t *kp, int strip_str)
474 {
475 	struct sfmmu_global_stat *sfmmugp;
476 
477 	/* PERL_ASSERT(kp->ks_ndata == 1); */
478 	PERL_ASSERT(kp->ks_data_size == sizeof (struct sfmmu_global_stat));
479 	sfmmugp = (struct sfmmu_global_stat *)(kp->ks_data);
480 
481 	SAVE_INT32(self, sfmmugp, sf_tsb_exceptions);
482 	SAVE_INT32(self, sfmmugp, sf_tsb_raise_exception);
483 	SAVE_INT32(self, sfmmugp, sf_pagefaults);
484 	SAVE_INT32(self, sfmmugp, sf_uhash_searches);
485 	SAVE_INT32(self, sfmmugp, sf_uhash_links);
486 	SAVE_INT32(self, sfmmugp, sf_khash_searches);
487 	SAVE_INT32(self, sfmmugp, sf_khash_links);
488 	SAVE_INT32(self, sfmmugp, sf_swapout);
489 	SAVE_INT32(self, sfmmugp, sf_tsb_alloc);
490 	SAVE_INT32(self, sfmmugp, sf_tsb_allocfail);
491 	SAVE_INT32(self, sfmmugp, sf_tsb_sectsb_create);
492 	SAVE_INT32(self, sfmmugp, sf_tteload8k);
493 	SAVE_INT32(self, sfmmugp, sf_tteload64k);
494 	SAVE_INT32(self, sfmmugp, sf_tteload512k);
495 	SAVE_INT32(self, sfmmugp, sf_tteload4m);
496 	SAVE_INT32(self, sfmmugp, sf_tteload32m);
497 	SAVE_INT32(self, sfmmugp, sf_tteload256m);
498 	SAVE_INT32(self, sfmmugp, sf_tsb_load8k);
499 	SAVE_INT32(self, sfmmugp, sf_tsb_load4m);
500 	SAVE_INT32(self, sfmmugp, sf_hblk_hit);
501 	SAVE_INT32(self, sfmmugp, sf_hblk8_ncreate);
502 	SAVE_INT32(self, sfmmugp, sf_hblk8_nalloc);
503 	SAVE_INT32(self, sfmmugp, sf_hblk1_ncreate);
504 	SAVE_INT32(self, sfmmugp, sf_hblk1_nalloc);
505 	SAVE_INT32(self, sfmmugp, sf_hblk_slab_cnt);
506 	SAVE_INT32(self, sfmmugp, sf_hblk_reserve_cnt);
507 	SAVE_INT32(self, sfmmugp, sf_hblk_recurse_cnt);
508 	SAVE_INT32(self, sfmmugp, sf_hblk_reserve_hit);
509 	SAVE_INT32(self, sfmmugp, sf_get_free_success);
510 	SAVE_INT32(self, sfmmugp, sf_get_free_throttle);
511 	SAVE_INT32(self, sfmmugp, sf_get_free_fail);
512 	SAVE_INT32(self, sfmmugp, sf_put_free_success);
513 	SAVE_INT32(self, sfmmugp, sf_put_free_fail);
514 	SAVE_INT32(self, sfmmugp, sf_pgcolor_conflict);
515 	SAVE_INT32(self, sfmmugp, sf_uncache_conflict);
516 	SAVE_INT32(self, sfmmugp, sf_unload_conflict);
517 	SAVE_INT32(self, sfmmugp, sf_ism_uncache);
518 	SAVE_INT32(self, sfmmugp, sf_ism_recache);
519 	SAVE_INT32(self, sfmmugp, sf_recache);
520 	SAVE_INT32(self, sfmmugp, sf_steal_count);
521 	SAVE_INT32(self, sfmmugp, sf_pagesync);
522 	SAVE_INT32(self, sfmmugp, sf_clrwrt);
523 	SAVE_INT32(self, sfmmugp, sf_pagesync_invalid);
524 	SAVE_INT32(self, sfmmugp, sf_kernel_xcalls);
525 	SAVE_INT32(self, sfmmugp, sf_user_xcalls);
526 	SAVE_INT32(self, sfmmugp, sf_tsb_grow);
527 	SAVE_INT32(self, sfmmugp, sf_tsb_shrink);
528 	SAVE_INT32(self, sfmmugp, sf_tsb_resize_failures);
529 	SAVE_INT32(self, sfmmugp, sf_tsb_reloc);
530 	SAVE_INT32(self, sfmmugp, sf_user_vtop);
531 	SAVE_INT32(self, sfmmugp, sf_ctx_inv);
532 	SAVE_INT32(self, sfmmugp, sf_tlb_reprog_pgsz);
533 }
534 #endif
535 
536 /*
537  * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h
538  */
539 
540 #ifdef __sparc
541 static void
542 save_sfmmu_tsbsize_stat(HV *self, kstat_t *kp, int strip_str)
543 {
544 	struct sfmmu_tsbsize_stat *sfmmutp;
545 
546 	/* PERL_ASSERT(kp->ks_ndata == 1); */
547 	PERL_ASSERT(kp->ks_data_size == sizeof (struct sfmmu_tsbsize_stat));
548 	sfmmutp = (struct sfmmu_tsbsize_stat *)(kp->ks_data);
549 
550 	SAVE_INT32(self, sfmmutp, sf_tsbsz_8k);
551 	SAVE_INT32(self, sfmmutp, sf_tsbsz_16k);
552 	SAVE_INT32(self, sfmmutp, sf_tsbsz_32k);
553 	SAVE_INT32(self, sfmmutp, sf_tsbsz_64k);
554 	SAVE_INT32(self, sfmmutp, sf_tsbsz_128k);
555 	SAVE_INT32(self, sfmmutp, sf_tsbsz_256k);
556 	SAVE_INT32(self, sfmmutp, sf_tsbsz_512k);
557 	SAVE_INT32(self, sfmmutp, sf_tsbsz_1m);
558 	SAVE_INT32(self, sfmmutp, sf_tsbsz_2m);
559 	SAVE_INT32(self, sfmmutp, sf_tsbsz_4m);
560 }
561 #endif
562 
563 /*
564  * Definition in /usr/platform/sun4u/include/sys/simmstat.h
565  */
566 
567 #ifdef __sparc
568 static void
569 save_simmstat(HV *self, kstat_t *kp, int strip_str)
570 {
571 	uchar_t	*simmstatp;
572 	SV	*list;
573 	int	i;
574 
575 	/* PERL_ASSERT(kp->ks_ndata == 1); */
576 	PERL_ASSERT(kp->ks_data_size == sizeof (uchar_t) * SIMM_COUNT);
577 
578 	list = newSVpv("", 0);
579 	for (i = 0, simmstatp = (uchar_t *)(kp->ks_data);
580 	i < SIMM_COUNT - 1; i++, simmstatp++) {
581 		sv_catpvf(list, "%d,", *simmstatp);
582 	}
583 	sv_catpvf(list, "%d", *simmstatp);
584 	hv_store(self, "status", 6, list, 0);
585 }
586 #endif
587 
588 /*
589  * Used by save_temperature to make CSV lists from arrays of
590  * short temperature values
591  */
592 
593 #ifdef __sparc
594 static SV *
595 short_array_to_SV(short *shortp, int len)
596 {
597 	SV  *list;
598 
599 	list = newSVpv("", 0);
600 	for (; len > 1; len--, shortp++) {
601 		sv_catpvf(list, "%d,", *shortp);
602 	}
603 	sv_catpvf(list, "%d", *shortp);
604 	return (list);
605 }
606 
607 /*
608  * Definition in /usr/platform/sun4u/include/sys/fhc.h
609  */
610 
611 static void
612 save_temperature(HV *self, kstat_t *kp, int strip_str)
613 {
614 	struct temp_stats *tempsp;
615 
616 	/* PERL_ASSERT(kp->ks_ndata == 1); */
617 	PERL_ASSERT(kp->ks_data_size == sizeof (struct temp_stats));
618 	tempsp = (struct temp_stats *)(kp->ks_data);
619 
620 	SAVE_UINT32(self, tempsp, index);
621 	hv_store(self, "l1", 2, short_array_to_SV(tempsp->l1, L1_SZ), 0);
622 	hv_store(self, "l2", 2, short_array_to_SV(tempsp->l2, L2_SZ), 0);
623 	hv_store(self, "l3", 2, short_array_to_SV(tempsp->l3, L3_SZ), 0);
624 	hv_store(self, "l4", 2, short_array_to_SV(tempsp->l4, L4_SZ), 0);
625 	hv_store(self, "l5", 2, short_array_to_SV(tempsp->l5, L5_SZ), 0);
626 	SAVE_INT32(self, tempsp, max);
627 	SAVE_INT32(self, tempsp, min);
628 	SAVE_INT32(self, tempsp, state);
629 	SAVE_INT32(self, tempsp, temp_cnt);
630 	SAVE_INT32(self, tempsp, shutdown_cnt);
631 	SAVE_INT32(self, tempsp, version);
632 	SAVE_INT32(self, tempsp, trend);
633 	SAVE_INT32(self, tempsp, override);
634 }
635 #endif
636 
637 /*
638  * Not actually defined anywhere - just a short.  Yuck.
639  */
640 
641 #ifdef __sparc
642 static void
643 save_temp_over(HV *self, kstat_t *kp, int strip_str)
644 {
645 	short *shortp;
646 
647 	/* PERL_ASSERT(kp->ks_ndata == 1); */
648 	PERL_ASSERT(kp->ks_data_size == sizeof (short));
649 
650 	shortp = (short *)(kp->ks_data);
651 	hv_store(self, "override", 8, newSViv(*shortp), 0);
652 }
653 #endif
654 
655 /*
656  * Defined in /usr/platform/sun4u/include/sys/sysctrl.h
657  * (Well, sort of.  Actually there's no structure, just a list of #defines
658  * enumerating *some* of the array indexes.)
659  */
660 
661 #ifdef __sparc
662 static void
663 save_ps_shadow(HV *self, kstat_t *kp, int strip_str)
664 {
665 	uchar_t *ucharp;
666 
667 	/* PERL_ASSERT(kp->ks_ndata == 1); */
668 	PERL_ASSERT(kp->ks_data_size == SYS_PS_COUNT);
669 
670 	ucharp = (uchar_t *)(kp->ks_data);
671 	hv_store(self, "core_0", 6, newSViv(*ucharp++), 0);
672 	hv_store(self, "core_1", 6, newSViv(*ucharp++), 0);
673 	hv_store(self, "core_2", 6, newSViv(*ucharp++), 0);
674 	hv_store(self, "core_3", 6, newSViv(*ucharp++), 0);
675 	hv_store(self, "core_4", 6, newSViv(*ucharp++), 0);
676 	hv_store(self, "core_5", 6, newSViv(*ucharp++), 0);
677 	hv_store(self, "core_6", 6, newSViv(*ucharp++), 0);
678 	hv_store(self, "core_7", 6, newSViv(*ucharp++), 0);
679 	hv_store(self, "pps_0", 5, newSViv(*ucharp++), 0);
680 	hv_store(self, "clk_33", 6, newSViv(*ucharp++), 0);
681 	hv_store(self, "clk_50", 6, newSViv(*ucharp++), 0);
682 	hv_store(self, "v5_p", 4, newSViv(*ucharp++), 0);
683 	hv_store(self, "v12_p", 5, newSViv(*ucharp++), 0);
684 	hv_store(self, "v5_aux", 6, newSViv(*ucharp++), 0);
685 	hv_store(self, "v5_p_pch", 8, newSViv(*ucharp++), 0);
686 	hv_store(self, "v12_p_pch", 9, newSViv(*ucharp++), 0);
687 	hv_store(self, "v3_pch", 6, newSViv(*ucharp++), 0);
688 	hv_store(self, "v5_pch", 6, newSViv(*ucharp++), 0);
689 	hv_store(self, "p_fan", 5, newSViv(*ucharp++), 0);
690 }
691 #endif
692 
693 /*
694  * Definition in /usr/platform/sun4u/include/sys/fhc.h
695  */
696 
697 #ifdef __sparc
698 static void
699 save_fault_list(HV *self, kstat_t *kp, int strip_str)
700 {
701 	struct ft_list	*faultp;
702 	int		i;
703 	char		name[KSTAT_STRLEN + 7];	/* room for 999999 faults */
704 
705 	/* PERL_ASSERT(kp->ks_ndata == 1); */
706 	/* PERL_ASSERT(kp->ks_data_size == sizeof (struct ft_list)); */
707 
708 	for (i = 1, faultp = (struct ft_list *)(kp->ks_data);
709 	    i <= 999999 && i <= kp->ks_data_size / sizeof (struct ft_list);
710 	    i++, faultp++) {
711 		(void) snprintf(name, sizeof (name), "unit_%d", i);
712 		hv_store(self, name, strlen(name), newSViv(faultp->unit), 0);
713 		(void) snprintf(name, sizeof (name), "type_%d", i);
714 		hv_store(self, name, strlen(name), newSViv(faultp->type), 0);
715 		(void) snprintf(name, sizeof (name), "fclass_%d", i);
716 		hv_store(self, name, strlen(name), newSViv(faultp->fclass), 0);
717 		(void) snprintf(name, sizeof (name), "create_time_%d", i);
718 		hv_store(self, name, strlen(name),
719 		    NEW_UV(faultp->create_time), 0);
720 		(void) snprintf(name, sizeof (name), "msg_%d", i);
721 		hv_store(self, name, strlen(name), newSVpv(faultp->msg, 0), 0);
722 	}
723 }
724 #endif
725 
726 /*
727  * We need to be able to find the function corresponding to a particular raw
728  * kstat.  To do this we ignore the instance and glue the module and name
729  * together to form a composite key.  We can then use the data in the kstat
730  * structure to find the appropriate function.  We use a perl hash to manage the
731  * lookup, where the key is "module:name" and the value is a pointer to the
732  * appropriate C function.
733  *
734  * Note that some kstats include the instance number as part of the module
735  * and/or name.  This could be construed as a bug.  However, to work around this
736  * we omit any digits from the module and name as we build the table in
737  * build_raw_kstat_loopup(), and we remove any digits from the module and name
738  * when we look up the functions in lookup_raw_kstat_fn()
739  */
740 
741 /*
742  * This function is called when the XS is first dlopen()ed, and builds the
743  * lookup table as described above.
744  */
745 
746 static void
747 build_raw_kstat_lookup()
748 	{
749 	/* Create new hash */
750 	raw_kstat_lookup = newHV();
751 
752 	SAVE_FNP(raw_kstat_lookup, save_cpu_stat, "cpu_stat:cpu_stat");
753 	SAVE_FNP(raw_kstat_lookup, save_var, "unix:var");
754 	SAVE_FNP(raw_kstat_lookup, save_flushmeter, "unix:flushmeter");
755 	SAVE_FNP(raw_kstat_lookup, save_ncstats, "unix:ncstats");
756 	SAVE_FNP(raw_kstat_lookup, save_sysinfo, "unix:sysinfo");
757 	SAVE_FNP(raw_kstat_lookup, save_vminfo, "unix:vminfo");
758 	SAVE_FNP(raw_kstat_lookup, save_nfs, "nfs:mntinfo");
759 #ifdef __sparc
760 	SAVE_FNP(raw_kstat_lookup, save_sfmmu_global_stat,
761 	    "unix:sfmmu_global_stat");
762 	SAVE_FNP(raw_kstat_lookup, save_sfmmu_tsbsize_stat,
763 	    "unix:sfmmu_tsbsize_stat");
764 	SAVE_FNP(raw_kstat_lookup, save_simmstat, "unix:simm-status");
765 	SAVE_FNP(raw_kstat_lookup, save_temperature, "unix:temperature");
766 	SAVE_FNP(raw_kstat_lookup, save_temp_over, "unix:temperature override");
767 	SAVE_FNP(raw_kstat_lookup, save_ps_shadow, "unix:ps_shadow");
768 	SAVE_FNP(raw_kstat_lookup, save_fault_list, "unix:fault_list");
769 #endif
770 }
771 
772 /*
773  * This finds and returns the raw kstat reader function corresponding to the
774  * supplied module and name.  If no matching function exists, 0 is returned.
775  */
776 
777 static kstat_raw_reader_t lookup_raw_kstat_fn(char *module, char *name)
778 	{
779 	char			key[KSTAT_STRLEN * 2];
780 	register char		*f, *t;
781 	SV			**entry;
782 	kstat_raw_reader_t	fnp;
783 
784 	/* Copy across module & name, removing any digits - see comment above */
785 	for (f = module, t = key; *f != '\0'; f++, t++) {
786 		while (*f != '\0' && isdigit(*f)) { f++; }
787 		*t = *f;
788 	}
789 	*t++ = ':';
790 	for (f = name; *f != '\0'; f++, t++) {
791 		while (*f != '\0' && isdigit(*f)) {
792 			f++;
793 		}
794 	*t = *f;
795 	}
796 	*t = '\0';
797 
798 	/* look up & return the function, or teturn 0 if not found */
799 	if ((entry = hv_fetch(raw_kstat_lookup, key, strlen(key), FALSE)) == 0)
800 	{
801 		fnp = 0;
802 	} else {
803 		fnp = (kstat_raw_reader_t)(uintptr_t)SvIV(*entry);
804 	}
805 	return (fnp);
806 }
807 
808 /*
809  * This module converts the flat list returned by kstat_read() into a perl hash
810  * tree keyed on module, instance, name and statistic.  The following functions
811  * provide code to create the nested hashes, and to iterate over them.
812  */
813 
814 /*
815  * Given module, instance and name keys return a pointer to the hash tied to
816  * the bottommost hash.  If the hash already exists, we just return a pointer
817  * to it, otherwise we create the hash and any others also required above it in
818  * the hierarchy.  The returned tiehash is blessed into the
819  * Sun::Solaris::Kstat::_Stat class, so that the appropriate TIEHASH methods are
820  * called when the bottommost hash is accessed.  If the is_new parameter is
821  * non-null it will be set to TRUE if a new tie has been created, and FALSE if
822  * the tie already existed.
823  */
824 
825 static HV *
826 get_tie(SV *self, char *module, int instance, char *name, int *is_new)
827 {
828 	char str_inst[11];	/* big enough for up to 10^10 instances */
829 	char *key[3];		/* 3 part key: module, instance, name */
830 	int  k;
831 	int  new;
832 	HV   *hash;
833 	HV   *tie;
834 
835 	/* Create the keys */
836 	(void) snprintf(str_inst, sizeof (str_inst), "%d", instance);
837 	key[0] = module;
838 	key[1] = str_inst;
839 	key[2] = name;
840 
841 	/* Iteratively descend the tree, creating new hashes as required */
842 	hash = (HV *)SvRV(self);
843 	for (k = 0; k < 3; k++) {
844 		SV **entry;
845 
846 		SvREADONLY_off(hash);
847 		entry = hv_fetch(hash, key[k], strlen(key[k]), TRUE);
848 
849 		/* If the entry doesn't exist, create it */
850 		if (! SvOK(*entry)) {
851 			HV *newhash;
852 			SV *rv;
853 
854 			newhash = newHV();
855 			rv = newRV_noinc((SV *)newhash);
856 			sv_setsv(*entry, rv);
857 			SvREFCNT_dec(rv);
858 			if (k < 2) {
859 				SvREADONLY_on(newhash);
860 			}
861 			SvREADONLY_on(*entry);
862 			SvREADONLY_on(hash);
863 			hash = newhash;
864 			new = 1;
865 
866 		/* Otherwise it already existed */
867 		} else {
868 			SvREADONLY_on(hash);
869 			hash = (HV *)SvRV(*entry);
870 			new = 0;
871 		}
872 	}
873 
874 	/* Create and bless a hash for the tie, if necessary */
875 	if (new) {
876 		SV *tieref;
877 		HV *stash;
878 
879 		tie = newHV();
880 		tieref = newRV_noinc((SV *)tie);
881 		stash = gv_stashpv("Sun::Solaris::Kstat::_Stat", TRUE);
882 		sv_bless(tieref, stash);
883 
884 		/* Add TIEHASH magic */
885 		hv_magic(hash, (GV *)tieref, 'P');
886 		SvREADONLY_on(hash);
887 
888 	/* Otherwise, just find the existing tied hash */
889 	} else {
890 		MAGIC *mg;
891 
892 		mg = mg_find((SV *)hash, 'P');
893 		PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
894 		tie = (HV *)SvRV(mg->mg_obj);
895 	}
896 	if (is_new) {
897 		*is_new = new;
898 	}
899 	return (tie);
900 }
901 
902 /*
903  * This is an iterator function used to traverse the hash hierarchy and apply
904  * the passed function to the tied hashes at the bottom of the hierarchy.  If
905  * any of the callback functions return 0, 0 is returned, otherwise 1
906  */
907 
908 static int
909 apply_to_ties(SV *self, ATTCb_t cb, void *arg)
910 {
911 	HV	*hash1;
912 	HE	*entry1;
913 	long	s;
914 	int	ret;
915 
916 	hash1 = (HV *)SvRV(self);
917 	hv_iterinit(hash1);
918 	ret = 1;
919 
920 	/* Iterate over each module */
921 	while (entry1 = hv_iternext(hash1)) {
922 		HV *hash2;
923 		HE *entry2;
924 
925 		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
926 		hv_iterinit(hash2);
927 
928 		/* Iterate over each module:instance */
929 		while (entry2 = hv_iternext(hash2)) {
930 			HV *hash3;
931 			HE *entry3;
932 
933 			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
934 			hv_iterinit(hash3);
935 
936 			/* Iterate over each module:instance:name */
937 			while (entry3 = hv_iternext(hash3)) {
938 				HV    *hash4;
939 				MAGIC *mg;
940 				HV    *tie;
941 
942 				/* Get the tie */
943 				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
944 				mg = mg_find((SV *)hash4, 'P');
945 				PERL_ASSERTMSG(mg != 0,
946 				    "apply_to_ties: lost P magic");
947 
948 				/* Apply the callback */
949 				if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
950 					ret = 0;
951 				}
952 			}
953 		}
954 	}
955 	return (ret);
956 }
957 
958 /*
959  * Mark this HV as valid - used by update() when pruning deleted kstat nodes
960  */
961 
962 static int
963 set_valid(HV *self, void *arg)
964 {
965 	MAGIC *mg;
966 
967 	mg = mg_find((SV *)self, '~');
968 	PERL_ASSERTMSG(mg != 0, "set_valid: lost ~ magic");
969 	((KstatInfo_t *)SvPVX(mg->mg_obj))->valid = (int)arg;
970 	return (1);
971 }
972 
973 /*
974  * Prune invalid kstat nodes. This is called when kstat_chain_update() detects
975  * that the kstat chain has been updated.  This removes any hash tree entries
976  * that no longer have a corresponding kstat.  If del is non-null it will be
977  * set to the keys of the deleted kstat nodes, if any.  If any entries are
978  * deleted 1 will be retured, otherwise 0
979  */
980 
981 static int
982 prune_invalid(SV *self, AV *del)
983 {
984 	HV	*hash1;
985 	HE	*entry1;
986 	STRLEN	klen;
987 	char	*module, *instance, *name, *key;
988 	int	ret;
989 
990 	hash1 = (HV *)SvRV(self);
991 	hv_iterinit(hash1);
992 	ret = 0;
993 
994 	/* Iterate over each module */
995 	while (entry1 = hv_iternext(hash1)) {
996 		HV *hash2;
997 		HE *entry2;
998 
999 		module = HePV(entry1, PL_na);
1000 		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
1001 		hv_iterinit(hash2);
1002 
1003 		/* Iterate over each module:instance */
1004 		while (entry2 = hv_iternext(hash2)) {
1005 			HV *hash3;
1006 			HE *entry3;
1007 
1008 			instance = HePV(entry2, PL_na);
1009 			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
1010 			hv_iterinit(hash3);
1011 
1012 			/* Iterate over each module:instance:name */
1013 			while (entry3 = hv_iternext(hash3)) {
1014 				HV    *hash4;
1015 				MAGIC *mg;
1016 				HV    *tie;
1017 
1018 				name = HePV(entry3, PL_na);
1019 				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
1020 				mg = mg_find((SV *)hash4, 'P');
1021 				PERL_ASSERTMSG(mg != 0,
1022 				    "prune_invalid: lost P magic");
1023 				tie = (HV *)SvRV(mg->mg_obj);
1024 				mg = mg_find((SV *)tie, '~');
1025 				PERL_ASSERTMSG(mg != 0,
1026 				    "prune_invalid: lost ~ magic");
1027 
1028 				/* If this is marked as invalid, prune it */
1029 				if (((KstatInfo_t *)SvPVX(
1030 				    (SV *)mg->mg_obj))->valid == FALSE) {
1031 					SvREADONLY_off(hash3);
1032 					key = HePV(entry3, klen);
1033 					hv_delete(hash3, key, klen, G_DISCARD);
1034 					SvREADONLY_on(hash3);
1035 					if (del) {
1036 						av_push(del,
1037 						    newSVpvf("%s:%s:%s",
1038 						    module, instance, name));
1039 					}
1040 					ret = 1;
1041 				}
1042 			}
1043 
1044 			/* If the module:instance:name hash is empty prune it */
1045 			if (HvKEYS(hash3) == 0) {
1046 				SvREADONLY_off(hash2);
1047 				key = HePV(entry2, klen);
1048 				hv_delete(hash2, key, klen, G_DISCARD);
1049 				SvREADONLY_on(hash2);
1050 			}
1051 		}
1052 		/* If the module:instance hash is empty prune it */
1053 		if (HvKEYS(hash2) == 0) {
1054 			SvREADONLY_off(hash1);
1055 			key = HePV(entry1, klen);
1056 			hv_delete(hash1, key, klen, G_DISCARD);
1057 			SvREADONLY_on(hash1);
1058 		}
1059 	}
1060 	return (ret);
1061 }
1062 
1063 /*
1064  * Named kstats are returned as a list of key/values.  This function converts
1065  * such a list into the equivalent perl datatypes, and stores them in the passed
1066  * hash.
1067  */
1068 
1069 static void
1070 save_named(HV *self, kstat_t *kp, int strip_str)
1071 {
1072 	kstat_named_t	*knp;
1073 	int		n;
1074 	SV*		value;
1075 
1076 	for (n = kp->ks_ndata, knp = KSTAT_NAMED_PTR(kp); n > 0; n--, knp++) {
1077 		switch (knp->data_type) {
1078 		case KSTAT_DATA_CHAR:
1079 			value = newSVpv(knp->value.c, strip_str ?
1080 			    strlen(knp->value.c) : sizeof (knp->value.c));
1081 			break;
1082 		case KSTAT_DATA_INT32:
1083 			value = newSViv(knp->value.i32);
1084 			break;
1085 		case KSTAT_DATA_UINT32:
1086 			value = NEW_UV(knp->value.ui32);
1087 			break;
1088 		case KSTAT_DATA_INT64:
1089 			value = NEW_UV(knp->value.i64);
1090 			break;
1091 		case KSTAT_DATA_UINT64:
1092 			value = NEW_UV(knp->value.ui64);
1093 			break;
1094 		case KSTAT_DATA_STRING:
1095 			if (KSTAT_NAMED_STR_PTR(knp) == NULL)
1096 				value = newSVpv("null", sizeof ("null") - 1);
1097 			else
1098 				value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
1099 						KSTAT_NAMED_STR_BUFLEN(knp) -1);
1100 			break;
1101 		default:
1102 			PERL_ASSERTMSG(0, "kstat_read: invalid data type");
1103 			break;
1104 		}
1105 		hv_store(self, knp->name, strlen(knp->name), value, 0);
1106 	}
1107 }
1108 
1109 /*
1110  * Save kstat interrupt statistics
1111  */
1112 
1113 static void
1114 save_intr(HV *self, kstat_t *kp, int strip_str)
1115 {
1116 	kstat_intr_t	*kintrp;
1117 	int		i;
1118 	static char	*intr_names[] =
1119 	    { "hard", "soft", "watchdog", "spurious", "multiple_service" };
1120 
1121 	PERL_ASSERT(kp->ks_ndata == 1);
1122 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
1123 	kintrp = KSTAT_INTR_PTR(kp);
1124 
1125 	for (i = 0; i < KSTAT_NUM_INTRS; i++) {
1126 		hv_store(self, intr_names[i], strlen(intr_names[i]),
1127 		    NEW_UV(kintrp->intrs[i]), 0);
1128 	}
1129 }
1130 
1131 /*
1132  * Save IO statistics
1133  */
1134 
1135 static void
1136 save_io(HV *self, kstat_t *kp, int strip_str)
1137 {
1138 	kstat_io_t *kiop;
1139 
1140 	PERL_ASSERT(kp->ks_ndata == 1);
1141 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_io_t));
1142 	kiop = KSTAT_IO_PTR(kp);
1143 	SAVE_UINT64(self, kiop, nread);
1144 	SAVE_UINT64(self, kiop, nwritten);
1145 	SAVE_UINT32(self, kiop, reads);
1146 	SAVE_UINT32(self, kiop, writes);
1147 	SAVE_HRTIME(self, kiop, wtime);
1148 	SAVE_HRTIME(self, kiop, wlentime);
1149 	SAVE_HRTIME(self, kiop, wlastupdate);
1150 	SAVE_HRTIME(self, kiop, rtime);
1151 	SAVE_HRTIME(self, kiop, rlentime);
1152 	SAVE_HRTIME(self, kiop, rlastupdate);
1153 	SAVE_UINT32(self, kiop, wcnt);
1154 	SAVE_UINT32(self, kiop, rcnt);
1155 }
1156 
1157 /*
1158  * Save timer statistics
1159  */
1160 
1161 static void
1162 save_timer(HV *self, kstat_t *kp, int strip_str)
1163 {
1164 	kstat_timer_t *ktimerp;
1165 
1166 	PERL_ASSERT(kp->ks_ndata == 1);
1167 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_timer_t));
1168 	ktimerp = KSTAT_TIMER_PTR(kp);
1169 	SAVE_STRING(self, ktimerp, name, strip_str);
1170 	SAVE_UINT64(self, ktimerp, num_events);
1171 	SAVE_HRTIME(self, ktimerp, elapsed_time);
1172 	SAVE_HRTIME(self, ktimerp, min_time);
1173 	SAVE_HRTIME(self, ktimerp, max_time);
1174 	SAVE_HRTIME(self, ktimerp, start_time);
1175 	SAVE_HRTIME(self, ktimerp, stop_time);
1176 }
1177 
1178 /*
1179  * Read kstats and copy into the supplied perl hash structure.  If refresh is
1180  * true, this function is being called as part of the update() method.  In this
1181  * case it is only necessary to read the kstats if they have previously been
1182  * accessed (kip->read == TRUE).  If refresh is false, this function is being
1183  * called prior to returning a value to the caller. In this case, it is only
1184  * necessary to read the kstats if they have not previously been read.  If the
1185  * kstat_read() fails, 0 is returned, otherwise 1
1186  */
1187 
1188 static int
1189 read_kstats(HV *self, int refresh)
1190 {
1191 	MAGIC			*mg;
1192 	KstatInfo_t		*kip;
1193 	kstat_raw_reader_t	fnp;
1194 
1195 	/* Find the MAGIC KstatInfo_t data structure */
1196 	mg = mg_find((SV *)self, '~');
1197 	PERL_ASSERTMSG(mg != 0, "read_kstats: lost ~ magic");
1198 	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1199 
1200 	/* Return early if we don't need to actually read the kstats */
1201 	if ((refresh && ! kip->read) || (! refresh && kip->read)) {
1202 		return (1);
1203 	}
1204 
1205 	/* Read the kstats and return 0 if this fails */
1206 	if (kstat_read(kip->kstat_ctl, kip->kstat, NULL) < 0) {
1207 		return (0);
1208 	}
1209 
1210 	/* Save the read data */
1211 	hv_store(self, "snaptime", 8, NEW_HRTIME(kip->kstat->ks_snaptime), 0);
1212 	switch (kip->kstat->ks_type) {
1213 		case KSTAT_TYPE_RAW:
1214 			if ((fnp = lookup_raw_kstat_fn(kip->kstat->ks_module,
1215 			    kip->kstat->ks_name)) != 0) {
1216 				fnp(self, kip->kstat, kip->strip_str);
1217 			}
1218 			break;
1219 		case KSTAT_TYPE_NAMED:
1220 			save_named(self, kip->kstat, kip->strip_str);
1221 			break;
1222 		case KSTAT_TYPE_INTR:
1223 			save_intr(self, kip->kstat, kip->strip_str);
1224 			break;
1225 		case KSTAT_TYPE_IO:
1226 			save_io(self, kip->kstat, kip->strip_str);
1227 			break;
1228 		case KSTAT_TYPE_TIMER:
1229 			save_timer(self, kip->kstat, kip->strip_str);
1230 			break;
1231 		default:
1232 			PERL_ASSERTMSG(0, "read_kstats: illegal kstat type");
1233 			break;
1234 	}
1235 	kip->read = TRUE;
1236 	return (1);
1237 }
1238 
1239 /*
1240  * The XS code exported to perl is below here.  Note that the XS preprocessor
1241  * has its own commenting syntax, so all comments from this point on are in
1242  * that form.
1243  */
1244 
1245 /* The following XS methods are the ABI of the Sun::Solaris::Kstat package */
1246 
1247 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat
1248 PROTOTYPES: ENABLE
1249 
1250  # Create the raw kstat to store function lookup table on load
1251 BOOT:
1252 	build_raw_kstat_lookup();
1253 
1254  #
1255  # The Sun::Solaris::Kstat constructor.  This builds the nested
1256  # name::instance::module hash structure, but doesn't actually read the
1257  # underlying kstats.  This is done on demand by the TIEHASH methods in
1258  # Sun::Solaris::Kstat::_Stat
1259  #
1260 
1261 SV*
1262 new(class, ...)
1263 	char *class;
1264 PREINIT:
1265 	HV		*stash;
1266 	kstat_ctl_t	*kc;
1267 	SV		*kcsv;
1268 	kstat_t		*kp;
1269 	KstatInfo_t	kstatinfo;
1270 	int		sp, strip_str;
1271 CODE:
1272 	/* Check we have an even number of arguments, excluding the class */
1273 	sp = 1;
1274 	if (((items - sp) % 2) != 0) {
1275 		croak(DEBUG_ID ": new: invalid number of arguments");
1276 	}
1277 
1278 	/* Process any (name => value) arguments */
1279 	strip_str = 0;
1280 	while (sp < items) {
1281 		SV *name, *value;
1282 
1283 		name = ST(sp);
1284 		sp++;
1285 		value = ST(sp);
1286 		sp++;
1287 		if (strcmp(SvPVX(name), "strip_strings") == 0) {
1288 			strip_str = SvTRUE(value);
1289 		} else {
1290 			croak(DEBUG_ID ": new: invalid parameter name '%s'",
1291 			    SvPVX(name));
1292 		}
1293 	}
1294 
1295 	/* Open the kstats handle */
1296 	if ((kc = kstat_open()) == 0) {
1297 		XSRETURN_UNDEF;
1298 	}
1299 
1300 	/* Create a blessed hash ref */
1301 	RETVAL = (SV *)newRV_noinc((SV *)newHV());
1302 	stash = gv_stashpv(class, TRUE);
1303 	sv_bless(RETVAL, stash);
1304 
1305 	/* Create a place to save the KstatInfo_t structure */
1306 	kcsv = newSVpv((char *)&kc, sizeof (kc));
1307 	sv_magic(SvRV(RETVAL), kcsv, '~', 0, 0);
1308 	SvREFCNT_dec(kcsv);
1309 
1310 	/* Initialise the KstatsInfo_t structure */
1311 	kstatinfo.read = FALSE;
1312 	kstatinfo.valid = TRUE;
1313 	kstatinfo.strip_str = strip_str;
1314 	kstatinfo.kstat_ctl = kc;
1315 
1316 	/* Scan the kstat chain, building hash entries for the kstats */
1317 	for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1318 		HV *tie;
1319 		SV *kstatsv;
1320 
1321 		/* Don't bother storing the kstat headers */
1322 		if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1323 			continue;
1324 		}
1325 
1326 		/* Don't bother storing raw stats we don't understand */
1327 		if (kp->ks_type == KSTAT_TYPE_RAW &&
1328 		    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) == 0) {
1329 #ifdef REPORT_UNKNOWN
1330 			(void) fprintf(stderr,
1331 			    "Unknown kstat type %s:%d:%s - %d of size %d\n",
1332 			    kp->ks_module, kp->ks_instance, kp->ks_name,
1333 			    kp->ks_ndata, kp->ks_data_size);
1334 #endif
1335 			continue;
1336 		}
1337 
1338 		/* Create a 3-layer hash hierarchy - module.instance.name */
1339 		tie = get_tie(RETVAL, kp->ks_module, kp->ks_instance,
1340 		    kp->ks_name, 0);
1341 
1342 		/* Save the data necessary to read the kstat info on demand */
1343 		hv_store(tie, "class", 5, newSVpv(kp->ks_class, 0), 0);
1344 		hv_store(tie, "crtime", 6, NEW_HRTIME(kp->ks_crtime), 0);
1345 		kstatinfo.kstat = kp;
1346 		kstatsv = newSVpv((char *)&kstatinfo, sizeof (kstatinfo));
1347 		sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1348 		SvREFCNT_dec(kstatsv);
1349 	}
1350 	SvREADONLY_on(SvRV(RETVAL));
1351 	/* SvREADONLY_on(RETVAL); */
1352 OUTPUT:
1353 	RETVAL
1354 
1355  #
1356  # Update the perl hash structure so that it is in line with the kernel kstats
1357  # data.  Only kstats athat have previously been accessed are read,
1358  #
1359 
1360  # Scalar context: true/false
1361  # Array context: (\@added, \@deleted)
1362 void
1363 update(self)
1364 	SV* self;
1365 PREINIT:
1366 	MAGIC		*mg;
1367 	kstat_ctl_t	*kc;
1368 	kstat_t		*kp;
1369 	int		ret;
1370 	AV		*add, *del;
1371 PPCODE:
1372 	/* Find the hidden KstatInfo_t structure */
1373 	mg = mg_find(SvRV(self), '~');
1374 	PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1375 	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1376 
1377 	/* Update the kstat chain, and return immediately on error. */
1378 	if ((ret = kstat_chain_update(kc)) == -1) {
1379 		if (GIMME_V == G_ARRAY) {
1380 			EXTEND(SP, 2);
1381 			PUSHs(sv_newmortal());
1382 			PUSHs(sv_newmortal());
1383 		} else {
1384 			EXTEND(SP, 1);
1385 			PUSHs(sv_2mortal(newSViv(ret)));
1386 		}
1387 	}
1388 
1389 	/* Create the arrays to be returned if in an array context */
1390 	if (GIMME_V == G_ARRAY) {
1391 		add = newAV();
1392 		del = newAV();
1393 	} else {
1394 		add = 0;
1395 		del = 0;
1396 	}
1397 
1398 	/*
1399 	 * If the kstat chain hasn't changed we can just reread any stats
1400 	 * that have already been read
1401 	 */
1402 	if (ret == 0) {
1403 		if (! apply_to_ties(self, (ATTCb_t)read_kstats, (void *)TRUE)) {
1404 			if (GIMME_V == G_ARRAY) {
1405 				EXTEND(SP, 2);
1406 				PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1407 				PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1408 			} else {
1409 				EXTEND(SP, 1);
1410 				PUSHs(sv_2mortal(newSViv(-1)));
1411 			}
1412 		}
1413 
1414 	/*
1415 	 * Otherwise we have to update the Perl structure so that it is in
1416 	 * agreement with the new kstat chain.  We do this in such a way as to
1417 	 * retain all the existing structures, just adding or deleting the
1418 	 * bare minimum.
1419 	 */
1420 	} else {
1421 		KstatInfo_t	kstatinfo;
1422 
1423 		/*
1424 		 * Step 1: set the 'invalid' flag on each entry
1425 		 */
1426 		apply_to_ties(self, &set_valid, (void *)FALSE);
1427 
1428 		/*
1429 		 * Step 2: Set the 'valid' flag on all entries still in the
1430 		 * kernel kstat chain
1431 		 */
1432 		kstatinfo.read		= FALSE;
1433 		kstatinfo.valid		= TRUE;
1434 		kstatinfo.kstat_ctl	= kc;
1435 		for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1436 			int	new;
1437 			HV	*tie;
1438 
1439 			/* Don't bother storing the kstat headers or types */
1440 			if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1441 				continue;
1442 			}
1443 
1444 			/* Don't bother storing raw stats we don't understand */
1445 			if (kp->ks_type == KSTAT_TYPE_RAW &&
1446 			    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name)
1447 			    == 0) {
1448 #ifdef REPORT_UNKNOWN
1449 				(void) printf("Unknown kstat type %s:%d:%s "
1450 				    "- %d of size %d\n", kp->ks_module,
1451 				    kp->ks_instance, kp->ks_name,
1452 				    kp->ks_ndata, kp->ks_data_size);
1453 #endif
1454 				continue;
1455 			}
1456 
1457 			/* Find the tied hash associated with the kstat entry */
1458 			tie = get_tie(self, kp->ks_module, kp->ks_instance,
1459 			    kp->ks_name, &new);
1460 
1461 			/* If newly created store the associated kstat info */
1462 			if (new) {
1463 				SV *kstatsv;
1464 
1465 				/*
1466 				 * Save the data necessary to read the kstat
1467 				 * info on demand
1468 				 */
1469 				hv_store(tie, "class", 5,
1470 				    newSVpv(kp->ks_class, 0), 0);
1471 				hv_store(tie, "crtime", 6,
1472 				    NEW_HRTIME(kp->ks_crtime), 0);
1473 				kstatinfo.kstat = kp;
1474 				kstatsv = newSVpv((char *)&kstatinfo,
1475 				    sizeof (kstatinfo));
1476 				sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1477 				SvREFCNT_dec(kstatsv);
1478 
1479 				/* Save the key on the add list, if required */
1480 				if (GIMME_V == G_ARRAY) {
1481 					av_push(add, newSVpvf("%s:%d:%s",
1482 					    kp->ks_module, kp->ks_instance,
1483 					    kp->ks_name));
1484 				}
1485 
1486 			/* If the stats already exist, just update them */
1487 			} else {
1488 				MAGIC *mg;
1489 				KstatInfo_t *kip;
1490 
1491 				/* Find the hidden KstatInfo_t */
1492 				mg = mg_find((SV *)tie, '~');
1493 				PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1494 				kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1495 
1496 				/* Mark the tie as valid */
1497 				kip->valid = TRUE;
1498 
1499 				/* Re-save the kstat_t pointer.  If the kstat
1500 				 * has been deleted and re-added since the last
1501 				 * update, the address of the kstat structure
1502 				 * will have changed, even though the kstat will
1503 				 * still live at the same place in the perl
1504 				 * hash tree structure.
1505 				 */
1506 				kip->kstat = kp;
1507 
1508 				/* Reread the stats, if read previously */
1509 				read_kstats(tie, TRUE);
1510 			}
1511 		}
1512 
1513 		/*
1514 		 *Step 3: Delete any entries still marked as 'invalid'
1515 		 */
1516 		ret = prune_invalid(self, del);
1517 
1518 	}
1519 	if (GIMME_V == G_ARRAY) {
1520 		EXTEND(SP, 2);
1521 		PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1522 		PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1523 	} else {
1524 		EXTEND(SP, 1);
1525 		PUSHs(sv_2mortal(newSViv(ret)));
1526 	}
1527 
1528 
1529  #
1530  # Destructor.  Closes the kstat connection
1531  #
1532 
1533 void
1534 DESTROY(self)
1535 	SV *self;
1536 PREINIT:
1537 	MAGIC		*mg;
1538 	kstat_ctl_t	*kc;
1539 CODE:
1540 	mg = mg_find(SvRV(self), '~');
1541 	PERL_ASSERTMSG(mg != 0, "DESTROY: lost ~ magic");
1542 	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1543 	if (kstat_close(kc) != 0) {
1544 		croak(DEBUG_ID ": kstat_close: failed");
1545 	}
1546 
1547  #
1548  # The following XS methods implement the TIEHASH mechanism used to update the
1549  # kstats hash structure.  These are blessed into a package that isn't
1550  # visible to callers of the Sun::Solaris::Kstat module
1551  #
1552 
1553 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat::_Stat
1554 PROTOTYPES: ENABLE
1555 
1556  #
1557  # If a value has already been read, return it.  Otherwise read the appropriate
1558  # kstat and then return the value
1559  #
1560 
1561 SV*
1562 FETCH(self, key)
1563 	SV* self;
1564 	SV* key;
1565 PREINIT:
1566 	char	*k;
1567 	STRLEN	klen;
1568 	SV	**value;
1569 CODE:
1570 	self = SvRV(self);
1571 	k = SvPV(key, klen);
1572 	if (strNE(k, "class") && strNE(k, "crtime")) {
1573 		read_kstats((HV *)self, FALSE);
1574 	}
1575 	value = hv_fetch((HV *)self, k, klen, FALSE);
1576 	if (value) {
1577 		RETVAL = *value; SvREFCNT_inc(RETVAL);
1578 	} else {
1579 		RETVAL = &PL_sv_undef;
1580 	}
1581 OUTPUT:
1582 	RETVAL
1583 
1584  #
1585  # Save the passed value into the kstat hash.  Read the appropriate kstat first,
1586  # if necessary.  Note that this DOES NOT update the underlying kernel kstat
1587  # structure.
1588  #
1589 
1590 SV*
1591 STORE(self, key, value)
1592 	SV* self;
1593 	SV* key;
1594 	SV* value;
1595 PREINIT:
1596 	char	*k;
1597 	STRLEN	klen;
1598 CODE:
1599 	self = SvRV(self);
1600 	k = SvPV(key, klen);
1601 	if (strNE(k, "class") && strNE(k, "crtime")) {
1602 		read_kstats((HV *)self, FALSE);
1603 	}
1604 	SvREFCNT_inc(value);
1605 	RETVAL = *(hv_store((HV *)self, k, klen, value, 0));
1606 	SvREFCNT_inc(RETVAL);
1607 OUTPUT:
1608 	RETVAL
1609 
1610  #
1611  # Check for the existence of the passed key.  Read the kstat first if necessary
1612  #
1613 
1614 bool
1615 EXISTS(self, key)
1616 	SV* self;
1617 	SV* key;
1618 PREINIT:
1619 	char *k;
1620 CODE:
1621 	self = SvRV(self);
1622 	k = SvPV(key, PL_na);
1623 	if (strNE(k, "class") && strNE(k, "crtime")) {
1624 		read_kstats((HV *)self, FALSE);
1625 	}
1626 	RETVAL = hv_exists_ent((HV *)self, key, 0);
1627 OUTPUT:
1628 	RETVAL
1629 
1630 
1631  #
1632  # Hash iterator initialisation.  Read the kstats if necessary.
1633  #
1634 
1635 SV*
1636 FIRSTKEY(self)
1637 	SV* self;
1638 PREINIT:
1639 	HE *he;
1640 PPCODE:
1641 	self = SvRV(self);
1642 	read_kstats((HV *)self, FALSE);
1643 	hv_iterinit((HV *)self);
1644 	if (he = hv_iternext((HV *)self)) {
1645 		EXTEND(SP, 1);
1646 		PUSHs(hv_iterkeysv(he));
1647 	}
1648 
1649  #
1650  # Return hash iterator next value.  Read the kstats if necessary.
1651  #
1652 
1653 SV*
1654 NEXTKEY(self, lastkey)
1655 	SV* self;
1656 	SV* lastkey;
1657 PREINIT:
1658 	HE *he;
1659 PPCODE:
1660 	self = SvRV(self);
1661 	if (he = hv_iternext((HV *)self)) {
1662 		EXTEND(SP, 1);
1663 		PUSHs(hv_iterkeysv(he));
1664 	}
1665 
1666 
1667  #
1668  # Delete the specified hash entry.
1669  #
1670 
1671 SV*
1672 DELETE(self, key)
1673 	SV *self;
1674 	SV *key;
1675 CODE:
1676 	self = SvRV(self);
1677 	RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
1678 	if (RETVAL) {
1679 		SvREFCNT_inc(RETVAL);
1680 	} else {
1681 		RETVAL = &PL_sv_undef;
1682 	}
1683 OUTPUT:
1684 	RETVAL
1685 
1686  #
1687  # Clear the entire hash.  This will stop any update() calls rereading this
1688  # kstat until it is accessed again.
1689  #
1690 
1691 void
1692 CLEAR(self)
1693 	SV* self;
1694 PREINIT:
1695 	MAGIC   *mg;
1696 	KstatInfo_t *kip;
1697 CODE:
1698 	self = SvRV(self);
1699 	hv_clear((HV *)self);
1700 	mg = mg_find(self, '~');
1701 	PERL_ASSERTMSG(mg != 0, "CLEAR: lost ~ magic");
1702 	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1703 	kip->read  = FALSE;
1704 	kip->valid = TRUE;
1705 	hv_store((HV *)self, "class", 5, newSVpv(kip->kstat->ks_class, 0), 0);
1706 	hv_store((HV *)self, "crtime", 6, NEW_HRTIME(kip->kstat->ks_crtime), 0);
1707