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