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