perl/Kstat.xs
changeset 0 fd074940082c
equal deleted inserted replaced
-1:000000000000 0:fd074940082c
       
     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 2007 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_scd_1sttsb_alloc);
       
   493 	SAVE_INT32(self, sfmmugp, sf_scd_2ndtsb_alloc);
       
   494 	SAVE_INT32(self, sfmmugp, sf_scd_1sttsb_allocfail);
       
   495 	SAVE_INT32(self, sfmmugp, sf_scd_2ndtsb_allocfail);
       
   496 	SAVE_INT32(self, sfmmugp, sf_tteload8k);
       
   497 	SAVE_INT32(self, sfmmugp, sf_tteload64k);
       
   498 	SAVE_INT32(self, sfmmugp, sf_tteload512k);
       
   499 	SAVE_INT32(self, sfmmugp, sf_tteload4m);
       
   500 	SAVE_INT32(self, sfmmugp, sf_tteload32m);
       
   501 	SAVE_INT32(self, sfmmugp, sf_tteload256m);
       
   502 	SAVE_INT32(self, sfmmugp, sf_tsb_load8k);
       
   503 	SAVE_INT32(self, sfmmugp, sf_tsb_load4m);
       
   504 	SAVE_INT32(self, sfmmugp, sf_hblk_hit);
       
   505 	SAVE_INT32(self, sfmmugp, sf_hblk8_ncreate);
       
   506 	SAVE_INT32(self, sfmmugp, sf_hblk8_nalloc);
       
   507 	SAVE_INT32(self, sfmmugp, sf_hblk1_ncreate);
       
   508 	SAVE_INT32(self, sfmmugp, sf_hblk1_nalloc);
       
   509 	SAVE_INT32(self, sfmmugp, sf_hblk_slab_cnt);
       
   510 	SAVE_INT32(self, sfmmugp, sf_hblk_reserve_cnt);
       
   511 	SAVE_INT32(self, sfmmugp, sf_hblk_recurse_cnt);
       
   512 	SAVE_INT32(self, sfmmugp, sf_hblk_reserve_hit);
       
   513 	SAVE_INT32(self, sfmmugp, sf_get_free_success);
       
   514 	SAVE_INT32(self, sfmmugp, sf_get_free_throttle);
       
   515 	SAVE_INT32(self, sfmmugp, sf_get_free_fail);
       
   516 	SAVE_INT32(self, sfmmugp, sf_put_free_success);
       
   517 	SAVE_INT32(self, sfmmugp, sf_put_free_fail);
       
   518 	SAVE_INT32(self, sfmmugp, sf_pgcolor_conflict);
       
   519 	SAVE_INT32(self, sfmmugp, sf_uncache_conflict);
       
   520 	SAVE_INT32(self, sfmmugp, sf_unload_conflict);
       
   521 	SAVE_INT32(self, sfmmugp, sf_ism_uncache);
       
   522 	SAVE_INT32(self, sfmmugp, sf_ism_recache);
       
   523 	SAVE_INT32(self, sfmmugp, sf_recache);
       
   524 	SAVE_INT32(self, sfmmugp, sf_steal_count);
       
   525 	SAVE_INT32(self, sfmmugp, sf_pagesync);
       
   526 	SAVE_INT32(self, sfmmugp, sf_clrwrt);
       
   527 	SAVE_INT32(self, sfmmugp, sf_pagesync_invalid);
       
   528 	SAVE_INT32(self, sfmmugp, sf_kernel_xcalls);
       
   529 	SAVE_INT32(self, sfmmugp, sf_user_xcalls);
       
   530 	SAVE_INT32(self, sfmmugp, sf_tsb_grow);
       
   531 	SAVE_INT32(self, sfmmugp, sf_tsb_shrink);
       
   532 	SAVE_INT32(self, sfmmugp, sf_tsb_resize_failures);
       
   533 	SAVE_INT32(self, sfmmugp, sf_tsb_reloc);
       
   534 	SAVE_INT32(self, sfmmugp, sf_user_vtop);
       
   535 	SAVE_INT32(self, sfmmugp, sf_ctx_inv);
       
   536 	SAVE_INT32(self, sfmmugp, sf_tlb_reprog_pgsz);
       
   537 	SAVE_INT32(self, sfmmugp, sf_region_remap_demap);
       
   538 	SAVE_INT32(self, sfmmugp, sf_create_scd);
       
   539 	SAVE_INT32(self, sfmmugp, sf_join_scd);
       
   540 	SAVE_INT32(self, sfmmugp, sf_leave_scd);
       
   541 	SAVE_INT32(self, sfmmugp, sf_destroy_scd);
       
   542 }
       
   543 #endif
       
   544 
       
   545 /*
       
   546  * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h
       
   547  */
       
   548 
       
   549 #ifdef __sparc
       
   550 static void
       
   551 save_sfmmu_tsbsize_stat(HV *self, kstat_t *kp, int strip_str)
       
   552 {
       
   553 	struct sfmmu_tsbsize_stat *sfmmutp;
       
   554 
       
   555 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   556 	PERL_ASSERT(kp->ks_data_size == sizeof (struct sfmmu_tsbsize_stat));
       
   557 	sfmmutp = (struct sfmmu_tsbsize_stat *)(kp->ks_data);
       
   558 
       
   559 	SAVE_INT32(self, sfmmutp, sf_tsbsz_8k);
       
   560 	SAVE_INT32(self, sfmmutp, sf_tsbsz_16k);
       
   561 	SAVE_INT32(self, sfmmutp, sf_tsbsz_32k);
       
   562 	SAVE_INT32(self, sfmmutp, sf_tsbsz_64k);
       
   563 	SAVE_INT32(self, sfmmutp, sf_tsbsz_128k);
       
   564 	SAVE_INT32(self, sfmmutp, sf_tsbsz_256k);
       
   565 	SAVE_INT32(self, sfmmutp, sf_tsbsz_512k);
       
   566 	SAVE_INT32(self, sfmmutp, sf_tsbsz_1m);
       
   567 	SAVE_INT32(self, sfmmutp, sf_tsbsz_2m);
       
   568 	SAVE_INT32(self, sfmmutp, sf_tsbsz_4m);
       
   569 }
       
   570 #endif
       
   571 
       
   572 /*
       
   573  * Definition in /usr/platform/sun4u/include/sys/simmstat.h
       
   574  */
       
   575 
       
   576 #ifdef __sparc
       
   577 static void
       
   578 save_simmstat(HV *self, kstat_t *kp, int strip_str)
       
   579 {
       
   580 	uchar_t	*simmstatp;
       
   581 	SV	*list;
       
   582 	int	i;
       
   583 
       
   584 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   585 	PERL_ASSERT(kp->ks_data_size == sizeof (uchar_t) * SIMM_COUNT);
       
   586 
       
   587 	list = newSVpv("", 0);
       
   588 	for (i = 0, simmstatp = (uchar_t *)(kp->ks_data);
       
   589 	i < SIMM_COUNT - 1; i++, simmstatp++) {
       
   590 		sv_catpvf(list, "%d,", *simmstatp);
       
   591 	}
       
   592 	sv_catpvf(list, "%d", *simmstatp);
       
   593 	hv_store(self, "status", 6, list, 0);
       
   594 }
       
   595 #endif
       
   596 
       
   597 /*
       
   598  * Used by save_temperature to make CSV lists from arrays of
       
   599  * short temperature values
       
   600  */
       
   601 
       
   602 #ifdef __sparc
       
   603 static SV *
       
   604 short_array_to_SV(short *shortp, int len)
       
   605 {
       
   606 	SV  *list;
       
   607 
       
   608 	list = newSVpv("", 0);
       
   609 	for (; len > 1; len--, shortp++) {
       
   610 		sv_catpvf(list, "%d,", *shortp);
       
   611 	}
       
   612 	sv_catpvf(list, "%d", *shortp);
       
   613 	return (list);
       
   614 }
       
   615 
       
   616 /*
       
   617  * Definition in /usr/platform/sun4u/include/sys/fhc.h
       
   618  */
       
   619 
       
   620 static void
       
   621 save_temperature(HV *self, kstat_t *kp, int strip_str)
       
   622 {
       
   623 	struct temp_stats *tempsp;
       
   624 
       
   625 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   626 	PERL_ASSERT(kp->ks_data_size == sizeof (struct temp_stats));
       
   627 	tempsp = (struct temp_stats *)(kp->ks_data);
       
   628 
       
   629 	SAVE_UINT32(self, tempsp, index);
       
   630 	hv_store(self, "l1", 2, short_array_to_SV(tempsp->l1, L1_SZ), 0);
       
   631 	hv_store(self, "l2", 2, short_array_to_SV(tempsp->l2, L2_SZ), 0);
       
   632 	hv_store(self, "l3", 2, short_array_to_SV(tempsp->l3, L3_SZ), 0);
       
   633 	hv_store(self, "l4", 2, short_array_to_SV(tempsp->l4, L4_SZ), 0);
       
   634 	hv_store(self, "l5", 2, short_array_to_SV(tempsp->l5, L5_SZ), 0);
       
   635 	SAVE_INT32(self, tempsp, max);
       
   636 	SAVE_INT32(self, tempsp, min);
       
   637 	SAVE_INT32(self, tempsp, state);
       
   638 	SAVE_INT32(self, tempsp, temp_cnt);
       
   639 	SAVE_INT32(self, tempsp, shutdown_cnt);
       
   640 	SAVE_INT32(self, tempsp, version);
       
   641 	SAVE_INT32(self, tempsp, trend);
       
   642 	SAVE_INT32(self, tempsp, override);
       
   643 }
       
   644 #endif
       
   645 
       
   646 /*
       
   647  * Not actually defined anywhere - just a short.  Yuck.
       
   648  */
       
   649 
       
   650 #ifdef __sparc
       
   651 static void
       
   652 save_temp_over(HV *self, kstat_t *kp, int strip_str)
       
   653 {
       
   654 	short *shortp;
       
   655 
       
   656 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   657 	PERL_ASSERT(kp->ks_data_size == sizeof (short));
       
   658 
       
   659 	shortp = (short *)(kp->ks_data);
       
   660 	hv_store(self, "override", 8, newSViv(*shortp), 0);
       
   661 }
       
   662 #endif
       
   663 
       
   664 /*
       
   665  * Defined in /usr/platform/sun4u/include/sys/sysctrl.h
       
   666  * (Well, sort of.  Actually there's no structure, just a list of #defines
       
   667  * enumerating *some* of the array indexes.)
       
   668  */
       
   669 
       
   670 #ifdef __sparc
       
   671 static void
       
   672 save_ps_shadow(HV *self, kstat_t *kp, int strip_str)
       
   673 {
       
   674 	uchar_t *ucharp;
       
   675 
       
   676 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   677 	PERL_ASSERT(kp->ks_data_size == SYS_PS_COUNT);
       
   678 
       
   679 	ucharp = (uchar_t *)(kp->ks_data);
       
   680 	hv_store(self, "core_0", 6, newSViv(*ucharp++), 0);
       
   681 	hv_store(self, "core_1", 6, newSViv(*ucharp++), 0);
       
   682 	hv_store(self, "core_2", 6, newSViv(*ucharp++), 0);
       
   683 	hv_store(self, "core_3", 6, newSViv(*ucharp++), 0);
       
   684 	hv_store(self, "core_4", 6, newSViv(*ucharp++), 0);
       
   685 	hv_store(self, "core_5", 6, newSViv(*ucharp++), 0);
       
   686 	hv_store(self, "core_6", 6, newSViv(*ucharp++), 0);
       
   687 	hv_store(self, "core_7", 6, newSViv(*ucharp++), 0);
       
   688 	hv_store(self, "pps_0", 5, newSViv(*ucharp++), 0);
       
   689 	hv_store(self, "clk_33", 6, newSViv(*ucharp++), 0);
       
   690 	hv_store(self, "clk_50", 6, newSViv(*ucharp++), 0);
       
   691 	hv_store(self, "v5_p", 4, newSViv(*ucharp++), 0);
       
   692 	hv_store(self, "v12_p", 5, newSViv(*ucharp++), 0);
       
   693 	hv_store(self, "v5_aux", 6, newSViv(*ucharp++), 0);
       
   694 	hv_store(self, "v5_p_pch", 8, newSViv(*ucharp++), 0);
       
   695 	hv_store(self, "v12_p_pch", 9, newSViv(*ucharp++), 0);
       
   696 	hv_store(self, "v3_pch", 6, newSViv(*ucharp++), 0);
       
   697 	hv_store(self, "v5_pch", 6, newSViv(*ucharp++), 0);
       
   698 	hv_store(self, "p_fan", 5, newSViv(*ucharp++), 0);
       
   699 }
       
   700 #endif
       
   701 
       
   702 /*
       
   703  * Definition in /usr/platform/sun4u/include/sys/fhc.h
       
   704  */
       
   705 
       
   706 #ifdef __sparc
       
   707 static void
       
   708 save_fault_list(HV *self, kstat_t *kp, int strip_str)
       
   709 {
       
   710 	struct ft_list	*faultp;
       
   711 	int		i;
       
   712 	char		name[KSTAT_STRLEN + 7];	/* room for 999999 faults */
       
   713 
       
   714 	/* PERL_ASSERT(kp->ks_ndata == 1); */
       
   715 	/* PERL_ASSERT(kp->ks_data_size == sizeof (struct ft_list)); */
       
   716 
       
   717 	for (i = 1, faultp = (struct ft_list *)(kp->ks_data);
       
   718 	    i <= 999999 && i <= kp->ks_data_size / sizeof (struct ft_list);
       
   719 	    i++, faultp++) {
       
   720 		(void) snprintf(name, sizeof (name), "unit_%d", i);
       
   721 		hv_store(self, name, strlen(name), newSViv(faultp->unit), 0);
       
   722 		(void) snprintf(name, sizeof (name), "type_%d", i);
       
   723 		hv_store(self, name, strlen(name), newSViv(faultp->type), 0);
       
   724 		(void) snprintf(name, sizeof (name), "fclass_%d", i);
       
   725 		hv_store(self, name, strlen(name), newSViv(faultp->fclass), 0);
       
   726 		(void) snprintf(name, sizeof (name), "create_time_%d", i);
       
   727 		hv_store(self, name, strlen(name),
       
   728 		    NEW_UV(faultp->create_time), 0);
       
   729 		(void) snprintf(name, sizeof (name), "msg_%d", i);
       
   730 		hv_store(self, name, strlen(name), newSVpv(faultp->msg, 0), 0);
       
   731 	}
       
   732 }
       
   733 #endif
       
   734 
       
   735 /*
       
   736  * We need to be able to find the function corresponding to a particular raw
       
   737  * kstat.  To do this we ignore the instance and glue the module and name
       
   738  * together to form a composite key.  We can then use the data in the kstat
       
   739  * structure to find the appropriate function.  We use a perl hash to manage the
       
   740  * lookup, where the key is "module:name" and the value is a pointer to the
       
   741  * appropriate C function.
       
   742  *
       
   743  * Note that some kstats include the instance number as part of the module
       
   744  * and/or name.  This could be construed as a bug.  However, to work around this
       
   745  * we omit any digits from the module and name as we build the table in
       
   746  * build_raw_kstat_loopup(), and we remove any digits from the module and name
       
   747  * when we look up the functions in lookup_raw_kstat_fn()
       
   748  */
       
   749 
       
   750 /*
       
   751  * This function is called when the XS is first dlopen()ed, and builds the
       
   752  * lookup table as described above.
       
   753  */
       
   754 
       
   755 static void
       
   756 build_raw_kstat_lookup()
       
   757 	{
       
   758 	/* Create new hash */
       
   759 	raw_kstat_lookup = newHV();
       
   760 
       
   761 	SAVE_FNP(raw_kstat_lookup, save_cpu_stat, "cpu_stat:cpu_stat");
       
   762 	SAVE_FNP(raw_kstat_lookup, save_var, "unix:var");
       
   763 	SAVE_FNP(raw_kstat_lookup, save_flushmeter, "unix:flushmeter");
       
   764 	SAVE_FNP(raw_kstat_lookup, save_ncstats, "unix:ncstats");
       
   765 	SAVE_FNP(raw_kstat_lookup, save_sysinfo, "unix:sysinfo");
       
   766 	SAVE_FNP(raw_kstat_lookup, save_vminfo, "unix:vminfo");
       
   767 	SAVE_FNP(raw_kstat_lookup, save_nfs, "nfs:mntinfo");
       
   768 #ifdef __sparc
       
   769 	SAVE_FNP(raw_kstat_lookup, save_sfmmu_global_stat,
       
   770 	    "unix:sfmmu_global_stat");
       
   771 	SAVE_FNP(raw_kstat_lookup, save_sfmmu_tsbsize_stat,
       
   772 	    "unix:sfmmu_tsbsize_stat");
       
   773 	SAVE_FNP(raw_kstat_lookup, save_simmstat, "unix:simm-status");
       
   774 	SAVE_FNP(raw_kstat_lookup, save_temperature, "unix:temperature");
       
   775 	SAVE_FNP(raw_kstat_lookup, save_temp_over, "unix:temperature override");
       
   776 	SAVE_FNP(raw_kstat_lookup, save_ps_shadow, "unix:ps_shadow");
       
   777 	SAVE_FNP(raw_kstat_lookup, save_fault_list, "unix:fault_list");
       
   778 #endif
       
   779 }
       
   780 
       
   781 /*
       
   782  * This finds and returns the raw kstat reader function corresponding to the
       
   783  * supplied module and name.  If no matching function exists, 0 is returned.
       
   784  */
       
   785 
       
   786 static kstat_raw_reader_t lookup_raw_kstat_fn(char *module, char *name)
       
   787 	{
       
   788 	char			key[KSTAT_STRLEN * 2];
       
   789 	register char		*f, *t;
       
   790 	SV			**entry;
       
   791 	kstat_raw_reader_t	fnp;
       
   792 
       
   793 	/* Copy across module & name, removing any digits - see comment above */
       
   794 	for (f = module, t = key; *f != '\0'; f++, t++) {
       
   795 		while (*f != '\0' && isdigit(*f)) { f++; }
       
   796 		*t = *f;
       
   797 	}
       
   798 	*t++ = ':';
       
   799 	for (f = name; *f != '\0'; f++, t++) {
       
   800 		while (*f != '\0' && isdigit(*f)) {
       
   801 			f++;
       
   802 		}
       
   803 	*t = *f;
       
   804 	}
       
   805 	*t = '\0';
       
   806 
       
   807 	/* look up & return the function, or teturn 0 if not found */
       
   808 	if ((entry = hv_fetch(raw_kstat_lookup, key, strlen(key), FALSE)) == 0)
       
   809 	{
       
   810 		fnp = 0;
       
   811 	} else {
       
   812 		fnp = (kstat_raw_reader_t)(uintptr_t)SvIV(*entry);
       
   813 	}
       
   814 	return (fnp);
       
   815 }
       
   816 
       
   817 /*
       
   818  * This module converts the flat list returned by kstat_read() into a perl hash
       
   819  * tree keyed on module, instance, name and statistic.  The following functions
       
   820  * provide code to create the nested hashes, and to iterate over them.
       
   821  */
       
   822 
       
   823 /*
       
   824  * Given module, instance and name keys return a pointer to the hash tied to
       
   825  * the bottommost hash.  If the hash already exists, we just return a pointer
       
   826  * to it, otherwise we create the hash and any others also required above it in
       
   827  * the hierarchy.  The returned tiehash is blessed into the
       
   828  * Sun::Solaris::Kstat::_Stat class, so that the appropriate TIEHASH methods are
       
   829  * called when the bottommost hash is accessed.  If the is_new parameter is
       
   830  * non-null it will be set to TRUE if a new tie has been created, and FALSE if
       
   831  * the tie already existed.
       
   832  */
       
   833 
       
   834 static HV *
       
   835 get_tie(SV *self, char *module, int instance, char *name, int *is_new)
       
   836 {
       
   837 	char str_inst[11];	/* big enough for up to 10^10 instances */
       
   838 	char *key[3];		/* 3 part key: module, instance, name */
       
   839 	int  k;
       
   840 	int  new;
       
   841 	HV   *hash;
       
   842 	HV   *tie;
       
   843 
       
   844 	/* Create the keys */
       
   845 	(void) snprintf(str_inst, sizeof (str_inst), "%d", instance);
       
   846 	key[0] = module;
       
   847 	key[1] = str_inst;
       
   848 	key[2] = name;
       
   849 
       
   850 	/* Iteratively descend the tree, creating new hashes as required */
       
   851 	hash = (HV *)SvRV(self);
       
   852 	for (k = 0; k < 3; k++) {
       
   853 		SV **entry;
       
   854 
       
   855 		SvREADONLY_off(hash);
       
   856 		entry = hv_fetch(hash, key[k], strlen(key[k]), TRUE);
       
   857 
       
   858 		/* If the entry doesn't exist, create it */
       
   859 		if (! SvOK(*entry)) {
       
   860 			HV *newhash;
       
   861 			SV *rv;
       
   862 
       
   863 			newhash = newHV();
       
   864 			rv = newRV_noinc((SV *)newhash);
       
   865 			sv_setsv(*entry, rv);
       
   866 			SvREFCNT_dec(rv);
       
   867 			if (k < 2) {
       
   868 				SvREADONLY_on(newhash);
       
   869 			}
       
   870 			SvREADONLY_on(*entry);
       
   871 			SvREADONLY_on(hash);
       
   872 			hash = newhash;
       
   873 			new = 1;
       
   874 
       
   875 		/* Otherwise it already existed */
       
   876 		} else {
       
   877 			SvREADONLY_on(hash);
       
   878 			hash = (HV *)SvRV(*entry);
       
   879 			new = 0;
       
   880 		}
       
   881 	}
       
   882 
       
   883 	/* Create and bless a hash for the tie, if necessary */
       
   884 	if (new) {
       
   885 		SV *tieref;
       
   886 		HV *stash;
       
   887 
       
   888 		tie = newHV();
       
   889 		tieref = newRV_noinc((SV *)tie);
       
   890 		stash = gv_stashpv("Sun::Solaris::Kstat::_Stat", TRUE);
       
   891 		sv_bless(tieref, stash);
       
   892 
       
   893 		/* Add TIEHASH magic */
       
   894 		hv_magic(hash, (GV *)tieref, 'P');
       
   895 		SvREADONLY_on(hash);
       
   896 
       
   897 	/* Otherwise, just find the existing tied hash */
       
   898 	} else {
       
   899 		MAGIC *mg;
       
   900 
       
   901 		mg = mg_find((SV *)hash, 'P');
       
   902 		PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
       
   903 		tie = (HV *)SvRV(mg->mg_obj);
       
   904 	}
       
   905 	if (is_new) {
       
   906 		*is_new = new;
       
   907 	}
       
   908 	return (tie);
       
   909 }
       
   910 
       
   911 /*
       
   912  * This is an iterator function used to traverse the hash hierarchy and apply
       
   913  * the passed function to the tied hashes at the bottom of the hierarchy.  If
       
   914  * any of the callback functions return 0, 0 is returned, otherwise 1
       
   915  */
       
   916 
       
   917 static int
       
   918 apply_to_ties(SV *self, ATTCb_t cb, void *arg)
       
   919 {
       
   920 	HV	*hash1;
       
   921 	HE	*entry1;
       
   922 	long	s;
       
   923 	int	ret;
       
   924 
       
   925 	hash1 = (HV *)SvRV(self);
       
   926 	hv_iterinit(hash1);
       
   927 	ret = 1;
       
   928 
       
   929 	/* Iterate over each module */
       
   930 	while (entry1 = hv_iternext(hash1)) {
       
   931 		HV *hash2;
       
   932 		HE *entry2;
       
   933 
       
   934 		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
       
   935 		hv_iterinit(hash2);
       
   936 
       
   937 		/* Iterate over each module:instance */
       
   938 		while (entry2 = hv_iternext(hash2)) {
       
   939 			HV *hash3;
       
   940 			HE *entry3;
       
   941 
       
   942 			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
       
   943 			hv_iterinit(hash3);
       
   944 
       
   945 			/* Iterate over each module:instance:name */
       
   946 			while (entry3 = hv_iternext(hash3)) {
       
   947 				HV    *hash4;
       
   948 				MAGIC *mg;
       
   949 				HV    *tie;
       
   950 
       
   951 				/* Get the tie */
       
   952 				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
       
   953 				mg = mg_find((SV *)hash4, 'P');
       
   954 				PERL_ASSERTMSG(mg != 0,
       
   955 				    "apply_to_ties: lost P magic");
       
   956 
       
   957 				/* Apply the callback */
       
   958 				if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
       
   959 					ret = 0;
       
   960 				}
       
   961 			}
       
   962 		}
       
   963 	}
       
   964 	return (ret);
       
   965 }
       
   966 
       
   967 /*
       
   968  * Mark this HV as valid - used by update() when pruning deleted kstat nodes
       
   969  */
       
   970 
       
   971 static int
       
   972 set_valid(HV *self, void *arg)
       
   973 {
       
   974 	MAGIC *mg;
       
   975 
       
   976 	mg = mg_find((SV *)self, '~');
       
   977 	PERL_ASSERTMSG(mg != 0, "set_valid: lost ~ magic");
       
   978 	((KstatInfo_t *)SvPVX(mg->mg_obj))->valid = (int)arg;
       
   979 	return (1);
       
   980 }
       
   981 
       
   982 /*
       
   983  * Prune invalid kstat nodes. This is called when kstat_chain_update() detects
       
   984  * that the kstat chain has been updated.  This removes any hash tree entries
       
   985  * that no longer have a corresponding kstat.  If del is non-null it will be
       
   986  * set to the keys of the deleted kstat nodes, if any.  If any entries are
       
   987  * deleted 1 will be retured, otherwise 0
       
   988  */
       
   989 
       
   990 static int
       
   991 prune_invalid(SV *self, AV *del)
       
   992 {
       
   993 	HV	*hash1;
       
   994 	HE	*entry1;
       
   995 	STRLEN	klen;
       
   996 	char	*module, *instance, *name, *key;
       
   997 	int	ret;
       
   998 
       
   999 	hash1 = (HV *)SvRV(self);
       
  1000 	hv_iterinit(hash1);
       
  1001 	ret = 0;
       
  1002 
       
  1003 	/* Iterate over each module */
       
  1004 	while (entry1 = hv_iternext(hash1)) {
       
  1005 		HV *hash2;
       
  1006 		HE *entry2;
       
  1007 
       
  1008 		module = HePV(entry1, PL_na);
       
  1009 		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
       
  1010 		hv_iterinit(hash2);
       
  1011 
       
  1012 		/* Iterate over each module:instance */
       
  1013 		while (entry2 = hv_iternext(hash2)) {
       
  1014 			HV *hash3;
       
  1015 			HE *entry3;
       
  1016 
       
  1017 			instance = HePV(entry2, PL_na);
       
  1018 			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
       
  1019 			hv_iterinit(hash3);
       
  1020 
       
  1021 			/* Iterate over each module:instance:name */
       
  1022 			while (entry3 = hv_iternext(hash3)) {
       
  1023 				HV    *hash4;
       
  1024 				MAGIC *mg;
       
  1025 				HV    *tie;
       
  1026 
       
  1027 				name = HePV(entry3, PL_na);
       
  1028 				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
       
  1029 				mg = mg_find((SV *)hash4, 'P');
       
  1030 				PERL_ASSERTMSG(mg != 0,
       
  1031 				    "prune_invalid: lost P magic");
       
  1032 				tie = (HV *)SvRV(mg->mg_obj);
       
  1033 				mg = mg_find((SV *)tie, '~');
       
  1034 				PERL_ASSERTMSG(mg != 0,
       
  1035 				    "prune_invalid: lost ~ magic");
       
  1036 
       
  1037 				/* If this is marked as invalid, prune it */
       
  1038 				if (((KstatInfo_t *)SvPVX(
       
  1039 				    (SV *)mg->mg_obj))->valid == FALSE) {
       
  1040 					SvREADONLY_off(hash3);
       
  1041 					key = HePV(entry3, klen);
       
  1042 					hv_delete(hash3, key, klen, G_DISCARD);
       
  1043 					SvREADONLY_on(hash3);
       
  1044 					if (del) {
       
  1045 						av_push(del,
       
  1046 						    newSVpvf("%s:%s:%s",
       
  1047 						    module, instance, name));
       
  1048 					}
       
  1049 					ret = 1;
       
  1050 				}
       
  1051 			}
       
  1052 
       
  1053 			/* If the module:instance:name hash is empty prune it */
       
  1054 			if (HvKEYS(hash3) == 0) {
       
  1055 				SvREADONLY_off(hash2);
       
  1056 				key = HePV(entry2, klen);
       
  1057 				hv_delete(hash2, key, klen, G_DISCARD);
       
  1058 				SvREADONLY_on(hash2);
       
  1059 			}
       
  1060 		}
       
  1061 		/* If the module:instance hash is empty prune it */
       
  1062 		if (HvKEYS(hash2) == 0) {
       
  1063 			SvREADONLY_off(hash1);
       
  1064 			key = HePV(entry1, klen);
       
  1065 			hv_delete(hash1, key, klen, G_DISCARD);
       
  1066 			SvREADONLY_on(hash1);
       
  1067 		}
       
  1068 	}
       
  1069 	return (ret);
       
  1070 }
       
  1071 
       
  1072 /*
       
  1073  * Named kstats are returned as a list of key/values.  This function converts
       
  1074  * such a list into the equivalent perl datatypes, and stores them in the passed
       
  1075  * hash.
       
  1076  */
       
  1077 
       
  1078 static void
       
  1079 save_named(HV *self, kstat_t *kp, int strip_str)
       
  1080 {
       
  1081 	kstat_named_t	*knp;
       
  1082 	int		n;
       
  1083 	SV*		value;
       
  1084 
       
  1085 	for (n = kp->ks_ndata, knp = KSTAT_NAMED_PTR(kp); n > 0; n--, knp++) {
       
  1086 		switch (knp->data_type) {
       
  1087 		case KSTAT_DATA_CHAR:
       
  1088 			value = newSVpv(knp->value.c, strip_str ?
       
  1089 			    strlen(knp->value.c) : sizeof (knp->value.c));
       
  1090 			break;
       
  1091 		case KSTAT_DATA_INT32:
       
  1092 			value = newSViv(knp->value.i32);
       
  1093 			break;
       
  1094 		case KSTAT_DATA_UINT32:
       
  1095 			value = NEW_UV(knp->value.ui32);
       
  1096 			break;
       
  1097 		case KSTAT_DATA_INT64:
       
  1098 			value = NEW_UV(knp->value.i64);
       
  1099 			break;
       
  1100 		case KSTAT_DATA_UINT64:
       
  1101 			value = NEW_UV(knp->value.ui64);
       
  1102 			break;
       
  1103 		case KSTAT_DATA_STRING:
       
  1104 			if (KSTAT_NAMED_STR_PTR(knp) == NULL)
       
  1105 				value = newSVpv("null", sizeof ("null") - 1);
       
  1106 			else
       
  1107 				value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
       
  1108 						KSTAT_NAMED_STR_BUFLEN(knp) -1);
       
  1109 			break;
       
  1110 		default:
       
  1111 			PERL_ASSERTMSG(0, "kstat_read: invalid data type");
       
  1112 			break;
       
  1113 		}
       
  1114 		hv_store(self, knp->name, strlen(knp->name), value, 0);
       
  1115 	}
       
  1116 }
       
  1117 
       
  1118 /*
       
  1119  * Save kstat interrupt statistics
       
  1120  */
       
  1121 
       
  1122 static void
       
  1123 save_intr(HV *self, kstat_t *kp, int strip_str)
       
  1124 {
       
  1125 	kstat_intr_t	*kintrp;
       
  1126 	int		i;
       
  1127 	static char	*intr_names[] =
       
  1128 	    { "hard", "soft", "watchdog", "spurious", "multiple_service" };
       
  1129 
       
  1130 	PERL_ASSERT(kp->ks_ndata == 1);
       
  1131 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
       
  1132 	kintrp = KSTAT_INTR_PTR(kp);
       
  1133 
       
  1134 	for (i = 0; i < KSTAT_NUM_INTRS; i++) {
       
  1135 		hv_store(self, intr_names[i], strlen(intr_names[i]),
       
  1136 		    NEW_UV(kintrp->intrs[i]), 0);
       
  1137 	}
       
  1138 }
       
  1139 
       
  1140 /*
       
  1141  * Save IO statistics
       
  1142  */
       
  1143 
       
  1144 static void
       
  1145 save_io(HV *self, kstat_t *kp, int strip_str)
       
  1146 {
       
  1147 	kstat_io_t *kiop;
       
  1148 
       
  1149 	PERL_ASSERT(kp->ks_ndata == 1);
       
  1150 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_io_t));
       
  1151 	kiop = KSTAT_IO_PTR(kp);
       
  1152 	SAVE_UINT64(self, kiop, nread);
       
  1153 	SAVE_UINT64(self, kiop, nwritten);
       
  1154 	SAVE_UINT32(self, kiop, reads);
       
  1155 	SAVE_UINT32(self, kiop, writes);
       
  1156 	SAVE_HRTIME(self, kiop, wtime);
       
  1157 	SAVE_HRTIME(self, kiop, wlentime);
       
  1158 	SAVE_HRTIME(self, kiop, wlastupdate);
       
  1159 	SAVE_HRTIME(self, kiop, rtime);
       
  1160 	SAVE_HRTIME(self, kiop, rlentime);
       
  1161 	SAVE_HRTIME(self, kiop, rlastupdate);
       
  1162 	SAVE_UINT32(self, kiop, wcnt);
       
  1163 	SAVE_UINT32(self, kiop, rcnt);
       
  1164 }
       
  1165 
       
  1166 /*
       
  1167  * Save timer statistics
       
  1168  */
       
  1169 
       
  1170 static void
       
  1171 save_timer(HV *self, kstat_t *kp, int strip_str)
       
  1172 {
       
  1173 	kstat_timer_t *ktimerp;
       
  1174 
       
  1175 	PERL_ASSERT(kp->ks_ndata == 1);
       
  1176 	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_timer_t));
       
  1177 	ktimerp = KSTAT_TIMER_PTR(kp);
       
  1178 	SAVE_STRING(self, ktimerp, name, strip_str);
       
  1179 	SAVE_UINT64(self, ktimerp, num_events);
       
  1180 	SAVE_HRTIME(self, ktimerp, elapsed_time);
       
  1181 	SAVE_HRTIME(self, ktimerp, min_time);
       
  1182 	SAVE_HRTIME(self, ktimerp, max_time);
       
  1183 	SAVE_HRTIME(self, ktimerp, start_time);
       
  1184 	SAVE_HRTIME(self, ktimerp, stop_time);
       
  1185 }
       
  1186 
       
  1187 /*
       
  1188  * Read kstats and copy into the supplied perl hash structure.  If refresh is
       
  1189  * true, this function is being called as part of the update() method.  In this
       
  1190  * case it is only necessary to read the kstats if they have previously been
       
  1191  * accessed (kip->read == TRUE).  If refresh is false, this function is being
       
  1192  * called prior to returning a value to the caller. In this case, it is only
       
  1193  * necessary to read the kstats if they have not previously been read.  If the
       
  1194  * kstat_read() fails, 0 is returned, otherwise 1
       
  1195  */
       
  1196 
       
  1197 static int
       
  1198 read_kstats(HV *self, int refresh)
       
  1199 {
       
  1200 	MAGIC			*mg;
       
  1201 	KstatInfo_t		*kip;
       
  1202 	kstat_raw_reader_t	fnp;
       
  1203 
       
  1204 	/* Find the MAGIC KstatInfo_t data structure */
       
  1205 	mg = mg_find((SV *)self, '~');
       
  1206 	PERL_ASSERTMSG(mg != 0, "read_kstats: lost ~ magic");
       
  1207 	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
       
  1208 
       
  1209 	/* Return early if we don't need to actually read the kstats */
       
  1210 	if ((refresh && ! kip->read) || (! refresh && kip->read)) {
       
  1211 		return (1);
       
  1212 	}
       
  1213 
       
  1214 	/* Read the kstats and return 0 if this fails */
       
  1215 	if (kstat_read(kip->kstat_ctl, kip->kstat, NULL) < 0) {
       
  1216 		return (0);
       
  1217 	}
       
  1218 
       
  1219 	/* Save the read data */
       
  1220 	hv_store(self, "snaptime", 8, NEW_HRTIME(kip->kstat->ks_snaptime), 0);
       
  1221 	switch (kip->kstat->ks_type) {
       
  1222 		case KSTAT_TYPE_RAW:
       
  1223 			if ((fnp = lookup_raw_kstat_fn(kip->kstat->ks_module,
       
  1224 			    kip->kstat->ks_name)) != 0) {
       
  1225 				fnp(self, kip->kstat, kip->strip_str);
       
  1226 			}
       
  1227 			break;
       
  1228 		case KSTAT_TYPE_NAMED:
       
  1229 			save_named(self, kip->kstat, kip->strip_str);
       
  1230 			break;
       
  1231 		case KSTAT_TYPE_INTR:
       
  1232 			save_intr(self, kip->kstat, kip->strip_str);
       
  1233 			break;
       
  1234 		case KSTAT_TYPE_IO:
       
  1235 			save_io(self, kip->kstat, kip->strip_str);
       
  1236 			break;
       
  1237 		case KSTAT_TYPE_TIMER:
       
  1238 			save_timer(self, kip->kstat, kip->strip_str);
       
  1239 			break;
       
  1240 		default:
       
  1241 			PERL_ASSERTMSG(0, "read_kstats: illegal kstat type");
       
  1242 			break;
       
  1243 	}
       
  1244 	kip->read = TRUE;
       
  1245 	return (1);
       
  1246 }
       
  1247 
       
  1248 /*
       
  1249  * The XS code exported to perl is below here.  Note that the XS preprocessor
       
  1250  * has its own commenting syntax, so all comments from this point on are in
       
  1251  * that form.
       
  1252  */
       
  1253 
       
  1254 /* The following XS methods are the ABI of the Sun::Solaris::Kstat package */
       
  1255 
       
  1256 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat
       
  1257 PROTOTYPES: ENABLE
       
  1258 
       
  1259  # Create the raw kstat to store function lookup table on load
       
  1260 BOOT:
       
  1261 	build_raw_kstat_lookup();
       
  1262 
       
  1263  #
       
  1264  # The Sun::Solaris::Kstat constructor.  This builds the nested
       
  1265  # name::instance::module hash structure, but doesn't actually read the
       
  1266  # underlying kstats.  This is done on demand by the TIEHASH methods in
       
  1267  # Sun::Solaris::Kstat::_Stat
       
  1268  #
       
  1269 
       
  1270 SV*
       
  1271 new(class, ...)
       
  1272 	char *class;
       
  1273 PREINIT:
       
  1274 	HV		*stash;
       
  1275 	kstat_ctl_t	*kc;
       
  1276 	SV		*kcsv;
       
  1277 	kstat_t		*kp;
       
  1278 	KstatInfo_t	kstatinfo;
       
  1279 	int		sp, strip_str;
       
  1280 CODE:
       
  1281 	/* Check we have an even number of arguments, excluding the class */
       
  1282 	sp = 1;
       
  1283 	if (((items - sp) % 2) != 0) {
       
  1284 		croak(DEBUG_ID ": new: invalid number of arguments");
       
  1285 	}
       
  1286 
       
  1287 	/* Process any (name => value) arguments */
       
  1288 	strip_str = 0;
       
  1289 	while (sp < items) {
       
  1290 		SV *name, *value;
       
  1291 
       
  1292 		name = ST(sp);
       
  1293 		sp++;
       
  1294 		value = ST(sp);
       
  1295 		sp++;
       
  1296 		if (strcmp(SvPVX(name), "strip_strings") == 0) {
       
  1297 			strip_str = SvTRUE(value);
       
  1298 		} else {
       
  1299 			croak(DEBUG_ID ": new: invalid parameter name '%s'",
       
  1300 			    SvPVX(name));
       
  1301 		}
       
  1302 	}
       
  1303 
       
  1304 	/* Open the kstats handle */
       
  1305 	if ((kc = kstat_open()) == 0) {
       
  1306 		XSRETURN_UNDEF;
       
  1307 	}
       
  1308 
       
  1309 	/* Create a blessed hash ref */
       
  1310 	RETVAL = (SV *)newRV_noinc((SV *)newHV());
       
  1311 	stash = gv_stashpv(class, TRUE);
       
  1312 	sv_bless(RETVAL, stash);
       
  1313 
       
  1314 	/* Create a place to save the KstatInfo_t structure */
       
  1315 	kcsv = newSVpv((char *)&kc, sizeof (kc));
       
  1316 	sv_magic(SvRV(RETVAL), kcsv, '~', 0, 0);
       
  1317 	SvREFCNT_dec(kcsv);
       
  1318 
       
  1319 	/* Initialise the KstatsInfo_t structure */
       
  1320 	kstatinfo.read = FALSE;
       
  1321 	kstatinfo.valid = TRUE;
       
  1322 	kstatinfo.strip_str = strip_str;
       
  1323 	kstatinfo.kstat_ctl = kc;
       
  1324 
       
  1325 	/* Scan the kstat chain, building hash entries for the kstats */
       
  1326 	for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
       
  1327 		HV *tie;
       
  1328 		SV *kstatsv;
       
  1329 
       
  1330 		/* Don't bother storing the kstat headers */
       
  1331 		if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
       
  1332 			continue;
       
  1333 		}
       
  1334 
       
  1335 		/* Don't bother storing raw stats we don't understand */
       
  1336 		if (kp->ks_type == KSTAT_TYPE_RAW &&
       
  1337 		    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) == 0) {
       
  1338 #ifdef REPORT_UNKNOWN
       
  1339 			(void) fprintf(stderr,
       
  1340 			    "Unknown kstat type %s:%d:%s - %d of size %d\n",
       
  1341 			    kp->ks_module, kp->ks_instance, kp->ks_name,
       
  1342 			    kp->ks_ndata, kp->ks_data_size);
       
  1343 #endif
       
  1344 			continue;
       
  1345 		}
       
  1346 
       
  1347 		/* Create a 3-layer hash hierarchy - module.instance.name */
       
  1348 		tie = get_tie(RETVAL, kp->ks_module, kp->ks_instance,
       
  1349 		    kp->ks_name, 0);
       
  1350 
       
  1351 		/* Save the data necessary to read the kstat info on demand */
       
  1352 		hv_store(tie, "class", 5, newSVpv(kp->ks_class, 0), 0);
       
  1353 		hv_store(tie, "crtime", 6, NEW_HRTIME(kp->ks_crtime), 0);
       
  1354 		kstatinfo.kstat = kp;
       
  1355 		kstatsv = newSVpv((char *)&kstatinfo, sizeof (kstatinfo));
       
  1356 		sv_magic((SV *)tie, kstatsv, '~', 0, 0);
       
  1357 		SvREFCNT_dec(kstatsv);
       
  1358 	}
       
  1359 	SvREADONLY_on(SvRV(RETVAL));
       
  1360 	/* SvREADONLY_on(RETVAL); */
       
  1361 OUTPUT:
       
  1362 	RETVAL
       
  1363 
       
  1364  #
       
  1365  # Update the perl hash structure so that it is in line with the kernel kstats
       
  1366  # data.  Only kstats athat have previously been accessed are read,
       
  1367  #
       
  1368 
       
  1369  # Scalar context: true/false
       
  1370  # Array context: (\@added, \@deleted)
       
  1371 void
       
  1372 update(self)
       
  1373 	SV* self;
       
  1374 PREINIT:
       
  1375 	MAGIC		*mg;
       
  1376 	kstat_ctl_t	*kc;
       
  1377 	kstat_t		*kp;
       
  1378 	int		ret;
       
  1379 	AV		*add, *del;
       
  1380 PPCODE:
       
  1381 	/* Find the hidden KstatInfo_t structure */
       
  1382 	mg = mg_find(SvRV(self), '~');
       
  1383 	PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
       
  1384 	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
       
  1385 
       
  1386 	/* Update the kstat chain, and return immediately on error. */
       
  1387 	if ((ret = kstat_chain_update(kc)) == -1) {
       
  1388 		if (GIMME_V == G_ARRAY) {
       
  1389 			EXTEND(SP, 2);
       
  1390 			PUSHs(sv_newmortal());
       
  1391 			PUSHs(sv_newmortal());
       
  1392 		} else {
       
  1393 			EXTEND(SP, 1);
       
  1394 			PUSHs(sv_2mortal(newSViv(ret)));
       
  1395 		}
       
  1396 	}
       
  1397 
       
  1398 	/* Create the arrays to be returned if in an array context */
       
  1399 	if (GIMME_V == G_ARRAY) {
       
  1400 		add = newAV();
       
  1401 		del = newAV();
       
  1402 	} else {
       
  1403 		add = 0;
       
  1404 		del = 0;
       
  1405 	}
       
  1406 
       
  1407 	/*
       
  1408 	 * If the kstat chain hasn't changed we can just reread any stats
       
  1409 	 * that have already been read
       
  1410 	 */
       
  1411 	if (ret == 0) {
       
  1412 		if (! apply_to_ties(self, (ATTCb_t)read_kstats, (void *)TRUE)) {
       
  1413 			if (GIMME_V == G_ARRAY) {
       
  1414 				EXTEND(SP, 2);
       
  1415 				PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
       
  1416 				PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
       
  1417 			} else {
       
  1418 				EXTEND(SP, 1);
       
  1419 				PUSHs(sv_2mortal(newSViv(-1)));
       
  1420 			}
       
  1421 		}
       
  1422 
       
  1423 	/*
       
  1424 	 * Otherwise we have to update the Perl structure so that it is in
       
  1425 	 * agreement with the new kstat chain.  We do this in such a way as to
       
  1426 	 * retain all the existing structures, just adding or deleting the
       
  1427 	 * bare minimum.
       
  1428 	 */
       
  1429 	} else {
       
  1430 		KstatInfo_t	kstatinfo;
       
  1431 
       
  1432 		/*
       
  1433 		 * Step 1: set the 'invalid' flag on each entry
       
  1434 		 */
       
  1435 		apply_to_ties(self, &set_valid, (void *)FALSE);
       
  1436 
       
  1437 		/*
       
  1438 		 * Step 2: Set the 'valid' flag on all entries still in the
       
  1439 		 * kernel kstat chain
       
  1440 		 */
       
  1441 		kstatinfo.read		= FALSE;
       
  1442 		kstatinfo.valid		= TRUE;
       
  1443 		kstatinfo.kstat_ctl	= kc;
       
  1444 		for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
       
  1445 			int	new;
       
  1446 			HV	*tie;
       
  1447 
       
  1448 			/* Don't bother storing the kstat headers or types */
       
  1449 			if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
       
  1450 				continue;
       
  1451 			}
       
  1452 
       
  1453 			/* Don't bother storing raw stats we don't understand */
       
  1454 			if (kp->ks_type == KSTAT_TYPE_RAW &&
       
  1455 			    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name)
       
  1456 			    == 0) {
       
  1457 #ifdef REPORT_UNKNOWN
       
  1458 				(void) printf("Unknown kstat type %s:%d:%s "
       
  1459 				    "- %d of size %d\n", kp->ks_module,
       
  1460 				    kp->ks_instance, kp->ks_name,
       
  1461 				    kp->ks_ndata, kp->ks_data_size);
       
  1462 #endif
       
  1463 				continue;
       
  1464 			}
       
  1465 
       
  1466 			/* Find the tied hash associated with the kstat entry */
       
  1467 			tie = get_tie(self, kp->ks_module, kp->ks_instance,
       
  1468 			    kp->ks_name, &new);
       
  1469 
       
  1470 			/* If newly created store the associated kstat info */
       
  1471 			if (new) {
       
  1472 				SV *kstatsv;
       
  1473 
       
  1474 				/*
       
  1475 				 * Save the data necessary to read the kstat
       
  1476 				 * info on demand
       
  1477 				 */
       
  1478 				hv_store(tie, "class", 5,
       
  1479 				    newSVpv(kp->ks_class, 0), 0);
       
  1480 				hv_store(tie, "crtime", 6,
       
  1481 				    NEW_HRTIME(kp->ks_crtime), 0);
       
  1482 				kstatinfo.kstat = kp;
       
  1483 				kstatsv = newSVpv((char *)&kstatinfo,
       
  1484 				    sizeof (kstatinfo));
       
  1485 				sv_magic((SV *)tie, kstatsv, '~', 0, 0);
       
  1486 				SvREFCNT_dec(kstatsv);
       
  1487 
       
  1488 				/* Save the key on the add list, if required */
       
  1489 				if (GIMME_V == G_ARRAY) {
       
  1490 					av_push(add, newSVpvf("%s:%d:%s",
       
  1491 					    kp->ks_module, kp->ks_instance,
       
  1492 					    kp->ks_name));
       
  1493 				}
       
  1494 
       
  1495 			/* If the stats already exist, just update them */
       
  1496 			} else {
       
  1497 				MAGIC *mg;
       
  1498 				KstatInfo_t *kip;
       
  1499 
       
  1500 				/* Find the hidden KstatInfo_t */
       
  1501 				mg = mg_find((SV *)tie, '~');
       
  1502 				PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
       
  1503 				kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
       
  1504 
       
  1505 				/* Mark the tie as valid */
       
  1506 				kip->valid = TRUE;
       
  1507 
       
  1508 				/* Re-save the kstat_t pointer.  If the kstat
       
  1509 				 * has been deleted and re-added since the last
       
  1510 				 * update, the address of the kstat structure
       
  1511 				 * will have changed, even though the kstat will
       
  1512 				 * still live at the same place in the perl
       
  1513 				 * hash tree structure.
       
  1514 				 */
       
  1515 				kip->kstat = kp;
       
  1516 
       
  1517 				/* Reread the stats, if read previously */
       
  1518 				read_kstats(tie, TRUE);
       
  1519 			}
       
  1520 		}
       
  1521 
       
  1522 		/*
       
  1523 		 *Step 3: Delete any entries still marked as 'invalid'
       
  1524 		 */
       
  1525 		ret = prune_invalid(self, del);
       
  1526 
       
  1527 	}
       
  1528 	if (GIMME_V == G_ARRAY) {
       
  1529 		EXTEND(SP, 2);
       
  1530 		PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
       
  1531 		PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
       
  1532 	} else {
       
  1533 		EXTEND(SP, 1);
       
  1534 		PUSHs(sv_2mortal(newSViv(ret)));
       
  1535 	}
       
  1536 
       
  1537 
       
  1538  #
       
  1539  # Destructor.  Closes the kstat connection
       
  1540  #
       
  1541 
       
  1542 void
       
  1543 DESTROY(self)
       
  1544 	SV *self;
       
  1545 PREINIT:
       
  1546 	MAGIC		*mg;
       
  1547 	kstat_ctl_t	*kc;
       
  1548 CODE:
       
  1549 	mg = mg_find(SvRV(self), '~');
       
  1550 	PERL_ASSERTMSG(mg != 0, "DESTROY: lost ~ magic");
       
  1551 	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
       
  1552 	if (kstat_close(kc) != 0) {
       
  1553 		croak(DEBUG_ID ": kstat_close: failed");
       
  1554 	}
       
  1555 
       
  1556  #
       
  1557  # The following XS methods implement the TIEHASH mechanism used to update the
       
  1558  # kstats hash structure.  These are blessed into a package that isn't
       
  1559  # visible to callers of the Sun::Solaris::Kstat module
       
  1560  #
       
  1561 
       
  1562 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat::_Stat
       
  1563 PROTOTYPES: ENABLE
       
  1564 
       
  1565  #
       
  1566  # If a value has already been read, return it.  Otherwise read the appropriate
       
  1567  # kstat and then return the value
       
  1568  #
       
  1569 
       
  1570 SV*
       
  1571 FETCH(self, key)
       
  1572 	SV* self;
       
  1573 	SV* key;
       
  1574 PREINIT:
       
  1575 	char	*k;
       
  1576 	STRLEN	klen;
       
  1577 	SV	**value;
       
  1578 CODE:
       
  1579 	self = SvRV(self);
       
  1580 	k = SvPV(key, klen);
       
  1581 	if (strNE(k, "class") && strNE(k, "crtime")) {
       
  1582 		read_kstats((HV *)self, FALSE);
       
  1583 	}
       
  1584 	value = hv_fetch((HV *)self, k, klen, FALSE);
       
  1585 	if (value) {
       
  1586 		RETVAL = *value; SvREFCNT_inc(RETVAL);
       
  1587 	} else {
       
  1588 		RETVAL = &PL_sv_undef;
       
  1589 	}
       
  1590 OUTPUT:
       
  1591 	RETVAL
       
  1592 
       
  1593  #
       
  1594  # Save the passed value into the kstat hash.  Read the appropriate kstat first,
       
  1595  # if necessary.  Note that this DOES NOT update the underlying kernel kstat
       
  1596  # structure.
       
  1597  #
       
  1598 
       
  1599 SV*
       
  1600 STORE(self, key, value)
       
  1601 	SV* self;
       
  1602 	SV* key;
       
  1603 	SV* value;
       
  1604 PREINIT:
       
  1605 	char	*k;
       
  1606 	STRLEN	klen;
       
  1607 CODE:
       
  1608 	self = SvRV(self);
       
  1609 	k = SvPV(key, klen);
       
  1610 	if (strNE(k, "class") && strNE(k, "crtime")) {
       
  1611 		read_kstats((HV *)self, FALSE);
       
  1612 	}
       
  1613 	SvREFCNT_inc(value);
       
  1614 	RETVAL = *(hv_store((HV *)self, k, klen, value, 0));
       
  1615 	SvREFCNT_inc(RETVAL);
       
  1616 OUTPUT:
       
  1617 	RETVAL
       
  1618 
       
  1619  #
       
  1620  # Check for the existence of the passed key.  Read the kstat first if necessary
       
  1621  #
       
  1622 
       
  1623 bool
       
  1624 EXISTS(self, key)
       
  1625 	SV* self;
       
  1626 	SV* key;
       
  1627 PREINIT:
       
  1628 	char *k;
       
  1629 CODE:
       
  1630 	self = SvRV(self);
       
  1631 	k = SvPV(key, PL_na);
       
  1632 	if (strNE(k, "class") && strNE(k, "crtime")) {
       
  1633 		read_kstats((HV *)self, FALSE);
       
  1634 	}
       
  1635 	RETVAL = hv_exists_ent((HV *)self, key, 0);
       
  1636 OUTPUT:
       
  1637 	RETVAL
       
  1638 
       
  1639 
       
  1640  #
       
  1641  # Hash iterator initialisation.  Read the kstats if necessary.
       
  1642  #
       
  1643 
       
  1644 SV*
       
  1645 FIRSTKEY(self)
       
  1646 	SV* self;
       
  1647 PREINIT:
       
  1648 	HE *he;
       
  1649 PPCODE:
       
  1650 	self = SvRV(self);
       
  1651 	read_kstats((HV *)self, FALSE);
       
  1652 	hv_iterinit((HV *)self);
       
  1653 	if (he = hv_iternext((HV *)self)) {
       
  1654 		EXTEND(SP, 1);
       
  1655 		PUSHs(hv_iterkeysv(he));
       
  1656 	}
       
  1657 
       
  1658  #
       
  1659  # Return hash iterator next value.  Read the kstats if necessary.
       
  1660  #
       
  1661 
       
  1662 SV*
       
  1663 NEXTKEY(self, lastkey)
       
  1664 	SV* self;
       
  1665 	SV* lastkey;
       
  1666 PREINIT:
       
  1667 	HE *he;
       
  1668 PPCODE:
       
  1669 	self = SvRV(self);
       
  1670 	if (he = hv_iternext((HV *)self)) {
       
  1671 		EXTEND(SP, 1);
       
  1672 		PUSHs(hv_iterkeysv(he));
       
  1673 	}
       
  1674 
       
  1675 
       
  1676  #
       
  1677  # Delete the specified hash entry.
       
  1678  #
       
  1679 
       
  1680 SV*
       
  1681 DELETE(self, key)
       
  1682 	SV *self;
       
  1683 	SV *key;
       
  1684 CODE:
       
  1685 	self = SvRV(self);
       
  1686 	RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
       
  1687 	if (RETVAL) {
       
  1688 		SvREFCNT_inc(RETVAL);
       
  1689 	} else {
       
  1690 		RETVAL = &PL_sv_undef;
       
  1691 	}
       
  1692 OUTPUT:
       
  1693 	RETVAL
       
  1694 
       
  1695  #
       
  1696  # Clear the entire hash.  This will stop any update() calls rereading this
       
  1697  # kstat until it is accessed again.
       
  1698  #
       
  1699 
       
  1700 void
       
  1701 CLEAR(self)
       
  1702 	SV* self;
       
  1703 PREINIT:
       
  1704 	MAGIC   *mg;
       
  1705 	KstatInfo_t *kip;
       
  1706 CODE:
       
  1707 	self = SvRV(self);
       
  1708 	hv_clear((HV *)self);
       
  1709 	mg = mg_find(self, '~');
       
  1710 	PERL_ASSERTMSG(mg != 0, "CLEAR: lost ~ magic");
       
  1711 	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
       
  1712 	kip->read  = FALSE;
       
  1713 	kip->valid = TRUE;
       
  1714 	hv_store((HV *)self, "class", 5, newSVpv(kip->kstat->ks_class, 0), 0);
       
  1715 	hv_store((HV *)self, "crtime", 6, NEW_HRTIME(kip->kstat->ks_crtime), 0);