[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]