Integrate mainline @ 18:15 CST 31 Oct 1997

p4raw-id: //depot/ansiperl@199

1 files changed, 44 insertions, 47 deletions

diff --git a/perl.c b/perl.c
index a7ff240424..0500164aec 100644
--- a/perl.c
+++ b/perl.c
@@ -106,9 +106,12 @@ perl_alloc(void)
 void
 perl_construct(register PerlInterpreter *sv_interp)
 {
-#if defined(USE_THREADS) && !defined(FAKE_THREADS)
+#ifdef USE_THREADS
+    int i;
+#ifndef FAKE_THREADS
     struct thread *thr;
-#endif
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
     
     if (!(curinterp = sv_interp))
 	return;
@@ -120,45 +123,23 @@ perl_construct(register PerlInterpreter *sv_interp)
    /* Init the real globals (and main thread)? */
     if (!linestr) {
 #ifdef USE_THREADS
-	XPV *xpv;
 
     	INIT_THREADS;
-	Newz(53, thr, 1, struct thread);
+	if (pthread_key_create(&thr_key, 0))
+	    croak("panic: pthread_key_create");
 	MUTEX_INIT(&malloc_mutex);
 	MUTEX_INIT(&sv_mutex);
-	/* Safe to use SVs from now on */
+	/*
+	 * Safe to use basic SV functions from now on (though
+	 * not things like mortals or tainting yet).
+	 */
 	MUTEX_INIT(&eval_mutex);
 	COND_INIT(&eval_cond);
 	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
-	nthreads = 1;
-	cvcache = newHV();
-	curcop = &compiling;
-	thr->flags = THRf_R_JOINABLE;
-	MUTEX_INIT(&thr->mutex);
-	thr->next = thr;
-	thr->prev = thr;
-	thr->tid = 0;
-
-	/* Handcraft thrsv similarly to mess_sv */
-    	New(53, thrsv, 1, SV);
-	Newz(53, xpv, 1, XPV);
-	SvFLAGS(thrsv) = SVt_PV;
-	SvANY(thrsv) = (void*)xpv;
-	SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
-	SvPVX(thrsv) = (char*)thr;
-	SvCUR_set(thrsv, sizeof(thr));
-	SvLEN_set(thrsv, sizeof(thr));
-	*SvEND(thrsv) = '\0';		/* in the trailing_nul field */
-	oursv = thrsv;
-#ifdef HAVE_THREAD_INTERN
-	init_thread_intern(thr);
-#else
-	thr->self = pthread_self();
-	if (pthread_key_create(&thr_key, 0))
-	    croak("panic: pthread_key_create");
-#endif /* HAVE_THREAD_INTERN */
-	SET_THR(thr);
+	MUTEX_INIT(&keys_mutex);
+	
+	thr = new_struct_thread(0);
 #endif /* USE_THREADS */
 
 	linestr = NEWSV(65,80);
@@ -228,6 +209,9 @@ perl_construct(register PerlInterpreter *sv_interp)
 
     fdpid = newAV();	/* for remembering popen pids by fd */
 
+    for (i = 0; i < N_PER_THREAD_MAGICALS; i++)
+	magical_keys[i] = NOT_IN_PAD;
+    keys = newSVpv("", 0);
     init_stacks(ARGS);
     DEBUG( {
 	New(51,debname,128,char);
@@ -485,7 +469,8 @@ perl_destruct(register PerlInterpreter *sv_interp)
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errgv = Nullgv;
+    errhv = Nullhv;
+    errsv = Nullsv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -979,8 +964,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
     /* now that script is parsed, we can modify record separator */
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+    sv_setsv(*av_fetch(thr->specific, find_thread_magical("/"), TRUE), rs); 
+#else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-
+#endif /* USE_THREADS */
     if (do_undump)
 	my_unexec();
 
@@ -1243,7 +1231,7 @@ perl_call_sv(SV *sv, I32 flags)
 	    if (flags & G_KEEPERR)
 		in_eval |= 4;
 	    else
-		sv_setpv(GvSV(errgv),"");
+		sv_setpv(errsv,"");
 	}
 	markstack_ptr++;
 
@@ -1288,7 +1276,7 @@ perl_call_sv(SV *sv, I32 flags)
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
   cleanup:
     if (flags & G_EVAL) {
@@ -1397,7 +1385,7 @@ perl_eval_sv(SV *sv, I32 flags)
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
   cleanup:
     JMPENV_POP;
@@ -1426,8 +1414,8 @@ perl_eval_pv(char *p, I32 croak_on_error)
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(GvSV(errgv)))
-	croak(SvPVx(GvSV(errgv), na));
+    if (croak_on_error && SvTRUE(errsv))
+	croak(SvPV(errsv, na));
 
     return sv;
 }
@@ -1504,6 +1492,8 @@ moreswitches(char *s)
 
     switch (*s) {
     case '0':
+    {
+	dTHR;
 	rschar = scan_oct(s, 4, &numlen);
 	SvREFCNT_dec(nrs);
 	if (rschar & ~((U8)~0))
@@ -1515,6 +1505,7 @@ moreswitches(char *s)
 	    nrs = newSVpv(&ch, 1);
 	}
 	return s + numlen;
+    }
     case 'F':
 	minus_F = TRUE;
 	splitstr = savepv(s + 1);
@@ -1601,6 +1592,7 @@ moreswitches(char *s)
 	    s += numlen;
 	}
 	else {
+	    dTHR;
 	    if (RsPARA(nrs)) {
 		ors = "\n\n";
 		orslen = 2;
@@ -1789,11 +1781,11 @@ init_main_stash(void)
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
-    GvMULTI_on(errgv);
+    errsv = newSVpv("", 0);
+    errhv = newHV();
     (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
-    sv_grow(GvSV(errgv), 240);	/* Preallocate - for immediate signals. */
-    sv_setpvn(GvSV(errgv), "", 0);
+    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));
@@ -2525,7 +2517,11 @@ init_predump_symbols(void)
     GV *tmpgv;
     GV *othergv;
 
+#ifdef USE_THREADS
+    sv_setpvn(*av_fetch(thr->specific,find_thread_magical("\""),TRUE), " ", 1);
+#else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
+#endif /* USE_THREADS */
 
     stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(stdingv);
@@ -2558,6 +2554,7 @@ init_predump_symbols(void)
 static void
 init_postdump_symbols(register int argc, register char **argv, register char **env)
 {
+    dTHR;
     char *s;
     SV *sv;
     GV* tmpgv;
@@ -2816,7 +2813,7 @@ call_list(I32 oldscope, AV *list)
 	JMPENV_PUSH(ret);
 	switch (ret) {
 	case 0: {
-		SV* atsv = GvSV(errgv);
+		SV* atsv = sv_mortalcopy(errsv);
 		PUSHMARK(stack_sp);
 		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
 		(void)SvPV(atsv, len);
@@ -2877,8 +2874,8 @@ my_exit(U32 status)
     dTHR;
 
 #ifdef USE_THREADS
-    DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread 0x%lx, status %lu\n",
-			 (unsigned long) thr, (unsigned long) status));
+    DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
+			  thr, (unsigned long) status));
 #endif /* USE_THREADS */
     switch (status) {
     case 0: