File Coverage

C.xs

Criterion	Covered	Total	%
statement	49	61	80.3
branch			n/a
condition			n/a
subroutine			n/a
pod			n/a
total	49	61	80.3

line	stmt	code
1		/*******************************************************************************
2		*
3		* MODULE: C.xs
4		*
5		********************************************************************************
6		*
7		* DESCRIPTION: XS Interface for Convert::Binary::C Perl extension module
8		*
9		********************************************************************************
10		*
11		* $Project: /Convert-Binary-C $
12		* $Author: mhx $
13		* $Date: 2006/08/26 13:33:44 +0200 $
14		* $Revision: 160 $
15		* $Source: /C.xs $
16		*
17		********************************************************************************
18		*
19		* Copyright (c) 2002-2006 Marcus Holland-Moritz. All rights reserved.
20		* This program is free software; you can redistribute it and/or modify
21		* it under the same terms as Perl itself.
22		*
23		********************************************************************************
24		*
25		* "All you have to do is to decide what you are going to do
26		* with the time that is given to you." -- Gandalf
27		*
28		*******************************************************************************/
29
30
31		/===== GLOBAL INCLUDES ======================================================/
32
33		#define PERL_NO_GET_CONTEXT
34		#include <EXTERN.h>
35		#include <perl.h>
36
37		#define NO_XSLOCKS
38		#include <XSUB.h>
39
40		#define NEED_newRV_noinc_GLOBAL
41		#define NEED_sv_2pv_nolen_GLOBAL
42		#include "ppport.h"
43
44
45		/===== LOCAL INCLUDES =======================================================/
46
47		#include "util/ccattr.h"
48		#include "util/list.h"
49		#include "util/hash.h"
50		#include "ctlib/cterror.h"
51		#include "ctlib/fileinfo.h"
52		#include "ctlib/parser.h"
53
54		#include "cbc/cbc.h"
55		#include "cbc/debug.h"
56		#include "cbc/hook.h"
57		#include "cbc/init.h"
58		#include "cbc/macros.h"
59		#include "cbc/member.h"
60		#include "cbc/object.h"
61		#include "cbc/option.h"
62		#include "cbc/pack.h"
63		#include "cbc/sourcify.h"
64		#include "cbc/tag.h"
65		#include "cbc/type.h"
66		#include "cbc/typeinfo.h"
67		#include "cbc/util.h"
68
69
70		/===== DEFINES ==============================================================/
71
72		#ifndef PerlEnv_getenv
73		# define PerlEnv_getenv getenv
74		#endif
75
76		#ifdef CBC_DEBUGGING
77
78		#define DBG_CTXT_FMT "%s"
79
80		#define DBG_CTXT_ARG (GIMME_V == G_VOID ? "0=" : \
81		(GIMME_V == G_SCALAR ? "$=" : \
82		(GIMME_V == G_ARRAY ? "@=" : \
83		"?=" \
84		)))
85
86		#endif
87
88		#define CBC_METHOD(name) const char * const method PERL_UNUSED_DECL = #name
89		#define CBC_METHOD_VAR const char * method PERL_UNUSED_DECL = ""
90		#define CBC_METHOD_SET(string) method = string
91
92		#define CT_DEBUG_METHOD \
93		CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s", DBG_CTXT_ARG, method))
94
95		#define CT_DEBUG_METHOD1(fmt, arg1) \
96		CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s( " fmt " )", \
97		DBG_CTXT_ARG, method, arg1))
98
99		#define CT_DEBUG_METHOD2(fmt, arg1, arg2) \
100		CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s( " fmt " )", \
101		DBG_CTXT_ARG, method, arg1, arg2) )
102
103		#define CHECK_PARSE_DATA \
104		STMT_START { \
105		if (!THIS->cpi.available) \
106		Perl_croak(aTHX_ "Call to %s without parse data", method); \
107		} STMT_END
108
109		#define NEED_PARSE_DATA \
110		STMT_START { \
111		if (THIS->cpi.available) \
112		{ \
113		if (!THIS->cpi.ready) \
114		update_parse_info(&THIS->cpi, &THIS->cfg); \
115		assert(THIS->cpi.ready); \
116		} \
117		} STMT_END
118
119		#define WARN_VOID_CONTEXT \
120		WARN((aTHX_ "Useless use of %s in void context", method))
121
122		#define CHECK_VOID_CONTEXT \
123		STMT_START { \
124		if (GIMME_V == G_VOID) \
125		{ \
126		WARN_VOID_CONTEXT; \
127		XSRETURN_EMPTY; \
128		} \
129		} STMT_END
130
131
132		/===== TYPEDEFS =============================================================/
133
134		/===== STATIC FUNCTION PROTOTYPES ===========================================/
135
136		static void *ct_newstr(void);
137		static void ct_scatf(void p, const char f, ...);
138		static void ct_vscatf(void p, const char f, va_list *l);
139		static const char ct_cstring(void p, size_t *len);
140		static void ct_fatal(void *p) __attribute__((__noreturn__));
141
142		static void handle_parse_errors(pTHX_ LinkedList stack);
143
144
145		/===== EXTERNAL VARIABLES ===================================================/
146
147		/===== GLOBAL VARIABLES =====================================================/
148
149		/===== STATIC VARIABLES =====================================================/
150
151		static int gs_DisableParser;
152		static int gs_OrderMembers;
153
154
155		/===== GLOBAL FUNCTIONS =====================================================/
156
157		/*******************************************************************************
158		*
159		* ROUTINE: CBC_malloc, CBC_calloc, CBC_realloc, CBC_free
160		*
161		* WRITTEN BY: Marcus Holland-Moritz ON: Feb 2005
162		* CHANGED BY: ON:
163		*
164		********************************************************************************
165		*
166		* DESCRIPTION: Memory allocation routines for ucpp and util libs.
167		*
168		*******************************************************************************/
169
170		void *CBC_malloc(size_t size)
171	7537118	{
172		void *p;
173	7537118	New(0, p, size, char);
174		return p;
175		}
176
177		void *CBC_calloc(size_t count, size_t size)
178	0	{
179		void *p;
180	0	Newz(0, p, count*size, char);
181		return p;
182		}
183
184		void CBC_realloc(void p, size_t size)
185	62947	{
186	62947	Renew(p, size, char);
187		return p;
188		}
189
190		void CBC_free(void *p)
191	7537118	{
192	7537118	Safefree(p);
193		}
194
195
196		/===== STATIC FUNCTIONS =====================================================/
197
198		/*******************************************************************************
199		*
200		* ROUTINE: ct_*
201		*
202		* WRITTEN BY: Marcus Holland-Moritz ON: Mar 2002
203		* CHANGED BY: ON:
204		*
205		********************************************************************************
206		*
207		* DESCRIPTION: These functions are used to build arbitrary strings within the
208		* ctlib routines and to provide an interface to perl's warn().
209		*
210		*******************************************************************************/
211
212		static void *ct_newstr(void)
213	190	{
214		dTHX;
215	190	return (void *) newSVpvn("", 0);
216		}
217
218		static void ct_destroy(void *p)
219	190	{
220		dTHX;
221	190	SvREFCNT_dec((SV*)p);
222		}
223
224		static void ct_scatf(void p, const char f, ...)
225	116	{
226		dTHX;
227		va_list l;
228	116	va_start(l, f);
229	116	sv_vcatpvf((SV*)p, f, &l);
230		va_end(l);
231		}
232
233		static void ct_vscatf(void p, const char f, va_list *l)
234	190	{
235		dTHX;
236	190	sv_vcatpvf((SV*)p, f, l);
237		}
238
239		static const char ct_cstring(void p, size_t *len)
240	190	{
241		dTHX;
242		STRLEN l;
243	190	const char s = SvPV((SV)p, l);
244	190	if (len)
245	190	*len = (size_t) l;
246		return s;
247		}
248
249		static void ct_fatal(void *p)
250	0	{
251		dTHX;
252	0	sv_2mortal((SV*)p);
253	0	fatal("%s", SvPV_nolen((SV*)p));
254		}
255
256		/*******************************************************************************
257		*
258		* ROUTINE: handle_parse_errors
259		*
260		* WRITTEN BY: Marcus Holland-Moritz ON: Nov 2003
261		* CHANGED BY: ON:
262		*
263		********************************************************************************
264		*
265		* DESCRIPTION:
266		*
267		* ARGUMENTS:
268		*
269		* RETURNS:
270		*
271		*******************************************************************************/
272
273		static void handle_parse_errors(pTHX_ LinkedList stack)
274	20810	{
275		ListIterator ei;
276		CTLibError *perr;
277
278	41633	LL_foreach(perr, ei, stack)
279		{
280	165	switch (perr->severity)
281		{
282		case CTES_ERROR:
283	152	Perl_croak(aTHX_ "%s", perr->string);
284		break;
285
286		case CTES_WARNING:
287	13	if( PERL_WARNINGS_ON )
288	13	Perl_warn(aTHX_ "%s", perr->string);
289		break;
290
291		default:
292	0	Perl_croak(aTHX_ "unknown severity [%d] for error: %s",
293		perr->severity, perr->string);
294		}
295		}
296		}
297
298
299		/===== XS FUNCTIONS =========================================================/
300
301		MODULE = Convert::Binary::C PACKAGE = Convert::Binary::C
302
303		PROTOTYPES: ENABLE
304
305		INCLUDE: xsubs/cbc.xs
306
307		INCLUDE: xsubs/clone.xs
308
309		INCLUDE: xsubs/clean.xs
310
311		INCLUDE: xsubs/configure.xs
312
313		INCLUDE: xsubs/include.xs
314
315		INCLUDE: xsubs/parse.xs
316
317		INCLUDE: xsubs/def.xs
318
319		INCLUDE: xsubs/pack.xs
320
321		INCLUDE: xsubs/sizeof.xs
322
323		INCLUDE: xsubs/typeof.xs
324
325		INCLUDE: xsubs/offsetof.xs
326
327		INCLUDE: xsubs/member.xs
328
329		INCLUDE: xsubs/tag.xs
330
331		INCLUDE: xsubs/enum.xs
332
333		INCLUDE: xsubs/compound.xs
334
335		INCLUDE: xsubs/typedef.xs
336
337		INCLUDE: xsubs/sourcify.xs
338
339		INCLUDE: xsubs/initializer.xs
340
341		INCLUDE: xsubs/dependencies.xs
342
343		INCLUDE: xsubs/defined.xs
344
345		INCLUDE: xsubs/macro.xs
346
347		INCLUDE: xsubs/arg.xs
348
349		INCLUDE: xsubs/feature.xs
350
351		INCLUDE: xsubs/native.xs
352
353
354		################################################################################
355		#
356		# FUNCTION: import
357		#
358		# WRITTEN BY: Marcus Holland-Moritz ON: Mar 2002
359		# CHANGED BY: ON:
360		#
361		################################################################################
362		#
363		# DESCRIPTION: Handle global features, currently only debugging support.
364		#
365		# ARGUMENTS:
366		#
367		# RETURNS:
368		#
369		################################################################################
370
371		#define WARN_NO_DEBUGGING 0x00000001
372
373		void
374		import(...)
375		PREINIT:
376		int i;
377		U32 wflags;
378
379		CODE:
380		wflags = 0;
381
382	70	if (items % 2 == 0)
383	1	Perl_croak(aTHX_ "You must pass an even number of module arguments");
384		else
385		{
386	73	for (i = 1; i < items; i += 2)
387		{
388	4	const char *opt = SvPV_nolen(ST(i));
389		#ifdef CBC_DEBUGGING
390		const char *arg = SvPV_nolen(ST(i+1));
391		#endif
392	4	if (strEQ(opt, "debug"))
393		{
394		#ifdef CBC_DEBUGGING
395		set_debug_options(aTHX_ arg);
396		#else
397	2	wflags \|= WARN_NO_DEBUGGING;
398		#endif
399		}
400	2	else if (strEQ(opt, "debugfile"))
401		{
402		#ifdef CBC_DEBUGGING
403		set_debug_file(aTHX_ arg);
404		#else
405	2	wflags \|= WARN_NO_DEBUGGING;
406		#endif
407		}
408		else
409	0	Perl_croak(aTHX_ "Invalid module option '%s'", opt);
410		}
411
412	3	if (wflags & WARN_NO_DEBUGGING)
413	3	Perl_warn(aTHX_ XSCLASS " not compiled with debugging support");
414		}
415
416		#undef WARN_NO_DEBUGGING
417
418
419		################################################################################
420		#
421		# FUNCTION: __DUMP__
422		#
423		# WRITTEN BY: Marcus Holland-Moritz ON: Mar 2002
424		# CHANGED BY: ON:
425		#
426		################################################################################
427		#
428		# DESCRIPTION: Internal function used for reference count checks.
429		#
430		# ARGUMENTS:
431		#
432		# RETURNS:
433		#
434		################################################################################
435
436		SV *
437		__DUMP__(val)
438		SV *val
439
440		CODE:
441	0	RETVAL = newSVpvn("", 0);
442		#ifdef CBC_DEBUGGING
443		dump_sv(aTHX_ RETVAL, 0, val);
444		#else
445		(void) val;
446	0	Perl_croak(aTHX_ "__DUMP__ not enabled in non-debug version");
447		#endif
448
449		OUTPUT:
450		RETVAL
451
452
453		################################################################################
454		#
455		# BOOTCODE
456		#