This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
IV changes for long long (was Re: 5.004_68 on its way to the CPAN)
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 7e2d562..db78b4e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -45,41 +45,13 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
 #endif
 #endif
 
-#define I_REINIT \
-  STMT_START {                 \
-    chopset    = " \n-";       \
-    copline    = NOLINE;       \
-    curcop     = &compiling;   \
-    curcopdb    = NULL;                \
-    dbargs     = 0;            \
-    dlmax      = 128;          \
-    laststatval        = -1;           \
-    laststype  = OP_STAT;      \
-    maxscream  = -1;           \
-    maxsysfd   = MAXSYSFD;     \
-    statname   = Nullsv;       \
-    tmps_floor = -1;           \
-    tmps_ix     = -1;          \
-    op_mask     = NULL;                \
-    dlmax       = 128;         \
-    laststatval = -1;          \
-    laststype   = OP_STAT;     \
-    mess_sv     = Nullsv;      \
-    splitstr    = " ";         \
-    generation  = 100;         \
-    exitlist    = NULL;                \
-    exitlistlen = 0;           \
-    regindent   = 0;           \
-    in_clean_objs = FALSE;     \
-    in_clean_all= FALSE;       \
-  } STMT_END
-
 #ifdef PERL_OBJECT
 static I32 read_e_script _((CPerlObj* pPerl, int idx, SV *buf_sv, int maxlen));
 #else
 static void find_beginning _((void));
 static void forbid_setid _((char *));
 static void incpush _((char *, int));
+static void init_interp _((void));
 static void init_ids _((void));
 static void init_debugger _((void));
 static void init_lexer _((void));
@@ -140,6 +112,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 #endif
 
 #ifdef MULTIPLICITY
+    ++ninterps;
     Zero(sv_interp, 1, PerlInterpreter);
 #endif
 
@@ -170,7 +143,7 @@ perl_construct(register PerlInterpreter *sv_interp)
        thr = init_main_thread();
 #endif /* USE_THREADS */
 
-       linestr = NEWSV(65,80);
+       linestr = NEWSV(65,79);
        sv_upgrade(linestr,SVt_PVIV);
 
        if (!SvREADONLY(&sv_undef)) {
@@ -209,11 +182,11 @@ perl_construct(register PerlInterpreter *sv_interp)
 
     init_stacks(ARGS);
 #ifdef MULTIPLICITY
-    I_REINIT;
+    init_interp();
     perl_destruct_level = 1; 
 #else
-   if(perl_destruct_level > 0)
-       I_REINIT;
+   if (perl_destruct_level > 0)
+       init_interp();
 #endif
 
     init_ids();
@@ -357,6 +330,10 @@ perl_destruct(register PerlInterpreter *sv_interp)
     LEAVE;
     FREETMPS;
 
+#ifdef MULTIPLICITY
+    --ninterps;
+#endif
+
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
@@ -1798,6 +1775,72 @@ my_unexec(void)
 #endif
 }
 
+/* initialize curinterp */
+STATIC void
+init_interp(void)
+{
+
+#ifdef PERL_OBJECT             /* XXX kludge */
+#define I_REINIT \
+  STMT_START {                 \
+    chopset    = " \n-";       \
+    copline    = NOLINE;       \
+    curcop     = &compiling;   \
+    curcopdb    = NULL;                \
+    dbargs     = 0;            \
+    dlmax      = 128;          \
+    laststatval        = -1;           \
+    laststype  = OP_STAT;      \
+    maxscream  = -1;           \
+    maxsysfd   = MAXSYSFD;     \
+    statname   = Nullsv;       \
+    tmps_floor = -1;           \
+    tmps_ix     = -1;          \
+    op_mask     = NULL;                \
+    dlmax       = 128;         \
+    laststatval = -1;          \
+    laststype   = OP_STAT;     \
+    mess_sv     = Nullsv;      \
+    splitstr    = " ";         \
+    generation  = 100;         \
+    exitlist    = NULL;                \
+    exitlistlen = 0;           \
+    regindent   = 0;           \
+    in_clean_objs = FALSE;     \
+    in_clean_all= FALSE;       \
+    profiledata = NULL;                \
+    rsfp       = Nullfp;       \
+    rsfp_filters= Nullav;      \
+  } STMT_END
+    I_REINIT;
+#else
+#  ifdef MULTIPLICITY
+#    define PERLVAR(var,type)
+#    define PERLVARI(var,type,init)    curinterp->var = init;
+#    define PERLVARIC(var,type,init)   curinterp->var = init;
+#    include "intrpvar.h"
+#    ifndef USE_THREADS
+#      include "thrdvar.h"
+#    endif
+#    undef PERLVAR
+#    undef PERLVARI
+#    undef PERLVARIC
+#    else
+#    define PERLVAR(var,type)
+#    define PERLVARI(var,type,init)    var = init;
+#    define PERLVARIC(var,type,init)   var = init;
+#    include "intrpvar.h"
+#    ifndef USE_THREADS
+#      include "thrdvar.h"
+#    endif
+#    undef PERLVAR
+#    undef PERLVARI
+#    undef PERLVARIC
+#  endif
+#endif
+
+}
+
 STATIC void
 init_main_stash(void)
 {
@@ -1824,7 +1867,7 @@ init_main_stash(void)
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
     errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
     GvMULTI_on(errgv);
-    replgv = gv_HVadd(gv_fetchpv("\022", TRUE, SVt_PV)); /* ^R */
+    replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
     GvMULTI_on(replgv);
     (void)form("%240s","");    /* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
@@ -1843,7 +1886,8 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript)
     dTHR;
     register char *s;
 
-    scriptname = find_script(scriptname, dosearch, NULL, 0);
+    /* scriptname will be non-NULL if find_script() returns */
+    scriptname = find_script(scriptname, dosearch, NULL, 1);
 
     if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
        char *s = scriptname + 8;
@@ -1855,7 +1899,7 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript)
     }
     else
        *fdscript = -1;
-    origfilename = savepv(e_script ? "-e" : scriptname);
+    origfilename = (e_script ? savepv("-e") : scriptname);
     curcop->cop_filegv = gv_fetchfile(origfilename);
     if (strEQ(origfilename,"-"))
        scriptname = "";
@@ -1868,7 +1912,7 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript)
     }
     else if (preprocess) {
        char *cpp_cfg = CPPSTDIN;
-       SV *cpp = NEWSV(0,0);
+       SV *cpp = newSVpv("",0);
        SV *cmd = NEWSV(0,0);
 
        if (strEQ(cpp_cfg, "cppstdin"))
@@ -2303,44 +2347,23 @@ init_stacks(ARGSproto)
     tmps_ix = -1;
     tmps_max = REASONABLE(128);
 
-    /*
-     * The following stacks almost certainly should be per-interpreter,
-     * but for now they're not.  XXX
-     */
-
-    if (markstack) {
-       markstack_ptr = markstack;
-    } else {
-       New(54,markstack,REASONABLE(32),I32);
-       markstack_ptr = markstack;
-       markstack_max = markstack + REASONABLE(32);
-    }
+    New(54,markstack,REASONABLE(32),I32);
+    markstack_ptr = markstack;
+    markstack_max = markstack + REASONABLE(32);
 
     SET_MARKBASE;
 
-    if (scopestack) {
-       scopestack_ix = 0;
-    } else {
-       New(54,scopestack,REASONABLE(32),I32);
-       scopestack_ix = 0;
-       scopestack_max = REASONABLE(32);
-    }
+    New(54,scopestack,REASONABLE(32),I32);
+    scopestack_ix = 0;
+    scopestack_max = REASONABLE(32);
 
-    if (savestack) {
-       savestack_ix = 0;
-    } else {
-       New(54,savestack,REASONABLE(128),ANY);
-       savestack_ix = 0;
-       savestack_max = REASONABLE(128);
-    }
+    New(54,savestack,REASONABLE(128),ANY);
+    savestack_ix = 0;
+    savestack_max = REASONABLE(128);
 
-    if (retstack) {
-       retstack_ix = 0;
-    } else {
-       New(54,retstack,REASONABLE(16),OP*);
-       retstack_ix = 0;
-       retstack_max = REASONABLE(16);
-    }
+    New(54,retstack,REASONABLE(16),OP*);
+    retstack_ix = 0;
+    retstack_max = REASONABLE(16);
 }
 
 #undef REASONABLE
@@ -2359,12 +2382,10 @@ nuke_stacks(void)
        curstackinfo = p;
     }
     Safefree(tmps_stack);
-    /*  XXX refcount interpreters to determine when to free global data
     Safefree(markstack);
     Safefree(scopestack);
     Safefree(savestack);
     Safefree(retstack);
-    */
     DEBUG( {
        Safefree(debname);
        Safefree(debdelim);