From: Gurusamy Sarathy Date: Sun, 2 Jan 2000 18:45:58 +0000 (+0000) Subject: usethreads build fixups for NeXTstep (as suggested by Hans Mulder) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7a3f225871b642595bb66695465453bbff5332c7;p=p5sagit%2Fp5-mst-13.2.git usethreads build fixups for NeXTstep (as suggested by Hans Mulder) p4raw-id: //depot/perl@4746 --- diff --git a/embed.h b/embed.h index 870e7e8..3b5c0bf 100644 --- a/embed.h +++ b/embed.h @@ -1808,20 +1808,20 @@ #define my(a) Perl_my(aTHX_ a) #define my_atof(a) Perl_my_atof(aTHX_ a) #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -#define my_bcopy(a,b,c) Perl_my_bcopy(aTHX_ a,b,c) +#define my_bcopy Perl_my_bcopy #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -#define my_bzero(a,b) Perl_my_bzero(aTHX_ a,b) +#define my_bzero Perl_my_bzero #endif #define my_exit(a) Perl_my_exit(aTHX_ a) #define my_failure_exit() Perl_my_failure_exit(aTHX) #define my_fflush_all() Perl_my_fflush_all(aTHX) #define my_lstat() Perl_my_lstat(aTHX) #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -#define my_memcmp(a,b,c) Perl_my_memcmp(aTHX_ a,b,c) +#define my_memcmp Perl_my_memcmp #endif #if !defined(HAS_MEMSET) -#define my_memset(a,b,c) Perl_my_memset(aTHX_ a,b,c) +#define my_memset Perl_my_memset #endif #if !defined(PERL_OBJECT) #define my_pclose(a) Perl_my_pclose(aTHX_ a) diff --git a/embed.pl b/embed.pl index db1ddf0..2265901 100755 --- a/embed.pl +++ b/embed.pl @@ -1419,20 +1419,20 @@ p |char* |moreswitches |char* s p |OP* |my |OP* o p |NV |my_atof |const char *s #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -p |char* |my_bcopy |const char* from|char* to|I32 len +np |char* |my_bcopy |const char* from|char* to|I32 len #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -p |char* |my_bzero |char* loc|I32 len +np |char* |my_bzero |char* loc|I32 len #endif pr |void |my_exit |U32 status pr |void |my_failure_exit p |I32 |my_fflush_all p |I32 |my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -p |I32 |my_memcmp |const char* s1|const char* s2|I32 len +np |I32 |my_memcmp |const char* s1|const char* s2|I32 len #endif #if !defined(HAS_MEMSET) -p |void* |my_memset |char* loc|I32 ch|I32 len +np |void* |my_memset |char* loc|I32 ch|I32 len #endif #if !defined(PERL_OBJECT) p |I32 |my_pclose |PerlIO* ptr diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs index 8779d3c..705c8bc 100644 --- a/ext/DynaLoader/dl_beos.xs +++ b/ext/DynaLoader/dl_beos.xs @@ -67,7 +67,7 @@ dl_find_symbol(libhandle, symbolname) status_t retcode; void *adr = 0; #ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif RETVAL = NULL; DLDEBUG(2, PerlIO_printf(Perl_debug_log, diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 0746bc5..9c07e60 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -175,7 +175,7 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index ad04029..582c047 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -104,7 +104,7 @@ dl_find_symbol(libhandle, symbolname) void *symaddr = NULL; int status; #ifdef __hp9000s300 - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 44a9d35..b8c19f2 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -93,11 +93,11 @@ static void TranslateError index = number; if (index > NUM_OFI_ERRORS - 1) index = NUM_OFI_ERRORS - 1; - error = form(OFIErrorStrings[index], path, number); + error = Perl_form_nocontext(OFIErrorStrings[index], path, number); break; default: - error = form("%s(%d): Totally unknown error type %d\n", + error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", path, number, type); break; } @@ -210,7 +210,7 @@ char *symbol; NXStream *nxerr = OpenError(); unsigned long symref = 0; - if (!rld_lookup(nxerr, form("_%s", symbol), &symref)) + if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref)) TransferError(nxerr); CloseError(nxerr); return (void*) symref; @@ -261,7 +261,7 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #if NS_TARGET_MAJOR >= 4 - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs index 774346f..768e99e 100644 --- a/ext/DynaLoader/dl_rhapsody.xs +++ b/ext/DynaLoader/dl_rhapsody.xs @@ -85,11 +85,11 @@ static void TranslateError index = number; if (index > NUM_OFI_ERRORS - 1) index = NUM_OFI_ERRORS - 1; - error = form(OFIErrorStrings[index], path, number); + error = Perl_form_nocontext(OFIErrorStrings[index], path, number); break; default: - error = form("%s(%d): Totally unknown error type %d\n", + error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", path, number, type); break; } @@ -174,7 +174,7 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); diff --git a/perlapi.c b/perlapi.c index d6c5d32..d0f8a4f 100644 --- a/perlapi.c +++ b/perlapi.c @@ -2302,8 +2302,9 @@ Perl_my_atof(pTHXo_ const char *s) #undef Perl_my_bcopy char* -Perl_my_bcopy(pTHXo_ const char* from, char* to, I32 len) +Perl_my_bcopy(const char* from, char* to, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_bcopy(from, to, len); } #endif @@ -2311,8 +2312,9 @@ Perl_my_bcopy(pTHXo_ const char* from, char* to, I32 len) #undef Perl_my_bzero char* -Perl_my_bzero(pTHXo_ char* loc, I32 len) +Perl_my_bzero(char* loc, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_bzero(loc, len); } #endif @@ -2348,8 +2350,9 @@ Perl_my_lstat(pTHXo) #undef Perl_my_memcmp I32 -Perl_my_memcmp(pTHXo_ const char* s1, const char* s2, I32 len) +Perl_my_memcmp(const char* s1, const char* s2, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_memcmp(s1, s2, len); } #endif @@ -2357,8 +2360,9 @@ Perl_my_memcmp(pTHXo_ const char* s1, const char* s2, I32 len) #undef Perl_my_memset void* -Perl_my_memset(pTHXo_ char* loc, I32 ch, I32 len) +Perl_my_memset(char* loc, I32 ch, I32 len) { + dTHXo; return ((CPerlObj*)pPerl)->Perl_my_memset(loc, ch, len); } #endif diff --git a/proto.h b/proto.h index 2118be4..4b991f8 100644 --- a/proto.h +++ b/proto.h @@ -383,20 +383,20 @@ PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s); PERL_CALLCONV OP* Perl_my(pTHX_ OP* o); PERL_CALLCONV NV Perl_my_atof(pTHX_ const char *s); #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -PERL_CALLCONV char* Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len); +PERL_CALLCONV char* Perl_my_bcopy(const char* from, char* to, I32 len); #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -PERL_CALLCONV char* Perl_my_bzero(pTHX_ char* loc, I32 len); +PERL_CALLCONV char* Perl_my_bzero(char* loc, I32 len); #endif PERL_CALLCONV void Perl_my_exit(pTHX_ U32 status) __attribute__((noreturn)); PERL_CALLCONV void Perl_my_failure_exit(pTHX) __attribute__((noreturn)); PERL_CALLCONV I32 Perl_my_fflush_all(pTHX); PERL_CALLCONV I32 Perl_my_lstat(pTHX); #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -PERL_CALLCONV I32 Perl_my_memcmp(pTHX_ const char* s1, const char* s2, I32 len); +PERL_CALLCONV I32 Perl_my_memcmp(const char* s1, const char* s2, I32 len); #endif #if !defined(HAS_MEMSET) -PERL_CALLCONV void* Perl_my_memset(pTHX_ char* loc, I32 ch, I32 len); +PERL_CALLCONV void* Perl_my_memset(char* loc, I32 ch, I32 len); #endif #if !defined(PERL_OBJECT) PERL_CALLCONV I32 Perl_my_pclose(pTHX_ PerlIO* ptr); diff --git a/thread.h b/thread.h index 87828ab..d03cef1 100644 --- a/thread.h +++ b/thread.h @@ -73,7 +73,9 @@ struct perl_thread *getTHR (void); } STMT_END #define MUTEX_LOCK(m) mutex_lock(*m) +#define MUTEX_LOCK_NOCONTEXT(m) mutex_lock(*m) #define MUTEX_UNLOCK(m) mutex_unlock(*m) +#define MUTEX_UNLOCK_NOCONTEXT(m) mutex_unlock(*m) #define MUTEX_DESTROY(m) \ STMT_START { \ mutex_free(*m); \ @@ -109,7 +111,7 @@ struct perl_thread *getTHR (void); #define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self)) #define SET_THR(thr) cthread_set_data(cthread_self(), thr) -#define THR cthread_data(cthread_self()) +#define THR ((struct perl_thread *)cthread_data(cthread_self())) #define INIT_THREADS cthread_init() #define YIELD cthread_yield() diff --git a/util.c b/util.c index 6cbfbcd..17d94db 100644 --- a/util.c +++ b/util.c @@ -2003,9 +2003,10 @@ Perl_unlnk(pTHX_ char *f) /* unlink all versions of a file */ } #endif +/* this is a drop-in replacement for bcopy() */ #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) char * -Perl_my_bcopy(pTHX_ register const char *from,register char *to,register I32 len) +Perl_my_bcopy(register const char *from,register char *to,register I32 len) { char *retval = to; @@ -2023,9 +2024,10 @@ Perl_my_bcopy(pTHX_ register const char *from,register char *to,register I32 len } #endif +/* this is a drop-in replacement for memset() */ #ifndef HAS_MEMSET void * -Perl_my_memset(pTHX_ register char *loc, register I32 ch, register I32 len) +Perl_my_memset(register char *loc, register I32 ch, register I32 len) { char *retval = loc; @@ -2035,9 +2037,10 @@ Perl_my_memset(pTHX_ register char *loc, register I32 ch, register I32 len) } #endif +/* this is a drop-in replacement for bzero() */ #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) char * -Perl_my_bzero(pTHX_ register char *loc, register I32 len) +Perl_my_bzero(register char *loc, register I32 len) { char *retval = loc; @@ -2047,9 +2050,10 @@ Perl_my_bzero(pTHX_ register char *loc, register I32 len) } #endif +/* this is a drop-in replacement for memcmp() */ #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) I32 -Perl_my_memcmp(pTHX_ const char *s1, const char *s2, register I32 len) +Perl_my_memcmp(const char *s1, const char *s2, register I32 len) { register U8 *a = (U8 *)s1; register U8 *b = (U8 *)s2;