X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=fc8307d52c354f2fc220a572d2230b57623707c6;hb=cc49e20bd7575d1d37e92731860d63daa4d52ecc;hp=d32f897c4e6314e7998d70c8f0bed01f53b3512f;hpb=57def98fcb6c98601beaf31e3c48ad681bfdc2a3;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index d32f897..fc8307d 100644
--- a/util.c
+++ b/util.c
@@ -85,7 +85,7 @@ Perl_safesysmalloc(MEM_SIZE size)
     Malloc_t ptr;
 #ifdef HAS_64K_LIMIT
 	if (size > 0xffff) {
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 			  "Allocation too large: %lx\n", size) FLUSH;
 	    my_exit(1);
 	}
@@ -95,13 +95,13 @@ Perl_safesysmalloc(MEM_SIZE size)
 	Perl_croak_nocontext("panic: malloc");
 #endif
     ptr = PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system */
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) malloc %ld bytes\n",PTR2UV(ptr),PL_an++,(long)size));
     if (ptr != Nullch)
 	return ptr;
     else if (PL_nomemok)
 	return Nullch;
     else {
-	PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+	PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
 	my_exit(1);
         return Nullch;
     }
@@ -121,7 +121,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
 #ifdef HAS_64K_LIMIT 
     if (size > 0xffff) {
-	PerlIO_printf(PerlIO_stderr(),
+	PerlIO_printf(Perl_error_log,
 		      "Reallocation too large: %lx\n", size) FLUSH;
 	my_exit(1);
     }
@@ -139,15 +139,15 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 #endif
     ptr = PerlMem_realloc(where,size);
 
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++));
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) rfree\n",PTR2UV(where),PL_an++));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) realloc %ld bytes\n",PTR2UV(ptr),PL_an++,(long)size));
 
     if (ptr != Nullch)
 	return ptr;
     else if (PL_nomemok)
 	return Nullch;
     else {
-	PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+	PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
 	my_exit(1);
 	return Nullch;
     }
@@ -160,7 +160,7 @@ Free_t
 Perl_safesysfree(Malloc_t where)
 {
     dTHX;
-    DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++));
+    DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) free\n",PTR2UV(where),PL_an++));
     if (where) {
 	/*SUPPRESS 701*/
 	PerlMem_free(where);
@@ -177,7 +177,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 
 #ifdef HAS_64K_LIMIT
     if (size * count > 0xffff) {
-	PerlIO_printf(PerlIO_stderr(),
+	PerlIO_printf(Perl_error_log,
 		      "Allocation too large: %lx\n", size * count) FLUSH;
 	my_exit(1);
     }
@@ -188,7 +188,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 #endif
     size *= count;
     ptr = PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system */
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05d) calloc %ld x %ld bytes\n",PTR2UV(ptr),PL_an++,(long)count,(long)size));
     if (ptr != Nullch) {
 	memset((void*)ptr, 0, size);
 	return ptr;
@@ -196,7 +196,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
     else if (PL_nomemok)
 	return Nullch;
     else {
-	PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
+	PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH;
 	my_exit(1);
 	return Nullch;
     }
@@ -298,7 +298,7 @@ S_xstat(pTHX_ int flag)
 	subtot[j] = 0;
     }
     
-    PerlIO_printf(PerlIO_stderr(), "   Id  subtot   4   8  12  16  20  24  28  32  36  40  48  56  64  72  80 80+\n", total);
+    PerlIO_printf(Perl_debug_log, "   Id  subtot   4   8  12  16  20  24  28  32  36  40  48  56  64  72  80 80+\n", total);
     for (i = 0; i < MAXXCOUNT; i++) {
 	total += xcount[i];
 	for (j = 0; j < MAXYCOUNT; j++) {
@@ -309,7 +309,7 @@ S_xstat(pTHX_ int flag)
 	    : (flag == 2 
 	       ? xcount[i] != lastxcount[i] /* Changed */
 	       : xcount[i] > lastxcount[i])) { /* Growed */
-	    PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100, 
+	    PerlIO_printf(Perl_debug_log,"%2d %02d %7ld ", i / 100, i % 100, 
 			  flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]);
 	    lastxcount[i] = xcount[i];
 	    for (j = 0; j < MAXYCOUNT; j++) {
@@ -318,28 +318,28 @@ S_xstat(pTHX_ int flag)
 		     : (flag == 2 
 			? xycount[i][j] != lastxycount[i][j] /* Changed */
 			: xycount[i][j] > lastxycount[i][j])) {	/* Growed */
-		    PerlIO_printf(PerlIO_stderr(),"%3ld ", 
+		    PerlIO_printf(Perl_debug_log,"%3ld ", 
 				  flag == 2 
 				  ? xycount[i][j] - lastxycount[i][j] 
 				  : xycount[i][j]);
 		    lastxycount[i][j] = xycount[i][j];
 		} else {
-		    PerlIO_printf(PerlIO_stderr(), "  . ", xycount[i][j]);
+		    PerlIO_printf(Perl_debug_log, "  . ", xycount[i][j]);
 		}
 	    }
-	    PerlIO_printf(PerlIO_stderr(), "\n");
+	    PerlIO_printf(Perl_debug_log, "\n");
 	}
     }
     if (flag != 2) {
-	PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total);
+	PerlIO_printf(Perl_debug_log, "Total %7ld ", total);
 	for (j = 0; j < MAXYCOUNT; j++) {
 	    if (subtot[j]) {
-		PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]);
+		PerlIO_printf(Perl_debug_log, "%3ld ", subtot[j]);
 	    } else {
-		PerlIO_printf(PerlIO_stderr(), "  . ");
+		PerlIO_printf(Perl_debug_log, "  . ");
 	    }
 	}
-	PerlIO_printf(PerlIO_stderr(), "\n");	
+	PerlIO_printf(Perl_debug_log, "\n");	
     }
 }
 
@@ -544,8 +544,6 @@ Perl_set_numeric_radix(pTHX)
     else
 	PL_numeric_radix = 0;
 # endif /* HAS_LOCALECONV */
-#else
-    PL_numeric_radix = 0;
 #endif /* USE_LOCALE_NUMERIC */
 }
 
@@ -711,41 +709,41 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 	if (locwarn) {
 #ifdef LC_ALL
   
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 	       "perl: warning: Setting locale failed.\n");
 
 #else /* !LC_ALL */
   
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 	       "perl: warning: Setting locale failed for the categories:\n\t");
 #ifdef USE_LOCALE_CTYPE
 	    if (! curctype)
-		PerlIO_printf(PerlIO_stderr(), "LC_CTYPE ");
+		PerlIO_printf(Perl_error_log, "LC_CTYPE ");
 #endif /* USE_LOCALE_CTYPE */
 #ifdef USE_LOCALE_COLLATE
 	    if (! curcoll)
-		PerlIO_printf(PerlIO_stderr(), "LC_COLLATE ");
+		PerlIO_printf(Perl_error_log, "LC_COLLATE ");
 #endif /* USE_LOCALE_COLLATE */
 #ifdef USE_LOCALE_NUMERIC
 	    if (! curnum)
-		PerlIO_printf(PerlIO_stderr(), "LC_NUMERIC ");
+		PerlIO_printf(Perl_error_log, "LC_NUMERIC ");
 #endif /* USE_LOCALE_NUMERIC */
-	    PerlIO_printf(PerlIO_stderr(), "\n");
+	    PerlIO_printf(Perl_error_log, "\n");
 
 #endif /* LC_ALL */
 
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 		"perl: warning: Please check that your locale settings:\n");
 
 #ifdef __GLIBC__
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 			  "\tLANGUAGE = %c%s%c,\n",
 			  language ? '"' : '(',
 			  language ? language : "unset",
 			  language ? '"' : ')');
 #endif
 
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 			  "\tLC_ALL = %c%s%c,\n",
 			  lc_all ? '"' : '(',
 			  lc_all ? lc_all : "unset",
@@ -757,18 +755,18 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 		  if (strnEQ(*e, "LC_", 3)
 			&& strnNE(*e, "LC_ALL=", 7)
 			&& (p = strchr(*e, '=')))
-		      PerlIO_printf(PerlIO_stderr(), "\t%.*s = \"%s\",\n",
+		      PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n",
 				    (int)(p - *e), *e, p + 1);
 	      }
 	    }
 
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 			  "\tLANG = %c%s%c\n",
 			  lang ? '"' : '(',
 			  lang ? lang : "unset",
 			  lang ? '"' : ')');
 
-	    PerlIO_printf(PerlIO_stderr(),
+	    PerlIO_printf(Perl_error_log,
 			  "    are supported and installed on your system.\n");
 	}
 
@@ -776,13 +774,13 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
 	if (setlocale(LC_ALL, "C")) {
 	    if (locwarn)
-		PerlIO_printf(PerlIO_stderr(),
+		PerlIO_printf(Perl_error_log,
       "perl: warning: Falling back to the standard locale (\"C\").\n");
 	    ok = 0;
 	}
 	else {
 	    if (locwarn)
-		PerlIO_printf(PerlIO_stderr(),
+		PerlIO_printf(Perl_error_log,
       "perl: warning: Failed to fall back to the standard locale (\"C\").\n");
 	    ok = -1;
 	}
@@ -802,7 +800,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 	    )
 	{
 	    if (locwarn)
-		PerlIO_printf(PerlIO_stderr(),
+		PerlIO_printf(Perl_error_log,
       "perl: warning: Cannot fall back to the standard locale (\"C\").\n");
 	    ok = -1;
 	}
@@ -1420,7 +1418,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 	dTHR;
 	if (PL_curcop->cop_line)
 	    Perl_sv_catpvf(aTHX_ sv, " at %_ line %"IVdf,
-		      GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+			   CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
 	if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
 	    bool line_mode = (RsSIMPLE(PL_rs) &&
 			      SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
@@ -1450,7 +1448,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     SV *msv;
     STRLEN msglen;
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
 			  "%p: die: curstack = %p, mainstack = %p\n",
 			  thr, PL_curstack, PL_mainstack));
 
@@ -1468,7 +1466,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 	message = Nullch;
     }
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
 			  "%p: die: message = %s\ndiehook = %p\n",
 			  thr, message, PL_diehook));
     if (PL_diehook) {
@@ -1497,18 +1495,14 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 	    PUSHMARK(SP);
 	    XPUSHs(msg);
 	    PUTBACK;
-	    /* HACK - REVISIT - avoid CATCH_SET(TRUE) in call_sv()
-	       or we come back here due to a JMPENV_JMP() and do 
-	       a POPSTACK - but die_where() will have already done 
-	       one as it unwound - NI-S 1999/08/14 */
-	    call_sv((SV*)cv, G_DISCARD|G_NOCATCH);
+	    call_sv((SV*)cv, G_DISCARD);
 	    POPSTACK;
 	    LEAVE;
 	}
     }
 
     PL_restartop = die_where(message, msglen);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
 	  "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n",
 	  thr, PL_restartop, was_in_eval, PL_top_env));
     if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev)
@@ -1561,8 +1555,8 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
     else
 	message = SvPV(msv,msglen);
 
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s",
-			  (unsigned long) thr, message));
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s",
+			  PTR2UV(thr), message));
 
     if (PL_diehook) {
 	/* sv_2cv might call Perl_croak() */
@@ -1599,8 +1593,10 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 	/* SFIO can really mess with your errno */
 	int e = errno;
 #endif
-	PerlIO_write(PerlIO_stderr(), message, msglen);
-	(void)PerlIO_flush(PerlIO_stderr());
+	PerlIO *serr = Perl_error_log;
+
+	PerlIO_write(serr, message, msglen);
+	(void)PerlIO_flush(serr);
 #ifdef USE_SFIO
 	errno = e;
 #endif
@@ -1672,16 +1668,20 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
 	    return;
 	}
     }
-    PerlIO_write(PerlIO_stderr(), message, msglen);
+    {
+	PerlIO *serr = Perl_error_log;
+
+	PerlIO_write(serr, message, msglen);
 #ifdef LEAKTEST
-    DEBUG_L(*message == '!' 
-	    ? (xstat(message[1]=='!'
-		     ? (message[2]=='!' ? 2 : 1)
-		     : 0)
-	       , 0)
-	    : 0);
+	DEBUG_L(*message == '!' 
+		? (xstat(message[1]=='!'
+			 ? (message[2]=='!' ? 2 : 1)
+			 : 0)
+		   , 0)
+		: 0);
 #endif
-    (void)PerlIO_flush(PerlIO_stderr());
+	(void)PerlIO_flush(serr);
+    }
 }
 
 #if defined(PERL_IMPLICIT_CONTEXT)
@@ -1742,7 +1742,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 
     if (ckDEAD(err)) {
 #ifdef USE_THREADS
-        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+        DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message));
 #endif /* USE_THREADS */
         if (PL_diehook) {
             /* sv_2cv might call Perl_croak() */
@@ -1773,8 +1773,11 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
             PL_restartop = die_where(message, msglen);
             JMPENV_JUMP(3);
         }
-        PerlIO_write(PerlIO_stderr(), message, msglen);
-        (void)PerlIO_flush(PerlIO_stderr());
+	{
+	    PerlIO *serr = Perl_error_log;
+	    PerlIO_write(serr, message, msglen);
+	    (void)PerlIO_flush(serr);
+	}
         my_failure_exit();
 
     }
@@ -1806,11 +1809,14 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
                 return;
             }
         }
-        PerlIO_write(PerlIO_stderr(), message, msglen);
+	{
+	    PerlIO *serr = Perl_error_log;
+	    PerlIO_write(serr, message, msglen);
 #ifdef LEAKTEST
-        DEBUG_L(xstat());
+	    DEBUG_L(xstat());
 #endif
-        (void)PerlIO_flush(PerlIO_stderr());
+	    (void)PerlIO_flush(serr);
+	}
     }
 }
 
@@ -2360,12 +2366,12 @@ Perl_dump_fds(pTHX_ char *s)
     int fd;
     struct stat tmpstatbuf;
 
-    PerlIO_printf(PerlIO_stderr(),"%s", s);
+    PerlIO_printf(Perl_debug_log,"%s", s);
     for (fd = 0; fd < 32; fd++) {
 	if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0)
-	    PerlIO_printf(PerlIO_stderr()," %d",fd);
+	    PerlIO_printf(Perl_debug_log," %d",fd);
     }
-    PerlIO_printf(PerlIO_stderr(),"\n");
+    PerlIO_printf(Perl_debug_log,"\n");
 }
 #endif	/* DUMP_FDS */
 
@@ -2575,7 +2581,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
     if (!pid)
 	return -1;
     if (pid > 0) {
-	sprintf(spid, "%d", pid);
+	sprintf(spid, "%"IVdf, (IV)pid);
 	svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
 	if (svp && *svp != &PL_sv_undef) {
 	    *statusp = SvIVX(*svp);
@@ -2591,7 +2597,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 	    pid = atoi(hv_iterkey(entry,(I32*)statusp));
 	    sv = hv_iterval(PL_pidstatus,entry);
 	    *statusp = SvIVX(sv);
-	    sprintf(spid, "%d", pid);
+	    sprintf(spid, "%"IVdf, (IV)pid);
 	    (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
 	    return pid;
 	}
@@ -2631,7 +2637,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
     register SV *sv;
     char spid[TYPE_CHARS(int)];
 
-    sprintf(spid, "%d", pid);
+    sprintf(spid, "%"IVdf, (IV)pid);
     sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE);
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = status;
@@ -3329,7 +3335,7 @@ Perl_condpair_magic(pTHX_ SV *sv)
 	    mg->mg_ptr = (char *)cp;
 	    mg->mg_len = sizeof(cp);
 	    MUTEX_UNLOCK(&PL_cred_mutex);	/* XXX need separate mutex? */
-	    DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
+	    DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
 					   "%p: condpair_magic %p\n", thr, sv));)
 	}
     }
@@ -3381,7 +3387,6 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     thr->threadsv = newAV();
     thr->specific = newAV();
     thr->errsv = newSVpvn("", 0);
-    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
 
@@ -3447,7 +3452,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
 	    SV *sv = newSVsv(*svp);
 	    av_store(thr->threadsv, i, sv);
 	    sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1);
-	    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+	    DEBUG_S(PerlIO_printf(Perl_debug_log,
 		"new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
 	}
     }