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