From 8ac853655d9b744749adcb9687c13d99cdd6e9fb Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 31 Oct 1997 01:43:49 +0000 Subject: Convert miniperl sources to ANSI C. Several passes of GNU C's 'protoize' plus a few hand edits. Will compile miniperl with gcc -x c++ (i.e. treat .c a C++ files) Does not link seems gcc's C++ does not define a symbol for const char foo[] = "...."; i.e. with empty []. p4raw-id: //depot/ansiperl@194 --- util.c | 162 +++++++++++++++++++---------------------------------------------- 1 file changed, 47 insertions(+), 115 deletions(-) (limited to 'util.c') diff --git a/util.c b/util.c index 0d33863411..d40f927ae9 100644 --- a/util.c +++ b/util.c @@ -282,13 +282,7 @@ xstat() /* copy a string up to some (non-backslashed) delimiter, if any */ char * -delimcpy(to, toend, from, fromend, delim, retlen) -register char *to; -register char *toend; -register char *from; -register char *fromend; -register int delim; -I32 *retlen; +delimcpy(register char *to, register char *toend, register char *from, register char *fromend, register int delim, I32 *retlen) { register I32 tolen; for (tolen = 0; from < fromend; from++, tolen++) { @@ -317,9 +311,7 @@ I32 *retlen; /* This routine was donated by Corey Satten. */ char * -instr(big, little) -register char *big; -register char *little; +instr(register char *big, register char *little) { register char *s, *x; register I32 first; @@ -349,11 +341,7 @@ register char *little; /* same as instr but allow embedded nulls */ char * -ninstr(big, bigend, little, lend) -register char *big; -register char *bigend; -char *little; -char *lend; +ninstr(register char *big, register char *bigend, char *little, char *lend) { register char *s, *x; register I32 first = *little; @@ -382,11 +370,7 @@ char *lend; /* reverse of the above--find last substring */ char * -rninstr(big, bigend, little, lend) -register char *big; -char *bigend; -char *little; -char *lend; +rninstr(register char *big, char *bigend, char *little, char *lend) { register char *bigbeg; register char *s, *x; @@ -416,8 +400,7 @@ char *lend; * Set up for a new ctype locale. */ void -perl_new_ctype(newctype) - char *newctype; +perl_new_ctype(char *newctype) { #ifdef USE_LOCALE_CTYPE @@ -439,8 +422,7 @@ perl_new_ctype(newctype) * Set up for a new collation locale. */ void -perl_new_collate(newcoll) - char *newcoll; +perl_new_collate(char *newcoll) { #ifdef USE_LOCALE_COLLATE @@ -484,8 +466,7 @@ perl_new_collate(newcoll) * Set up for a new numeric locale. */ void -perl_new_numeric(newnum) - char *newnum; +perl_new_numeric(char *newnum) { #ifdef USE_LOCALE_NUMERIC @@ -510,7 +491,7 @@ perl_new_numeric(newnum) } void -perl_set_numeric_standard() +perl_set_numeric_standard(void) { #ifdef USE_LOCALE_NUMERIC @@ -524,7 +505,7 @@ perl_set_numeric_standard() } void -perl_set_numeric_local() +perl_set_numeric_local(void) { #ifdef USE_LOCALE_NUMERIC @@ -542,8 +523,7 @@ perl_set_numeric_local() * Initialize locale awareness. */ int -perl_init_i18nl10n(printwarn) - int printwarn; +perl_init_i18nl10n(int printwarn) { int ok = 1; /* returns @@ -772,8 +752,7 @@ perl_init_i18nl10n(printwarn) /* Backwards compatibility. */ int -perl_init_i18nl14n(printwarn) - int printwarn; +perl_init_i18nl14n(int printwarn) { return perl_init_i18nl10n(printwarn); } @@ -788,10 +767,7 @@ perl_init_i18nl14n(printwarn) * Please see sv_collxfrm() to see how this is used. */ char * -mem_collxfrm(s, len, xlen) - const char *s; - STRLEN len; - STRLEN *xlen; +mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) { char *xbuf; STRLEN xalloc, xin, xout; @@ -841,8 +817,7 @@ mem_collxfrm(s, len, xlen) #endif /* USE_LOCALE_COLLATE */ void -fbm_compile(sv) -SV *sv; +fbm_compile(SV *sv) { register unsigned char *s; register unsigned char *table; @@ -883,10 +858,7 @@ SV *sv; } char * -fbm_instr(big, bigend, littlestr) -unsigned char *big; -register unsigned char *bigend; -SV *littlestr; +fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr) { register unsigned char *s; register I32 tmp; @@ -959,9 +931,7 @@ SV *littlestr; } char * -screaminstr(bigstr, littlestr) -SV *bigstr; -SV *littlestr; +screaminstr(SV *bigstr, SV *littlestr) { register unsigned char *s, *x; register unsigned char *big; @@ -1020,9 +990,7 @@ SV *littlestr; } I32 -ibcmp(s1, s2, len) -char *s1, *s2; -register I32 len; +ibcmp(char *s1, char *s2, register I32 len) { register U8 *a = (U8 *)s1; register U8 *b = (U8 *)s2; @@ -1035,9 +1003,7 @@ register I32 len; } I32 -ibcmp_locale(s1, s2, len) -char *s1, *s2; -register I32 len; +ibcmp_locale(char *s1, char *s2, register I32 len) { register U8 *a = (U8 *)s1; register U8 *b = (U8 *)s2; @@ -1052,8 +1018,7 @@ register I32 len; /* copy a string to a safe spot */ char * -savepv(sv) -char *sv; +savepv(char *sv) { register char *newaddr; @@ -1065,9 +1030,7 @@ char *sv; /* same thing but with a known length */ char * -savepvn(sv, len) -char *sv; -register I32 len; +savepvn(char *sv, register I32 len) { register char *newaddr; @@ -1080,7 +1043,7 @@ register I32 len; /* the SV for form() and mess() is not kept in an arena */ static SV * -mess_alloc() +mess_alloc(void) { SV *sv; XPVMG *any; @@ -1119,9 +1082,7 @@ form(pat, va_alist) } char * -mess(pat, args) - const char *pat; - va_list *args; +mess(const char *pat, va_list *args) { SV *sv; static char dgd[] = " during global destruction.\n"; @@ -1350,8 +1311,7 @@ warn(pat,va_alist) #ifndef VMS /* VMS' my_setenv() is in VMS.c */ #ifndef WIN32 void -my_setenv(nam,val) -char *nam, *val; +my_setenv(char *nam, char *val) { register I32 i=setenv_getix(nam); /* where does it go? */ @@ -1465,8 +1425,7 @@ char *nam, *val; #endif /* WIN32 */ I32 -setenv_getix(nam) -char *nam; +setenv_getix(char *nam) { register I32 i, len = strlen(nam); @@ -1754,12 +1713,10 @@ VTOH(vtohl,long) /* VMS' my_popen() is in VMS.c, same with OS/2. */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) PerlIO * -my_popen(cmd,mode) -char *cmd; -char *mode; +my_popen(char *cmd, char *mode) { int p[2]; - register I32 this, that; + register I32 This, that; register I32 pid; SV *sv; I32 doexec = strNE(cmd,"-"); @@ -1771,15 +1728,15 @@ char *mode; #endif if (pipe(p) < 0) return Nullfp; - this = (*mode == 'w'); - that = !this; + This = (*mode == 'w'); + that = !This; if (doexec && tainting) { taint_env(); taint_proper("Insecure %s%s", "EXEC"); } while ((pid = (doexec?vfork():fork())) < 0) { if (errno != EAGAIN) { - close(p[this]); + close(p[This]); if (!doexec) croak("Can't fork"); return Nullfp; @@ -1790,7 +1747,7 @@ char *mode; GV* tmpgv; #define THIS that -#define THAT this +#define THAT This close(p[THAT]); if (p[THIS] != (*mode == 'r')) { dup2(p[THIS], *mode == 'r'); @@ -1820,16 +1777,16 @@ char *mode; } do_execfree(); /* free any memory malloced by child on vfork */ close(p[that]); - if (p[that] < p[this]) { - dup2(p[this], p[that]); - close(p[this]); - p[this] = p[that]; + if (p[that] < p[This]) { + dup2(p[This], p[that]); + close(p[This]); + p[This] = p[that]; } - sv = *av_fetch(fdpid,p[this],TRUE); + sv = *av_fetch(fdpid,p[This],TRUE); (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = pid; forkprocess = pid; - return PerlIO_fdopen(p[this], mode); + return PerlIO_fdopen(p[This], mode); } #else #if defined(atarist) || defined(DJGPP) @@ -1903,9 +1860,7 @@ int newfd; #ifdef HAS_SIGACTION Sighandler_t -rsignal(signo, handler) -int signo; -Sighandler_t handler; +rsignal(int signo, Sighandler_t handler) { struct sigaction act, oact; @@ -1922,8 +1877,7 @@ Sighandler_t handler; } Sighandler_t -rsignal_state(signo) -int signo; +rsignal_state(int signo) { struct sigaction oact; @@ -1934,10 +1888,7 @@ int signo; } int -rsignal_save(signo, handler, save) -int signo; -Sighandler_t handler; -Sigsave_t *save; +rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save) { struct sigaction act; @@ -1951,9 +1902,7 @@ Sigsave_t *save; } int -rsignal_restore(signo, save) -int signo; -Sigsave_t *save; +rsignal_restore(int signo, Sigsave_t *save) { return sigaction(signo, save, (struct sigaction *)NULL); } @@ -2015,8 +1964,7 @@ Sigsave_t *save; /* VMS' my_pclose() is in VMS.c; same with OS/2 */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) I32 -my_pclose(ptr) -PerlIO *ptr; +my_pclose(FILE *ptr) { Sigsave_t hstat, istat, qstat; int status; @@ -2065,10 +2013,7 @@ PerlIO *ptr; #if !defined(DOSISH) || defined(OS2) I32 -wait4pid(pid,statusp,flags) -int pid; -int *statusp; -int flags; +wait4pid(int pid, int *statusp, int flags) { SV *sv; SV** svp; @@ -2128,9 +2073,7 @@ int flags; void /*SUPPRESS 590*/ -pidgone(pid,status) -int pid; -int status; +pidgone(int pid, int status) { register SV *sv; char spid[TYPE_CHARS(int)]; @@ -2163,11 +2106,7 @@ PerlIO *ptr; #endif void -repeatcpy(to,from,len,count) -register char *to; -register char *from; -I32 len; -register I32 count; +repeatcpy(register char *to, register char *from, I32 len, register I32 count) { register I32 todo; register char *frombase = from; @@ -2301,10 +2240,7 @@ char *b; #endif /* !HAS_RENAME */ UV -scan_oct(start, len, retlen) -char *start; -I32 len; -I32 *retlen; +scan_oct(char *start, I32 len, I32 *retlen) { register char *s = start; register UV retval = 0; @@ -2326,10 +2262,7 @@ I32 *retlen; } UV -scan_hex(start, len, retlen) -char *start; -I32 len; -I32 *retlen; +scan_hex(char *start, I32 len, I32 *retlen) { register char *s = start; register UV retval = 0; @@ -2441,8 +2374,7 @@ getTHR _((void)) #endif /* OLD_PTHREADS_API */ MAGIC * -condpair_magic(sv) -SV *sv; +condpair_magic(SV *sv) { MAGIC *mg; @@ -2487,7 +2419,7 @@ SV *sv; * Needed for SunOS with Sun's 'acc' for example. */ double -Perl_huge() +Perl_huge(void) { return HUGE_VAL; } -- cgit v1.2.1 From f0f333f45536802923a359d930d1dcfd5b4589ea Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 31 Oct 1997 23:54:01 +0000 Subject: Further ANSI changes now builds and passes (most) tests with gcc -x c++. p4raw-id: //depot/ansiperl@196 --- util.c | 36 +++++++++++------------------------- 1 file changed, 11 insertions(+), 25 deletions(-) (limited to 'util.c') diff --git a/util.c b/util.c index d40f927ae9..e3233e578a 100644 --- a/util.c +++ b/util.c @@ -67,8 +67,7 @@ static void xstat _((void)); */ Malloc_t -safemalloc(size) -MEM_SIZE size; +safemalloc(MEM_SIZE size) { Malloc_t ptr; #ifdef HAS_64K_LIMIT @@ -101,9 +100,7 @@ MEM_SIZE size; /* paranoid version of realloc */ Malloc_t -saferealloc(where,size) -Malloc_t where; -MEM_SIZE size; +saferealloc(Malloc_t where,MEM_SIZE size) { Malloc_t ptr; #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) @@ -151,13 +148,12 @@ MEM_SIZE size; /* safe version of free */ Free_t -safefree(where) -Malloc_t where; +safefree(Malloc_t where) { #if !(defined(I286) || defined(atarist)) - DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",where,an++)); + DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,an++)); #else - DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",where,an++)); + DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,an++)); #endif if (where) { /*SUPPRESS 701*/ @@ -168,9 +164,7 @@ Malloc_t where; /* safe version of calloc */ Malloc_t -safecalloc(count, size) -MEM_SIZE count; -MEM_SIZE size; +safecalloc(MEM_SIZE count, MEM_SIZE size) { Malloc_t ptr; @@ -212,9 +206,7 @@ MEM_SIZE size; #define ALIGN sizeof(long) Malloc_t -safexmalloc(x,size) -I32 x; -MEM_SIZE size; +safexmalloc(I32 x, MEM_SIZE size) { register Malloc_t where; @@ -226,17 +218,14 @@ MEM_SIZE size; } Malloc_t -safexrealloc(where,size) -Malloc_t where; -MEM_SIZE size; +safexrealloc(Malloc_t where, MEM_SIZE size) { register Malloc_t new = saferealloc(where - ALIGN, size + ALIGN); return new + ALIGN; } void -safexfree(where) -Malloc_t where; +safexfree(Malloc_t where) { I32 x; @@ -249,10 +238,7 @@ Malloc_t where; } Malloc_t -safexcalloc(x,count,size) -I32 x; -MEM_SIZE count; -MEM_SIZE size; +safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size) { register Malloc_t where; @@ -265,7 +251,7 @@ MEM_SIZE size; } static void -xstat() +xstat(void) { register I32 i; -- cgit v1.2.1 From 4e35701fd273ba8d0093a29660dee38a92408e9b Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Wed, 5 Nov 1997 01:04:10 +0000 Subject: Builds C++ Borland, MSVC++ (Win32) and GCC++ (Solaris) p4raw-id: //depot/ansiperl@203 --- util.c | 171 +++++------------------------------------------------------------ 1 file changed, 13 insertions(+), 158 deletions(-) (limited to 'util.c') diff --git a/util.c b/util.c index 985448728a..6eccc55acd 100644 --- a/util.c +++ b/util.c @@ -56,10 +56,6 @@ static void xstat _((void)); #endif -#ifdef USE_THREADS -static U32 threadnum = 0; -#endif /* USE_THREADS */ - #ifndef MYMALLOC /* paranoid version of malloc */ @@ -97,6 +93,7 @@ safemalloc(MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -145,6 +142,7 @@ saferealloc(Malloc_t where,MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -199,6 +197,7 @@ safecalloc(MEM_SIZE count, MEM_SIZE size) else { PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH; my_exit(1); + return Nullch; } /*NOTREACHED*/ } @@ -1349,8 +1348,7 @@ my_setenv(char *nam, char *val) #else /* if WIN32 */ void -my_setenv(nam,val) -char *nam, *val; +my_setenv(char *nam,char *val) { #ifdef USE_WIN32_RTL_ENV @@ -1448,10 +1446,7 @@ char *f; #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) char * -my_bcopy(from,to,len) -register char *from; -register char *to; -register I32 len; +my_bcopy(register char *from,register char *to,register I32 len) { char *retval = to; @@ -1900,9 +1895,7 @@ rsignal_restore(int signo, Sigsave_t *save) #else /* !HAS_SIGACTION */ Sighandler_t -rsignal(signo, handler) -int signo; -Sighandler_t handler; +rsignal(int signo, Sighandler_t handler) { return signal(signo, handler); } @@ -1911,15 +1904,13 @@ static int sig_trapped; static Signal_t -sig_trap(signo) -int signo; +sig_trap(int signo) { sig_trapped++; } Sighandler_t -rsignal_state(signo) -int signo; +rsignal_state(int signo) { Sighandler_t oldsig; @@ -1932,19 +1923,14 @@ int signo; } int -rsignal_save(signo, handler, save) -int signo; -Sighandler_t handler; -Sigsave_t *save; +rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save) { *save = signal(signo, handler); return (*save == SIG_ERR) ? -1 : 0; } int -rsignal_restore(signo, save) -int signo; -Sigsave_t *save; +rsignal_restore(int signo, Sigsave_t *save) { return (signal(signo, *save) == SIG_ERR) ? -1 : 0; } @@ -2259,13 +2245,13 @@ scan_hex(char *start, I32 len, I32 *retlen) bool overflowed = FALSE; char *tmp; - while (len-- && *s && (tmp = strchr(hexdigit, *s))) { + while (len-- && *s && (tmp = strchr((char *) hexdigit, *s))) { register UV n = retval << 4; if (!overflowed && (n >> 4) != retval) { warn("Integer overflow in hex number"); overflowed = TRUE; } - retval = n | (tmp - hexdigit) & 15; + retval = n | ((tmp - hexdigit) & 15); s++; } *retlen = s - start; @@ -2400,138 +2386,6 @@ condpair_magic(SV *sv) } return mg; } - -/* - * Make a new perl thread structure using t as a prototype. If t is NULL - * then this is the initial main thread and we have to bootstrap carefully. - * Some of the fields for the new thread are copied from the prototype - * thread, t, so t should not be running in perl at the time this function - * is called. The usual case, where t is the thread calling new_struct_thread, - * clearly satisfies this constraint. - */ -struct thread * -new_struct_thread(t) -struct thread *t; -{ - struct thread *thr; - XPV *xpv; - SV *sv; - - Newz(53, thr, 1, struct thread); - cvcache = newHV(); - curcop = &compiling; - thr->specific = newAV(); - thr->flags = THRf_R_JOINABLE; - MUTEX_INIT(&thr->mutex); - if (t) { - oursv = newSVpv("", 0); - SvGROW(oursv, sizeof(struct thread) + 1); - SvCUR_set(oursv, sizeof(struct thread)); - thr = (struct thread *) SvPVX(sv); - } else { - /* 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; - } - if (t) { - curcop = t->Tcurcop; /* XXX As good a guess as any? */ - defstash = t->Tdefstash; /* XXX maybe these should */ - curstash = t->Tcurstash; /* always be set to main? */ - /* top_env? */ - /* runlevel */ - tainted = t->Ttainted; - curpm = t->Tcurpm; /* XXX No PMOP ref count */ - nrs = newSVsv(t->Tnrs); - rs = newSVsv(t->Trs); - last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv); - ofslen = t->Tofslen; - ofs = savepvn(t->Tofs, ofslen); - defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); - chopset = t->Tchopset; - formtarget = newSVsv(t->Tformtarget); - bodytarget = newSVsv(t->Tbodytarget); - toptarget = newSVsv(t->Ttoptarget); - keys = newSVpv("", 0); - } else { - curcop = &compiling; - chopset = " \n-"; - } - MUTEX_LOCK(&threads_mutex); - nthreads++; - thr->tid = threadnum++; - if (t) { - thr->next = t->next; - thr->prev = t; - t->next = thr; - thr->next->prev = thr; - } else { - thr->next = thr; - thr->prev = thr; - } - MUTEX_UNLOCK(&threads_mutex); - -#ifdef HAVE_THREAD_INTERN - init_thread_intern(thr); -#else - thr->self = pthread_self(); -#endif /* HAVE_THREAD_INTERN */ - SET_THR(thr); - if (!t) { - /* - * These must come after the SET_THR because sv_setpvn does - * SvTAINT and the taint fields require dTHR. - */ - toptarget = NEWSV(0,0); - sv_upgrade(toptarget, SVt_PVFM); - sv_setpvn(toptarget, "", 0); - bodytarget = NEWSV(0,0); - sv_upgrade(bodytarget, SVt_PVFM); - sv_setpvn(bodytarget, "", 0); - formtarget = bodytarget; - } - return thr; -} - -PADOFFSET -key_create() -{ - char *s; - STRLEN len; - PADOFFSET i; - MUTEX_LOCK(&keys_mutex); - s = SvPV(keys, len); - for (i = 0; i < len; i++) { - if (!s[i]) { - s[i] = 1; - break; - } - } - if (i == len) - sv_catpvn(keys, "\1", 1); - MUTEX_UNLOCK(&keys_mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_create: %d\n", (int)i)); - return i; -} - -void -key_destroy(key) -PADOFFSET key; -{ - char *s; - MUTEX_LOCK(&keys_mutex); - s = SvPVX(keys); - s[key] = 0; - MUTEX_UNLOCK(&keys_mutex); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_destroy: %d\n", (int)key)); -} #endif /* USE_THREADS */ #ifdef HUGE_VAL @@ -2546,3 +2400,4 @@ Perl_huge(void) return HUGE_VAL; } #endif + -- cgit v1.2.1 From aeea060ce4b653ecf5b0731f1cbfcf468f688acd Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 7 Nov 1997 23:52:35 +0000 Subject: Reverse integrate Malcolm's chanes into local repository, then import result back into my view of Malcolm's repository. Builds and passes (most) tests with GNU C++/Solaris and Borland C++, Win32. p4raw-id: //depot/ansiperl@210 --- util.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'util.c') diff --git a/util.c b/util.c index 93f5620e2e..4ece7f1224 100644 --- a/util.c +++ b/util.c @@ -56,6 +56,10 @@ static void xstat _((void)); #endif +#ifdef USE_THREADS +static U32 threadnum = 0; +#endif /* USE_THREADS */ + #ifndef MYMALLOC /* paranoid version of malloc */ @@ -2397,8 +2401,7 @@ condpair_magic(SV *sv) * thread calling new_struct_thread) clearly satisfies this constraint. */ struct thread * -new_struct_thread(t) -struct thread *t; +new_struct_thread(struct thread *t) { struct thread *thr; SV *sv; -- cgit v1.2.1 From 0b9678a8abcf790b88babcb35eec34072787a87f Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Sat, 8 Nov 1997 15:03:39 +0000 Subject: Get threads working again on Win32 Root cause of fail was init_thread_intern() in new_struct_thread() (which is called in parent thread) clobbering dTHR of parent thread. It is doubtfull if setting 'self' in new_struct_thread() is 'right' but left in for now. p4raw-id: //depot/ansiperl@213 --- util.c | 40 +++++++++++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 9 deletions(-) (limited to 'util.c') diff --git a/util.c b/util.c index 914ec6ace5..62b0f00c01 100644 --- a/util.c +++ b/util.c @@ -2418,8 +2418,6 @@ new_struct_thread(struct thread *t) SvGROW(sv, sizeof(struct thread) + 1); SvCUR_set(sv, sizeof(struct thread)); thr = (Thread) SvPVX(sv); - /* Zero(thr, 1, struct thread); */ - /* debug */ memset(thr, 0xab, sizeof(struct thread)); markstack = 0; @@ -2431,7 +2429,7 @@ new_struct_thread(struct thread *t) /* end debug */ thr->oursv = sv; - init_stacks(thr); + init_stacks(ARGS); curcop = &compiling; thr->cvcache = newHV(); @@ -2443,9 +2441,23 @@ new_struct_thread(struct thread *t) curcop = t->Tcurcop; /* XXX As good a guess as any? */ defstash = t->Tdefstash; /* XXX maybe these should */ curstash = t->Tcurstash; /* always be set to main? */ - /* top_env needs to be non-zero. The particular value doesn't matter */ - top_env = t->Ttop_env; - runlevel = 1; /* XXX should be safe ? */ + + + /* top_env needs to be non-zero. It points to an area + in which longjmp() stuff is stored, as C callstack + info there at least is thread specific this has to + be per-thread. Otherwise a 'die' in a thread gives + that thread the C stack of last thread to do an eval {}! + See comments in scope.h + Initialize top entry (as in perl.c for main thread) + */ + start_env.je_prev = NULL; + start_env.je_ret = -1; + start_env.je_mustcatch = TRUE; + top_env = &start_env; + + runlevel = 0; /* Let entering sub do increment */ + in_eval = FALSE; restartop = 0; @@ -2470,7 +2482,8 @@ new_struct_thread(struct thread *t) av_store(thr->magicals, i, sv); sv_magic(sv, 0, 0, &per_thread_magicals[i], 1); DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "new_struct_thread: copied magical %d\n",i)); + "new_struct_thread: copied magical %d %p->%p\n",i, + t, thr)); } } @@ -2483,8 +2496,17 @@ new_struct_thread(struct thread *t) thr->next->prev = thr; MUTEX_UNLOCK(&threads_mutex); -#ifdef HAVE_THREAD_INTERN - init_thread_intern(thr); +/* + * This is highly suspect - new_struct_thread is executed + * by creating thread so pthread_self() or equivalent + * is parent thread not the child. + * In particular this should _NOT_ change dTHR value of calling thread. + * + * But a good place to have a 'hook' for filling in port-private + * fields of thr. + */ +#ifdef INIT_THREAD_INTERN + INIT_THREAD_INTERN(thr); #else thr->self = pthread_self(); #endif /* HAVE_THREAD_INTERN */ -- cgit v1.2.1