return my_perl;
}
#else
+
+/*
+=for apidoc perl_alloc
+
+Allocates a new Perl interpreter. See L<perlembed>.
+
+=cut
+*/
+
PerlInterpreter *
perl_alloc(void)
{
}
#endif /* PERL_IMPLICIT_SYS */
+/*
+=for apidoc perl_construct
+
+Initializes a new Perl interpreter. See L<perlembed>.
+
+=cut
+*/
+
void
perl_construct(pTHXx)
{
ENTER;
}
+/*
+=for apidoc perl_destruct
+
+Shuts down a Perl interpreter. See L<perlembed>.
+
+=cut
+*/
+
void
perl_destruct(pTHXx)
{
/* startup and shutdown function lists */
SvREFCNT_dec(PL_beginav);
SvREFCNT_dec(PL_endav);
- SvREFCNT_dec(PL_stopav);
+ SvREFCNT_dec(PL_checkav);
SvREFCNT_dec(PL_initav);
PL_beginav = Nullav;
PL_endav = Nullav;
- PL_stopav = Nullav;
+ PL_checkav = Nullav;
PL_initav = Nullav;
/* shortcuts just get cleared */
}
}
+/*
+=for apidoc perl_free
+
+Releases a Perl interpreter. See L<perlembed>.
+
+=cut
+*/
+
void
perl_free(pTHXx)
{
++PL_exitlistlen;
}
+/*
+=for apidoc perl_parse
+
+Tells a Perl interpreter to parse a Perl script. See L<perlembed>.
+
+=cut
+*/
+
int
perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
env, xsinit);
switch (ret) {
case 0:
- if (PL_stopav)
- call_list(oldscope, PL_stopav);
+ if (PL_checkav)
+ call_list(oldscope, PL_checkav);
return 0;
case 1:
STATUS_ALL_FAILURE;
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_stopav)
- call_list(oldscope, PL_stopav);
+ if (PL_checkav)
+ call_list(oldscope, PL_checkav);
return STATUS_NATIVE_EXPORT;
case 3:
PerlIO_printf(Perl_error_log, "panic: top_env\n");
# ifdef USE_THREADS
sv_catpv(PL_Sv," USE_THREADS");
# endif
+# ifdef USE_ITHREADS
+ sv_catpv(PL_Sv," USE_ITHREADS");
+# endif
+# ifdef USE_64_BITS
+ sv_catpv(PL_Sv," USE_64_BITS");
+# endif
+# ifdef USE_LONG_DOUBLE
+ sv_catpv(PL_Sv," USE_LONG_DOUBLE");
+# endif
+# ifdef USE_LARGE_FILES
+ sv_catpv(PL_Sv," USE_LARGE_FILES");
+# endif
+# ifdef USE_SOCKS
+ sv_catpv(PL_Sv," USE_SOCKS");
+# endif
# ifdef PERL_OBJECT
sv_catpv(PL_Sv," PERL_OBJECT");
# endif
return NULL;
}
+/*
+=for apidoc perl_run
+
+Tells a Perl interpreter to run. See L<perlembed>.
+
+=cut
+*/
+
int
perl_run(pTHXx)
{
return NULL;
}
+/*
+=for apidoc p||get_sv
+
+Returns the SV of the specified Perl scalar. If C<create> is set and the
+Perl variable does not exist then it will be created. If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
SV*
Perl_get_sv(pTHX_ const char *name, I32 create)
{
return Nullsv;
}
+/*
+=for apidoc p||get_av
+
+Returns the AV of the specified Perl array. If C<create> is set and the
+Perl variable does not exist then it will be created. If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
AV*
Perl_get_av(pTHX_ const char *name, I32 create)
{
return Nullav;
}
+/*
+=for apidoc p||get_hv
+
+Returns the HV of the specified Perl hash. If C<create> is set and the
+Perl variable does not exist then it will be created. If C<create> is not
+set and the variable does not exist then NULL is returned.
+
+=cut
+*/
+
HV*
Perl_get_hv(pTHX_ const char *name, I32 create)
{
return Nullhv;
}
+/*
+=for apidoc p||get_cv
+
+Returns the CV of the specified Perl subroutine. If C<create> is set and
+the Perl subroutine does not exist then it will be declared (which has the
+same effect as saying C<sub name;>). If C<create> is not set and the
+subroutine does not exist then NULL is returned.
+
+=cut
+*/
+
CV*
Perl_get_cv(pTHX_ const char *name, I32 create)
{
/* Be sure to refetch the stack pointer after calling these routines. */
+/*
+=for apidoc p||call_argv
+
+Performs a callback to the specified Perl sub. See L<perlcall>.
+
+=cut
+*/
+
I32
Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
return call_pv(sub_name, flags);
}
+/*
+=for apidoc p||call_pv
+
+Performs a callback to the specified Perl sub. See L<perlcall>.
+
+=cut
+*/
+
I32
Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
/* name of the subroutine */
return call_sv((SV*)get_cv(sub_name, TRUE), flags);
}
+/*
+=for apidoc p||call_method
+
+Performs a callback to the specified Perl method. The blessed object must
+be on the stack. See L<perlcall>.
+
+=cut
+*/
+
I32
Perl_call_method(pTHX_ const char *methname, I32 flags)
/* name of the subroutine */
}
/* May be called with any of a CV, a GV, or an SV containing the name. */
+/*
+=for apidoc p||call_sv
+
+Performs a callback to the Perl sub whose name is in the SV. See
+L<perlcall>.
+
+=cut
+*/
+
I32
Perl_call_sv(pTHX_ SV *sv, I32 flags)
/* Eval a string. The G_EVAL flag is always assumed. */
+/*
+=for apidoc p||eval_sv
+
+Tells Perl to C<eval> the string in the SV.
+
+=cut
+*/
+
I32
Perl_eval_sv(pTHX_ SV *sv, I32 flags)
return retval;
}
+/*
+=for apidoc p||eval_pv
+
+Tells Perl to C<eval> the given string and return an SV* result.
+
+=cut
+*/
+
SV*
Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
{
/* Require a module. */
+/*
+=for apidoc p||require_pv
+
+Tells Perl to C<require> a module.
+
+=cut
+*/
+
void
Perl_require_pv(pTHX_ const char *pv)
{
-e \"/^#[ ]*undef[ ]/b\" \
-e \"/^#[ ]*endif/b\" \
-e \"s/^#.*//\" \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
(PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
#else
# ifdef __OPEN_VM
-e '/^#[ ]*undef[ ]/b' \
-e '/^#[ ]*endif/b' \
-e 's/^[ ]*#.*//' \
- %s | %_ %_ %s",
+ %s | %"SVf" %"SVf" %s",
# else
Perl_sv_setpvf(aTHX_ cmd, "\
%s %s -e '/^[^#]/b' \
-e '/^#[ ]*undef[ ]/b' \
-e '/^#[ ]*endif/b' \
-e 's/^[ ]*#.*//' \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
# endif
#ifdef LOC_SED
LOC_SED,
for (; argc > 0 && **argv == '-'; argc--,argv++) {
if (!argv[0][1])
break;
- if (argv[0][1] == '-') {
+ if (argv[0][1] == '-' && !argv[0][2]) {
argc--,argv++;
break;
}
SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
- Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir,
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s/"PERL_FS_VER_FMT"/auto", libdir,
ARCHNAME, (int)PERL_REVISION,
(int)PERL_VERSION, (int)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
- Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME);
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s/auto", libdir, ARCHNAME);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
else
Perl_sv_catpvf(aTHX_ atsv,
"%s failed--call queue aborted",
- paramList == PL_stopav ? "STOP"
+ paramList == PL_checkav ? "CHECK"
: paramList == PL_initav ? "INIT"
: "END");
while (PL_scopestack_ix > oldscope)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
else
Perl_croak(aTHX_ "%s failed--call queue aborted",
- paramList == PL_stopav ? "STOP"
+ paramList == PL_checkav ? "CHECK"
: paramList == PL_initav ? "INIT"
: "END");
}
projects / p5sagit/p5-mst-13.2.git / blobdiff