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