view release on metacpan or  search on metacpan

lib/Devel/CallParser.xs  view on Meta::CPAN

	return (parser_flags & CALLPARSER_STATEMENT) ?
		KEYWORD_PLUGIN_STMT : KEYWORD_PLUGIN_EXPR;
}

#define fmt_header(n, content) THX_fmt_header(aTHX_ n, content)
static SV *THX_fmt_header(pTHX_ char n, char const *content)
{
	return newSVpvf(
		"/* DO NOT EDIT -- generated "
			"by Devel::CallParser version "XS_VERSION" */\n"
		"#ifndef "QPFXS"INCLUDED_callparser%c\n"
		"#define "QPFXS"INCLUDED_callparser%c 1\n"
		"#ifndef PERL_VERSION\n"
		" #error you must include perl.h before callparser%c.h\n"
		"#elif !(PERL_REVISION == "STRINGIFY(PERL_REVISION)
			" && PERL_VERSION == "STRINGIFY(PERL_VERSION)
#if PERL_VERSION & 1
			" && PERL_SUBVERSION == "STRINGIFY(PERL_SUBVERSION)
#endif /* PERL_VERSION & 1 */
			")\n"
		" #error this callparser%c.h is for Perl "
			STRINGIFY(PERL_REVISION)"."STRINGIFY(PERL_VERSION)
#if PERL_VERSION & 1
			"."STRINGIFY(PERL_SUBVERSION)
#endif /* PERL_VERSION & 1 */
			" only\n"
		"#endif /* Perl version mismatch */\n"
		"%s"
		"#endif /* !"QPFXS"INCLUDED_callparser%c */\n",
		n, n, n, n, content, n);
}

#define DEFFN(RETTYPE, PUBNAME, PRIVNAME, ARGTYPES, ARGNAMES) \
	MY_IMPORT_CALLCONV_S" "RETTYPE" "QPFXS PRIVNAME"(pTHX_ "ARGTYPES");\n" \
	"#define Perl_"PUBNAME" "QPFXS PRIVNAME"\n" \
	"#define "PUBNAME"("ARGNAMES") Perl_"PUBNAME"(aTHX_ "ARGNAMES")\n"

#define DEFCALLBACK \
	"typedef OP *(*Perl_call_parser)(pTHX_ GV *, SV *, U32 *);\n" \
	"#define CALLPARSER_PARENS    0x00000001\n" \
	"#define CALLPARSER_STATEMENT 0x00000002\n"

MODULE = Devel::CallParser PACKAGE = Devel::CallParser

PROTOTYPES: DISABLE

BOOT:
	next_keyword_plugin = PL_keyword_plugin;
	PL_keyword_plugin = my_keyword_plugin;

SV *
callparser0_h()
CODE:
	RETVAL = fmt_header('0',
		DEFCALLBACK
		DEFFN("void", "cv_get_call_parser", "gcp0",
			"CV *, Perl_call_parser *, SV **", "cv, fp, op")
		DEFFN("void", "cv_set_call_parser", "scp0",
			"CV *, Perl_call_parser, SV *", "cv, f, o")
	);
OUTPUT:
	RETVAL

SV *
callparser1_h()
CODE:
#if Q_PARSER_AVAILABLE
	RETVAL = fmt_header('1',
		DEFFN("OP *", "parse_args_parenthesised", "pac0", "U32 *", "fp")
		DEFFN("OP *", "parse_args_nullary", "paz0", "U32 *", "fp")
		DEFFN("OP *", "parse_args_unary", "pau0", "U32 *", "fp")
		DEFFN("OP *", "parse_args_list", "pal0", "U32 *", "fp")
		DEFFN("OP *", "parse_args_block_list", "pab0", "U32 *", "fp")
		DEFFN("OP *", "parse_args_proto", "pap0",
			"GV *, SV *, U32 *", "gv, sv, fp")
		DEFFN("OP *", "parse_args_proto_or_list", "pan0",
			"GV *, SV *, U32 *", "gv, sv, fp")
		DEFCALLBACK
		DEFFN("void", "cv_get_call_parser", "gcp1",
			"CV *, Perl_call_parser *, SV **", "cv, fp, op")
		DEFFN("void", "cv_set_call_parser", "scp1",
			"CV *, Perl_call_parser, SV *", "cv, f, o")
	);
#else /* !Q_PARSER_AVAILABLE */
	croak("callparser1.h not available on this version of Perl");
#endif /* !Q_PARSER_AVAILABLE */
OUTPUT:
	RETVAL