Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.88k stars 531 forks source link

Building threaded _63 on NeXTstep #1011

Closed p5pRT closed 20 years ago

p5pRT commented 24 years ago

Migrated from rt.perl.org#1961 (status was 'resolved')

Searchable as RT1961$

p5pRT commented 24 years ago

From hansmu@xs4all.nl

I've built a threaded _63 on NeXTstep. The patch below fixes all but one of the issues I encountered​:

1. Threaded malloc.c assumes the existence of two new macros   MUTEX_LOCK_NOCONTEXT and MUTEX_UNLOCK_NOCONTEXT. They   were not provided in the Mach threads section of thread.h

2. The THR macro must contain a cast to struct perl_thread *; there   was not such cast in the Mach version.

3. dl_next.xs calls form(); that function is now called Perl_form_nocontext().   There's a macro in embed.h to make this work\, but XSLoader disables it   by adding -DPERL_CORE to its CCFLAGS.   An alternative fix would be to replace all occurrences of form() in   dl_next.xs by Perl_form_nocontext().

4. A similar porblem exists in SDBM_File​: it tries to call memcmp().   Unfortunately the memcmp() provided by NeXT is buggy. Furtunately\,   perl comes with a drop-in replacement called Perl_my_memcmp().   Unfortunately\, the threaded version of Perl_my_memcmp() takes an   extra argument\, so its no longer a valid replacement for memcmp().   The result is that SDBM_File calls Perl_my_memcmp() with the wrong   number of arguments.   I could fix this by writing a function Perl_my_memcmp_nocontext()   with the same prototype as ANSI memcmp()\, but AFAIK Perl_my_memcmp()   serves no other purpose than as a drop-in replacement for memcmp()   on platforms where the latter is missing or defective\, so I think the   proper fix is to remove the extra argument.   I think the same goes for memset()\, bcopy() and bzero().

-- HansM

--- thread.h.orig Wed Oct 6 02​:58​:56 1999 *** thread.h Thu Dec 30 00​:26​:38 1999 @​@​ -73\,7 +73\,9 @​@​   } 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 @​@​ #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() --- ext/DynaLoader/Makefile.PL.orig Wed Dec 29 16​:39​:12 1999 *** ext/DynaLoader/Makefile.PL Thu Dec 30 19​:34​:15 1999 @​@​ -3\,7 +3\,7 @​@​ WriteMakefile(   NAME => 'DynaLoader'\,   LINKTYPE => 'static'\, - DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"'\, + DEFINE => '-DLIBC="$(LIBC)"'\,   MAN3PODS => {}\, # Pods will be built by installman.   SKIP => [qw(dynamic dynamic_lib dynamic_bs)]\,   XSPROTOARG => '-noprototypes'\, # XXX remove later?


Site configuration information for perl 5.00563​:

Configured by hansm at Wed Dec 29 19​:04​:12 MET 1999.

Summary of my perl5 (revision 5.0 version 5 subversion 63) configuration​:   Platform​:   osname=next\, osvers=4_2\, archname=OPENSTEP-Mach-thread   uname='bombadil '   config_args='-des -Dcf_email=hansmu@​xs4all.nl -Dusethreads -Doptimize=-g -O'   hint=recommended\, useposix=undef\, d_sigaction=undef   usethreads=define useperlio=undef d_sfio=undef   use64bits=undef usemultiplicity=undef   Compiler​:   cc='cc'\, optimize='-g -O'\, gccversion=NeXT DevKit-based CPP 4.0   cppflags='-dynamic -fno-common -DUSE_NEXT_CTYPE -DUSE_PERL_SBRK -arch m68k -DDEBUGGING -I/usr/local/include'   ccflags ='-dynamic -fno-common -DUSE_NEXT_CTYPE -DUSE_PERL_SBRK -arch m68k -arch i386 -DDEBUGGING -I/usr/local/include'   stdchar='char'\, d_stdstdio=define\, usevfork=false   intsize=4\, longsize=4\, ptrsize=4\, doublesize=8   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=12   alignbytes=8\, usemymalloc=y\, prototype=define   Linker and Libraries​:   ld='cc'\, ldflags =' -dynamic -prebind -arch m68k -arch i386 -L/usr/local/lib'   libpth=/lib /usr/lib /usr/local/lib   libs=   libc=/NextLibrary/Frameworks/System.framework/System\, so=dylib\, useshrplib=true\, libperl=libperl.5.dylib   Dynamic Linking​:   dlsrc=dl_next.xs\, dlext=bundle\, d_dlsymun=undef\, ccdlflags=' '   cccdlflags=' '\, lddlflags=' -dynamic -bundle -undefined suppress -arch m68k -arch i386 -L/usr/local/lib'

Locally applied patches​:  


@​INC for perl 5.00563​:   lib   /Users/hansm/lib/perl   /usr/local/OPENSTEP/lib/perl5/5.00563/OPENSTEP-Mach-thread   /usr/local/OPENSTEP/lib/perl5/5.00563   /usr/local/OPENSTEP/lib/site_perl/5.00563/OPENSTEP-Mach-thread   /usr/local/OPENSTEP/lib/site_perl   .


Environment for perl 5.00563​:   DYLD_LIBRARY_PATH=/Users/hansm/src/perl/build/perl-5.006/perl5.005_63t   HOME=/Users/hansm   LANG (unset)   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/Users/hansm/bin​:/usr/local/bin​:/usr/games​:/usr/ucb​:/bin​:/usr/bin​:/usr/etc​:/Users/hansm/bin/cookies​:/LocalApps/Opener.app​:.   PERL5LIB=/Users/hansm/lib/perl   PERL_BADLANG (unset)   SHELL=/usr/bin/zsh

p5pRT commented 24 years ago

From @gsar

On Fri\, 31 Dec 1999 02​:15​:47 +0100\, Hans Mulder wrote​:

I've built a threaded _63 on NeXTstep. The patch below fixes all but one of the issues I encountered​:

1. Threaded malloc.c assumes the existence of two new macros MUTEX_LOCK_NOCONTEXT and MUTEX_UNLOCK_NOCONTEXT. They were not provided in the Mach threads section of thread.h

2. The THR macro must contain a cast to struct perl_thread *; there was not such cast in the Mach version.

3. dl_next.xs calls form(); that function is now called Perl_form_nocontext(). There's a macro in embed.h to make this work\, but XSLoader disables it by adding -DPERL_CORE to its CCFLAGS. An alternative fix would be to replace all occurrences of form() in dl_next.xs by Perl_form_nocontext().

4. A similar porblem exists in SDBM_File​: it tries to call memcmp(). Unfortunately the memcmp() provided by NeXT is buggy. Furtunately\, perl comes with a drop-in replacement called Perl_my_memcmp(). Unfortunately\, the threaded version of Perl_my_memcmp() takes an extra argument\, so its no longer a valid replacement for memcmp(). The result is that SDBM_File calls Perl_my_memcmp() with the wrong number of arguments. I could fix this by writing a function Perl_my_memcmp_nocontext() with the same prototype as ANSI memcmp()\, but AFAIK Perl_my_memcmp() serves no other purpose than as a drop-in replacement for memcmp() on platforms where the latter is missing or defective\, so I think the proper fix is to remove the extra argument. I think the same goes for memset()\, bcopy() and bzero().

Thanks for the patch. Here's what I've put in.

Sarathy gsar@​ActiveState.com

Inline Patch ```diff -----------------------------------8<----------------------------------- Change 4746 by gsar@auger on 2000/01/02 18:45:58 usethreads build fixups for NeXTstep (as suggested by Hans Mulder) Affected files ... ... //depot/perl/embed.h#151 edit ... //depot/perl/embed.pl#95 edit ... //depot/perl/ext/DynaLoader/dl_beos.xs#8 edit ... //depot/perl/ext/DynaLoader/dl_dlopen.xs#14 edit ... //depot/perl/ext/DynaLoader/dl_hpux.xs#12 edit ... //depot/perl/ext/DynaLoader/dl_next.xs#16 edit ... //depot/perl/ext/DynaLoader/dl_rhapsody.xs#8 edit ... //depot/perl/perlapi.c#34 edit ... //depot/perl/proto.h#185 edit ... //depot/perl/thread.h#55 edit ... //depot/perl/util.c#166 edit Differences ... ==== //depot/perl/embed.h#151 (text+w) ==== Index: perl/embed.h --- perl/embed.h.~1~ Sun Jan 2 10:46:03 2000 +++ perl/embed.h Sun Jan 2 10:46:03 2000 @@ -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) ==== //depot/perl/embed.pl#95 (xtext) ==== Index: perl/embed.pl --- perl/embed.pl.~1~ Sun Jan 2 10:46:03 2000 +++ perl/embed.pl Sun Jan 2 10:46:03 2000 @@ -1419,20 +1419,20 @@ 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 ==== //depot/perl/ext/DynaLoader/dl_beos.xs#8 (text) ==== Index: perl/ext/DynaLoader/dl_beos.xs --- perl/ext/DynaLoader/dl_beos.xs.~1~ Sun Jan 2 10:46:03 2000 +++ perl/ext/DynaLoader/dl_beos.xs Sun Jan 2 10:46:03 2000 @@ -67,7 +67,7 @@ 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, ==== //depot/perl/ext/DynaLoader/dl_dlopen.xs#14 (text) ==== Index: perl/ext/DynaLoader/dl_dlopen.xs --- perl/ext/DynaLoader/dl_dlopen.xs.~1~ Sun Jan 2 10:46:03 2000 +++ perl/ext/DynaLoader/dl_dlopen.xs Sun Jan 2 10:46:03 2000 @@ -175,7 +175,7 @@ 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", ==== //depot/perl/ext/DynaLoader/dl_hpux.xs#12 (text) ==== Index: perl/ext/DynaLoader/dl_hpux.xs --- perl/ext/DynaLoader/dl_hpux.xs.~1~ Sun Jan 2 10:46:03 2000 +++ perl/ext/DynaLoader/dl_hpux.xs Sun Jan 2 10:46:03 2000 @@ -104,7 +104,7 @@ 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", ==== //depot/perl/ext/DynaLoader/dl_next.xs#16 (text) ==== Index: perl/ext/DynaLoader/dl_next.xs --- perl/ext/DynaLoader/dl_next.xs.~1~ Sun Jan 2 10:46:03 2000 +++ perl/ext/DynaLoader/dl_next.xs Sun Jan 2 10:46:03 2000 @@ -93,11 +93,11 @@ 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 @@ 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 @@ 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", ==== //depot/perl/ext/DynaLoader/dl_rhapsody.xs#8 (text) ==== Index: perl/ext/DynaLoader/dl_rhapsody.xs --- perl/ext/DynaLoader/dl_rhapsody.xs.~1~ Sun Jan 2 10:46:03 2000 +++ perl/ext/DynaLoader/dl_rhapsody.xs Sun Jan 2 10:46:03 2000 @@ -85,11 +85,11 @@ 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 @@ 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)); ==== //depot/perl/perlapi.c#34 (text+w) ==== Index: perl/perlapi.c --- perl/perlapi.c.~1~ Sun Jan 2 10:46:03 2000 +++ perl/perlapi.c Sun Jan 2 10:46:03 2000 @@ -2302,8 +2302,9 @@ #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 @@ #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 @@ #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 @@ #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 ==== //depot/perl/proto.h#185 (text+w) ==== Index: perl/proto.h --- perl/proto.h.~1~ Sun Jan 2 10:46:03 2000 +++ perl/proto.h Sun Jan 2 10:46:03 2000 @@ -383,20 +383,20 @@ 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); ==== //depot/perl/thread.h#55 (text) ==== Index: perl/thread.h --- perl/thread.h.~1~ Sun Jan 2 10:46:03 2000 +++ perl/thread.h Sun Jan 2 10:46:03 2000 @@ -73,7 +73,9 @@ } 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 @@ #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() ==== //depot/perl/util.c#166 (text) ==== Index: perl/util.c --- perl/util.c.~1~ Sun Jan 2 10:46:03 2000 +++ perl/util.c Sun Jan 2 10:46:03 2000 @@ -2003,9 +2003,10 @@ } #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 @@ } #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 @@ } #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 @@ } #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; End of Patch. ```