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