#include "EXTERN.h"
#include "perl.h"
+/* XXX Configure test needed */
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#endif
else
setlocale_failure = TRUE;
}
- if (!setlocale_failure)
-#endif /* LC_ALL */
- {
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE,
- (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
+ if (! (curctype =
+ setlocale(LC_CTYPE,
+ (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE,
- (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
+ if (! (curcoll =
+ setlocale(LC_COLLATE,
+ (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC,
- (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
+ if (! (curnum =
+ setlocale(LC_NUMERIC,
+ (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
}
-#else /* !LOCALE_ENVIRON_REQUIRED */
+#endif /* LC_ALL */
+
+#endif /* !LOCALE_ENVIRON_REQUIRED */
#ifdef LC_ALL
-
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
- else {
-#ifdef USE_LOCALE_CTYPE
- curctype = setlocale(LC_CTYPE, Nullch);
-#endif /* USE_LOCALE_CTYPE */
-#ifdef USE_LOCALE_COLLATE
- curcoll = setlocale(LC_COLLATE, Nullch);
-#endif /* USE_LOCALE_COLLATE */
-#ifdef USE_LOCALE_NUMERIC
- curnum = setlocale(LC_NUMERIC, Nullch);
-#endif /* USE_LOCALE_NUMERIC */
- }
-
-#else /* !LC_ALL */
+#endif /* LC_ALL */
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE, "")))
- setlocale_failure = TRUE;
+ if (! (curctype = setlocale(LC_CTYPE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE, "")))
- setlocale_failure = TRUE;
+ if (! (curcoll = setlocale(LC_COLLATE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC, "")))
- setlocale_failure = TRUE;
+ if (! (curnum = setlocale(LC_NUMERIC, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
-
-#endif /* LC_ALL */
-
-#endif /* !LOCALE_ENVIRON_REQUIRED */
+ }
if (setlocale_failure) {
char *p;
U32 frequency = 256;
s = (U8*)SvPV_force(sv, len);
- sv_upgrade(sv, SVt_PVBM);
+ (void)SvUPGRADE(sv, SVt_PVBM);
if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */
return; /* can't have offsets that big */
if (len > 2) {
STATIC SV *
mess_alloc(void)
{
+ dTHR;
SV *sv;
XPVMG *any;
+ if (!PL_dirty)
+ return sv_2mortal(newSVpvn("",0));
+
+ if (PL_mess_sv)
+ return PL_mess_sv;
+
/* Create as PVMG now, to avoid any upgrading later */
New(905, sv, 1, SV);
Newz(905, any, 1, XPVMG);
SvFLAGS(sv) = SVt_PVMG;
SvANY(sv) = (void*)any;
SvREFCNT(sv) = 1 << 30; /* practically infinite */
+ PL_mess_sv = sv;
return sv;
}
char *
form(const char* pat, ...)
{
+ SV *sv = mess_alloc();
va_list args;
va_start(args, pat);
- if (!PL_mess_sv)
- PL_mess_sv = mess_alloc();
- sv_vsetpvfn(PL_mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
- return SvPVX(PL_mess_sv);
+ return SvPVX(sv);
}
char *
mess(const char *pat, va_list *args)
{
- SV *sv;
+ SV *sv = mess_alloc();
static char dgd[] = " during global destruction.\n";
- if (!PL_mess_sv)
- PL_mess_sv = mess_alloc();
- sv = PL_mess_sv;
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
dTHR;
{
return PL_specialsv_list;
}
+
+
+MGVTBL*
+get_vtbl(int vtbl_id)
+{
+ MGVTBL* result = Null(MGVTBL*);
+
+ switch(vtbl_id) {
+ case want_vtbl_sv:
+ result = &PL_vtbl_sv;
+ break;
+ case want_vtbl_env:
+ result = &PL_vtbl_env;
+ break;
+ case want_vtbl_envelem:
+ result = &PL_vtbl_envelem;
+ break;
+ case want_vtbl_sig:
+ result = &PL_vtbl_sig;
+ break;
+ case want_vtbl_sigelem:
+ result = &PL_vtbl_sigelem;
+ break;
+ case want_vtbl_pack:
+ result = &PL_vtbl_pack;
+ break;
+ case want_vtbl_packelem:
+ result = &PL_vtbl_packelem;
+ break;
+ case want_vtbl_dbline:
+ result = &PL_vtbl_dbline;
+ break;
+ case want_vtbl_isa:
+ result = &PL_vtbl_isa;
+ break;
+ case want_vtbl_isaelem:
+ result = &PL_vtbl_isaelem;
+ break;
+ case want_vtbl_arylen:
+ result = &PL_vtbl_arylen;
+ break;
+ case want_vtbl_glob:
+ result = &PL_vtbl_glob;
+ break;
+ case want_vtbl_mglob:
+ result = &PL_vtbl_mglob;
+ break;
+ case want_vtbl_nkeys:
+ result = &PL_vtbl_nkeys;
+ break;
+ case want_vtbl_taint:
+ result = &PL_vtbl_taint;
+ break;
+ case want_vtbl_substr:
+ result = &PL_vtbl_substr;
+ break;
+ case want_vtbl_vec:
+ result = &PL_vtbl_vec;
+ break;
+ case want_vtbl_pos:
+ result = &PL_vtbl_pos;
+ break;
+ case want_vtbl_bm:
+ result = &PL_vtbl_bm;
+ break;
+ case want_vtbl_fm:
+ result = &PL_vtbl_fm;
+ break;
+ case want_vtbl_uvar:
+ result = &PL_vtbl_uvar;
+ break;
+#ifdef USE_THREADS
+ case want_vtbl_mutex:
+ result = &PL_vtbl_mutex;
+ break;
+#endif
+ case want_vtbl_defelem:
+ result = &PL_vtbl_defelem;
+ break;
+ case want_vtbl_regexp:
+ result = &PL_vtbl_regexp;
+ break;
+ case want_vtbl_regdata:
+ result = &PL_vtbl_regdata;
+ break;
+ case want_vtbl_regdatum:
+ result = &PL_vtbl_regdatum;
+ break;
+ case want_vtbl_collxfrm:
+ result = &PL_vtbl_collxfrm;
+ break;
+ case want_vtbl_amagic:
+ result = &PL_vtbl_amagic;
+ break;
+ case want_vtbl_amagicelem:
+ result = &PL_vtbl_amagicelem;
+ break;
+ }
+ return result;
+}
+
projects / p5sagit/p5-mst-13.2.git / blobdiff