USE_THREADS case builds and passes all tests using both compilers.
Additional tweaks:
- fixup win32/makedef.pl to skip more symbols for non-thread build.
- sync win32/Makefile with win32/makefile.mk
>>>Non-thread build fails a lot of tests.<<<
p4raw-id: //depot/win32/perl@222
t/pragma/warning.t See if warning controls work
taint.c Tainting code
thread.h Threading header
+thread.sym Symbols for threads
toke.c The tokener
universal.c The default UNIVERSAL package methods
unixish.h Defines that are assumed on Unix
/* Magic signature for Thread's mg_private is "Th" */
#define Thread_MAGIC_SIGNATURE 0x5468
+#ifdef __cplusplus
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+#endif
+#include <fcntl.h>
+
static U32 threadnum = 0;
static int sig_pipe[2];
+
+#ifndef THREAD_RET_TYPE
+typedef struct thread *Thread;
+#define THREAD_RET_TYPE void *
+#define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
+#endif;
static void
-remove_thread(t)
-Thread t;
+remove_thread(struct thread *t)
{
+#ifdef USE_THREADS
DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(),
"%p: remove_thread %p\n", thr, t)));
MUTEX_LOCK(&threads_mutex);
t->next->prev = t->prev;
COND_BROADCAST(&nthreads_cond);
MUTEX_UNLOCK(&threads_mutex);
+#endif
}
static THREAD_RET_TYPE
-threadstart(arg)
-void *arg;
+threadstart(void *arg)
{
+#ifdef USE_THREADS
#ifdef FAKE_THREADS
Thread savethread = thr;
LOGOP myop;
AV *returnav;
int i, ret;
dJMPENV;
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
+ thr));
- /* Don't call *anything* requiring dTHR until after pthread_setspecific */
+ /* Don't call *anything* requiring dTHR until after SET_THR() */
/*
* Wait until our creator releases us. If we didn't do this, then
* it would be potentially possible for out thread to carry on and
/* us unless we're detached, in which */
/* case noone sees the value anyway. */
#endif
+#else
+ return THREAD_RET_CAST(NULL);
+#endif
}
static SV *
-newthread(startsv, initargs, class)
-SV *startsv;
-AV *initargs;
-char *class;
+newthread (SV *startsv, AV *initargs, char *Class)
{
dTHR;
+#ifdef USE_THREADS
dSP;
Thread savethread;
int i;
thr = new_struct_thread(thr);
SPAGAIN;
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
- "%p: newthread, tid is %u, preparing stack\n",
- savethread, thr->tid));
+ "%p: newthread (%p), tid is %u, preparing stack\n",
+ savethread, thr, thr->tid));
/* The following pushes the arg list and startsv onto the *new* stack */
PUSHMARK(sp);
/* Could easily speed up the following greatly */
XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
XPUSHs(SvREFCNT_inc(startsv));
PUTBACK;
-
#ifdef THREAD_CREATE
- THREAD_CREATE(thr, threadstart);
+ err = THREAD_CREATE(thr, threadstart);
#else
/* On your marks... */
MUTEX_LOCK(&thr->mutex);
MUTEX_UNLOCK(&thr->mutex);
#endif
if (err) {
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+ "%p: create of %p failed %d\n", savethread, thr, err));
/* Thread creation failed--clean up */
SvREFCNT_dec(thr->cvcache);
remove_thread(thr);
sv = newSViv(thr->tid);
sv_magic(sv, thr->oursv, '~', 0, 0);
SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
- return sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE));
+ return sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE));
+#else
+ croak("No threads in this perl");
+ return &sv_undef;
+#endif
}
+static Signal_t handle_thread_signal _((int sig));
+
static Signal_t
-handle_thread_signal(sig)
-int sig;
+handle_thread_signal(int sig)
{
char c = (char) sig;
write(sig_pipe[0], &c, 1);
}
MODULE = Thread PACKAGE = Thread
+PROTOTYPES: DISABLE
void
-new(class, startsv, ...)
- char * class
+new(Class, startsv, ...)
+ char * Class
SV * startsv
AV * av = av_make(items - 2, &ST(2));
PPCODE:
- XPUSHs(sv_2mortal(newthread(startsv, av, class)));
+ XPUSHs(sv_2mortal(newthread(startsv, av, Class)));
void
join(t)
AV * av = NO_INIT
int i = NO_INIT
PPCODE:
+#ifdef USE_THREADS
DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
thr, t, ThrSTATE(t)););
MUTEX_LOCK(&t->mutex);
/* Could easily speed up the following if necessary */
for (i = 0; i <= AvFILL(av); i++)
XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
+#endif
void
detach(t)
Thread t
CODE:
+#ifdef USE_THREADS
DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
thr, t, ThrSTATE(t)););
MUTEX_LOCK(&t->mutex);
croak("can't detach thread");
/* NOTREACHED */
}
+#endif
void
equal(t1, t2)
flags(t)
Thread t
PPCODE:
+#ifdef USE_THREADS
PUSHs(sv_2mortal(newSViv(t->flags)));
+#endif
void
-self(class)
- char * class
+self(Class)
+ char * Class
PREINIT:
SV *sv;
- PPCODE:
+ PPCODE:
+#ifdef USE_THREADS
sv = newSViv(thr->tid);
sv_magic(sv, thr->oursv, '~', 0, 0);
SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
- PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE))));
+ PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE))));
+#endif
U32
tid(t)
Thread t
CODE:
+#ifdef USE_THREADS
MUTEX_LOCK(&t->mutex);
RETVAL = t->tid;
MUTEX_UNLOCK(&t->mutex);
+#else
+ RETVAL = 0;
+#endif
OUTPUT:
RETVAL
void
yield()
CODE:
+{
+#ifdef USE_THREADS
YIELD;
+#endif
+}
void
cond_wait(sv)
SV * sv
MAGIC * mg = NO_INIT
-CODE:
+CODE:
+#ifdef USE_THREADS
if (SvROK(sv))
sv = SvRV(sv);
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
MUTEX_UNLOCK(MgMUTEXP(mg));
-
+#endif
+
void
cond_signal(sv)
SV * sv
MAGIC * mg = NO_INIT
CODE:
+#ifdef USE_THREADS
if (SvROK(sv))
sv = SvRV(sv);
}
COND_SIGNAL(MgCONDP(mg));
MUTEX_UNLOCK(MgMUTEXP(mg));
+#endif
void
cond_broadcast(sv)
SV * sv
MAGIC * mg = NO_INIT
-CODE:
+CODE:
+#ifdef USE_THREADS
if (SvROK(sv))
sv = SvRV(sv);
}
COND_BROADCAST(MgCONDP(mg));
MUTEX_UNLOCK(MgMUTEXP(mg));
+#endif
void
-list(class)
- char * class
+list(Class)
+ char * Class
PREINIT:
Thread t;
AV * av;
SV ** svp;
int n = 0;
PPCODE:
+#ifdef USE_THREADS
av = newAV();
/*
* Iterate until we have enough dynamic storage for all threads.
SV *sv = newSViv(0); /* fill in tid later */
sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */
av_push(av, sv_bless(newRV_noinc(sv),
- gv_stashpv(class, TRUE)));
+ gv_stashpv(Class, TRUE)));
}
}
for (svp = AvARRAY(av); n > 0; n--, svp++)
PUSHs(*svp);
(void)sv_2mortal((SV*)av);
+#endif
MODULE = Thread PACKAGE = Thread::Signal
RETVAL = c ? psig_ptr[c] : &sv_no;
OUTPUT:
RETVAL
+
thr->prev = thr;
MUTEX_UNLOCK(&threads_mutex);
-#ifdef HAVE_THREAD_INTERN
- init_thread_intern(thr);
+#ifdef INIT_THREAD_INTERN
+ INIT_THREAD_INTERN(thr);
#else
thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
+#endif /* INIT_THREAD_INTERN */
SET_THR(thr);
/*
#include "embed.h"
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#endif
+
+#if defined(USE_THREADS) /* && !defined(PERL_CORE) && !defined(PERLDLL) */
+#ifndef CRIPPLED_CC
+#define CRIPPLED_CC
+#endif
+#endif
+
#ifdef OP_IN_REGISTER
# ifdef __GNUC__
# define stringify_immed(s) #s
#define WITH_THR(s) do { dTHR; s; } while (0)
-#ifdef USE_THREADS
-# ifdef FAKE_THREADS
-# include "fakethr.h"
-# else
-# ifdef WIN32
-# include "win32/win32thread.h"
-# else
-# include <pthread.h>
-typedef pthread_mutex_t perl_mutex;
-typedef pthread_cond_t perl_cond;
-typedef pthread_key_t perl_key;
-# endif /* WIN32 */
-# endif /* FAKE_THREADS */
-#endif /* USE_THREADS */
-
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
* type checking; it only casts if the compiler does not know prototypes.
# include "unixish.h"
# endif
# endif
-#endif
+#endif
+
+/*
+ * USE_THREADS needs to be after unixish.h as <pthread.h> includes <sys/signal.h>
+ * which defines NSIG - which will stop inclusion of <signal.h>
+ * this results in many functions being undeclared which bothers C++
+ * May make sense to have threads after "*ish.h" anyway
+ */
+
+#ifdef USE_THREADS
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include <win32thread.h>
+# else
+# include <pthread.h>
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+
#ifdef VMS
# define STATUS_NATIVE statusvalue_vms
};
#ifdef USE_THREADS
-#define ARGSproto struct thread *
+#define ARGSproto struct thread *thr
#else
#define ARGSproto void
#endif /* USE_THREADS */
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
-U32 cast_ulong _((double));
-# ifdef __cplusplus
- }
-# endif
+EXTERN_C U32 cast_ulong _((double));
#define U_S(what) ((U16)cast_ulong((double)(what)))
#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
#define U_L(what) (cast_ulong((double)(what)))
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
I32 cast_i32 _((double));
IV cast_iv _((double));
UV cast_uv _((double));
-# ifdef __cplusplus
- }
-# endif
+END_EXTERN_C
#define I_32(what) (cast_i32((double)(what)))
#define I_V(what) (cast_iv((double)(what)))
#define U_V(what) (cast_uv((double)(what)))
#ifdef I_MATH
# include <math.h>
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
double exp _((double));
double log _((double));
double log10 _((double));
double cos _((double));
double atan2 _((double,double));
double pow _((double,double));
-# ifdef __cplusplus
- };
-# endif
+END_EXTERN_C
#endif
#ifndef __cplusplus
/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
-#ifndef DONT_DECLARE_STD
+#if !defined(DONT_DECLARE_STD) || (defined(__svr4__) && defined(__GNUC__) && defined(sun))
extern char ** environ; /* environment variables supplied via exec */
#endif
#else
#include "thread.h"
#include "pp.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-
+START_EXTERN_C
#include "proto.h"
#ifdef EMBED
#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
#endif
-#ifdef __cplusplus
-};
-#endif
+END_EXTERN_C
/* The following must follow proto.h */
CATCH_SET(oldcatch);
#else
ENTER;
- perl_call_sv((SV*)gv, G_SCALAR);
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
#endif
sv = TOPs;
return sv;
}
-#ifdef CRIPPLED_CC
+
+
SV *
-newRV_noinc(ref)
+Perl_newRV_noinc(ref)
SV *ref;
{
register SV *sv;
SvREFCNT_dec(ref);
return sv;
}
-#endif /* CRIPPLED_CC */
/* make an exact duplicate of old */
}
}
-#ifndef SvTRUE
I32
-SvTRUE(sv)
+sv_true(sv)
register SV *sv;
{
+ dTHR;
if (!sv)
return 0;
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvPOK(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* tXpv;
+ if ((tXpv = (XPV*)SvANY(sv)) &&
+ (*tXpv->xpv_pv > '0' ||
+ tXpv->xpv_cur > 1 ||
+ (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
return 1;
else
return 0;
}
}
}
-#endif /* !SvTRUE */
-#ifndef SvIV
IV
-SvIV(sv)
+sv_iv(sv)
register SV *sv;
{
if (SvIOK(sv))
return SvIVX(sv);
return sv_2iv(sv);
}
-#endif /* !SvIV */
-#ifndef SvUV
UV
-SvUV(sv)
+sv_uv(sv)
register SV *sv;
{
if (SvIOK(sv))
return SvUVX(sv);
return sv_2uv(sv);
}
-#endif /* !SvUV */
-#ifndef SvNV
double
-SvNV(sv)
+sv_nv(sv)
register SV *sv;
{
if (SvNOK(sv))
return SvNVX(sv);
return sv_2nv(sv);
}
-#endif /* !SvNV */
-#ifdef CRIPPLED_CC
char *
sv_pvn(sv, lp)
SV *sv;
}
return sv_2pv(sv, lp);
}
-#endif
char *
sv_pvn_force(sv, lp)
--- /dev/null
+#
\ No newline at end of file
INIT_THREAD_INTERN(thr);
#else
thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
+#endif /* INIT_THREAD_INTERN */
return thr;
}
#endif /* USE_THREADS */
# newly built perl.
INST_DRV=c:
INST_TOP=$(INST_DRV)\perl
-BUILDOPT=-DUSE_THREADS -TP
+BUILDOPT=-DUSE_THREADS
CORECCOPT=
#
WIN32_OBJ = win32.obj \
win32io.obj \
win32sck.obj \
- win32thread.obj
+ win32thread.obj
PERL95_OBJ = perl95.obj \
win32mt.obj \
$(OPCODE_DLL) \
$(SDBM_FILE_DLL)\
$(IO_DLL) \
- $(ATTRS_DLL) \
+ $(ATTRS_DLL) \
$(THREAD_DLL)
POD2HTML=$(PODDIR)\pod2html
.\config.h : $(CFGH_TMPL)
-del /f config.h
copy $(CFGH_TMPL) config.h
-
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
$(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
"INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(OPTIMIZE) $(DEFINES)" \
"cf_email=$(EMAIL)" "libs=$(LIBFILES)" "incpath=$(CCINCDIR)" \
"libpth=$(CCLIBDIR)" "libc=$(LIBC)" \
+ "LINK_FLAGS=$(LINK_FLAGS)" \
config.w32 > ..\config.sh
$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
del perl95.exe
$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
- if not exist ..\lib\auto md ..\lib\auto
+ if not exist ..\lib\auto mkdir ..\lib\auto
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B)
$(XSUBPP) dl_win32.xs > $(*B).c
csh='undef'
d_Gconvert='gcvt((x),(n),(b))'
d_access='define'
-d_alarm='define'
+d_alarm='undef'
d_archlib='define'
d_attribut='undef'
d_bcmp='undef'
* This symbol, if defined, indicates that the alarm routine is
* available.
*/
-#define HAS_ALARM /**/
+/*#define HAS_ALARM /**/
/* HASATTRIBUTE:
* This symbol indicates the C compiler can check for function attributes,
Perl_eval_cond
Perl_eval_owner
Perl_threads_mutex
+Perl_new_struct_thread
+Perl_nthreads
Perl_nthreads_cond
+Perl_per_thread_magicals
+Perl_thrsv
Perl_unlock_condpair
Perl_vtbl_mutex
Perl_magic_mutexfree
.ENDIF
INCLUDES = -I.\include -I. -I..
#PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX
-DEFINES = -DWIN32 $(BUILDOPT) -D_CONSOLE -D_WIN32_WINNT=0x400
+DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT)
LOCDEFS = -DPERLDLL
SUBSYS = console
version.lib odbc32.lib odbccp32.lib
CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE)
-LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386
+LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE)
OBJOUT_FLAG = -Fo
.ENDIF
.\include\sys\socket.h \
.\win32.h
-
EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File attrs Thread
DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
cd ..\t && \
$(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t
-test : all
+test-prep : all
$(XCOPY) $(PERLEXE) ..\t\$(NULL)
$(XCOPY) $(PERLDLL) ..\t\$(NULL)
.IF "$(CCTYPE)" == "BORLAND"
.ELSE
$(XCOPY) $(GLOBEXE) ..\t\$(NULL)
.ENDIF
+
+test : test-prep
cd ..\t && $(PERLEXE) -I..\lib harness
+test-notty : test-prep
+ set PERL_SKIP_TTY_TEST=1 && \
+ cd ..\t && $(PERLEXE) -I.\lib harness
+
clean :
-@erase miniperlmain.obj
-@erase $(MINIPERL)