[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

Re: [ID 19991230.007] Building threaded _63 on NeXTstep



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
-----------------------------------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.


References to:
Hans Mulder <hansmu@xs4all.nl>

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]