void get_basic_type_spec_string(pTHX_ SV **sv, u_32 flags)
{
struct { u_32 flag; const char *str; } *pSpec, spec[] = {
{T_SIGNED, "signed" },
{T_UNSIGNED, "unsigned"},
{T_SHORT, "short" },
{T_LONGLONG, "long" },
{T_LONG, "long" },
{T_VOID, "void" },
{T_CHAR, "char" },
{T_INT , "int" },
{T_FLOAT , "float" },
{T_DOUBLE , "double" },
{0, NULL }
};
int first = 1;
CT_DEBUG(MAIN, (XSCLASS "::get_basic_type_spec_string( sv=%p, flags=0x%08lX )",
sv, (unsigned long) flags));
for (pSpec = spec; pSpec->flag; ++pSpec)
{
if (pSpec->flag & flags)
{
if (*sv)
sv_catpvf(*sv, first ? "%s" : " %s", pSpec->str);
else
*sv = newSVpv(CONST_CHAR(pSpec->str), 0);
first = 0;
}
}
}
static const StringOption *get_string_option(pTHX_ const StringOption *options,
int count, int value, SV *sv, const char *name)
{
char *string = NULL;
if (sv)
{
if (SvROK(sv))
Perl_croak(aTHX_ "%s must be a string value, not a reference", name);
else
string = SvPV_nolen(sv);
}
if (string)
{
const StringOption *opt = options;
int n = count;
while (n--)
{
if (strEQ(string, opt->string))
return opt;
opt++;
}
if (name)
{
SV *str = sv_2mortal(newSVpvn("", 0));
for (n = 0; n < count; n++)
{
sv_catpv(str, CONST_CHAR((options++)->string));
if (n < count-2)
sv_catpv(str, "', '");
else if (n == count-2)
sv_catpv(str, "' or '");
}
Perl_croak(aTHX_ "%s must be '%s', not '%s'", name, SvPV_nolen(str), string);
}
}
else
{
while (count--)
{
if (value == options->value)
return options;
options++;
}
fatal("Inconsistent data detected in get_string_option()!");
}
return NULL;
}
HV *newHV_indexed(pTHX_ const CBC *THIS)
{
dSP;
HV *hv, *stash;
GV *gv;
SV *sv;
int count;
hv = newHV();
sv = newSVpv(CONST_CHAR(THIS->ixhash), 0);
stash = gv_stashpv(CONST_CHAR(THIS->ixhash), 0);
gv = gv_fetchmethod(stash, "TIEHASH");
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(sv));
PUTBACK;
count = call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
if (count != 1)
fatal("%s::TIEHASH returned %d elements instead of 1",
THIS->ixhash, count);
sv = POPs;
PUTBACK;
hv_magic(hv, (GV *)sv, PERL_MAGIC_tied);
FREETMPS;
LEAVE;
return hv;
}
void handle_string_list(pTHX_ const char *option, LinkedList list, SV *sv, SV **rval)
{
const char *str;
if (sv)
{
LL_flush(list, (LLDestroyFunc) string_delete);
if (SvROK(sv))
{
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVAV)
{
AV *av = (AV *) sv;
SV **pSV;
int i, max = av_len(av);
for (i = 0; i <= max; i++)
{
if ((pSV = av_fetch(av, i, 0)) != NULL)
{
SvGETMAGIC(*pSV);
LL_push(list, string_new_fromSV(aTHX_ *pSV));
}
else
fatal("NULL returned by av_fetch() in handle_string_list()");
}
}
else
Perl_croak(aTHX_ "%s wants an array reference", option);
}
else
Perl_croak(aTHX_ "%s wants a reference to an array of strings", option);
}
if (rval)
{
ListIterator li;
AV *av = newAV();
LL_foreach(str, li, list)
av_push(av, newSVpv(CONST_CHAR(str), 0));
*rval = newRV_noinc((SV *) av);
}
}
void add_indent(pTHX_ SV *s, int level)
{
#define MAXINDENT 16
static const char tab[MAXINDENT] = "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t";
#ifndef CBC_DONT_CLAMP_TO_MAXINDENT
if (level > MAXINDENT)
level = MAXINDENT;
#else
while (level > MAXINDENT)
{
sv_catpvn( s, tab, MAXINDENT );
level -= MAXINDENT;
}
#endif
sv_catpvn(s, CONST_CHAR(tab), level);
#undef MAXINDENT
}
void handle_option(pTHX_ CBC *THIS, SV *opt, SV *sv_val, SV **rval, HandleOptionResult *p_res)
{
START_OPTIONS
FLAG_OPTION(OrderMembers, order_members, 0, 0)
FLAG_OPTION(Warnings, cfg.issue_warnings, 0, 0)
FLAG_OPTION(HasCPPComments, cfg.has_cpp_comments, 0, 1)
FLAG_OPTION(HasMacroVAARGS, cfg.has_macro_vaargs, 0, 1)
FLAG_OPTION(UnsignedChars, cfg.unsigned_chars, 0, 0)
FLAG_OPTION(UnsignedBitfields, cfg.unsigned_bitfields, 0, 0)
IVAL_OPTION(PointerSize, cfg.layout.ptr_size, 1, 0)
IVAL_OPTION(EnumSize, cfg.layout.enum_size, 1, 0)
IVAL_OPTION(IntSize, cfg.layout.int_size, 1, 0)
IVAL_OPTION(CharSize, cfg.layout.char_size, 1, 0)
IVAL_OPTION(ShortSize, cfg.layout.short_size, 1, 0)
IVAL_OPTION(LongSize, cfg.layout.long_size, 1, 0)
IVAL_OPTION(LongLongSize, cfg.layout.long_long_size, 1, 0)
IVAL_OPTION(FloatSize, cfg.layout.float_size, 1, 0)
IVAL_OPTION(DoubleSize, cfg.layout.double_size, 1, 0)
IVAL_OPTION(LongDoubleSize, cfg.layout.long_double_size, 1, 0)
IVAL_OPTION(Alignment, cfg.layout.alignment, 1, 0)
IVAL_OPTION(CompoundAlignment, cfg.layout.compound_alignment, 1, 0)
TRISTATE_FLAG_OPTION(HostedC, cfg.has_std_c_hosted, cfg.is_std_c_hosted, 0, 1)
TRISTATE_INT_OPTION(StdCVersion, cfg.has_std_c, cfg.std_c_version, 0, 1)
STRLIST_OPTION(Include, cfg.includes, 0, 1)
STRLIST_OPTION(Define, cfg.defines, 0, 1)
STRLIST_OPTION(Assert, cfg.assertions, 0, 1)
OPTION(DisabledKeywords)
IMPACTS_LAYOUT(0);
disabled_keywords(aTHX_ &THIS->cfg.disabled_keywords, sv_val, rval,
&THIS->cfg.keywords);
DID_CHANGE(sv_val != NULL);
ENDOPT
OPTION(KeywordMap)
IMPACTS_LAYOUT(0);
keyword_map(aTHX_ &THIS->cfg.keyword_map, sv_val, rval);
DID_CHANGE(sv_val != NULL);
ENDOPT
OPTION(ByteOrder)
IMPACTS_LAYOUT(1);
if (sv_val)
{
const StringOption *pOpt = GET_STR_OPTION(ByteOrder, 0, sv_val);
UPDATE_OPT(cfg.layout.byte_order, pOpt->value);
}
if (rval)
{
const StringOption *pOpt = GET_STR_OPTION(ByteOrder,
THIS->cfg.layout.byte_order, NULL);
*rval = newSVpv(CONST_CHAR(pOpt->string), 0);
}
ENDOPT
OPTION(EnumType)
IMPACTS_LAYOUT(0);
if (sv_val)
{
const StringOption *pOpt = GET_STR_OPTION(EnumType, 0, sv_val);
UPDATE_OPT(enumType, pOpt->value);
}
if (rval)
{
const StringOption *pOpt = GET_STR_OPTION(EnumType, THIS->enumType, NULL);
*rval = newSVpv(CONST_CHAR(pOpt->string), 0);
}
ENDOPT
OPTION(Bitfields)
IMPACTS_LAYOUT(1);
bitfields_option(aTHX_ &THIS->cfg.layout.bflayouter, sv_val, rval);
DID_CHANGE(sv_val != NULL);
ENDOPT
INVALID_OPTION
POST_PROCESS
OPTION(OrderMembers)
if (sv_val && THIS->order_members && THIS->ixhash == NULL)
load_indexed_hash_module(aTHX_ THIS);
ENDOPT
END_OPTIONS
}
static void keyword_map(pTHX_ HashTable *current, SV *sv, SV **rval)
{
HashTable keyword_map = NULL;
if(sv)
{
if (SvROK(sv))
{
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVHV)
{
HV *hv = (HV *) sv;
HE *entry;
keyword_map = HT_new_ex(4, HT_AUTOGROW);
(void) hv_iterinit(hv);
while ((entry = hv_iternext(hv)) != NULL)
{
SV *value;
I32 keylen;
const char *key, *c;
const CKeywordToken *pTok;
c = key = hv_iterkey(entry, &keylen);
if (*c == '\0')
FAIL_CLEAN((aTHX_ "Cannot use empty string as a keyword"));
while (*c == '_' || isALPHA(*c))
c++;
if (*c != '\0')
FAIL_CLEAN((aTHX_ "Cannot use '%s' as a keyword", key));
value = hv_iterval(hv, entry);
if (!SvOK(value))
pTok = get_skip_token();
else
{
const char *map;
if (SvROK(value))
FAIL_CLEAN((aTHX_ "Cannot use a reference as a keyword"));
map = SvPV_nolen(value);
if ((pTok = get_c_keyword_token(map)) == NULL)
FAIL_CLEAN((aTHX_ "Cannot use '%s' as a keyword", map));
}
(void) HT_store(keyword_map, key, (int) keylen, 0,
(CKeywordToken *) pTok);
}
if (current != NULL)
{
HT_destroy(*current, NULL);
*current = keyword_map;
}
}
else
Perl_croak(aTHX_ "KeywordMap wants a hash reference");
}
else
Perl_croak(aTHX_ "KeywordMap wants a hash reference");
}
if (rval)
{
HashIterator hi;
HV *hv = newHV();
CKeywordToken *tok;
const char *key;
int keylen;
HI_init(&hi, *current);
while (HI_next(&hi, &key, &keylen, (void **) &tok))
{
SV *val;
val = tok->name == NULL ? newSV(0) : newSVpv(CONST_CHAR(tok->name), 0);
if (hv_store(hv, key, keylen, val, 0) == NULL)
SvREFCNT_dec(val);
}
*rval = newRV_noinc((SV *) hv);
}
}
static void disabled_keywords(pTHX_ LinkedList *current, SV *sv, SV **rval,
u_32 *pKeywordMask)
{
const char *str;
LinkedList keyword_list = NULL;
if (sv)
{
if (SvROK(sv))
{
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVAV)
{
AV *av = (AV *) sv;
SV **pSV;
int i, max = av_len(av);
u_32 keywords = HAS_ALL_KEYWORDS;
keyword_list = LL_new();
for (i = 0; i <= max; i++)
{
if ((pSV = av_fetch(av, i, 0)) != NULL)
{
SvGETMAGIC(*pSV);
str = SvPV_nolen(*pSV);
#include "token/t_keywords.c"
success:
LL_push(keyword_list, string_new(str));
}
else
fatal("NULL returned by av_fetch() in disabled_keywords()");
}
if (pKeywordMask != NULL)
*pKeywordMask = keywords;
if (current != NULL)
{
LL_destroy(*current, (LLDestroyFunc) string_delete);
*current = keyword_list;
}
}
else
Perl_croak(aTHX_ "DisabledKeywords wants an array reference");
}
else
Perl_croak(aTHX_ "DisabledKeywords wants a reference to "
"an array of strings");
}
if (rval)
{
ListIterator li;
AV *av = newAV();
LL_foreach (str, li, *current)
av_push(av, newSVpv(CONST_CHAR(str), 0));
*rval = newRV_noinc((SV *) av);
}
return;
unknown:
LL_destroy(keyword_list, (LLDestroyFunc) string_delete);
Perl_croak(aTHX_ "Cannot disable unknown keyword '%s'", str);
}
SV *single_hook_call(pTHX_ SV *self, const char *hook_id_str, const char *id_pre,
const char *id, const SingleHook *hook, SV *in, int mortal)
{
dSP;
int count;
SV *out;
CT_DEBUG(MAIN, ("single_hook_call(hid='%s', id='%s%s', hook=%p, in=%p(%d), mortal=%d)",
hook_id_str, id_pre, id, hook, in, in ? (int) SvREFCNT(in) : 0, mortal));
assert(self != NULL);
assert(hook != NULL);
if (hook->sub == NULL)
return in;
ENTER;
SAVETMPS;
PUSHMARK(SP);
if (hook->arg)
{
I32 ix, len;
len = av_len(hook->arg);
for (ix = 0; ix <= len; ++ix)
{
SV **pSV = av_fetch(hook->arg, ix, 0);
SV *sv;
if (pSV == NULL)
fatal("NULL returned by av_fetch() in single_hook_call()");
if (SvROK(*pSV) && sv_isa(*pSV, ARGTYPE_PACKAGE))
{
HookArgType type = (HookArgType) SvIV(SvRV(*pSV));
switch (type)
{
case HOOK_ARG_SELF:
sv = sv_mortalcopy(self);
break;
case HOOK_ARG_DATA:
assert(in != NULL);
sv = sv_mortalcopy(in);
break;
case HOOK_ARG_TYPE:
assert(id != NULL);
sv = sv_newmortal();
if (id_pre)
{
sv_setpv(sv, id_pre);
sv_catpv(sv, CONST_CHAR(id));
}
else
sv_setpv(sv, id);
break;
case HOOK_ARG_HOOK:
if (hook_id_str)
{
sv = sv_newmortal();
sv_setpv(sv, hook_id_str);
}
else
{
sv = &PL_sv_undef;
}
break;
default:
fatal("Invalid hook argument type (%d) in single_hook_call()", type);
break;
}
}
else
sv = sv_mortalcopy(*pSV);
XPUSHs(sv);
}
}
else
{
if (in)
{
/* only push the data argument */
XPUSHs(in);
}
}
PUTBACK;
count = call_sv(hook->sub, G_SCALAR);
SPAGAIN;
if (count != 1)
fatal("Hook returned %d elements instead of 1", count);
out = POPs;
CT_DEBUG(MAIN, ("single_hook_call: in=%p(%d), out=%p(%d)",
in, in ? (int) SvREFCNT(in) : 0, out, (int) SvREFCNT(out)));
if (!mortal && in != NULL)
SvREFCNT_dec(in);
SvREFCNT_inc(out);
PUTBACK;
FREETMPS;
LEAVE;
if (mortal)
sv_2mortal(out);
CT_DEBUG(MAIN, ("single_hook_call: out=%p(%d)", out, (int) SvREFCNT(out)));
return out;
}
static int load_indexed_hash_module_ex(pTHX_ CBC *THIS, const char **modlist, int num)
{
const char *p = NULL;
int i;
if (THIS->ixhash != NULL)
{
/* a module has already been loaded */
return 1;
}
for (i = 0; i < num; i++)
{
if (modlist[i])
{
SV *sv = newSVpvn("require ", 8);
sv_catpv(sv, CONST_CHAR(modlist[i]));
CT_DEBUG(MAIN, ("trying to require \"%s\"", modlist[i]));
(void) eval_sv(sv, G_DISCARD);
SvREFCNT_dec(sv);
if ((sv = get_sv("@", 0)) != NULL && strEQ(SvPV_nolen(sv), ""))
{
p = modlist[i];
break;
}
if (i == 0)
{
Perl_warn(aTHX_ "Couldn't load %s for member ordering, "
"trying default modules", modlist[i]);
}
CT_DEBUG(MAIN, ("failed: \"%s\"", sv ? SvPV_nolen(sv) : "[NULL]"));
}
}
if (p == NULL)
{
SV *sv = newSVpvn("", 0);
for (i = 1; i < num; i++)
{
if (i > 1)
{
if (i == num-1)
sv_catpvn(sv, " or ", 4);
else
sv_catpvn(sv, ", ", 2);
}
sv_catpv(sv, CONST_CHAR(modlist[i]));
}
Perl_warn(aTHX_ "Couldn't load a module for member ordering "
"(consider installing %s)", SvPV_nolen(sv));
return 0;
}
CT_DEBUG(MAIN, ("using \"%s\" for member ordering", p));
THIS->ixhash = p;
return 1;
}
