char *getenv (char *); /* Usually in <stdlib.h> */
#endif
-static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
+static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
#ifdef IAMSUID
#ifndef DOSUID
#endif
#endif
-#ifdef PERL_OBJECT
-#define perl_construct Perl_construct
-#define perl_parse Perl_parse
-#define perl_run Perl_run
-#define perl_destruct Perl_destruct
-#define perl_free Perl_free
-#endif
-
-#if defined(USE_THREADS)
+#if defined(USE_5005THREADS)
# define INIT_TLS_AND_INTERP \
STMT_START { \
if (!PL_curinterp) { \
struct IPerlProc* ipP)
{
PerlInterpreter *my_perl;
-#ifdef PERL_OBJECT
- my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
- ipLIO, ipD, ipS, ipP);
- INIT_TLS_AND_INTERP;
-#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
INIT_TLS_AND_INTERP;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
-#endif
return my_perl;
}
void
perl_construct(pTHXx)
{
-#ifdef USE_THREADS
- int i;
+#ifdef USE_5005THREADS
#ifndef FAKE_THREADS
struct perl_thread *thr = NULL;
#endif /* FAKE_THREADS */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
#ifdef MULTIPLICITY
init_interp();
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
MUTEX_INIT(&PL_sv_mutex);
/*
* Safe to use basic SV functions from now on (though
MUTEX_INIT(&PL_fdpid_mutex);
thr = init_main_thread();
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
#ifdef PERL_FLEXIBLE_EXCEPTIONS
PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
}
-#ifdef PERL_OBJECT
- /* TODO: */
- /* PL_sighandlerp = sighandler; */
-#else
PL_sighandlerp = Perl_sighandler;
-#endif
PL_pidstatus = newHV();
#ifdef MSDOS
* space. The other alternative would be to provide STDAUX and STDPRN
* filehandles.
*/
- (void)fclose(stdaux);
- (void)fclose(stdprn);
+ (void)PerlIO_close(PerlIO_importFILE(stdaux, 0));
+ (void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
#endif
}
- PL_nrs = newSVpvn("\n", 1);
- PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_rs = newSVpvn("\n", 1);
init_stacks();
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
PL_errors = newSVpvn("",0);
+#ifdef USE_ITHREADS
+ PL_regex_padav = newAV();
+ av_push(PL_regex_padav,(SV*)newAV()); /* First entry is an array of empty elements */
+ PL_regex_pad = AvARRAY(PL_regex_padav);
+#endif
+#ifdef USE_REENTRANT_API
+ New(31337, PL_reentrant_buffer,1, REBUF);
+ New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+#endif
+
+ /* Note that strtab is a rather special HV. Assumptions are made
+ about not iterating on it, and not adding tie magic to it.
+ It is properly deallocated in perl_destruct() */
+ PL_strtab = newHV();
+
+#ifdef USE_5005THREADS
+ MUTEX_INIT(&PL_strtab_mutex);
+#endif
+ HvSHAREKEYS_off(PL_strtab); /* mandatory */
+ hv_ksplit(PL_strtab, 512);
+
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
+ _dyld_lookup_and_bind
+ ("__environ", (unsigned long *) &environ_pointer, NULL);
+#endif /* environ */
+
+#ifdef USE_ENVIRON_ARRAY
+ PL_origenviron = environ;
+#endif
ENTER;
}
=cut
*/
-void
+int
perl_destruct(pTHXx)
{
- int destruct_level; /* 0=none, 1=full, 2=full with checks */
+ volatile int destruct_level; /* 0=none, 1=full, 2=full with checks */
HV *hv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
Thread t;
dTHX;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
/* wait for all pseudo-forked children to finish */
PERL_WAIT_FOR_CHILDREN;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
#ifndef FAKE_THREADS
/* Pass 1 on any remaining threads: detach joinables, join zombies */
retry_cleanup:
COND_DESTROY(&PL_nthreads_cond);
PL_nthreads--;
#endif /* !defined(FAKE_THREADS) */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
destruct_level = PL_perl_destruct_level;
#ifdef DEBUGGING
}
#endif
+
+ if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+ dJMPENV;
+ int x = 0;
+
+ JMPENV_PUSH(x);
+ if (PL_endav && !PL_minus_c)
+ call_list(PL_scopestack_ix, PL_endav);
+ JMPENV_POP;
+ }
LEAVE;
FREETMPS;
-
/* We must account for everything. */
/* Destroy the main CV and syntax tree */
/* call exit list functions */
while (PL_exitlistlen-- > 0)
- PL_exitlist[PL_exitlistlen].fn(aTHXo_ PL_exitlist[PL_exitlistlen].ptr);
+ PL_exitlist[PL_exitlistlen].fn(aTHX_ PL_exitlist[PL_exitlistlen].ptr);
Safefree(PL_exitlist);
DEBUG_P(debprofdump());
/* The exit() function will do everything that needs doing. */
- return;
+ return STATUS_NATIVE_EXPORT;;
}
/* jettison our possibly duplicated environment */
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
+
/* Must use safesysfree() when working with environ. */
safesysfree(environ);
}
#endif
+#ifdef USE_ITHREADS
+ /* the syntax tree is shared between clones
+ * so op_free(PL_main_root) only ReREFCNT_dec's
+ * REGEXPs in the parent interpreter
+ * we need to manually ReREFCNT_dec for the clones
+ */
+ {
+ I32 i = AvFILLp(PL_regex_padav) + 1;
+ SV **ary = AvARRAY(PL_regex_padav);
+
+ while (i) {
+ SV *resv = ary[--i];
+ REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
+
+ if (SvFLAGS(resv) & SVf_BREAK) {
+ /* this is PL_reg_curpm, already freed
+ * flag is set in regexec.c:S_regtry
+ */
+ SvFLAGS(resv) &= ~SVf_BREAK;
+ }
+ else if(SvREPADTMP(resv)) {
+ SvREPADTMP_off(resv);
+ }
+ else {
+ ReREFCNT_dec(re);
+ }
+ }
+ }
+ SvREFCNT_dec(PL_regex_padav);
+ PL_regex_padav = Nullav;
+ PL_regex_pad = NULL;
+#endif
+
/* loosen bonds of global variables */
if(PL_rsfp) {
PL_e_script = Nullsv;
}
+ while (--PL_origargc >= 0) {
+ Safefree(PL_origargv[PL_origargc]);
+ }
+ Safefree(PL_origargv);
+
/* magical thingies */
SvREFCNT_dec(PL_ofs_sv); /* $, */
SvREFCNT_dec(PL_rs); /* $/ */
PL_rs = Nullsv;
- SvREFCNT_dec(PL_nrs); /* $/ helper */
- PL_nrs = Nullsv;
-
PL_multiline = 0; /* $* */
Safefree(PL_osname); /* $^O */
PL_osname = Nullch;
/* startup and shutdown function lists */
SvREFCNT_dec(PL_beginav);
+ SvREFCNT_dec(PL_beginav_save);
SvREFCNT_dec(PL_endav);
SvREFCNT_dec(PL_checkav);
SvREFCNT_dec(PL_initav);
PL_beginav = Nullav;
+ PL_beginav_save = Nullav;
PL_endav = Nullav;
PL_checkav = Nullav;
PL_initav = Nullav;
SvREFCNT_dec(PL_utf8_xdigit);
SvREFCNT_dec(PL_utf8_mark);
SvREFCNT_dec(PL_utf8_toupper);
+ SvREFCNT_dec(PL_utf8_totitle);
SvREFCNT_dec(PL_utf8_tolower);
PL_utf8_alnum = Nullsv;
PL_utf8_alnumc = Nullsv;
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
DEBUG_P(debprofdump());
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
MUTEX_DESTROY(&PL_strtab_mutex);
MUTEX_DESTROY(&PL_sv_mutex);
MUTEX_DESTROY(&PL_eval_mutex);
Safefree(SvANY(PL_thrsv));
Safefree(PL_thrsv);
PL_thrsv = Nullsv;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
+
+#ifdef USE_REENTRANT_API
+ Safefree(PL_reentrant_buffer->tmbuff);
+ Safefree(PL_reentrant_buffer);
+#endif
sv_free_arenas();
Safefree(PL_mess_sv);
PL_mess_sv = Nullsv;
}
+ return STATUS_NATIVE_EXPORT;
}
/*
void
perl_free(pTHXx)
{
-#if defined(PERL_OBJECT)
- PerlMem_free(this);
-#else
-# if defined(WIN32)
+#if defined(WIN32) || defined(NETWARE)
# if defined(PERL_IMPLICIT_SYS)
+# ifdef NETWARE
+ void *host = nw_internal_host;
+# else
void *host = w32_internal_host;
+# endif
+# ifndef NETWARE
if (PerlProc_lasthost()) {
+# ifdef USE_PERLIO
PerlIO_cleanup();
+# endif
}
+# endif
PerlMem_free(aTHXx);
+# ifdef NETWARE
+ nw5_delete_internal_host(host);
+# else
win32_delete_internal_host(host);
-#else
- PerlIO_cleanup();
- PerlMem_free(aTHXx);
-#endif
+# endif
# else
+# ifdef USE_PERLIO
+ PerlIO_cleanup();
+# endif
PerlMem_free(aTHXx);
# endif
+#else
+ PerlMem_free(aTHXx);
#endif
}
I32 oldscope;
int ret;
dJMPENV;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
dTHX;
#endif
#endif
#endif
-#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
- _dyld_lookup_and_bind
- ("__environ", (unsigned long *) &environ_pointer, NULL);
-#endif /* environ */
-
- PL_origargv = argv;
PL_origargc = argc;
-#ifdef USE_ENVIRON_ARRAY
- PL_origenviron = environ;
-#endif
+ {
+ /* we copy rather than point to argv
+ * since perl_clone will copy and perl_destruct
+ * has no way of knowing if we've made a copy or
+ * just point to argv
+ */
+ int i = PL_origargc;
+ New(0, PL_origargv, i+1, char*);
+ PL_origargv[i] = '\0';
+ while (i-- > 0) {
+ PL_origargv[i] = savepv(argv[i]);
+ }
+ }
+
+
if (PL_do_undump) {
AV* comppadlist;
register SV *sv;
register char *s;
- char *popts, *cddir = Nullch;
+ char *cddir = Nullch;
sv_setpvn(PL_linestr,"",0);
sv = newSVpvn("",0); /* first used for -I flags */
# ifdef MULTIPLICITY
sv_catpv(PL_Sv," MULTIPLICITY");
# endif
-# ifdef USE_THREADS
- sv_catpv(PL_Sv," USE_THREADS");
+# ifdef USE_5005THREADS
+ sv_catpv(PL_Sv," USE_5005THREADS");
# endif
# ifdef USE_ITHREADS
sv_catpv(PL_Sv," USE_ITHREADS");
# ifdef USE_SOCKS
sv_catpv(PL_Sv," USE_SOCKS");
# endif
-# ifdef PERL_OBJECT
- sv_catpv(PL_Sv," PERL_OBJECT");
-# endif
# ifdef PERL_IMPLICIT_CONTEXT
sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
# endif
#endif
sv_catpv(PL_Sv, "; \
$\"=\"\\n \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
+@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+#ifdef __CYGWIN__
+ sv_catpv(PL_Sv,"\
+push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+#endif
+ sv_catpv(PL_Sv, "\
print \" \\%ENV:\\n @env\\n\" if @env; \
print \" \\@INC:\\n @INC\\n\";");
}
#ifndef SECURE_INTERNAL_GETENV
!PL_tainting &&
#endif
- (popts = PerlEnv_getenv("PERL5OPT")))
+ (s = PerlEnv_getenv("PERL5OPT")))
{
- s = savepv(popts);
+ char *popt = s;
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T')
PL_tainting = TRUE;
else {
+ char *popt_copy = Nullch;
while (s && *s) {
char *d;
while (isSPACE(*s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
+ if (!popt_copy) {
+ popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
+ s = popt_copy + (s - popt);
+ d = popt_copy + (d - popt);
+ }
*s++ = '\0';
break;
}
PL_comppad_name_fill = 0;
PL_min_intro_pending = 0;
PL_padix = 0;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
av_store(comppadlist, 1, (SV*)PL_comppad);
CvPADLIST(PL_compcv) = comppadlist;
+ boot_core_PerlIO();
boot_core_UNIVERSAL();
#ifndef PERL_MICRO
boot_core_xsutils();
#endif
if (xsinit)
- (*xsinit)(aTHXo); /* in case linked C routines want magical variables */
+ (*xsinit)(aTHX); /* in case linked C routines want magical variables */
#ifndef PERL_MICRO
#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC)
init_os_extras();
PL_e_script = Nullsv;
}
- /* now that script is parsed, we can modify record separator */
- SvREFCNT_dec(PL_rs);
- PL_rs = SvREFCNT_inc(PL_nrs);
+/*
+ Not sure that this is still the right place to do this now that we
+ no longer use PL_nrs. HVDS 2001/09/09
+*/
sv_setsv(get_sv("/", TRUE), PL_rs);
+
if (PL_do_undump)
my_unexec();
I32 oldscope;
int ret = 0;
dJMPENV;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
dTHX;
#endif
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav && !PL_minus_c)
+ if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
+ PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
#ifdef MYMALLOC
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
if (PL_minus_c) {
#ifdef MACOS_TRADITIONAL
- PerlIO_printf(Perl_error_log, "%s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
+ PerlIO_printf(Perl_error_log, "# %s syntax OK\n", MacPerl_MPWFileName(PL_origfilename));
#else
PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
#endif
Perl_get_sv(pTHX_ const char *name, I32 create)
{
GV *gv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
if (name[1] == '\0' && !isALPHA(name[0])) {
PADOFFSET tmp = find_threadsv(name);
if (tmp != NOT_IN_PAD)
return THREADSV(tmp);
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
gv = gv_fetchpv(name, create, SVt_PV);
if (gv)
return GvSV(gv);
LOGOP myop; /* fake syntax tree node */
UNOP method_op;
I32 oldmark;
- I32 retval;
+ volatile I32 retval = 0;
I32 oldscope;
bool oldcatch = CATCH_GET;
int ret;
{
dSP;
UNOP myop; /* fake syntax tree node */
- I32 oldmark = SP - PL_stack_base;
- I32 retval;
+ volatile I32 oldmark = SP - PL_stack_base;
+ volatile I32 retval = 0;
I32 oldscope;
int ret;
OP* oldop = PL_op;
S_usage(pTHX_ char *name) /* XXX move this out into a module ? */
{
/* This message really ought to be max 23 lines.
- * Removed -h because the user already knows that opton. Others? */
+ * Removed -h because the user already knows that option. Others? */
static char *usage_msg[] = {
"-0[octal] specify record separator (\\0, if no argument)",
switch (*s) {
case '0':
{
- numlen = 0; /* disallow underscores */
- rschar = (U32)scan_oct(s, 4, &numlen);
- SvREFCNT_dec(PL_nrs);
+ I32 flags = 0;
+ numlen = 4;
+ rschar = (U32)grok_oct(s, &numlen, &flags, NULL);
+ SvREFCNT_dec(PL_rs);
if (rschar & ~((U8)~0))
- PL_nrs = &PL_sv_undef;
+ PL_rs = &PL_sv_undef;
else if (!rschar && numlen >= 2)
- PL_nrs = newSVpvn("", 0);
+ PL_rs = newSVpvn("", 0);
else {
char ch = rschar;
- PL_nrs = newSVpvn(&ch, 1);
+ PL_rs = newSVpvn(&ch, 1);
}
return s + numlen;
}
PL_ors_sv = Nullsv;
}
if (isDIGIT(*s)) {
+ I32 flags = 0;
PL_ors_sv = newSVpvn("\n",1);
- numlen = 0; /* disallow underscores */
- *SvPVX(PL_ors_sv) = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
+ numlen = 3 + (*s == '0');
+ *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
s += numlen;
}
else {
- if (RsPARA(PL_nrs)) {
+ if (RsPARA(PL_rs)) {
PL_ors_sv = newSVpvn("\n\n",2);
}
else {
- PL_ors_sv = newSVsv(PL_nrs);
+ PL_ors_sv = newSVsv(PL_rs);
}
}
return s;
#endif
#ifdef MPE
PerlIO_printf(PerlIO_stdout(),
- "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
+ "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2001\n");
#endif
#ifdef OEMVS
PerlIO_printf(PerlIO_stdout(),
PerlIO_printf(PerlIO_stdout(),
"EPOC port by Olaf Flebbe, 1999-2000\n");
#endif
+#ifdef UNDER_CE
+ printf("WINCE port by Rainer Keuchel, 2001\n");
+ printf("Built on " __DATE__ " " __TIME__ "\n\n");
+ wce_hitreturn();
+#endif
#ifdef BINARY_BUILD_NOTICE
BINARY_BUILD_NOTICE;
#endif
S_init_interp(pTHX)
{
-#ifdef PERL_OBJECT /* XXX kludge */
-#define I_REINIT \
- STMT_START { \
- PL_chopset = " \n-"; \
- PL_copline = NOLINE; \
- PL_curcop = &PL_compiling;\
- PL_curcopdb = NULL; \
- PL_dbargs = 0; \
- PL_dumpindent = 4; \
- PL_laststatval = -1; \
- PL_laststype = OP_STAT; \
- PL_maxscream = -1; \
- PL_maxsysfd = MAXSYSFD; \
- PL_statname = Nullsv; \
- PL_tmps_floor = -1; \
- PL_tmps_ix = -1; \
- PL_op_mask = NULL; \
- PL_laststatval = -1; \
- PL_laststype = OP_STAT; \
- PL_mess_sv = Nullsv; \
- PL_splitstr = " "; \
- PL_generation = 100; \
- PL_exitlist = NULL; \
- PL_exitlistlen = 0; \
- PL_regindent = 0; \
- PL_in_clean_objs = FALSE; \
- PL_in_clean_all = FALSE; \
- PL_profiledata = NULL; \
- PL_rsfp = Nullfp; \
- PL_rsfp_filters = Nullav; \
- PL_dirty = FALSE; \
- } STMT_END
- I_REINIT;
-#else
-# ifdef MULTIPLICITY
-# define PERLVAR(var,type)
-# define PERLVARA(var,n,type)
-# if defined(PERL_IMPLICIT_CONTEXT)
-# if defined(USE_THREADS)
-# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
-# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
-# else /* !USE_THREADS */
-# define PERLVARI(var,type,init) aTHX->var = init;
-# define PERLVARIC(var,type,init) aTHX->var = init;
-# endif /* USE_THREADS */
-# else
-# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
+#ifdef MULTIPLICITY
+# define PERLVAR(var,type)
+# define PERLVARA(var,n,type)
+# if defined(PERL_IMPLICIT_CONTEXT)
+# if defined(USE_5005THREADS)
+# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
-# endif
-# include "intrpvar.h"
-# ifndef USE_THREADS
-# include "thrdvar.h"
-# endif
-# undef PERLVAR
-# undef PERLVARA
-# undef PERLVARI
-# undef PERLVARIC
+# else /* !USE_5005THREADS */
+# define PERLVARI(var,type,init) aTHX->var = init;
+# define PERLVARIC(var,type,init) aTHX->var = init;
+# endif /* USE_5005THREADS */
# else
-# define PERLVAR(var,type)
-# define PERLVARA(var,n,type)
-# define PERLVARI(var,type,init) PL_##var = init;
-# define PERLVARIC(var,type,init) PL_##var = init;
-# include "intrpvar.h"
-# ifndef USE_THREADS
-# include "thrdvar.h"
-# endif
-# undef PERLVAR
-# undef PERLVARA
-# undef PERLVARI
-# undef PERLVARIC
+# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
+# endif
+# include "intrpvar.h"
+# ifndef USE_5005THREADS
+# include "thrdvar.h"
# endif
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
+#else
+# define PERLVAR(var,type)
+# define PERLVARA(var,n,type)
+# define PERLVARI(var,type,init) PL_##var = init;
+# define PERLVARIC(var,type,init) PL_##var = init;
+# include "intrpvar.h"
+# ifndef USE_5005THREADS
+# include "thrdvar.h"
+# endif
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
#endif
}
{
GV *gv;
- /* Note that strtab is a rather special HV. Assumptions are made
- about not iterating on it, and not adding tie magic to it.
- It is properly deallocated in perl_destruct() */
- PL_strtab = newHV();
-#ifdef USE_THREADS
- MUTEX_INIT(&PL_strtab_mutex);
-#endif
- HvSHAREKEYS_off(PL_strtab); /* mandatory */
- hv_ksplit(PL_strtab, 512);
+
PL_curstash = PL_defstash = newHV();
PL_curstname = newSVpvn("main",4);
if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
Perl_croak(aTHX_ "No Perl script found in input\n");
#endif
- if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
+ s2 = s;
+ if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
PL_doextract = FALSE;
while (*s && !(isSPACE (*s) || *s == '#')) s++;
while ((s = moreswitches(s)))
;
}
+#ifdef MACOS_TRADITIONAL
+ break;
+#endif
}
}
}
Safefree(PL_retstack);
}
-#ifndef PERL_OBJECT
-static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */
-#endif
-
STATIC void
S_init_lexer(pTHX)
{
-#ifdef PERL_OBJECT
- PerlIO *tmpfp;
-#endif
+ PerlIO *tmpfp;
tmpfp = PL_rsfp;
PL_rsfp = Nullfp;
lex_start(PL_linestr);
} /* else what? */
}
#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
- for (; *env; env++) {
+ if (env)
+ for (; *env; env++) {
if (!(s = strchr(*env,'=')))
continue;
*s++ = '\0';
sv = newSVpv(s--,0);
(void)hv_store(hv, *env, s - *env, sv, 0);
*s = '=';
- }
+ }
#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
if (dup_env_base) {
char **dup_env;
}
#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
#endif /* USE_ENVIRON_ARRAY */
-#ifdef DYNAMIC_ENV_FETCH
- HvNAME(hv) = savepv(ENV_HV_NAME);
-#endif
}
TAINT_NOT;
if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
}
}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
STATIC struct perl_thread *
S_init_main_thread(pTHX)
{
(void) find_threadsv("@"); /* Ensure $@ is initialised early */
PL_maxscream = -1;
+ PL_peepp = MEMBER_TO_FPTR(Perl_peep);
PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);
return thr;
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
- if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
+ if (PL_savebegin && (paramList == PL_beginav)) {
/* save PL_beginav for compiler */
if (! PL_beginav_save)
PL_beginav_save = newAV();
JMPENV_JUMP(2);
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
static I32
-read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
+read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
char *p, *nl;
p = SvPVX(PL_e_script);
https://perl5.git.perl.org / perl5.git / blobdiff