Integrate from ansi branch to mainline.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 3fe2c50..381d574 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -70,7 +70,7 @@ static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
 #ifdef USE_THREADS
-static struct thread * init_main_thread _((void));
+static struct perl_thread * init_main_thread _((void));
 #endif /* USE_THREADS */
 static void init_perllib _((void));
 static void init_postdump_symbols _((int, char **, char **));
@@ -112,7 +112,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 #ifdef USE_THREADS
     int i;
 #ifndef FAKE_THREADS
-    struct thread *thr;
+    struct perl_thread *thr;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
     
@@ -418,36 +418,6 @@ perl_destruct(register PerlInterpreter *sv_interp)
 
     /* defgv, aka *_ should be taken care of elsewhere */
 
-#if 0  /* just about all regexp stuff, seems to be ok */
-
-    /* shortcuts to regexp stuff */
-    leftgv = Nullgv;
-    ampergv = Nullgv;
-
-    SAVEFREEOP(curpm);
-    SAVEFREEOP(oldlastpm); /* for saving regexp context during debugger */
-
-    regprecomp = NULL; /* uncompiled string. */
-    regparse = NULL;   /* Input-scan pointer. */
-    regxend = NULL;    /* End of input for compile */
-    regnpar = 0;       /* () count. */
-    regcode = NULL;    /* Code-emit pointer; &regdummy = don't. */
-    regsize = 0;       /* Code size. */
-    regnaughty = 0;    /* How bad is this pattern? */
-    regsawback = 0;    /* Did we see \1, ...? */
-
-    reginput = NULL;           /* String-input pointer. */
-    regbol = NULL;             /* Beginning of input, for ^ check. */
-    regeol = NULL;             /* End of input, for $ check. */
-    regstartp = (char **)NULL; /* Pointer to startp array. */
-    regendp = (char **)NULL;   /* Ditto for endp. */
-    reglastparen = 0;          /* Similarly for lastparen. */
-    regtill = NULL;            /* How far we are required to go. */
-    regflags = 0;              /* are we folding, multilining? */
-    regprev = (char)NULL;      /* char before regbol, \n if none */
-
-#endif /* if 0 */
-
     /* clean up after study() */
     SvREFCNT_dec(lastscream);
     lastscream = Nullsv;
@@ -472,8 +442,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errhv = Nullhv;
-    errsv = Nullsv;
+    errgv = Nullgv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -968,7 +937,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
 #ifdef USE_THREADS
-    sv_setsv(*av_fetch(thr->magicals, find_thread_magical("/"), FALSE), rs); 
+    sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs); 
 #else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
 #endif /* USE_THREADS */
@@ -1083,10 +1052,10 @@ perl_get_sv(char *name, I32 create)
     GV *gv;
 #ifdef USE_THREADS
     if (name[1] == '\0' && !isALPHA(name[0])) {
-       PADOFFSET tmp = find_thread_magical(name);
+       PADOFFSET tmp = find_threadsv(name);
        if (tmp != NOT_IN_PAD) {
            dTHR;
-           return *av_fetch(thr->magicals, tmp, FALSE);
+           return *av_fetch(thr->threadsv, tmp, FALSE);
        }
     }
 #endif /* USE_THREADS */
@@ -1227,7 +1196,7 @@ perl_call_sv(SV *sv, I32 flags)
        markstack_ptr--;
        /* we're trying to emulate pp_entertry() here */
        {
-           register CONTEXT *cx;
+           register PERL_CONTEXT *cx;
            I32 gimme = GIMME_V;
            
            ENTER;
@@ -1295,7 +1264,7 @@ perl_call_sv(SV *sv, I32 flags)
            SV **newsp;
            PMOP *newpm;
            I32 gimme;
-           register CONTEXT *cx;
+           register PERL_CONTEXT *cx;
            I32 optype;
 
            POPBLOCK(cx,newpm);
@@ -1717,6 +1686,9 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
        break;
     case '-':
     case 0:
+#ifdef WIN32
+    case '\r':
+#endif
     case '\n':
     case '\t':
        break;
@@ -1791,14 +1763,15 @@ init_main_stash(void)
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errsv = newSVpv("", 0);
-    errhv = newHV();
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
     (void)form("%240s","");    /* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+    globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
     sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
 }
@@ -2017,7 +1990,7 @@ SV *sv;
     if (strEQ(origfilename,"-"))
        scriptname = "";
     if (fdscript >= 0) {
-       rsfp = PerlIO_fdopen(fdscript,"r");
+       rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
        if (rsfp)
            fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
@@ -2101,7 +2074,7 @@ sed %s -e \"/^[^#]/b\" \
        rsfp = PerlIO_stdin();
     }
     else {
-       rsfp = PerlIO_open(scriptname,"r");
+       rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
        if (rsfp)
            fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
@@ -2449,8 +2422,8 @@ init_stacks(ARGSproto)
     stack_sp = stack_base;
     stack_max = stack_base + 127;
 
-    cxstack_max = 8192 / sizeof(CONTEXT) - 2;  /* Use most of 8K. */
-    New(50,cxstack,cxstack_max + 1,CONTEXT);
+    cxstack_max = 8192 / sizeof(PERL_CONTEXT) - 2;     /* Use most of 8K. */
+    New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
     cxstack_ix = -1;
 
     New(50,tmps_stack,128,SV*);
@@ -2528,7 +2501,7 @@ init_predump_symbols(void)
     GV *othergv;
 
 #ifdef USE_THREADS
-    sv_setpvn(*av_fetch(thr->magicals,find_thread_magical("\""),FALSE)," ", 1);
+    sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
 #else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
 #endif /* USE_THREADS */
@@ -2807,16 +2780,16 @@ incpush(char *p, int addsubdirs)
 }
 
 #ifdef USE_THREADS
-static struct thread *
+static struct perl_thread *
 init_main_thread()
 {
-    struct thread *thr;
+    struct perl_thread *thr;
     XPV *xpv;
 
-    Newz(53, thr, 1, struct thread);
+    Newz(53, thr, 1, struct perl_thread);
     curcop = &compiling;
     thr->cvcache = newHV();
-    thr->magicals = newAV();
+    thr->threadsv = newAV();
     thr->specific = newAV();
     thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
@@ -2844,9 +2817,13 @@ init_main_thread()
 
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+    SET_THREAD_SELF(thr);
 #else
     thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
+#endif /* SET_THREAD_SELF */
     SET_THR(thr);
 
     /*
@@ -2885,18 +2862,18 @@ call_list(I32 oldscope, AV *list)
                SV* atsv = ERRSV;
                PUSHMARK(stack_sp);
                perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-               (void)SvPV(errsv, len);
+               (void)SvPV(atsv, len);
                if (len) {
                    JMPENV_POP;
                    curcop = &compiling;
                    curcop->cop_line = oldline;
                    if (list == beginav)
-                       sv_catpv(errsv, "BEGIN failed--compilation aborted");
+                       sv_catpv(atsv, "BEGIN failed--compilation aborted");
                    else
-                       sv_catpv(errsv, "END failed--cleanup aborted");
+                       sv_catpv(atsv, "END failed--cleanup aborted");
                    while (scopestack_ix > oldscope)
                        LEAVE;
-                   croak("%s", SvPVX(errsv));
+                   croak("%s", SvPVX(atsv));
                }
            }
            break;
@@ -2987,7 +2964,7 @@ static void
 my_exit_jump(void)
 {
     dTHR;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;