to reverse integrate the win32 branch into mainline.
p4raw-id: //depot/win32/perl@253
ext/Thread/README Thread README
ext/Thread/Thread/Queue.pm Thread synchronised queue objects
ext/Thread/Thread/Semaphore.pm Thread semaphore objects
+ ext/Thread/Thread/Specific.pm Thread specific data access
ext/Thread/Thread.pm Thread extension Perl module
ext/Thread/Thread.xs Thread extension external subroutines
ext/Thread/create.t Test thread creation
+ ext/Thread/die.t Test thread die()
+ ext/Thread/die2.t Test thread die() differently
ext/Thread/io.t Test threads doing simple I/O
ext/Thread/join.t Test thread joining
ext/Thread/join2.t Test thread joining differently
ext/Thread/list.t Test getting list of all threads
ext/Thread/lock.t Test lock primitive
ext/Thread/queue.t Test Thread::Queue module
+ ext/Thread/specific.t Test thread-specific user data
ext/Thread/sync.t Test thread synchronisation
ext/Thread/sync2.t Test thread synchronisation
ext/Thread/typemap Thread extension interface types
win32/splittree.pl Win32 port
win32/win32.c Win32 port
win32/win32.h Win32 port
-win32/win32io.c Win32 port
-win32/win32io.h Win32 port
win32/win32iop.h Win32 port
win32/win32sck.c Win32 port
win32/win32thread.h Win32 port mapping to threads
markstack_ptr--;
/* we're trying to emulate pp_entertry() here */
{
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+ globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
}
stack_sp = stack_base;
stack_max = stack_base + 127;
- cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */
- New(50,cxstack,cxstack_max + 1,CONTEXT);
+ cxstack_max = 8192 / sizeof(PERL_CONTEXT) - 2; /* Use most of 8K. */
+ New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
cxstack_ix = -1;
New(50,tmps_stack,128,SV*);
#ifdef HAVE_THREAD_INTERN
init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+ SET_THREAD_SELF(thr);
#else
thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
+#endif /* SET_THREAD_SELF */
SET_THR(thr);
/*
my_exit_jump(void)
{
dTHR;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
#include "embed.h"
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
#ifdef __cplusplus
# define START_EXTERN_C extern "C" {
# define END_EXTERN_C }
#endif
- /* Digital UNIX defines a typedef CONTEXT when pthreads is in use */
- #if defined(__osf__)
- # define CONTEXT PERL_CONTEXT
- #endif
-
typedef MEM_SIZE STRLEN;
typedef struct op OP;
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
- typedef struct context CONTEXT;
+ typedef struct context PERL_CONTEXT;
typedef struct block BLOCK;
typedef struct magic MAGIC;
IEXT HV * Idefstash; /* main symbol table */
IEXT HV * Icurstash; /* symbol table for current package */
IEXT HV * Idebstash; /* symbol table for perldb package */
+IEXT HV * Iglobalstash; /* global keyword overrides imported here */
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
IEXT COP * VOL Icurcop IINIT(&compiling);
IEXT COP * Icurcopdb IINIT(NULL);
IEXT line_t Icopline IINIT(NOLINE);
- IEXT CONTEXT * Icxstack;
+ IEXT PERL_CONTEXT * Icxstack;
IEXT I32 Icxstack_ix IINIT(-1);
IEXT I32 Icxstack_max IINIT(128);
IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */
IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */
-IEXT I32 Irunlevel;
/* stack stuff */
IEXT AV * Icurstack; /* THE STACK */
{
djSP;
register PMOP *pm = (PMOP*) cLOGOP->op_other;
- register CONTEXT *cx = &cxstack[cxstack_ix];
+ register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
register SV *dstr = cx->sb_dstr;
register char *s = cx->sb_s;
register char *m = cx->sb_m;
if (sortcop) {
if (max > 1) {
AV *oldstack;
- CONTEXT *cx;
+ PERL_CONTEXT *cx;
SV** newsp;
bool oldcatch = CATCH_GET;
{
dTHR;
register I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = cxstack_ix; i >= 0; i--) {
cx = &cxstack[i];
{
dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
switch (cx->cx_type) {
{
dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
switch (cx->cx_type) {
{
dTHR;
I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
switch (cx->cx_type) {
dounwind(I32 cxix)
{
dTHR;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
SV **newsp;
I32 optype;
dTHR;
if (in_eval) {
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
{
djSP;
register I32 cxix = dopoptosub(cxstack_ix);
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 dbcxix;
I32 gimme;
SV *sv;
{
SV **sp;
register CV *cv;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = G_ARRAY;
I32 hasargs;
GV *gv;
PP(pp_enteriter)
{
djSP; dMARK;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
PP(pp_enterloop)
{
djSP;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
PP(pp_leaveloop)
{
djSP;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_loop cxloop;
I32 gimme;
SV **newsp;
{
djSP; dMARK;
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_sub cxsub;
bool popsub2 = FALSE;
I32 gimme;
{
djSP;
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
struct block_loop cxloop;
struct block_sub cxsub;
I32 pop2 = 0;
PP(pp_next)
{
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 oldsave;
if (op->op_flags & OPf_SPECIAL) {
PP(pp_redo)
{
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 oldsave;
if (op->op_flags & OPf_SPECIAL) {
djSP;
OP *retop = 0;
I32 ix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
char *label;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
I32 cxix;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
CV* cv = (CV*)SvRV(sv);
SV** mark;
I32 items = 0;
{
dTHR;
int ret;
- I32 oldrunlevel = runlevel;
OP *oldop = op;
dJMPENV;
op = o;
#ifdef DEBUGGING
assert(CATCH_GET == TRUE);
- DEBUG_l(deb("(Setting up local jumplevel, runlevel = %ld)\n", (long)runlevel+1));
+ DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, top_env));
#endif
JMPENV_PUSH(ret);
switch (ret) {
default: /* topmost level handles it */
JMPENV_POP;
- runlevel = oldrunlevel;
op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
break;
}
JMPENV_POP;
- runlevel = oldrunlevel;
op = oldop;
return Nullop;
}
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
- CONTEXT *cx;
+ PERL_CONTEXT *cx;
I32 optype;
op = saveop;
PP(pp_require)
{
djSP;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
SV *sv;
char *name;
char *tryname;
PP(pp_entereval)
{
djSP;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = sub_generation;
char tmpbuf[TYPE_DIGITS(long) + 12];
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
OP *retop;
U8 save_flags = op -> op_flags;
I32 optype;
PP(pp_entertry)
{
djSP;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
U8 Tlocalizing;
COP * Tcurcop;
- CONTEXT * Tcxstack;
+ PERL_CONTEXT * Tcxstack;
I32 Tcxstack_ix;
I32 Tcxstack_max;
AV * Tcurstack;
AV * Tmainstack;
JMPENV * Ttop_env;
- I32 Trunlevel;
/* XXX Sort stuff, firstgv, secongv and so on? */
#define THRf_ZOMBIE 3
#define THRf_DEAD 4
- #define THRf_DIE_FATAL 8
+ #define THRf_DID_DIE 8
/* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
- #define ThrSTATE(t) ((t)->flags)
+ #define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
#define ThrSETSTATE(t, s) STMT_START { \
(t)->flags &= ~THRf_STATE_MASK; \
(t)->flags |= (s); \
#undef chopset
#undef formtarget
#undef bodytarget
+#undef start_env
#undef toptarget
#undef top_env
-#undef runlevel
#undef in_eval
#undef restartop
#undef delaymagic
#define localizing (thr->Tlocalizing)
#define top_env (thr->Ttop_env)
-#define runlevel (thr->Trunlevel)
#define start_env (thr->Tstart_env)
#else
https://perl5.git.perl.org / perl5.git / commitdiff