perl5.004 hints file (maint and dev paths)

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index bc55ba1..7e2d562 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -51,8 +51,6 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
     copline    = NOLINE;       \
     curcop     = &compiling;   \
     curcopdb    = NULL;                \
-    cxstack_ix  = -1;          \
-    cxstack_max = 128;         \
     dbargs     = 0;            \
     dlmax      = 128;          \
     laststatval        = -1;           \
@@ -67,9 +65,18 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
     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
 
-#ifndef PERL_OBJECT
+#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));
@@ -384,7 +391,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
 
     /* call exit list functions */
     while (exitlistlen-- > 0)
-       exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+       exitlist[exitlistlen].fn(PERL_OBJECT_THIS_ exitlist[exitlistlen].ptr);
 
     Safefree(exitlist);
 
@@ -474,6 +481,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     argvoutgv = Nullgv;
     stdingv = Nullgv;
     last_in_gv = Nullgv;
+    replgv = Nullgv;
 
     /* reset so print() ends up where we expect */
     setdefout(Nullgv);
@@ -548,8 +556,11 @@ perl_destruct(register PerlInterpreter *sv_interp)
     /* No SVs have survived, need to clean out */
     linestr = NULL;
     pidstatus = Nullhv;
-    if (origfilename)
-       Safefree(origfilename);
+    Safefree(origfilename);
+    Safefree(archpat_auto);
+    Safefree(reg_start_tmp);
+    Safefree(HeKEY_hek(&hv_fetch_ent_mh));
+    Safefree(op_mask);
     nuke_stacks();
     hints = 0;         /* Reset hints. Should hints be per-interpreter ? */
     
@@ -595,7 +606,11 @@ perl_free(PerlInterpreter *sv_interp)
 }
 
 void
+#ifdef PERL_OBJECT
+CPerlObj::perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr)
+#else
 perl_atexit(void (*fn) (void *), void *ptr)
+#endif
 {
     Renew(exitlist, exitlistlen+1, PerlExitListEntry);
     exitlist[exitlistlen].fn = fn;
@@ -938,7 +953,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     boot_core_UNIVERSAL();
 
     if (xsinit)
-       (*xsinit)(THIS);        /* in case linked C routines want magical variables */
+       (*xsinit)(PERL_OBJECT_THIS);    /* in case linked C routines want magical variables */
 #if defined(VMS) || defined(WIN32) || defined(DJGPP)
     init_os_extras();
 #endif
@@ -1809,6 +1824,8 @@ 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 */
+    GvMULTI_on(replgv);
     (void)form("%240s","");    /* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
@@ -2219,22 +2236,6 @@ find_beginning(void)
 }
 
 
-STATIC I32
-read_e_script(int idx, SV *buf_sv, int maxlen)
-{
-    char *p, *nl;
-    FILTER_READ(idx+1, buf_sv, maxlen);
-    p  = SvPVX(e_script);
-    nl = strchr(p, '\n');
-    nl = (nl) ? nl+1 : SvEND(e_script);
-    if (nl-p == 0)
-       return 0;
-    sv_catpvn(buf_sv, p, nl-p);
-    sv_chop(e_script, nl);
-    return 1;
-}
-
-
 STATIC void
 init_ids(void)
 {
@@ -2358,6 +2359,12 @@ 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);
@@ -2484,7 +2491,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e
            if (!(s = strchr(*env,'=')))
                continue;
            *s++ = '\0';
-#if defined(WIN32) || defined(MSDOS)
+#if defined(MSDOS)
            (void)strupr(*env);
 #endif
            sv = newSVpv(s--,0);
@@ -2585,7 +2592,7 @@ incpush(char *p, int addsubdirs)
        return;
 
     if (addsubdirs) {
-       subdir = NEWSV(55,0);
+       subdir = sv_newmortal();
        if (!archpat_auto) {
            STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
                          + sizeof("//auto"));
@@ -2661,8 +2668,6 @@ incpush(char *p, int addsubdirs)
        /* finally push this lib directory on the end of @INC */
        av_push(GvAVn(incgv), libdir);
     }
-
-    SvREFCNT_dec(subdir);
 }
 
 #ifdef USE_THREADS
@@ -2876,3 +2881,26 @@ my_exit_jump(void)
 
     JMPENV_JUMP(2);
 }
+
+
+#include "XSUB.h"
+
+static I32
+#ifdef PERL_OBJECT
+read_e_script(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
+#else
+read_e_script(int idx, SV *buf_sv, int maxlen)
+#endif
+{
+    char *p, *nl;
+    p  = SvPVX(e_script);
+    nl = strchr(p, '\n');
+    nl = (nl) ? nl+1 : SvEND(e_script);
+    if (nl-p == 0)
+       return 0;
+    sv_catpvn(buf_sv, p, nl-p);
+    sv_chop(e_script, nl);
+    return 1;
+}
+
+