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_5005THREADS)
# define INIT_TLS_AND_INTERP \
STMT_START { \
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;
}
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
#endif
}
- PL_nrs = newSVpvn("\n", 1);
- PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_rs = newSVpvn("\n", 1);
init_stacks();
sys_intern_init();
#endif
- PerlIO_init(); /* Hook to IO system */
+ PerlIO_init(aTHX); /* Hook to IO system */
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
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;
}
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_5005THREADS
Thread t;
/* 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());
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
/* The exit() function will do everything that needs doing. */
return STATUS_NATIVE_EXPORT;;
}
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
+
/* Must use safesysfree() when working with environ. */
safesysfree(environ);
while (i) {
SV *resv = ary[--i];
- REGEXP *re = (REGEXP *)SvIVX(resv);
+ REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
if (SvFLAGS(resv) & SVf_BREAK) {
/* this is PL_reg_curpm, already freed
*/
SvFLAGS(resv) &= ~SVf_BREAK;
}
+ else if(SvREPADTMP(resv)) {
+ SvREPADTMP_off(resv);
+ }
else {
ReREFCNT_dec(re);
}
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;
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
Safefree(PL_origfilename);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
void
perl_free(pTHXx)
{
-#if defined(PERL_OBJECT)
- PerlMem_free(this);
-#else
-# if defined(WIN32) || defined(NETWARE)
+#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()) {
- PerlIO_cleanup();
- }
- #endif
- PerlMem_free(aTHXx);
- #ifdef NETWARE
- nw5_delete_internal_host(host);
- #else
- win32_delete_internal_host(host);
- #endif
-#else
- PerlIO_cleanup();
+# ifdef NETWARE
+ void *host = nw_internal_host;
+# else
+ void *host = w32_internal_host;
+# endif
PerlMem_free(aTHXx);
-#endif
+# ifdef NETWARE
+ nw5_delete_internal_host(host);
+# else
+ win32_delete_internal_host(host);
+# endif
# else
PerlMem_free(aTHXx);
# endif
+#else
+ PerlMem_free(aTHXx);
#endif
}
#endif
#endif
-#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
- _dyld_lookup_and_bind
- ("__environ", (unsigned long *) &environ_pointer, NULL);
-#endif /* environ */
-
PL_origargc = argc;
{
/* 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
+ * has no way of knowing if we've made a copy or
* just point to argv
*/
int i = PL_origargc;
}
}
-#ifdef USE_ENVIRON_ARRAY
- PL_origenviron = environ;
-#endif
+
if (PL_do_undump) {
# 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
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();
#endif
oldscope = PL_scopestack_ix;
+#ifdef VMS
+ VMSISH_HUSHED = 0;
+#endif
#ifdef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
+ if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
#ifdef MYMALLOC
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
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;
"\n\nCopyright 1987-2001, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
- "\nMac OS port Copyright (c) 1991-2001, Matthias Neeracher\n");
+ "\nMac OS port Copyright 1991-2001, Matthias Neeracher;\n"
+ "maintained by Chris Nandor\n");
#endif
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
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_5005THREADS)
-# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
-# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
-# else /* !USE_5005THREADS */
-# define PERLVARI(var,type,init) aTHX->var = init;
-# define PERLVARIC(var,type,init) aTHX->var = init;
-# endif /* USE_5005THREADS */
-# 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_5005THREADS
-# 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_5005THREADS
-# 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_5005THREADS
- 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);
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);
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);
projects / p5sagit/p5-mst-13.2.git / blobdiff