1 /* 2 * CDDL HEADER START 3 * 4 * The contents of this file are subject to the terms of the 5 * Common Development and Distribution License (the "License"). 6 * You may not use this file except in compliance with the License. 7 * 8 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 9 * or http://www.opensolaris.org/os/licensing. 10 * See the License for the specific language governing permissions 11 * and limitations under the License. 12 * 13 * When distributing Covered Code, include this CDDL HEADER in each 14 * file and include the License file at usr/src/OPENSOLARIS.LICENSE. 15 * If applicable, add the following below this CDDL HEADER, with the 16 * fields enclosed by brackets "[]" replaced with your own identifying 17 * information: Portions Copyright [yyyy] [name of copyright owner] 18 * 19 * CDDL HEADER END 20 */ 21 22 /* 23 * Copyright 2006 Sun Microsystems, Inc. All rights reserved. 24 * Use is subject to license terms. 25 */ 26 27 #pragma ident "%Z%%M% %I% %E% SMI" 28 29 /* 30 * Lgrp.xs contains XS wrappers for the system locality group library 31 * liblgrp(3LIB). 32 */ 33 34 #include <sys/errno.h> 35 #include <sys/lgrp_user.h> 36 37 /* 38 * On i386 Solaris defines SP, which conflicts with the perl definition of SP 39 * We don't need the Solaris one, so get rid of it to avoid warnings. 40 */ 41 #undef SP 42 43 /* Perl XS includes. */ 44 #include "EXTERN.h" 45 #if __GNUC__ >= 5 46 #include "perl.h" 47 #else 48 #define _Thread_local 49 #include "perl.h" 50 #undef _Thread_local 51 #undef PERL_GET_CONTEXT 52 #undef PERL_SET_CONTEXT 53 #define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) 54 #define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) 55 #endif 56 #include "XSUB.h" 57 58 /* Return undef in scalar context and empty list in list context */ 59 #define LGRP_BADVAL() { \ 60 if (GIMME_V == G_ARRAY) \ 61 XSRETURN_EMPTY; \ 62 else \ 63 XSRETURN_UNDEF; \ 64 } 65 66 /* 67 * Push all values from input array onto the perl return stack. 68 */ 69 #define PUSHARRAY(array, nitems) \ 70 { \ 71 int x; \ 72 \ 73 if (nitems < 0) { \ 74 LGRP_BADVAL() \ 75 } else if (nitems > 0) { \ 76 EXTEND(SP, nitems); \ 77 for (x = 0; x < nitems; x++) { \ 78 PUSHs(sv_2mortal(newSVnv(array[x]))); \ 79 } \ 80 } \ 81 } 82 83 /* 84 * Several constants are not present in the first version of the Lgrp API, 85 * we define them here. 86 * 87 * lgrp_resources() and lgrp_latency_cookie() only appear in API v2. If the 88 * module is linked with old version of liblgrp(3LIB) there is no lgrp_resources 89 * symbol in the library and perl wrapper returns empty list and sets errno to 90 * EINVAL. 91 * 92 * The lgrp_latency_cookie() is emulated using lgrp_latency(). 93 */ 94 #if LGRP_VER_CURRENT == 1 95 #define LGRP_CONTENT_ALL LGRP_CONTENT_HIERARCHY 96 #define LGRP_LAT_CPU_TO_MEM 0 97 #define LGRP_RSRC_CPU 0 /* CPU resources */ 98 #define LGRP_RSRC_MEM 1 /* memory resources */ 99 100 #define LGRP_RESOURCES(c, lgrp, type) \ 101 { errno = EINVAL; LGRP_BADVAL(); } 102 103 /* 104 * Simulate lgrp_latency_cookie() which just fails. This macro is never called 105 * and we just define it so that the C compiler will not complain about the 106 * missing symbol. 107 */ 108 #define lgrp_latency_cookie(c, f, t, b) (errno = EINVAL, -1) 109 110 #else 111 #define LGRP_RESOURCES(c, lgrp, type) { \ 112 int nr; \ 113 lgrp_id_t *lgrps; \ 114 \ 115 errno = 0; \ 116 nr = lgrp_resources(c, lgrp, NULL, 0, type); \ 117 if (nr < 0) \ 118 LGRP_BADVAL(); \ 119 if (GIMME_V == G_SCALAR) \ 120 XSRETURN_IV(nr); \ 121 if (nr == 0) { \ 122 XSRETURN_EMPTY; \ 123 } else if (New(0, lgrps, nr, lgrp_id_t) == NULL) { \ 124 errno = ENOMEM; \ 125 LGRP_BADVAL(); \ 126 } else { \ 127 nr = lgrp_resources(c, lgrp, lgrps, nr, type); \ 128 PUSHARRAY(lgrps, nr); \ 129 Safefree(lgrps); \ 130 } \ 131 } 132 #endif 133 134 /* 135 * Special version of lgrp_latency_cookie(). Use lgrp_latency() for liblgrp V1 136 * and lgrp_latency_cookie for V2. 137 */ 138 static int 139 _lgrp_latency_cookie(lgrp_cookie_t cookie, lgrp_id_t from, lgrp_id_t to, 140 int between) 141 { 142 return (LGRP_VER_CURRENT < 2 ? 143 lgrp_latency(from, to) : 144 lgrp_latency_cookie(cookie, from, to, between)); 145 } 146 147 /* 148 * Most functions in liblgrp return -1 on failure. The perl equivalent returns 149 * 'undef' instead. The macro should be call after the RETVAL is set to the 150 * return value of the function. 151 */ 152 #define RETURN_UNDEF_IF_FAIL { if (RETVAL < 0) XSRETURN_UNDEF; } 153 154 /* 155 * End of C part, start of XS part. 156 * 157 * The XS code exported to perl is below here. Note that the XS preprocessor 158 * has its own commenting syntax, so all comments from this point on are in 159 * that form. 160 */ 161 162 MODULE = Sun::Solaris::Lgrp PACKAGE = Sun::Solaris::Lgrp 163 PROTOTYPES: ENABLE 164 165 # 166 # Define any constants that need to be exported. By doing it this way we can 167 # avoid the overhead of using the DynaLoader package, and in addition constants 168 # defined using this mechanism are eligible for inlining by the perl 169 # interpreter at compile time. 170 # 171 BOOT: 172 { 173 HV *stash; 174 175 stash = gv_stashpv("Sun::Solaris::Lgrp", TRUE); 176 newCONSTSUB(stash, "LGRP_AFF_NONE", newSViv(LGRP_AFF_NONE)); 177 newCONSTSUB(stash, "LGRP_AFF_STRONG", newSViv(LGRP_AFF_STRONG)); 178 newCONSTSUB(stash, "LGRP_AFF_WEAK", newSViv(LGRP_AFF_WEAK)); 179 newCONSTSUB(stash, "LGRP_VER_CURRENT", newSViv(LGRP_VER_CURRENT)); 180 newCONSTSUB(stash, "LGRP_VER_NONE", newSViv(LGRP_VER_NONE)); 181 newCONSTSUB(stash, "LGRP_NONE", newSViv(LGRP_NONE)); 182 newCONSTSUB(stash, "LGRP_RSRC_CPU", newSViv(LGRP_RSRC_CPU)); 183 newCONSTSUB(stash, "LGRP_RSRC_MEM", newSViv(LGRP_RSRC_MEM)); 184 newCONSTSUB(stash, "LGRP_CONTENT_HIERARCHY", 185 newSViv(LGRP_CONTENT_HIERARCHY)); 186 newCONSTSUB(stash, "LGRP_CONTENT_DIRECT", newSViv(LGRP_CONTENT_DIRECT)); 187 newCONSTSUB(stash, "LGRP_VIEW_CALLER", newSViv(LGRP_VIEW_CALLER)); 188 newCONSTSUB(stash, "LGRP_VIEW_OS", newSViv(LGRP_VIEW_OS)); 189 newCONSTSUB(stash, "LGRP_MEM_SZ_FREE", newSViv(LGRP_MEM_SZ_FREE)); 190 newCONSTSUB(stash, "LGRP_MEM_SZ_INSTALLED", 191 newSViv(LGRP_MEM_SZ_INSTALLED)); 192 newCONSTSUB(stash, "LGRP_CONTENT_ALL", newSViv(LGRP_CONTENT_ALL)); 193 newCONSTSUB(stash, "LGRP_LAT_CPU_TO_MEM", newSViv(LGRP_LAT_CPU_TO_MEM)); 194 newCONSTSUB(stash, "P_PID", newSViv(P_PID)); 195 newCONSTSUB(stash, "P_LWPID", newSViv(P_LWPID)); 196 newCONSTSUB(stash, "P_MYID", newSViv(P_MYID)); 197 } 198 199 # 200 # The code below uses POSTCALL directive which allows to return 'undef' 201 # whenever a C function returns a negative value. 202 # 203 204 205 # 206 # lgrp_init([view]) 207 # Use LGRP_VIEW_OS as the default view. 208 # 209 lgrp_cookie_t 210 lgrp_init(lgrp_view_t view = LGRP_VIEW_OS) 211 POSTCALL: 212 RETURN_UNDEF_IF_FAIL; 213 214 lgrp_view_t 215 lgrp_view(cookie) 216 lgrp_cookie_t cookie 217 POSTCALL: 218 RETURN_UNDEF_IF_FAIL; 219 220 lgrp_affinity_t 221 lgrp_affinity_get(idtype, id, lgrp) 222 idtype_t idtype; 223 id_t id; 224 lgrp_id_t lgrp; 225 POSTCALL: 226 RETURN_UNDEF_IF_FAIL; 227 228 int 229 lgrp_affinity_set(idtype, id, lgrp, affinity) 230 idtype_t idtype; 231 id_t id; 232 lgrp_id_t lgrp; 233 lgrp_affinity_t affinity; 234 POSTCALL: 235 RETURN_UNDEF_IF_FAIL; 236 XSRETURN_YES; 237 238 int 239 lgrp_cookie_stale(cookie) 240 lgrp_cookie_t cookie; 241 POSTCALL: 242 RETURN_UNDEF_IF_FAIL; 243 244 int 245 lgrp_fini(cookie) 246 lgrp_cookie_t cookie; 247 POSTCALL: 248 RETURN_UNDEF_IF_FAIL; 249 XSRETURN_YES; 250 251 lgrp_id_t 252 lgrp_home(idtype, id) 253 idtype_t idtype; 254 id_t id; 255 POSTCALL: 256 RETURN_UNDEF_IF_FAIL; 257 258 int 259 lgrp_latency(lgrp_id_t from,lgrp_id_t to) 260 POSTCALL: 261 RETURN_UNDEF_IF_FAIL; 262 263 lgrp_mem_size_t 264 lgrp_mem_size(cookie, lgrp, type, content) 265 lgrp_cookie_t cookie 266 lgrp_id_t lgrp 267 int type 268 lgrp_content_t content 269 POSTCALL: 270 RETURN_UNDEF_IF_FAIL; 271 272 int 273 lgrp_nlgrps(cookie) 274 lgrp_cookie_t cookie; 275 POSTCALL: 276 RETURN_UNDEF_IF_FAIL; 277 278 lgrp_id_t 279 lgrp_root(cookie) 280 lgrp_cookie_t cookie 281 POSTCALL: 282 RETURN_UNDEF_IF_FAIL; 283 284 int 285 lgrp_version(int version = LGRP_VER_NONE) 286 287 # 288 # lgrp_latency_cookie calls our internal wrapper _lgrp_latency_cookie() which 289 # works for both old and new versions of liblgrp. 290 # 291 int 292 lgrp_latency_cookie(lgrp_cookie_t cookie, lgrp_id_t from, lgrp_id_t to, int between = 0) 293 CODE: 294 RETVAL = _lgrp_latency_cookie(cookie, from, to, between); 295 POSTCALL: 296 RETURN_UNDEF_IF_FAIL; 297 OUTPUT: 298 RETVAL 299 300 # 301 # Functions below convert C arrays into Perl lists. They use XS PPCODE 302 # directive to avoid implicit RETVAL assignments and manipulate perl 303 # stack directly. 304 # 305 # When called in scalar context functions return the number of elements 306 # in the list or undef on failure. 307 # 308 # The PUSHARRAY() macro defined above pushes all values from the C array to 309 # the perl stack. 310 # 311 312 # 313 # @children = lgrp_children($cookie, $parent). 314 # 315 void 316 lgrp_children(cookie, lgrp) 317 lgrp_cookie_t cookie; 318 lgrp_id_t lgrp; 319 PREINIT: 320 lgrp_id_t *lgrps; 321 int count; 322 PPCODE: 323 errno = 0; 324 if ((count = lgrp_children(cookie, lgrp, NULL, 0)) < 0) 325 LGRP_BADVAL(); 326 327 if (GIMME_V == G_SCALAR) 328 XSRETURN_IV(count); 329 330 if (count > 0) { 331 if (New(0, lgrps, count, lgrp_id_t) == NULL) { 332 errno = ENOMEM; 333 LGRP_BADVAL(); 334 } else { 335 count = lgrp_children(cookie, lgrp, lgrps, count); 336 PUSHARRAY(lgrps, count); 337 Safefree(lgrps); 338 } 339 } 340 341 # 342 # @parents = lgrp_parents($cookie, $lgrp). 343 # 344 void 345 lgrp_parents(cookie, lgrp) 346 lgrp_cookie_t cookie; 347 lgrp_id_t lgrp; 348 PREINIT: 349 lgrp_id_t *lgrps; 350 int count; 351 PPCODE: 352 errno = 0; 353 if ((count = lgrp_parents(cookie, lgrp, NULL, 0)) < 0) 354 LGRP_BADVAL(); 355 356 if (GIMME_V == G_SCALAR) 357 XSRETURN_IV(count); 358 359 if (count > 0) { 360 if (New(0, lgrps, count, lgrp_id_t) == NULL) { 361 errno = ENOMEM; 362 LGRP_BADVAL(); 363 } else { 364 count = lgrp_parents(cookie, lgrp, lgrps, count); 365 PUSHARRAY(lgrps, count); 366 Safefree(lgrps); 367 } 368 } 369 370 # 371 # @parents = lgrp_cpus($cookie, $lgrp, $content). 372 # Content should be LGRP_CONTENT_HIERARCHY or LGRP_CONTENT_ALL or 373 # LGRP_CONTENT_DIRECT 374 void 375 lgrp_cpus(cookie, lgrp, content) 376 lgrp_cookie_t cookie; 377 lgrp_id_t lgrp; 378 lgrp_content_t content; 379 PREINIT: 380 int ncpus; 381 processorid_t *cpus; 382 PPCODE: 383 errno = 0; 384 if ((ncpus = lgrp_cpus(cookie, lgrp, NULL, 0, content)) < 0) 385 LGRP_BADVAL(); 386 387 if (GIMME_V == G_SCALAR) 388 XSRETURN_IV(ncpus); 389 390 if (ncpus > 0) { 391 if (New(0, cpus, ncpus, processorid_t) == NULL) { 392 errno = ENOMEM; 393 LGRP_BADVAL(); 394 } else { 395 ncpus = lgrp_cpus(cookie, lgrp, cpus, ncpus, content); 396 PUSHARRAY(cpus, ncpus); 397 Safefree(cpus); 398 } 399 } 400 401 void 402 lgrp_resources(cookie, lgrp, type) 403 lgrp_cookie_t cookie; 404 lgrp_id_t lgrp; 405 int type; 406 PPCODE: 407 LGRP_RESOURCES(cookie, lgrp, type); 408