/* util.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* safe version of free */
-void
+Free_t
safefree(where)
Malloc_t where;
{
if ((long)size < 0 || (long)count < 0)
croak("panic: calloc");
#endif
+ size *= count;
+ ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
#if !(defined(I286) || defined(atarist))
DEBUG_m(PerlIO_printf(PerlIO_stderr(), "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
#else
DEBUG_m(PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
#endif
- size *= count;
- ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
return ptr;
/* copy a string up to some (non-backslashed) delimiter, if any */
char *
-cpytill(to,from,fromend,delim,retlen)
+delimcpy(to, toend, from, fromend, delim, retlen)
register char *to;
+register char *toend;
register char *from;
register char *fromend;
register int delim;
I32 *retlen;
{
- char *origto = to;
-
- for (; from < fromend; from++,to++) {
+ register I32 tolen;
+ for (tolen = 0; from < fromend; from++, tolen++) {
if (*from == '\\') {
if (from[1] == delim)
from++;
- else if (from[1] == '\\')
- *to++ = *from++;
+ else {
+ if (to < toend)
+ *to++ = *from;
+ tolen++;
+ from++;
+ }
}
else if (*from == delim)
break;
- *to = *from;
+ if (to < toend)
+ *to++ = *from;
}
- *to = '\0';
- *retlen = to - origto;
+ if (to < toend)
+ *to = '\0';
+ *retlen = tolen;
return from;
}
#ifdef USE_LOCALE
-#ifdef LC_ALL
- char *lc_all = getenv("LC_ALL");
-#endif /* LC_ALL */
#ifdef USE_LOCALE_CTYPE
- char *lc_ctype = getenv("LC_CTYPE");
char *curctype = NULL;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- char *lc_collate = getenv("LC_COLLATE");
char *curcoll = NULL;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- char *lc_numeric = getenv("LC_NUMERIC");
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
+ char *lc_all = getenv("LC_ALL");
char *lang = getenv("LANG");
bool setlocale_failure = FALSE;
+#ifdef LOCALE_ENVIRON_REQUIRED
+
+ /*
+ * Ultrix setlocale(..., "") fails if there are no environment
+ * variables from which to get a locale name.
+ */
+
+ bool done = FALSE;
+
+#ifdef LC_ALL
+ if (lang) {
+ if (setlocale(LC_ALL, ""))
+ done = TRUE;
+ else
+ setlocale_failure = TRUE;
+ }
+ if (!setlocale_failure)
+#endif /* LC_ALL */
+ {
+#ifdef USE_LOCALE_CTYPE
+ if (! (curctype = setlocale(LC_CTYPE,
+ (!done && (lang || getenv("LC_CTYPE")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_CTYPE */
+#ifdef USE_LOCALE_COLLATE
+ if (! (curcoll = setlocale(LC_COLLATE,
+ (!done && (lang || getenv("LC_COLLATE")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_COLLATE */
+#ifdef USE_LOCALE_NUMERIC
+ if (! (curnum = setlocale(LC_NUMERIC,
+ (!done && (lang || getenv("LC_NUMERIC")))
+ ? "" : Nullch)))
+ setlocale_failure = TRUE;
+#endif /* USE_LOCALE_NUMERIC */
+ }
+
+#else /* !LOCALE_ENVIRON_REQUIRED */
+
#ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
#endif /* LC_ALL */
+#endif /* !LOCALE_ENVIRON_REQUIRED */
+
if (setlocale_failure) {
char *p;
bool locwarn = (printwarn > 1 ||
PerlIO_printf(PerlIO_stderr(),
"perl: warning: Please check that your locale settings:\n");
-#ifdef LC_ALL
PerlIO_printf(PerlIO_stderr(),
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
lc_all ? lc_all : "unset",
lc_all ? '"' : ')');
-#endif /* LC_ALL */
{
char **e;
return newaddr;
}
+/* the SV for form() and mess() is not kept in an arena */
+
+static SV *
+mess_alloc()
+{
+ SV *sv;
+ XPVMG *any;
+
+ /* Create as PVMG now, to avoid any upgrading later */
+ New(905, sv, 1, SV);
+ Newz(905, any, 1, XPVMG);
+ SvFLAGS(sv) = SVt_PVMG;
+ SvANY(sv) = (void*)any;
+ SvREFCNT(sv) = 1 << 30; /* practically infinite */
+ return sv;
+}
+
#ifdef I_STDARG
char *
-mess(char *pat, va_list *args)
+form(const char* pat, ...)
#else
/*VARARGS0*/
char *
-mess(pat, args)
- char *pat;
- va_list *args;
+form(pat, va_alist)
+ const char *pat;
+ va_dcl
#endif
{
- char *s;
- char *s_start;
- SV *tmpstr;
- I32 usermess;
-#ifndef HAS_VPRINTF
-#ifdef USE_CHAR_VSPRINTF
- char *vsprintf();
+ va_list args;
+#ifdef I_STDARG
+ va_start(args, pat);
#else
- I32 vsprintf();
-#endif
+ va_start(args);
#endif
+ if (!mess_sv)
+ mess_sv = mess_alloc();
+ sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ va_end(args);
+ return SvPVX(mess_sv);
+}
- s = s_start = buf;
- usermess = strEQ(pat, "%s");
- if (usermess) {
- tmpstr = sv_newmortal();
- sv_setpv(tmpstr, va_arg(*args, char *));
- *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
- }
- else {
- (void) vsprintf(s,pat,*args);
- s += strlen(s);
- }
- va_end(*args);
-
- if (!(s > s_start && s[-1] == '\n')) {
+char *
+mess(pat, args)
+ const char *pat;
+ va_list *args;
+{
+ SV *sv;
+ static char dgd[] = " during global destruction.\n";
+
+ if (!mess_sv)
+ mess_sv = mess_alloc();
+ sv = mess_sv;
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
+ dTHR;
if (dirty)
- strcpy(s, " during global destruction.\n");
+ sv_catpv(sv, dgd);
else {
- if (curcop->cop_line) {
- (void)sprintf(s," at %s line %ld",
- SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
- s += strlen(s);
- }
+ if (curcop->cop_line)
+ sv_catpvf(sv, " at %_ line %ld",
+ GvSV(curcop->cop_filegv), (long)curcop->cop_line);
if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
bool line_mode = (RsSIMPLE(rs) &&
SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
- (void)sprintf(s,", <%s> %s %ld",
- last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
- line_mode ? "line" : "chunk",
- (long)IoLINES(GvIOp(last_in_gv)));
- s += strlen(s);
+ sv_catpvf(sv, ", <%s> %s %ld",
+ last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
+ line_mode ? "line" : "chunk",
+ (long)IoLINES(GvIOp(last_in_gv)));
}
- (void)strcpy(s,".\n");
- s += 2;
+ sv_catpv(sv, ".\n");
}
- if (usermess)
- sv_catpv(tmpstr,buf+1);
- }
-
- if (s - s_start >= sizeof(buf)) { /* Ooops! */
- if (usermess)
- PerlIO_puts(PerlIO_stderr(), SvPVX(tmpstr));
- else
- PerlIO_puts(PerlIO_stderr(), buf);
- PerlIO_puts(PerlIO_stderr(), "panic: message overflow - memory corrupted!\n");
- my_exit(1);
}
- if (usermess)
- return SvPVX(tmpstr);
- else
- return buf;
+ return SvPVX(sv);
}
#ifdef I_STDARG
OP *
-die(char* pat, ...)
+die(const char* pat, ...)
#else
/*VARARGS0*/
OP *
die(pat, va_alist)
- char *pat;
+ const char *pat;
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
- int oldrunlevel = runlevel;
+ I32 oldrunlevel = runlevel;
int was_in_eval = in_eval;
HV *stash;
GV *gv;
CV *cv;
+ DEBUG_L(fprintf(stderr, "die: curstack = %p, mainstack= %p\n",
+ curstack, mainstack));/*debug*/
/* We have to switch back to mainstack or die_where may try to pop
* the eval block from the wrong stack if die is being called from a
* signal handler. - dkindred@cs.cmu.edu */
message = mess(pat, &args);
va_end(args);
- if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
- dSP;
- SV *msg = sv_2mortal(newSVpv(message, 0));
+ DEBUG_L(fprintf(stderr, "die: message = %s\ndiehook = %p\n",
+ message, diehook));/*debug*/
+ if (diehook) {
+ /* sv_2cv might call croak() */
+ SV *olddiehook = diehook;
+ ENTER;
+ SAVESPTR(diehook);
+ diehook = Nullsv;
+ cv = sv_2cv(olddiehook, &stash, &gv, 0);
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
+ dSP;
+ SV *msg;
- PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(msg);
- PUTBACK;
- perl_call_sv((SV*)cv, G_DISCARD);
+ ENTER;
+ msg = newSVpv(message, 0);
+ SvREADONLY_on(msg);
+ SAVEFREESV(msg);
- /* It's okay for the __DIE__ hook to modify the message. */
- message = SvPV(msg, na);
+ PUSHMARK(sp);
+ XPUSHs(msg);
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+
+ LEAVE;
+ }
}
restartop = die_where(message);
+ DEBUG_L(fprintf(stderr,
+ "die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
+ restartop, was_in_eval, oldrunlevel));/*debug*/
if ((!restartop && was_in_eval) || oldrunlevel > 1)
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
return restartop;
}
#ifdef I_STDARG
void
-croak(char* pat, ...)
+croak(const char* pat, ...)
#else
/*VARARGS0*/
void
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
HV *stash;
#endif
message = mess(pat, &args);
va_end(args);
+#ifdef USE_THREADS
+ DEBUG_L(fprintf(stderr, "croak: 0x%lx %s", (unsigned long) thr, message));
+#endif /* USE_THREADS */
if (diehook) {
+ /* sv_2cv might call croak() */
SV *olddiehook = diehook;
- diehook = Nullsv; /* sv_2cv might call croak() */
+ ENTER;
+ SAVESPTR(diehook);
+ diehook = Nullsv;
cv = sv_2cv(olddiehook, &stash, &gv, 0);
- diehook = olddiehook;
- if (cv && !CvDEPTH(cv)) {
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
- SV *msg = sv_2mortal(newSVpv(message, 0));
+ SV *msg;
+
+ ENTER;
+ msg = newSVpv(message, 0);
+ SvREADONLY_on(msg);
+ SAVEFREESV(msg);
PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(msg);
+ XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
- /* It's okay for the __DIE__ hook to modify the message. */
- message = SvPV(msg, na);
+ LEAVE;
}
}
if (in_eval) {
restartop = die_where(message);
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
}
PerlIO_puts(PerlIO_stderr(),message);
(void)PerlIO_flush(PerlIO_stderr());
- if (e_tmpname) {
- if (e_fp) {
- PerlIO_close(e_fp);
- e_fp = Nullfp;
- }
- (void)UNLINK(e_tmpname);
- Safefree(e_tmpname);
- e_tmpname = Nullch;
- }
- statusvalue = SHIFTSTATUS(statusvalue);
-#ifdef VMS
- my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
-#else
- my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
-#endif
+ my_failure_exit();
}
void
#ifdef I_STDARG
-warn(char* pat,...)
+warn(const char* pat,...)
#else
/*VARARGS0*/
warn(pat,va_alist)
- char *pat;
+ const char *pat;
va_dcl
#endif
{
va_end(args);
if (warnhook) {
+ /* sv_2cv might call warn() */
+ dTHR;
SV *oldwarnhook = warnhook;
- warnhook = Nullsv; /* sv_2cv might end up calling warn() */
+ ENTER;
+ SAVESPTR(warnhook);
+ warnhook = Nullsv;
cv = sv_2cv(oldwarnhook, &stash, &gv, 0);
- warnhook = oldwarnhook;
- if (cv && !CvDEPTH(cv)) {
+ LEAVE;
+ if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
+ SV *msg;
+
+ ENTER;
+ msg = newSVpv(message, 0);
+ SvREADONLY_on(msg);
+ SAVEFREESV(msg);
PUSHMARK(sp);
- EXTEND(sp, 1);
- PUSHs(sv_2mortal(newSVpv(message,0)));
+ XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
+
+ LEAVE;
return;
}
}
}
#ifndef VMS /* VMS' my_setenv() is in VMS.c */
+#ifndef _WIN32
void
my_setenv(nam,val)
char *nam, *val;
environ = tmpenv; /* tell exec where it is now */
}
if (!val) {
+ Safefree(environ[i]);
while (environ[i]) {
environ[i] = environ[i+1];
i++;
} /* potential SEGV's */
return i;
}
+
+#else /* if _WIN32 */
+
+void
+my_setenv(nam,val)
+char *nam, *val;
+{
+ register char *envstr;
+ STRLEN namlen = strlen(nam);
+ STRLEN vallen = strlen(val ? val : "");
+
+ New(904, envstr, namlen + vallen + 3, char);
+ (void)sprintf(envstr,"%s=%s",nam,val);
+ if (!vallen) {
+ /* An attempt to delete the entry.
+ * We try to fix a Win32 process handling goof: Children
+ * of the current process will end up seeing the
+ * grandparent's entry if the current process has never
+ * modified the entry being deleted. So we call _putenv()
+ * twice: once to pretend to modify the entry, and the
+ * second time to actually delete it. GSAR 97-03-19
+ */
+ envstr[namlen+1] = 'X'; envstr[namlen+2] = '\0';
+ (void)_putenv(envstr);
+ envstr[namlen+1] = '\0';
+ }
+ (void)_putenv(envstr);
+}
+
+#endif /* _WIN32 */
#endif /* !VMS */
#ifdef UNLINK_ALL_VERSIONS
}
#endif
+#ifndef HAS_MEMSET
+void *
+my_memset(loc,ch,len)
+register char *loc;
+register I32 ch;
+register I32 len;
+{
+ char *retval = loc;
+
+ while (len--)
+ *loc++ = ch;
+ return retval;
+}
+#endif
+
#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
char *
my_bzero(loc,len)
int
#endif
vsprintf(dest, pat, args)
-char *dest, *pat, *args;
+char *dest;
+const char *pat;
+char *args;
{
FILE fakebuf;
register I32 this, that;
register I32 pid;
SV *sv;
- I32 doexec =
-#ifdef AMIGAOS
- 1;
-#else
- strNE(cmd,"-");
-#endif
+ I32 doexec = strNE(cmd,"-");
#ifdef OS2
if (doexec) {
}
/*SUPPRESS 560*/
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
- sv_setiv(GvSV(tmpgv),(I32)getpid());
+ sv_setiv(GvSV(tmpgv), (IV)getpid());
forkprocess = 0;
hv_clear(pidstatus); /* we have no children */
return Nullfp;
close(newfd);
return fcntl(oldfd, F_DUPFD, newfd);
#else
- int fdtmp[256];
+#define DUP2_MAX_FDS 256
+ int fdtmp[DUP2_MAX_FDS];
I32 fdx = 0;
int fd;
if (oldfd == newfd)
return oldfd;
close(newfd);
- while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
+ /* good enough for low fd's... */
+ while ((fd = dup(oldfd)) != newfd && fd >= 0) {
+ if (fdx >= DUP2_MAX_FDS) {
+ close(fd);
+ fd = -1;
+ break;
+ }
fdtmp[fdx++] = fd;
+ }
while (fdx > 0)
close(fdtmp[--fdx]);
return fd;
int status;
SV **svp;
int pid;
+ bool close_failed;
+ int saved_errno;
+#ifdef VMS
+ int saved_vaxc_errno;
+#endif
svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE);
pid = (int)SvIVX(*svp);
return my_syspclose(ptr);
}
#endif
- PerlIO_close(ptr);
+ if ((close_failed = (PerlIO_close(ptr) == EOF))) {
+ saved_errno = errno;
+#ifdef VMS
+ saved_vaxc_errno = vaxc$errno;
+#endif
+ }
#ifdef UTS
if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
rsignal_restore(SIGHUP, &hstat);
rsignal_restore(SIGINT, &istat);
rsignal_restore(SIGQUIT, &qstat);
- return(pid < 0 ? pid : status);
+ if (close_failed) {
+ SETERRNO(saved_errno, saved_vaxc_errno);
+ return -1;
+ }
+ return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status));
}
#endif /* !DOSISH */
{
SV *sv;
SV** svp;
- char spid[16];
+ char spid[TYPE_CHARS(int)];
if (!pid)
return -1;
int status;
{
register SV *sv;
- char spid[16];
+ char spid[TYPE_CHARS(int)];
sprintf(spid, "%d", pid);
sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
char *fb = strrchr(b,'/');
struct stat tmpstatbuf1;
struct stat tmpstatbuf2;
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 1024
-#endif
- char tmpbuf[MAXPATHLEN+1];
+ SV *tmpsv = sv_newmortal();
if (fa)
fa++;
if (strNE(a,b))
return FALSE;
if (fa == a)
- strcpy(tmpbuf,".");
+ sv_setpv(tmpsv, ".");
else
- strncpy(tmpbuf, a, fa - a);
- if (Stat(tmpbuf, &tmpstatbuf1) < 0)
+ sv_setpvn(tmpsv, a, fa - a);
+ if (Stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
return FALSE;
if (fb == b)
- strcpy(tmpbuf,".");
+ sv_setpv(tmpsv, ".");
else
- strncpy(tmpbuf, b, fb - b);
- if (Stat(tmpbuf, &tmpstatbuf2) < 0)
+ sv_setpvn(tmpsv, b, fb - b);
+ if (Stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
return FALSE;
return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
return retval;
}
-unsigned long
+UV
scan_hex(start, len, retlen)
char *start;
I32 len;
return retval;
}
+#ifdef USE_THREADS
+#ifdef FAKE_THREADS
+/* Very simplistic scheduler for now */
+void
+schedule(void)
+{
+ thr = thr->next_run;
+}
+
+void
+perl_cond_init(cp)
+perl_cond *cp;
+{
+ *cp = 0;
+}
+
+void
+perl_cond_signal(cp)
+perl_cond *cp;
+{
+ perl_thread t;
+ perl_cond cond = *cp;
+
+ if (!cond)
+ return;
+ t = cond->thread;
+ /* Insert t in the runnable queue just ahead of us */
+ t->next_run = thr->next_run;
+ thr->next_run->prev_run = t;
+ t->prev_run = thr;
+ thr->next_run = t;
+ thr->wait_queue = 0;
+ /* Remove from the wait queue */
+ *cp = cond->next;
+ Safefree(cond);
+}
+
+void
+perl_cond_broadcast(cp)
+perl_cond *cp;
+{
+ perl_thread t;
+ perl_cond cond, cond_next;
+
+ for (cond = *cp; cond; cond = cond_next) {
+ t = cond->thread;
+ /* Insert t in the runnable queue just ahead of us */
+ t->next_run = thr->next_run;
+ thr->next_run->prev_run = t;
+ t->prev_run = thr;
+ thr->next_run = t;
+ thr->wait_queue = 0;
+ /* Remove from the wait queue */
+ cond_next = cond->next;
+ Safefree(cond);
+ }
+ *cp = 0;
+}
+
+void
+perl_cond_wait(cp)
+perl_cond *cp;
+{
+ perl_cond cond;
+
+ if (thr->next_run == thr)
+ croak("panic: perl_cond_wait called by last runnable thread");
+
+ New(666, cond, 1, struct perl_wait_queue);
+ cond->thread = thr;
+ cond->next = *cp;
+ *cp = cond;
+ thr->wait_queue = cond;
+ /* Remove ourselves from runnable queue */
+ thr->next_run->prev_run = thr->prev_run;
+ thr->prev_run->next_run = thr->next_run;
+}
+#endif /* FAKE_THREADS */
+
+#ifdef OLD_PTHREADS_API
+struct thread *
+getTHR _((void))
+{
+ pthread_addr_t t;
+
+ if (pthread_getspecific(thr_key, &t))
+ croak("panic: pthread_getspecific");
+ return (struct thread *) t;
+}
+#endif /* OLD_PTHREADS_API */
+
+MAGIC *
+condpair_magic(sv)
+SV *sv;
+{
+ MAGIC *mg;
+
+ SvUPGRADE(sv, SVt_PVMG);
+ mg = mg_find(sv, 'm');
+ if (!mg) {
+ condpair_t *cp;
+
+ New(53, cp, 1, condpair_t);
+ MUTEX_INIT(&cp->mutex);
+ COND_INIT(&cp->owner_cond);
+ COND_INIT(&cp->cond);
+ cp->owner = 0;
+ MUTEX_LOCK(&sv_mutex);
+ mg = mg_find(sv, 'm');
+ if (mg) {
+ /* someone else beat us to initialising it */
+ MUTEX_UNLOCK(&sv_mutex);
+ MUTEX_DESTROY(&cp->mutex);
+ COND_DESTROY(&cp->owner_cond);
+ COND_DESTROY(&cp->cond);
+ Safefree(cp);
+ }
+ else {
+ sv_magic(sv, Nullsv, 'm', 0, 0);
+ mg = SvMAGIC(sv);
+ mg->mg_ptr = (char *)cp;
+ mg->mg_len = sizeof(cp);
+ MUTEX_UNLOCK(&sv_mutex);
+ }
+ }
+ return mg;
+}
+#endif /* USE_THREADS */
#ifdef HUGE_VAL
/*