X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/424a8fe95d507998fe8750793da1b35bd6d7074b..e8347627432a616ec1485de221b2cd8c9e311c8b:/perlapi.c diff --git a/perlapi.c b/perlapi.c old mode 100755 new mode 100644 index 1945146..3f52e8f --- a/perlapi.c +++ b/perlapi.c @@ -17,9 +17,9 @@ START_EXTERN_C #undef PERLVARI #undef PERLVARIC #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v, const t) @@ -39,8 +39,20 @@ START_EXTERN_C #undef PERLVARI #undef PERLVARIC +#if defined(PERL_IMPLICIT_SYS) +#else +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#endif #if defined(PERL_OBJECT) #endif +#if defined(PERL_OBJECT) +#else +#endif #undef Perl_amagic_call SV* @@ -314,7 +326,7 @@ Perl_convert(pTHXo_ I32 optype, I32 flags, OP* o) #undef Perl_croak void -Perl_croak(pTHXo_ const char* pat) +Perl_croak(pTHXo_ const char* pat, ...) { va_list args; va_start(args, pat); @@ -332,7 +344,7 @@ Perl_vcroak(pTHXo_ const char* pat, va_list* args) #undef Perl_croak_nocontext void -Perl_croak_nocontext(const char* pat) +Perl_croak_nocontext(const char* pat, ...) { dTHXo; va_list args; @@ -343,7 +355,7 @@ Perl_croak_nocontext(const char* pat) #undef Perl_die_nocontext OP* -Perl_die_nocontext(const char* pat) +Perl_die_nocontext(const char* pat, ...) { dTHXo; OP* retval; @@ -357,7 +369,7 @@ Perl_die_nocontext(const char* pat) #undef Perl_deb_nocontext void -Perl_deb_nocontext(const char* pat) +Perl_deb_nocontext(const char* pat, ...) { dTHXo; va_list args; @@ -368,7 +380,7 @@ Perl_deb_nocontext(const char* pat) #undef Perl_form_nocontext char* -Perl_form_nocontext(const char* pat) +Perl_form_nocontext(const char* pat, ...) { dTHXo; char* retval; @@ -380,9 +392,23 @@ Perl_form_nocontext(const char* pat) } +#undef Perl_mess_nocontext +SV* +Perl_mess_nocontext(const char* pat, ...) +{ + dTHXo; + SV* retval; + va_list args; + va_start(args, pat); + retval = ((CPerlObj*)pPerl)->Perl_vmess(pat, &args); + va_end(args); + return retval; + +} + #undef Perl_warn_nocontext void -Perl_warn_nocontext(const char* pat) +Perl_warn_nocontext(const char* pat, ...) { dTHXo; va_list args; @@ -393,7 +419,7 @@ Perl_warn_nocontext(const char* pat) #undef Perl_warner_nocontext void -Perl_warner_nocontext(U32 err, const char* pat) +Perl_warner_nocontext(U32 err, const char* pat, ...) { dTHXo; va_list args; @@ -404,7 +430,7 @@ Perl_warner_nocontext(U32 err, const char* pat) #undef Perl_newSVpvf_nocontext SV* -Perl_newSVpvf_nocontext(const char* pat) +Perl_newSVpvf_nocontext(const char* pat, ...) { dTHXo; SV* retval; @@ -418,7 +444,7 @@ Perl_newSVpvf_nocontext(const char* pat) #undef Perl_sv_catpvf_nocontext void -Perl_sv_catpvf_nocontext(SV* sv, const char* pat) +Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...) { dTHXo; va_list args; @@ -429,7 +455,7 @@ Perl_sv_catpvf_nocontext(SV* sv, const char* pat) #undef Perl_sv_setpvf_nocontext void -Perl_sv_setpvf_nocontext(SV* sv, const char* pat) +Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...) { dTHXo; va_list args; @@ -440,7 +466,7 @@ Perl_sv_setpvf_nocontext(SV* sv, const char* pat) #undef Perl_sv_catpvf_mg_nocontext void -Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat) +Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...) { dTHXo; va_list args; @@ -451,7 +477,7 @@ Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat) #undef Perl_sv_setpvf_mg_nocontext void -Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat) +Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...) { dTHXo; va_list args; @@ -570,7 +596,7 @@ Perl_cxinc(pTHXo) #undef Perl_deb void -Perl_deb(pTHXo_ const char* pat) +Perl_deb(pTHXo_ const char* pat, ...) { va_list args; va_start(args, pat); @@ -585,13 +611,6 @@ Perl_vdeb(pTHXo_ const char* pat, va_list* args) ((CPerlObj*)pPerl)->Perl_vdeb(pat, args); } -#undef Perl_deb_growlevel -void -Perl_deb_growlevel(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_deb_growlevel(); -} - #undef Perl_debprofdump void Perl_debprofdump(pTHXo) @@ -636,7 +655,7 @@ Perl_deprecate(pTHXo_ char* s) #undef Perl_die OP* -Perl_die(pTHXo_ const char* pat) +Perl_die(pTHXo_ const char* pat, ...) { OP* retval; va_list args; @@ -1014,7 +1033,7 @@ Perl_fold_constants(pTHXo_ OP* arg) #undef Perl_form char* -Perl_form(pTHXo_ const char* pat) +Perl_form(pTHXo_ const char* pat, ...) { char* retval; va_list args; @@ -2143,16 +2162,6 @@ Perl_magicname(pTHXo_ char* sym, char* name, I32 namlen) { ((CPerlObj*)pPerl)->Perl_magicname(sym, name, namlen); } -#if defined(MYMALLOC) - -#undef Perl_malloced_size -MEM_SIZE -Perl_malloced_size(void *p) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_malloced_size(p); -} -#endif #undef Perl_markstack_grow void @@ -2172,9 +2181,29 @@ Perl_mem_collxfrm(pTHXo_ const char* s, STRLEN len, STRLEN* xlen) #undef Perl_mess SV* -Perl_mess(pTHXo_ const char* pat, va_list* args) +Perl_mess(pTHXo_ const char* pat, ...) +{ + SV* retval; + va_list args; + va_start(args, pat); + retval = ((CPerlObj*)pPerl)->Perl_vmess(pat, &args); + va_end(args); + return retval; + +} + +#undef Perl_vmess +SV* +Perl_vmess(pTHXo_ const char* pat, va_list* args) { - return ((CPerlObj*)pPerl)->Perl_mess(pat, args); + return ((CPerlObj*)pPerl)->Perl_vmess(pat, args); +} + +#undef Perl_qerror +void +Perl_qerror(pTHXo_ SV* err) +{ + ((CPerlObj*)pPerl)->Perl_qerror(err); } #undef Perl_mg_clear @@ -2609,6 +2638,13 @@ Perl_newLISTOP(pTHXo_ I32 type, I32 flags, OP* first, OP* last) return ((CPerlObj*)pPerl)->Perl_newLISTOP(type, flags, first, last); } +#undef Perl_newPADOP +OP* +Perl_newPADOP(pTHXo_ I32 type, I32 flags, SV* sv) +{ + return ((CPerlObj*)pPerl)->Perl_newPADOP(type, flags, sv); +} + #undef Perl_newPMOP OP* Perl_newPMOP(pTHXo_ I32 type, I32 flags) @@ -2688,7 +2724,7 @@ Perl_newSVpvn(pTHXo_ const char* s, STRLEN len) #undef Perl_newSVpvf SV* -Perl_newSVpvf(pTHXo_ const char* pat) +Perl_newSVpvf(pTHXo_ const char* pat, ...) { SV* retval; va_list args; @@ -2853,15 +2889,42 @@ Perl_peep(pTHXo_ OP* o) ((CPerlObj*)pPerl)->Perl_peep(o); } #if defined(PERL_OBJECT) -#else -#undef perl_alloc -PerlInterpreter* -perl_alloc() +#undef Perl_construct +void +Perl_construct(pTHXo) { - dTHXo; - return ((CPerlObj*)pPerl)->perl_alloc(); + ((CPerlObj*)pPerl)->Perl_construct(); +} + +#undef Perl_destruct +void +Perl_destruct(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_destruct(); +} + +#undef Perl_free +void +Perl_free(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_free(); +} + +#undef Perl_run +int +Perl_run(pTHXo) +{ + return ((CPerlObj*)pPerl)->Perl_run(); +} + +#undef Perl_parse +int +Perl_parse(pTHXo_ XSINIT_t xsinit, int argc, char** argv, char** env) +{ + return ((CPerlObj*)pPerl)->Perl_parse(xsinit, argc, argv, env); } +#endif #if defined(USE_THREADS) #undef Perl_new_struct_thread @@ -2871,7 +2934,6 @@ Perl_new_struct_thread(pTHXo_ struct perl_thread *t) return ((CPerlObj*)pPerl)->Perl_new_struct_thread(t); } #endif -#endif #undef Perl_call_atexit void @@ -3290,11 +3352,18 @@ Perl_save_delete(pTHXo_ HV* hv, char* key, I32 klen) #undef Perl_save_destructor void -Perl_save_destructor(pTHXo_ DESTRUCTORFUNC_t f, void* p) +Perl_save_destructor(pTHXo_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { ((CPerlObj*)pPerl)->Perl_save_destructor(f, p); } +#undef Perl_save_destructor_x +void +Perl_save_destructor_x(pTHXo_ DESTRUCTORFUNC_t f, void* p) +{ + ((CPerlObj*)pPerl)->Perl_save_destructor_x(f, p); +} + #undef Perl_save_freesv void Perl_save_freesv(pTHXo_ SV* sv) @@ -3372,6 +3441,13 @@ Perl_save_I32(pTHXo_ I32* intp) ((CPerlObj*)pPerl)->Perl_save_I32(intp); } +#undef Perl_save_I8 +void +Perl_save_I8(pTHXo_ I8* bytep) +{ + ((CPerlObj*)pPerl)->Perl_save_I8(bytep); +} + #undef Perl_save_int void Perl_save_int(pTHXo_ int* intp) @@ -3435,6 +3511,13 @@ Perl_save_pptr(pTHXo_ char** pptr) ((CPerlObj*)pPerl)->Perl_save_pptr(pptr); } +#undef Perl_save_vptr +void +Perl_save_vptr(pTHXo_ void* pptr) +{ + ((CPerlObj*)pPerl)->Perl_save_vptr(pptr); +} + #undef Perl_save_re_context void Perl_save_re_context(pTHXo) @@ -3713,7 +3796,7 @@ Perl_sv_bless(pTHXo_ SV* sv, HV* stash) #undef Perl_sv_catpvf void -Perl_sv_catpvf(pTHXo_ SV* sv, const char* pat) +Perl_sv_catpvf(pTHXo_ SV* sv, const char* pat, ...) { va_list args; va_start(args, pat); @@ -3991,7 +4074,7 @@ Perl_sv_reset(pTHXo_ char* s, HV* stash) #undef Perl_sv_setpvf void -Perl_sv_setpvf(pTHXo_ SV* sv, const char* pat) +Perl_sv_setpvf(pTHXo_ SV* sv, const char* pat, ...) { va_list args; va_start(args, pat); @@ -4134,16 +4217,16 @@ Perl_sv_usepvn(pTHXo_ SV* sv, char* ptr, STRLEN len) #undef Perl_sv_vcatpvfn void -Perl_sv_vcatpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale) +Perl_sv_vcatpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted) { - ((CPerlObj*)pPerl)->Perl_sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale); + ((CPerlObj*)pPerl)->Perl_sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted); } #undef Perl_sv_vsetpvfn void -Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale) +Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted) { - ((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale); + ((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted); } #undef Perl_swash_init @@ -4169,7 +4252,7 @@ Perl_taint_env(pTHXo) #undef Perl_taint_proper void -Perl_taint_proper(pTHXo_ const char* f, char* s) +Perl_taint_proper(pTHXo_ const char* f, const char* s) { ((CPerlObj*)pPerl)->Perl_taint_proper(f, s); } @@ -4297,9 +4380,16 @@ Perl_wait4pid(pTHXo_ Pid_t pid, int* statusp, int flags) return ((CPerlObj*)pPerl)->Perl_wait4pid(pid, statusp, flags); } +#undef Perl_report_uninit +void +Perl_report_uninit(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_report_uninit(); +} + #undef Perl_warn void -Perl_warn(pTHXo_ const char* pat) +Perl_warn(pTHXo_ const char* pat, ...) { va_list args; va_start(args, pat); @@ -4316,7 +4406,7 @@ Perl_vwarn(pTHXo_ const char* pat, va_list* args) #undef Perl_warner void -Perl_warner(pTHXo_ U32 err, const char* pat) +Perl_warner(pTHXo_ U32 err, const char* pat, ...) { va_list args; va_start(args, pat); @@ -4390,38 +4480,6 @@ Perl_dump_mstats(pTHXo_ char* s) { ((CPerlObj*)pPerl)->Perl_dump_mstats(s); } - -#undef Perl_malloc -Malloc_t -Perl_malloc(MEM_SIZE nbytes) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_malloc(nbytes); -} - -#undef Perl_calloc -Malloc_t -Perl_calloc(MEM_SIZE elements, MEM_SIZE size) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_calloc(elements, size); -} - -#undef Perl_realloc -Malloc_t -Perl_realloc(Malloc_t where, MEM_SIZE nbytes) -{ - dTHXo; - return ((CPerlObj*)pPerl)->Perl_realloc(where, nbytes); -} - -#undef Perl_mfree -Free_t -Perl_mfree(Malloc_t where) -{ - dTHXo; - ((CPerlObj*)pPerl)->Perl_mfree(where); -} #endif #undef Perl_safesysmalloc @@ -4515,7 +4573,7 @@ Perl_runops_debug(pTHXo) #undef Perl_sv_catpvf_mg void -Perl_sv_catpvf_mg(pTHXo_ SV *sv, const char* pat) +Perl_sv_catpvf_mg(pTHXo_ SV *sv, const char* pat, ...) { va_list args; va_start(args, pat); @@ -4553,7 +4611,7 @@ Perl_sv_catsv_mg(pTHXo_ SV *dstr, SV *sstr) #undef Perl_sv_setpvf_mg void -Perl_sv_setpvf_mg(pTHXo_ SV *sv, const char* pat) +Perl_sv_setpvf_mg(pTHXo_ SV *sv, const char* pat, ...) { va_list args; va_start(args, pat); @@ -4640,7 +4698,7 @@ Perl_pv_display(pTHXo_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) #undef Perl_dump_indent void -Perl_dump_indent(pTHXo_ I32 level, PerlIO *file, const char* pat) +Perl_dump_indent(pTHXo_ I32 level, PerlIO *file, const char* pat, ...) { va_list args; va_start(args, pat); @@ -4713,12 +4771,12 @@ Perl_magic_dump(pTHXo_ MAGIC *mg) #undef Perl_default_protect void* -Perl_default_protect(pTHXo_ int *excpt, protect_body_t body) +Perl_default_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, ...) { void* retval; va_list args; va_start(args, body); - retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, &args); + retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, &args); va_end(args); return retval; @@ -4726,9 +4784,9 @@ Perl_default_protect(pTHXo_ int *excpt, protect_body_t body) #undef Perl_vdefault_protect void* -Perl_vdefault_protect(pTHXo_ int *excpt, protect_body_t body, va_list *args) +Perl_vdefault_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args) { - return ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, args); + return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args); } #undef Perl_reginitcolors @@ -4814,7 +4872,124 @@ Perl_boot_core_xsutils(pTHXo) { ((CPerlObj*)pPerl)->Perl_boot_core_xsutils(); } +#if defined(USE_ITHREADS) + +#undef Perl_cx_dup +PERL_CONTEXT* +Perl_cx_dup(pTHXo_ PERL_CONTEXT* cx, I32 ix, I32 max) +{ + return ((CPerlObj*)pPerl)->Perl_cx_dup(cx, ix, max); +} + +#undef Perl_si_dup +PERL_SI* +Perl_si_dup(pTHXo_ PERL_SI* si) +{ + return ((CPerlObj*)pPerl)->Perl_si_dup(si); +} + +#undef Perl_ss_dup +ANY* +Perl_ss_dup(pTHXo_ PerlInterpreter* proto_perl) +{ + return ((CPerlObj*)pPerl)->Perl_ss_dup(proto_perl); +} + +#undef Perl_any_dup +void* +Perl_any_dup(pTHXo_ void* v, PerlInterpreter* proto_perl) +{ + return ((CPerlObj*)pPerl)->Perl_any_dup(v, proto_perl); +} + +#undef Perl_he_dup +HE* +Perl_he_dup(pTHXo_ HE* e, bool shared) +{ + return ((CPerlObj*)pPerl)->Perl_he_dup(e, shared); +} + +#undef Perl_re_dup +REGEXP* +Perl_re_dup(pTHXo_ REGEXP* r) +{ + return ((CPerlObj*)pPerl)->Perl_re_dup(r); +} + +#undef Perl_fp_dup +PerlIO* +Perl_fp_dup(pTHXo_ PerlIO* fp, char type) +{ + return ((CPerlObj*)pPerl)->Perl_fp_dup(fp, type); +} + +#undef Perl_dirp_dup +DIR* +Perl_dirp_dup(pTHXo_ DIR* dp) +{ + return ((CPerlObj*)pPerl)->Perl_dirp_dup(dp); +} + +#undef Perl_gp_dup +GP* +Perl_gp_dup(pTHXo_ GP* gp) +{ + return ((CPerlObj*)pPerl)->Perl_gp_dup(gp); +} + +#undef Perl_mg_dup +MAGIC* +Perl_mg_dup(pTHXo_ MAGIC* mg) +{ + return ((CPerlObj*)pPerl)->Perl_mg_dup(mg); +} + +#undef Perl_sv_dup +SV* +Perl_sv_dup(pTHXo_ SV* sstr) +{ + return ((CPerlObj*)pPerl)->Perl_sv_dup(sstr); +} +#if defined(HAVE_INTERP_INTERN) + +#undef Perl_sys_intern_dup +void +Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst); +} +#endif + +#undef Perl_ptr_table_new +PTR_TBL_t* +Perl_ptr_table_new(pTHXo) +{ + return ((CPerlObj*)pPerl)->Perl_ptr_table_new(); +} + +#undef Perl_ptr_table_fetch +void* +Perl_ptr_table_fetch(pTHXo_ PTR_TBL_t *tbl, void *sv) +{ + return ((CPerlObj*)pPerl)->Perl_ptr_table_fetch(tbl, sv); +} + +#undef Perl_ptr_table_store +void +Perl_ptr_table_store(pTHXo_ PTR_TBL_t *tbl, void *oldsv, void *newsv) +{ + ((CPerlObj*)pPerl)->Perl_ptr_table_store(tbl, oldsv, newsv); +} + +#undef Perl_ptr_table_split +void +Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl) +{ + ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl); +} +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #endif @@ -4869,12 +5044,12 @@ Perl_boot_core_xsutils(pTHXo) #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) #endif -#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT) -#endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) # if defined(LEAKTEST) # endif #endif +#if defined(PERL_OBJECT) +#endif #undef Perl_ck_anoncode OP * @@ -4981,6 +5156,13 @@ Perl_ck_index(pTHXo_ OP *o) return ((CPerlObj*)pPerl)->Perl_ck_index(o); } +#undef Perl_ck_join +OP * +Perl_ck_join(pTHXo_ OP *o) +{ + return ((CPerlObj*)pPerl)->Perl_ck_join(o); +} + #undef Perl_ck_lengthconst OP * Perl_ck_lengthconst(pTHXo_ OP *o) @@ -6304,6 +6486,13 @@ Perl_pp_leavesub(pTHXo) return ((CPerlObj*)pPerl)->Perl_pp_leavesub(); } +#undef Perl_pp_leavesublv +OP * +Perl_pp_leavesublv(pTHXo) +{ + return ((CPerlObj*)pPerl)->Perl_pp_leavesublv(); +} + #undef Perl_pp_leavetry OP * Perl_pp_leavetry(pTHXo) @@ -7550,7 +7739,7 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) dTHXo; va_list(arglist); va_start(arglist, format); - return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist); + return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist); } END_EXTERN_C