diff options
42 files changed, 561 insertions, 293 deletions
@@ -53,8 +53,8 @@ av_extend(AV *av, I32 key) dSP; ENTER; SAVETMPS; - PUSHMARK(sp); - EXTEND(sp,2); + PUSHMARK(SP); + EXTEND(SP,2); PUSHs(mg->mg_obj); PUSHs(sv_2mortal(newSViv(key+1))); PUTBACK; @@ -157,8 +157,8 @@ av_fetch(register AV *av, I32 key, I32 lval) dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); - Sv = sv; - return &Sv; + av_fetch_sv = sv; + return &av_fetch_sv; } } @@ -388,8 +388,8 @@ av_push(register AV *av, SV *val) if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { dSP; - PUSHMARK(sp); - EXTEND(sp,2); + PUSHMARK(SP); + EXTEND(SP,2); PUSHs(mg->mg_obj); PUSHs(val); PUTBACK; @@ -413,7 +413,7 @@ av_pop(register AV *av) croak(no_modify); if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; @@ -446,8 +446,8 @@ av_unshift(register AV *av, register I32 num) if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { dSP; - PUSHMARK(sp); - EXTEND(sp,1+num); + PUSHMARK(SP); + EXTEND(SP,1+num); PUSHs(mg->mg_obj); while (num-- > 0) { PUSHs(&sv_undef); @@ -495,7 +495,7 @@ av_shift(register AV *av) croak(no_modify); if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; @@ -536,8 +536,8 @@ av_fill(register AV *av, I32 fill) dSP; ENTER; SAVETMPS; - PUSHMARK(sp); - EXTEND(sp,2); + PUSHMARK(SP); + EXTEND(SP,2); PUSHs(mg->mg_obj); PUSHs(sv_2mortal(newSViv(fill+1))); PUTBACK; @@ -816,7 +816,7 @@ my_stat(ARGSproto) GV* tmpgv; if (op->op_flags & OPf_REF) { - EXTEND(sp,1); + EXTEND(SP,1); tmpgv = cGVOP->op_gv; do_fstat: io = GvIO(tmpgv); @@ -867,7 +867,7 @@ my_lstat(ARGSproto) djSP; SV *sv; if (op->op_flags & OPf_REF) { - EXTEND(sp,1); + EXTEND(SP,1); if (cGVOP->op_gv == defgv) { if (laststype != OP_LSTAT) croak("The stat preceding -l _ wasn't an lstat"); @@ -502,7 +502,7 @@ do_kv(ARGSproto) } /* Guess how much room we need. hv_max may be a few too many. Oh well. */ - EXTEND(sp, HvMAX(hv) * (dokeys + dovalues)); + EXTEND(SP, HvMAX(hv) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) { diff --git a/embedvar.h b/embedvar.h index bfc39d54f2..1b93609d8c 100644 --- a/embedvar.h +++ b/embedvar.h @@ -22,6 +22,7 @@ #define Sv (curinterp->TSv) #define Xpv (curinterp->TXpv) +#define av_fetch_sv (curinterp->Tav_fetch_sv) #define bodytarget (curinterp->Tbodytarget) #define chopset (curinterp->Tchopset) #define curcop (curinterp->Tcurcop) @@ -37,6 +38,8 @@ #define delaymagic (curinterp->Tdelaymagic) #define dirty (curinterp->Tdirty) #define formtarget (curinterp->Tformtarget) +#define hv_fetch_ent_mh (curinterp->Thv_fetch_ent_mh) +#define hv_fetch_sv (curinterp->Thv_fetch_sv) #define in_eval (curinterp->Tin_eval) #define last_in_gv (curinterp->Tlast_in_gv) #define localizing (curinterp->Tlocalizing) @@ -316,6 +319,7 @@ #define TSv Sv #define TXpv Xpv +#define Tav_fetch_sv av_fetch_sv #define Tbodytarget bodytarget #define Tchopset chopset #define Tcurcop curcop @@ -331,6 +335,8 @@ #define Tdelaymagic delaymagic #define Tdirty dirty #define Tformtarget formtarget +#define Thv_fetch_ent_mh hv_fetch_ent_mh +#define Thv_fetch_sv hv_fetch_sv #define Tin_eval in_eval #define Tlast_in_gv last_in_gv #define Tlocalizing localizing @@ -494,6 +500,7 @@ #define Sv Perl_Sv #define Xpv Perl_Xpv +#define av_fetch_sv Perl_av_fetch_sv #define bodytarget Perl_bodytarget #define chopset Perl_chopset #define curcop Perl_curcop @@ -509,6 +516,8 @@ #define delaymagic Perl_delaymagic #define dirty Perl_dirty #define formtarget Perl_formtarget +#define hv_fetch_ent_mh Perl_hv_fetch_ent_mh +#define hv_fetch_sv Perl_hv_fetch_sv #define in_eval Perl_in_eval #define last_in_gv Perl_last_in_gv #define localizing Perl_localizing @@ -556,6 +565,7 @@ #define Sv (thr->TSv) #define Xpv (thr->TXpv) +#define av_fetch_sv (thr->Tav_fetch_sv) #define bodytarget (thr->Tbodytarget) #define chopset (thr->Tchopset) #define curcop (thr->Tcurcop) @@ -571,6 +581,8 @@ #define delaymagic (thr->Tdelaymagic) #define dirty (thr->Tdirty) #define formtarget (thr->Tformtarget) +#define hv_fetch_ent_mh (thr->Thv_fetch_ent_mh) +#define hv_fetch_sv (thr->Thv_fetch_sv) #define in_eval (thr->Tin_eval) #define last_in_gv (thr->Tlast_in_gv) #define localizing (thr->Tlocalizing) diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 91b4dc2ad5..4f70a2df73 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -356,8 +356,8 @@ const DBT * key2 ; ENTER ; SAVETMPS; - PUSHMARK(sp) ; - EXTEND(sp,2) ; + PUSHMARK(SP) ; + EXTEND(SP,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; @@ -403,8 +403,8 @@ const DBT * key2 ; ENTER ; SAVETMPS; - PUSHMARK(sp) ; - EXTEND(sp,2) ; + PUSHMARK(SP) ; + EXTEND(SP,2) ; PUSHs(sv_2mortal(newSVpv(data1,key1->size))); PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; @@ -441,7 +441,7 @@ size_t size ; ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSVpv((char*)data,size))); PUTBACK ; diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index 44933ec92c..a0bdcc8de1 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -144,7 +144,7 @@ dl_undef_symbols() if (dld_undefined_sym_count) { int x; char **undef_syms = dld_list_undefined_sym(); - EXTEND(sp, dld_undefined_sym_count); + EXTEND(SP, dld_undefined_sym_count); for (x=0; x < dld_undefined_sym_count; x++) PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); free(undef_syms); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index cf5c859395..b9e4c87200 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -252,7 +252,7 @@ _safe_call_sv(package, mask, codesv) sv_free((SV*)GvHV(gv)); GvHV(gv) = (HV*)SvREFCNT_inc(defstash); - PUSHMARK(sp); + PUSHMARK(SP); perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ SPAGAIN; /* for the PUTBACK added by xsubpp */ LEAVE; diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 31439b2365..8807d68189 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3213,7 +3213,7 @@ pipe() PPCODE: int fds[2]; if (pipe(fds) != -1) { - EXTEND(sp,2); + EXTEND(SP,2); PUSHs(sv_2mortal(newSViv(fds[0]))); PUSHs(sv_2mortal(newSViv(fds[1]))); } @@ -3257,7 +3257,7 @@ uname() #ifdef HAS_UNAME struct utsname buf; if (uname(&buf) >= 0) { - EXTEND(sp, 5); + EXTEND(SP, 5); PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); PUSHs(sv_2mortal(newSVpv(buf.release, 0))); @@ -3325,7 +3325,7 @@ strtod(str) num = strtod(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME == G_ARRAY) { - EXTEND(sp, 1); + EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else @@ -3346,7 +3346,7 @@ strtol(str, base = 0) else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { - EXTEND(sp, 1); + EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else @@ -3367,7 +3367,7 @@ strtoul(str, base = 0) else PUSHs(sv_2mortal(newSVnv((double)num))); if (GIMME == G_ARRAY) { - EXTEND(sp, 1); + EXTEND(SP, 1); if (unparsed) PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); else @@ -3468,7 +3468,7 @@ times() struct tms tms; clock_t realtime; realtime = times( &tms ); - EXTEND(sp,5); + EXTEND(SP,5); PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); @@ -3546,7 +3546,7 @@ tzset() void tzname() PPCODE: - EXTEND(sp,2); + EXTEND(SP,2); PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0])))); PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1])))); diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index d2f3d9e10d..3664368cab 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -828,7 +828,7 @@ unpack_sockaddr_in(sin_sv) port = ntohs(addr.sin_port); ip_address = addr.sin_addr; - EXTEND(sp, 2); + EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv((IV) port))); PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); } diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 3b49dbecb2..aea72f4a46 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -117,8 +117,8 @@ threadstart(void *arg) PUTBACK; perl_call_sv(sv, G_ARRAY|G_EVAL); SPAGAIN; - retval = sp - (stack_base + oldmark); - sp = stack_base + oldmark + 1; + retval = SP - (stack_base + oldmark); + SP = stack_base + oldmark + 1; if (SvCUR(thr->errsv)) { MUTEX_LOCK(&thr->mutex); thr->flags |= THRf_DID_DIE; @@ -131,12 +131,12 @@ threadstart(void *arg) DEBUG_L(STMT_START { for (i = 1; i <= retval; i++) { PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", - thr, i, SvPEEK(sp[i - 1])); + thr, i, SvPEEK(SP[i - 1])); } } STMT_END); av_store(av, 0, &sv_yes); - for (i = 1; i <= retval; i++, sp++) - sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*sp)); + for (i = 1; i <= retval; i++, SP++) + sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP)); } finishoff: @@ -219,7 +219,7 @@ newthread (SV *startsv, AV *initargs, char *classname) "%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); + PUSHMARK(SP); /* Could easily speed up the following greatly */ for (i = 0; i <= AvFILL(initargs); i++) XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); @@ -543,7 +543,7 @@ list(classname) /* Truncate any unneeded slots in av */ av_fill(av, n - 1); /* Finally, push all the new objects onto the stack and drop av */ - EXTEND(sp, n); + EXTEND(SP, n); for (svp = AvARRAY(av); n > 0; n--, svp++) PUSHs(*svp); (void)sv_2mortal((SV*)av); @@ -1319,7 +1319,7 @@ amagic_call(SV *left, SV *right, int method, int flags) PUTBACK; pp_pushmark(ARGS); - EXTEND(sp, notfound + 5); + EXTEND(SP, notfound + 5); PUSHs(lr>0? right: left); PUSHs(lr>0? left: right); PUSHs( lr > 0 ? &sv_yes : ( assign ? &sv_undef : &sv_no )); @@ -94,8 +94,8 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval) dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); - Sv = sv; - return &Sv; + hv_fetch_sv = sv; + return &hv_fetch_sv; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv,'E')) { @@ -170,19 +170,17 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - static HE mh; - sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); - if (!HeKEY_hek(&mh)) { + if (!HeKEY_hek(&hv_fetch_ent_mh)) { char *k; New(54, k, HEK_BASESIZE + sizeof(SV*), char); - HeKEY_hek(&mh) = (HEK*)k; + HeKEY_hek(&hv_fetch_ent_mh) = (HEK*)k; } - HeSVKEY_set(&mh, keysv); - HeVAL(&mh) = sv; - return &mh; + HeSVKEY_set(&hv_fetch_ent_mh, keysv); + HeVAL(&hv_fetch_ent_mh) = sv; + return &hv_fetch_ent_mh; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv,'E')) { diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 20cc96f0b5..03ba050d1e 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -262,7 +262,7 @@ T_ARRAY ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } - sp += $var.size - 1; + SP += $var.size - 1; T_IN { GV *gv = newGVgen("$Package"); @@ -959,8 +959,8 @@ magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) { dSP; - PUSHMARK(sp); - EXTEND(sp, n); + PUSHMARK(SP); + EXTEND(SP, n); PUSHs(mg->mg_obj); if (n > 1) { if (mg->mg_ptr) { @@ -1044,7 +1044,7 @@ int magic_wipepack(SV *sv, MAGIC *mg) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; @@ -1061,8 +1061,8 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key) ENTER; SAVETMPS; - PUSHMARK(sp); - EXTEND(sp, 2); + PUSHMARK(SP); + EXTEND(SP, 2); PUSHs(mg->mg_obj); if (SvOK(key)) PUSHs(key); @@ -1874,7 +1874,7 @@ sighandler(int sig) sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); } - PUSHMARK(sp); + PUSHMARK(SP); PUSHs(sv); PUTBACK; @@ -1573,7 +1573,7 @@ newPROG(OP *o) CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs((SV*)compiling.cop_filegv); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -3466,7 +3466,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr)) && (cv = GvCV(db_postponed))) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(tmpstr); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index 43c92c8b46..14489f965d 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -133,7 +133,7 @@ PERLCALL(PSZ name, ULONG argc, PRXSTRING argv, PSZ queue, PRXSTRING ret) ENTER; SAVETMPS; - PUSHMARK(sp); + PUSHMARK(SP); #if 0 if (!my_perl) { @@ -339,7 +339,7 @@ _fetch(name, ...) { int i; ULONG rc; - EXTEND(sp, items); + EXTEND(SP, items); needvars(items); if (trace) fprintf(stderr, "REXXCALL::_fetch"); @@ -410,7 +410,7 @@ _next(stem) rc = RexxVariablePool(&sv); } while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0); if (!rc) { - EXTEND(sp, 2); + EXTEND(SP, 2); /* returned lengths appear to be swapped */ /* but beware of "future bug fixes" */ namelen = sv.shvname.strlength; /* should be */ diff --git a/patchlevel.h b/patchlevel.h index aec072e4a1..efcda310cd 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,6 +1,6 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ #define PATCHLEVEL 4 -#define SUBVERSION 62 +#define SUBVERSION 63 /* local_patches -- list of locally applied less-than-subversion patches. @@ -1102,7 +1102,7 @@ perl_call_argv(char *sub_name, I32 flags, register char **argv) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); if (argv) { while (*argv) { XPUSHs(sv_2mortal(newSVpv(*argv,0))); @@ -1142,9 +1142,8 @@ perl_call_sv(SV *sv, I32 flags) /* See G_* flags in cop.h */ { - dTHR; + dSP; LOGOP myop; /* fake syntax tree node */ - SV** sp = stack_sp; I32 oldmark; I32 retval; I32 oldscope; @@ -1286,10 +1285,9 @@ perl_eval_sv(SV *sv, I32 flags) /* See G_* flags in cop.h */ { - dTHR; + dSP; UNOP myop; /* fake syntax tree node */ - SV** sp = stack_sp; - I32 oldmark = sp - stack_base; + I32 oldmark = SP - stack_base; I32 retval; I32 oldscope; dJMPENV; @@ -1376,7 +1374,7 @@ perl_eval_pv(char *p, I32 croak_on_error) dSP; SV* sv = newSVpv(p, 0); - PUSHMARK(sp); + PUSHMARK(SP); perl_eval_sv(sv, G_SCALAR); SvREFCNT_dec(sv); diff --git a/pod/perlcall.pod b/pod/perlcall.pod index f90e09f238..865d3bf88d 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -404,7 +404,7 @@ via this XSUB void Call_fred() CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_pv("fred", G_DISCARD|G_NOARGS) ; fprintf(stderr, "back in Call_fred\n") ; @@ -421,7 +421,7 @@ higher, or use the G_EVAL flag with I<perl_call_*> as shown below void Call_fred() CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_pv("fred", G_EVAL|G_DISCARD|G_NOARGS) ; fprintf(stderr, "back in Call_fred\n") ; @@ -462,7 +462,7 @@ and here is a C function to call it { dSP ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_pv("PrintUID", G_DISCARD|G_NOARGS) ; } @@ -474,7 +474,7 @@ A few points to note about this example. =item 1. -Ignore C<dSP> and C<PUSHMARK(sp)> for now. They will be discussed in +Ignore C<dSP> and C<PUSHMARK(SP)> for now. They will be discussed in the next example. =item 2. @@ -526,7 +526,7 @@ The C function required to call I<LeftString> would look like this. { dSP ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSVpv(a, 0))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -542,8 +542,9 @@ Here are a few notes on the C function I<call_LeftString>. Parameters are passed to the Perl subroutine using the Perl stack. This is the purpose of the code beginning with the line C<dSP> and -ending with the line C<PUTBACK>. - +ending with the line C<PUTBACK>. The C<dSP> declares a local copy +of the stack pointer. This local copy should B<always> be accessed +as C<SP>. =item 2. @@ -630,7 +631,7 @@ function required to call it is now a bit more complex. ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -766,7 +767,7 @@ and this is the C function ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -829,7 +830,7 @@ context, like this ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -897,7 +898,7 @@ and here is a C function to call it. sva = sv_2mortal(newSViv(a)) ; svb = sv_2mortal(newSViv(b)) ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sva); XPUSHs(svb); PUTBACK ; @@ -954,7 +955,7 @@ and some C to call it ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -1087,7 +1088,7 @@ Here is a snippet of XSUB which defines I<CallSubPV>. CallSubPV(name) char * name CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_pv(name, G_DISCARD|G_NOARGS) ; That is fine as far as it goes. The thing is, the Perl subroutine @@ -1103,7 +1104,7 @@ I<perl_call_sv> instead of I<perl_call_pv>. CallSubSV(name) SV * name CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_sv(name, G_DISCARD|G_NOARGS) ; Because we are using an SV to call I<fred> the following can all be used @@ -1133,7 +1134,7 @@ pointer to the SV. Say the code above had been like this void CallSavedSub1() CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_sv(rememberSub, G_DISCARD|G_NOARGS) ; The reason this is wrong is that by the time you come to use the @@ -1209,7 +1210,7 @@ SV. The code below shows C<SaveSub2> modified to do that void CallSavedSub2() CODE: - PUSHMARK(sp) ; + PUSHMARK(SP) ; perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ; To avoid creating a new SV every time C<SaveSub2> is called, @@ -1318,7 +1319,7 @@ the C<PrintID> and C<Display> methods from C. char * method int index CODE: - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(ref); XPUSHs(sv_2mortal(newSViv(index))) ; PUTBACK; @@ -1330,7 +1331,7 @@ the C<PrintID> and C<Display> methods from C. char * class char * method CODE: - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(class, 0))) ; PUTBACK; @@ -1522,7 +1523,7 @@ Now change that to call a Perl subroutine instead { dSP ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; /* Call the Perl sub to process the callback */ perl_call_sv(callback, G_DISCARD) ; @@ -1625,7 +1626,7 @@ and C<asynch_read_if> could look like this if (sv == (SV**)NULL) croak("Internal error...\n") ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(fh))) ; XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ; PUTBACK ; @@ -1709,7 +1710,7 @@ series of C functions to act as the interface to Perl, thus { dSP ; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ; PUTBACK ; @@ -1863,7 +1864,7 @@ of values> recoded to use C<ST> instead of C<POP*>. ENTER ; SAVETMPS; - PUSHMARK(sp) ; + PUSHMARK(SP) ; XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK ; @@ -1871,8 +1872,8 @@ of values> recoded to use C<ST> instead of C<POP*>. count = perl_call_pv("AddSubtract", G_ARRAY); SPAGAIN ; - sp -= count ; - ax = (sp - stack_base) + 1 ; + SP -= count ; + ax = (SP - stack_base) + 1 ; if (count != 2) croak("Big trouble\n") ; @@ -1901,8 +1902,8 @@ you. The code SPAGAIN ; - sp -= count ; - ax = (sp - stack_base) + 1 ; + SP -= count ; + ax = (SP - stack_base) + 1 ; sets the stack up so that we can use the C<ST> macro. diff --git a/pod/perlembed.pod b/pod/perlembed.pod index e7164b58f9..32096789ec 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -370,7 +370,7 @@ been wrapped here): dSP; SV* retval; - PUSHMARK(sp); + PUSHMARK(SP); perl_eval_sv(sv, G_SCALAR); SPAGAIN; @@ -563,7 +563,7 @@ deep breath... dSP; /* initialize stack pointer */ ENTER; /* everything created after here */ SAVETMPS; /* ...is a temporary variable. */ - PUSHMARK(sp); /* remember the stack pointer */ + PUSHMARK(SP); /* remember the stack pointer */ XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack */ XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack */ PUTBACK; /* make local stack pointer global */ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index e84e7e59a0..9b7cab627e 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1088,10 +1088,10 @@ two, the local time zone's standard and summer time abbreviations. To handle this situation, the PPCODE directive is used and the stack is extended using the macro: - EXTEND(sp, num); + EXTEND(SP, num); -where C<sp> is the stack pointer, and C<num> is the number of elements the -stack should be extended by. +where C<SP> is the macro that represents the local copy of the stack pointer, +and C<num> is the number of elements the stack should be extended by. Now that there is room on the stack, values can be pushed on it using the macros to push IVs, doubles, strings, and SV pointers respectively: @@ -1144,6 +1144,7 @@ must manipulate the Perl stack. These include the following macros and functions: dSP + SP PUSHMARK() PUTBACK SPAGAIN @@ -1575,7 +1576,8 @@ The C variable which corresponds to Perl's $^W warning variable. =item dSP -Declares a stack pointer variable, C<sp>, for the XSUB. See C<SP>. +Declares a local copy of perl's stack pointer for the XSUB, available via +the C<SP> macro. See C<SP>. =item dXSARGS diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 07abd10564..d065b94425 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -558,7 +558,7 @@ Perl as a single list. bool_t status; PPCODE: status = rpcb_gettime( host, &timep ); - EXTEND(sp, 2); + EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv(status))); PUSHs(sv_2mortal(newSViv(timep))); @@ -573,7 +573,7 @@ directive. The EXTEND() macro is used to make room on the argument stack for 2 return values. The PPCODE: directive causes the -B<xsubpp> compiler to create a stack pointer called C<sp>, and it +B<xsubpp> compiler to create a stack pointer available as C<SP>, and it is this pointer which is being used in the EXTEND() macro. The values are then pushed onto the stack with the PUSHs() macro. @@ -2216,7 +2216,7 @@ PP(pp_aslice) if (SvTYPE(av) == SVt_PVAV) { if (lval && op->op_private & OPpLVAL_INTRO) { I32 max = -1; - for (svp = mark + 1; svp <= sp; svp++) { + for (svp = MARK + 1; svp <= SP; svp++) { elem = SvIVx(*svp); if (elem > max) max = elem; @@ -2858,7 +2858,7 @@ PP(pp_unpack) { djSP; dPOPPOPssrl; - SV **oldsp = sp; + SV **oldsp = SP; I32 gimme = GIMME_V; SV *sv; STRLEN llen; @@ -3542,7 +3542,7 @@ PP(pp_unpack) checksum = 0; } } - if (sp == oldsp && gimme == G_SCALAR) + if (SP == oldsp && gimme == G_SCALAR) PUSHs(&sv_undef); RETURN; } @@ -4436,7 +4436,7 @@ PP(pp_threadsv) { djSP; #ifdef USE_THREADS - EXTEND(sp, 1); + EXTEND(SP, 1); if (op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(op->op_targ)); else @@ -535,7 +535,7 @@ PP(pp_grepstart) djSP; SV *src; - if (stack_base + *markstack_ptr == sp) { + if (stack_base + *markstack_ptr == SP) { (void)POPMARK; if (GIMME_V == G_SCALAR) XPUSHs(&sv_no); @@ -574,7 +574,7 @@ PP(pp_mapstart) PP(pp_mapwhile) { djSP; - I32 diff = (sp - stack_base) - *markstack_ptr; + I32 diff = (SP - stack_base) - *markstack_ptr; I32 count; I32 shift; SV** src; @@ -584,11 +584,11 @@ PP(pp_mapwhile) if (diff) { if (diff > markstack_ptr[-1] - markstack_ptr[-2]) { shift = diff - (markstack_ptr[-1] - markstack_ptr[-2]); - count = (sp - stack_base) - markstack_ptr[-1] + 2; + count = (SP - stack_base) - markstack_ptr[-1] + 2; - EXTEND(sp,shift); - src = sp; - dst = (sp += shift); + EXTEND(SP,shift); + src = SP; + dst = (SP += shift); markstack_ptr[-1] += shift; *markstack_ptr += shift; while (--count) @@ -791,7 +791,7 @@ PP(pp_flip) } else { sv_setiv(targ, 0); - sp--; + SP--; RETURNOP(((CONDOP*)cUNOP->op_first)->op_false); } } @@ -1285,7 +1285,7 @@ PP(pp_dbstate) if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace)) { - SV **sp; + djSP; register CV *cv; register PERL_CONTEXT *cx; I32 gimme = G_ARRAY; @@ -1307,10 +1307,10 @@ PP(pp_dbstate) SAVESTACK_POS(); debug = 0; hasargs = 0; - sp = stack_sp; + SPAGAIN; push_return(op->op_next); - PUSHBLOCK(cx, CXt_SUB, sp); + PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB(cx); CvDEPTH(cv)++; (void)SvREFCNT_inc(cv); @@ -1360,7 +1360,7 @@ PP(pp_enteriter) cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); else { cx->blk_loop.iterary = curstack; - AvFILLp(curstack) = sp - stack_base; + AvFILLp(curstack) = SP - stack_base; cx->blk_loop.iterix = MARK - stack_base; } @@ -1752,15 +1752,15 @@ PP(pp_goto) if (CvXSUB(cv)) { if (CvOLDSTYLE(cv)) { I32 (*fp3)_((int,int,int)); - while (sp > mark) { - sp[1] = sp[0]; - sp--; + while (SP > mark) { + SP[1] = SP[0]; + SP--; } fp3 = (I32(*)_((int,int,int)))CvXSUB(cv); items = (*fp3)(CvXSUBANY(cv).any_i32, mark - stack_base + 1, items); - sp = stack_base + items; + SP = stack_base + items; } else { stack_sp--; /* There is no cv arg. */ @@ -1834,9 +1834,9 @@ PP(pp_goto) items = AvFILLp(av) + 1; if (items) { /* Mark is at the end of the stack. */ - EXTEND(sp, items); - Copy(AvARRAY(av), sp + 1, items, SV*); - sp += items; + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; PUTBACK ; } } @@ -2337,7 +2337,7 @@ doeval(int gimme, OP** startop) CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs((SV*)compiling.cop_filegv); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -2650,7 +2650,7 @@ PP(pp_leaveeval) lex_end(); if (optype == OP_REQUIRE && - !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) + !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp)) { /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; @@ -65,7 +65,7 @@ PP(pp_nextstate) PP(pp_gvsv) { djSP; - EXTEND(sp,1); + EXTEND(SP,1); if (op->op_private & OPpLVAL_INTRO) PUSHs(save_scalar(cGVOP->op_gv)); else @@ -1268,7 +1268,7 @@ PP(pp_enter) ENTER; SAVETMPS; - PUSHBLOCK(cx, CXt_BLOCK, sp); + PUSHBLOCK(cx, CXt_BLOCK, SP); RETURN; } @@ -1385,7 +1385,7 @@ PP(pp_iter) SV* sv; AV* av; - EXTEND(sp, 1); + EXTEND(SP, 1); cx = &cxstack[cxstack_ix]; if (cx->cx_type != CXt_LOOP) DIE("panic: pp_iter"); @@ -1717,7 +1717,7 @@ PP(pp_grepwhile) LEAVE; /* exit inner scope */ /* All done yet? */ - if (stack_base + *markstack_ptr > sp) { + if (stack_base + *markstack_ptr > SP) { I32 items; I32 gimme = GIMME_V; @@ -2041,9 +2041,9 @@ PP(pp_entersub) dMARK; register I32 items = SP - MARK; /* We dont worry to copy from @_. */ - while (sp > mark) { - sp[1] = sp[0]; - sp--; + while (SP > mark) { + SP[1] = SP[0]; + SP--; } stack_sp = mark + 1; fp3 = (I32(*)_((int,int,int)))CvXSUB(cv); @@ -2072,9 +2072,9 @@ PP(pp_entersub) if (items) { /* Mark is at the end of the stack. */ - EXTEND(sp, items); - Copy(AvARRAY(av), sp + 1, items, SV*); - sp += items; + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; PUTBACK ; } } @@ -2160,9 +2160,9 @@ PP(pp_entersub) items = AvFILLp(av) + 1; if (items) { /* Mark is at the end of the stack. */ - EXTEND(sp, items); - Copy(AvARRAY(av), sp + 1, items, SV*); - sp += items; + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; PUTBACK ; } } @@ -648,9 +648,9 @@ PP(pp_dbmopen) } ENTER; - PUSHMARK(sp); + PUSHMARK(SP); - EXTEND(sp, 5); + EXTEND(SP, 5); PUSHs(sv); PUSHs(left); if (SvIV(right)) @@ -663,8 +663,8 @@ PP(pp_dbmopen) SPAGAIN; if (!sv_isobject(TOPs)) { - sp--; - PUSHMARK(sp); + SP--; + PUSHMARK(SP); PUSHs(sv); PUSHs(left); PUSHs(sv_2mortal(newSViv(O_RDONLY))); @@ -3994,7 +3994,7 @@ PP(pp_ehostent) djSP; #ifdef HAS_ENDHOSTENT endhostent(); - EXTEND(sp,1); + EXTEND(SP,1); RETPUSHYES; #else DIE(no_sock_func, "endhostent"); @@ -4006,7 +4006,7 @@ PP(pp_enetent) djSP; #ifdef HAS_ENDNETENT endnetent(); - EXTEND(sp,1); + EXTEND(SP,1); RETPUSHYES; #else DIE(no_sock_func, "endnetent"); @@ -4018,7 +4018,7 @@ PP(pp_eprotoent) djSP; #ifdef HAS_ENDPROTOENT endprotoent(); - EXTEND(sp,1); + EXTEND(SP,1); RETPUSHYES; #else DIE(no_sock_func, "endprotoent"); @@ -4030,7 +4030,7 @@ PP(pp_eservent) djSP; #ifdef HAS_ENDSERVENT endservent(); - EXTEND(sp,1); + EXTEND(SP,1); RETPUSHYES; #else DIE(no_sock_func, "endservent"); @@ -167,11 +167,12 @@ SV * save_scalar(GV *gv) { dTHR; + SV **sptr = &GvSV(gv); SSCHECK(3); - SSPUSHPTR(gv); - SSPUSHPTR(GvSV(gv)); + SSPUSHPTR(SvREFCNT_inc(gv)); + SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SV); - return save_scalar_at(&GvSV(gv)); + return save_scalar_at(sptr); } SV* @@ -180,7 +181,7 @@ save_svref(SV **sptr) dTHR; SSCHECK(3); SSPUSHPTR(sptr); - SSPUSHPTR(*sptr); + SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SVREF); return save_scalar_at(sptr); } @@ -440,35 +441,11 @@ save_delete(HV *hv, char *key, I32 klen) SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); - SSPUSHPTR(hv); + SSPUSHPTR(SvREFCNT_inc(hv)); SSPUSHINT(SAVEt_DELETE); } void -save_aelem(AV *av, I32 idx, SV **sptr) -{ - dTHR; - SSCHECK(4); - SSPUSHPTR(av); - SSPUSHINT(idx); - SSPUSHPTR(*sptr); - SSPUSHINT(SAVEt_AELEM); - save_scalar_at(sptr); -} - -void -save_helem(HV *hv, SV *key, SV **sptr) -{ - dTHR; - SSCHECK(4); - SSPUSHPTR(hv); - SSPUSHPTR(key); - SSPUSHPTR(*sptr); - SSPUSHINT(SAVEt_HELEM); - save_scalar_at(sptr); -} - -void save_list(register SV **sarg, I32 maxsarg) { dTHR; @@ -496,6 +473,30 @@ save_destructor(void (*f) (void *), void *p) } void +save_aelem(AV *av, I32 idx, SV **sptr) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(SvREFCNT_inc(av)); + SSPUSHINT(idx); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_AELEM); + save_scalar_at(sptr); +} + +void +save_helem(HV *hv, SV *key, SV **sptr) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(SvREFCNT_inc(hv)); + SSPUSHPTR(SvREFCNT_inc(key)); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_HELEM); + save_scalar_at(sptr); +} + +void save_op(void) { dTHR; @@ -532,6 +533,7 @@ leave_scope(I32 base) value = (SV*)SSPOPPTR; gv = (GV*)SSPOPPTR; ptr = &GvSV(gv); + SvREFCNT_dec(gv); goto restore_sv; case SAVEt_SVREF: /* scalar reference */ value = (SV*)SSPOPPTR; @@ -563,6 +565,7 @@ leave_scope(I32 base) localizing = 2; SvSETMAGIC(value); localizing = 0; + SvREFCNT_dec(value); break; case SAVEt_AV: /* array reference */ av = (AV*)SSPOPPTR; @@ -719,6 +722,7 @@ leave_scope(I32 base) hv = (HV*)ptr; ptr = SSPOPPTR; (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD); + SvREFCNT_dec(hv); Safefree(ptr); break; case SAVEt_DESTRUCTOR: @@ -738,14 +742,38 @@ leave_scope(I32 base) i = SSPOPINT; av = (AV*)SSPOPPTR; ptr = av_fetch(av,i,1); - goto restore_sv; + if (ptr) { + sv = *(SV**)ptr; + if (sv && sv != &sv_undef) { + if (SvRMAGICAL(av) && mg_find((SV*)av, 'P')) + (void)SvREFCNT_inc(sv); + SvREFCNT_dec(av); + goto restore_sv; + } + } + SvREFCNT_dec(av); + SvREFCNT_dec(value); + break; case SAVEt_HELEM: /* hash element */ value = (SV*)SSPOPPTR; sv = (SV*)SSPOPPTR; hv = (HV*)SSPOPPTR; ptr = hv_fetch_ent(hv, sv, 1, 0); - ptr = &HeVAL((HE*)ptr); - goto restore_sv; + if (ptr) { + SV *oval = HeVAL((HE*)ptr); + if (oval && oval != &sv_undef) { + ptr = &HeVAL((HE*)ptr); + if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P')) + (void)SvREFCNT_inc(*(SV**)ptr); + SvREFCNT_dec(hv); + SvREFCNT_dec(sv); + goto restore_sv; + } + } + SvREFCNT_dec(hv); + SvREFCNT_dec(sv); + SvREFCNT_dec(value); + break; case SAVEt_OP: op = (OP*)SSPOPPTR; break; diff --git a/t/op/local.t b/t/op/local.t index 0df1b6d1dc..513e06310f 100755 --- a/t/op/local.t +++ b/t/op/local.t @@ -2,7 +2,7 @@ # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $ -print "1..36\n"; +print "1..47\n"; sub foo { local($a, $b) = @_; @@ -101,3 +101,61 @@ eval { } }; print $m == 5 ? "" : "not ", "ok 36\n"; + +# see if localization works on tied arrays +{ + package TA; + sub TIEARRAY { bless [], $_[0] } + sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] } + sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v } + sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); } + sub FETCHSIZE { scalar(@{$_[0]}) } + sub SHIFT { shift (@{$_[0]}) } + sub EXTEND {} +} + +tie @a, 'TA'; +@a = ('a', 'b', 'c'); +{ + local($a[1]) = 'foo'; + local($a[2]) = $a[1]; # XXX LHS == RHS doesn't work yet + print +($a[1] eq 'foo') ? "" : "not ", "ok 37\n"; + print +($a[2] eq 'foo') ? "" : "not ", "ok 38\n"; + @a = (); +} +print +($a[1] eq 'b') ? "" : "not ", "ok 39\n"; +print +($a[2] eq 'c') ? "" : "not ", "ok 40\n"; +print +(!defined $a[0]) ? "" : "not ", "ok 41\n"; + +{ + package TH; + sub TIEHASH { bless {}, $_[0] } + sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } + sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } + sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } + sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } +} + +# see if localization works on tied hashes +tie %h, 'TH'; +%h = ('a' => 1, 'b' => 2, 'c' => 3); + +{ + local($h{'a'}) = 'foo'; + local($h{'b'}) = $h{'a'}; # XXX LHS == RHS doesn't work yet + print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n"; + print +($h{'b'} eq 'foo') ? "" : "not ", "ok 43\n"; + local($h{'c'}); + delete $h{'c'}; +} +print +($h{'a'} == 1) ? "" : "not ", "ok 44\n"; +print +($h{'b'} == 2) ? "" : "not ", "ok 45\n"; +print +($h{'c'} == 3) ? "" : "not ", "ok 46\n"; + +@a = ('a', 'b', 'c'); +{ + local($a[1]) = "X"; + shift @a; +} +print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 47\n"; + @@ -77,6 +77,11 @@ PERLVAR(Tmainstack, AV *) /* the stack when nothing funny is happening */ PERLVAR(Ttop_env, JMPENV *) /* ptr. to current sigjmp() environment */ PERLVAR(Tstart_env, JMPENV) /* empty startup sigjmp() environment */ +/* statics "owned" by various functions */ +PERLVAR(Tav_fetch_sv, SV *) +PERLVAR(Thv_fetch_sv, SV *) +PERLVAR(Thv_fetch_ent_mh, HE) + /* XXX Sort stuff, firstgv secongv and so on? */ /* XXX What about regexp stuff? */ @@ -1311,7 +1311,7 @@ die(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1376,7 +1376,7 @@ croak(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1435,7 +1435,7 @@ warn(pat,va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); diff --git a/win32/Makefile b/win32/Makefile index 26539208b6..54ce1920c1 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -186,7 +186,6 @@ X2P=..\x2p\a2p.exe PL2BAT=bin\pl2bat.pl GLOBBAT = bin\perlglob.bat -MAKE=nmake -nologo CFGSH_TMPL = config.vc CFGH_TMPL = config_H.vc PERL95EXE=..\perl95.exe @@ -421,8 +420,7 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(XCOPY) ..\*.h $(COREDIR)\*.* $(XCOPY) *.h $(COREDIR)\*.* $(RCOPY) include $(COREDIR)\*.* - $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \ - RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) + $(MINIPERL) -I..\lib config_h.PL || $(MAKE) $(MAKEFLAGS) $(CONFIGPM) $(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ) $(LINK32) -subsystem:console -out:$@ @<< diff --git a/win32/config.bc b/win32/config.bc index 365c5dea45..b161429035 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -458,9 +458,9 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' -sig_name='ZERO INT ILL FPE SEGV TERM USR1 USR2 USR3 BREAK ABRT' -sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "USR1", "USR2", "USR3", "BREAK", "ABRT", 0' -sig_num='0, 2, 4, 8, 11, 15, 16, 17, 20, 21, 22, 0' +sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM USR1 USR2 CHLD USR3 BREAK ABRT STOP CONT CLD' +sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' +sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0' signal_t='void' sitearch='~INST_TOP~\lib\site\~archname~' sitearchexp='~INST_TOP~\lib\site\~archname~' diff --git a/win32/config.gc b/win32/config.gc index 0bf2718e1a..ac16650eb7 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -458,9 +458,9 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' -sig_name='ZERO INT ILL FPE SEGV TERM BREAK ABRT' -sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0' -sig_num='0, 2, 4, 8, 11, 15, 21, 22, 0' +sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CONT CLD' +sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' +sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0' signal_t='void' sitearch='~INST_TOP~\lib\site\~archname~' sitearchexp='~INST_TOP~\lib\site\~archname~' diff --git a/win32/config.vc b/win32/config.vc index 9797319b61..5e05b6366e 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -458,9 +458,9 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' -sig_name='ZERO INT ILL FPE SEGV TERM BREAK ABRT' -sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0' -sig_num='0, 2, 4, 8, 11, 15, 21, 22, 0' +sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CONT CLD' +sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0' +sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0' signal_t='void' sitearch='~INST_TOP~\lib\site\~archname~' sitearchexp='~INST_TOP~\lib\site\~archname~' diff --git a/win32/config_H.bc b/win32/config_H.bc index bcdc0b8d78..29d088aff2 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -1732,8 +1732,8 @@ * The last element is 0, corresponding to the 0 at the end of * the sig_name list. */ -#define SIG_NAME "ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "USR1", "USR2", "USR3", "BREAK", "ABRT", 0 /**/ -#define SIG_NUM 0, 2, 4, 8, 11, 15, 16, 17, 20, 21, 22, 0 /**/ +#define SIG_NAME "ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0 /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. diff --git a/win32/config_H.gc b/win32/config_H.gc index eef1a63b5c..c05fcebc6d 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -1732,8 +1732,8 @@ * The last element is 0, corresponding to the 0 at the end of * the sig_name list. */ -#define SIG_NAME "ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0 /**/ -#define SIG_NUM 0, 2, 4, 8, 11, 15, 21, 22, 0 /**/ +#define SIG_NAME "ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0 /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. diff --git a/win32/config_H.vc b/win32/config_H.vc index c38ae593f9..17cddf5bca 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1732,8 +1732,8 @@ * The last element is 0, corresponding to the 0 at the end of * the sig_name list. */ -#define SIG_NAME "ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0 /**/ -#define SIG_NUM 0, 2, 4, 8, 11, 15, 21, 22, 0 /**/ +#define SIG_NAME "ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0 /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. diff --git a/win32/config_h.PL b/win32/config_h.PL index 471c43c7e1..f317e5a407 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -27,6 +27,7 @@ eval $str; die "$str:$@" if $@; open(H,">$file.new") || die "Cannot open $file.new:$!"; +binmode H; # no CRs (which cause a spurious rebuild) while (<SH>) { last if /^$term$/o; diff --git a/win32/makefile.mk b/win32/makefile.mk index 45af8778f0..45cbe4ba25 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -157,8 +157,8 @@ DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console LIBC = -lcrtdll -LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lwsock32 -lmingw32 -lgcc -lmoldname $(LIBC) \ - -lkernel32 +LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 -lmingw32 \ + -lgcc -lmoldname $(LIBC) -lkernel32 WINIOMAYBE = diff --git a/win32/win32.c b/win32/win32.c index 9f678f230c..9178631df5 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -16,6 +16,18 @@ #endif #include <windows.h> +#ifndef __MINGW32__ +#include <lmcons.h> +#include <lmerr.h> +/* ugliness to work around a buggy struct definition in lmwksta.h */ +#undef LPTSTR +#define LPTSTR LPWSTR +#include <lmwksta.h> +#undef LPTSTR +#define LPTSTR LPSTR +#include <lmapibuf.h> +#endif /* __MINGW32__ */ + /* #include "config.h" */ #define PERLIO_NOT_STDIO 0 @@ -72,6 +84,20 @@ long w32_num_children = 0; HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS]; #endif +#ifndef FOPEN_MAX +# ifdef _NSTREAM_ +# define FOPEN_MAX _NSTREAM_ +# elsif _NFILE_ +# define FOPEN_MAX _NFILE_ +# elsif _NFILE +# define FOPEN_MAX _NFILE +# endif +#endif + +#ifndef USE_CRT_POPEN +int w32_popen_pids[FOPEN_MAX]; +#endif + #ifdef USE_THREADS # ifdef USE_DECLSPEC_THREAD __declspec(thread) char strerror_buffer[512]; @@ -138,12 +164,12 @@ has_redirection(char *ptr) * Scan string looking for redirection (< or >) or pipe * characters (|) that are not in a quoted string */ - while(*ptr) { + while (*ptr) { switch(*ptr) { case '\'': case '\"': - if(inquote) { - if(quote == *ptr) { + if (inquote) { + if (quote == *ptr) { inquote = 0; quote = '\0'; } @@ -156,7 +182,7 @@ has_redirection(char *ptr) case '>': case '<': case '|': - if(!inquote) + if (!inquote) return TRUE; default: break; @@ -188,10 +214,8 @@ my_popen(char *cmd, char *mode) #define fixcmd(x) #endif fixcmd(cmd); -#ifdef __BORLANDC__ /* workaround a Borland stdio bug */ win32_fflush(stdout); win32_fflush(stderr); -#endif return win32_popen(cmd, mode); } @@ -309,7 +333,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) flag = SvIVx(*mark); } - while(++mark <= sp) { + while (++mark <= sp) { if (*mark && (str = SvPV(*mark, na))) argv[index++] = str; else @@ -335,15 +359,18 @@ do_aspawn(void *vreally, void **vmark, void **vsp) (const char* const*)argv); } - if (status < 0) { - if (dowarn) - warn("Can't spawn \"%s\": %s", argv[0], strerror(errno)); - status = 255 * 256; + if (flag != P_NOWAIT) { + if (status < 0) { + if (dowarn) + warn("Can't spawn \"%s\": %s", argv[0], strerror(errno)); + status = 255 * 256; + } + else + status *= 256; + statusvalue = status; } - else if (flag != P_NOWAIT) - status *= 256; Safefree(argv); - return (statusvalue = status); + return (status); } static int @@ -358,7 +385,7 @@ do_spawn2(char *cmd, int exectype) /* Save an extra exec if possible. See if there are shell * metacharacters in it */ - if(!has_redirection(cmd)) { + if (!has_redirection(cmd)) { New(1301,argv, strlen(cmd) / 2 + 2, char*); New(1302,cmd2, strlen(cmd) + 1, char); strcpy(cmd2, cmd); @@ -368,9 +395,9 @@ do_spawn2(char *cmd, int exectype) s++; if (*s) *(a++) = s; - while(*s && !isspace(*s)) + while (*s && !isspace(*s)) s++; - if(*s) + if (*s) *s++ = '\0'; } *a = Nullch; @@ -419,16 +446,19 @@ do_spawn2(char *cmd, int exectype) cmd = argv[0]; Safefree(argv); } - if (status < 0) { - if (dowarn) - warn("Can't %s \"%s\": %s", - (exectype == EXECF_EXEC ? "exec" : "spawn"), - cmd, strerror(errno)); - status = 255 * 256; + if (exectype != EXECF_SPAWN_NOWAIT) { + if (status < 0) { + if (dowarn) + warn("Can't %s \"%s\": %s", + (exectype == EXECF_EXEC ? "exec" : "spawn"), + cmd, strerror(errno)); + status = 255 * 256; + } + else + status *= 256; + statusvalue = status; } - else if (exectype != EXECF_SPAWN_NOWAIT) - status *= 256; - return (statusvalue = status); + return (status); } int @@ -450,9 +480,6 @@ do_exec(char *cmd) return FALSE; } - -#define PATHLEN 1024 - /* The idea here is to read all the directory names into a string table * (separated by nulls) and when one of the other dir functions is called * return the pointer to the current file name. @@ -460,19 +487,17 @@ do_exec(char *cmd) DIR * opendir(char *filename) { - DIR *p; - long len; - long idx; - char scannamespc[PATHLEN]; - char *scanname = scannamespc; - struct stat sbuf; - WIN32_FIND_DATA FindData; - HANDLE fh; -/* char root[_MAX_PATH];*/ -/* char volname[_MAX_PATH];*/ -/* DWORD serial, maxname, flags;*/ -/* BOOL downcase;*/ -/* char *dummy;*/ + DIR *p; + long len; + long idx; + char scanname[MAX_PATH+3]; + struct stat sbuf; + WIN32_FIND_DATA FindData; + HANDLE fh; + + len = strlen(filename); + if (len > MAX_PATH) + return NULL; /* check to see if filename is a directory */ if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) { @@ -482,35 +507,21 @@ opendir(char *filename) return NULL; } - /* get the file system characteristics */ -/* if(GetFullPathName(filename, MAX_PATH, root, &dummy)) { - * if(dummy = strchr(root, '\\')) - * *++dummy = '\0'; - * if(GetVolumeInformation(root, volname, MAX_PATH, &serial, - * &maxname, &flags, 0, 0)) { - * downcase = !(flags & FS_CASE_IS_PRESERVED); - * } - * } - * else { - * downcase = TRUE; - * } - */ /* Get us a DIR structure */ Newz(1303, p, 1, DIR); - if(p == NULL) + if (p == NULL) return NULL; /* Create the search pattern */ strcpy(scanname, filename); - - if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL) - strcat(scanname, "/*"); - else - strcat(scanname, "*"); + if (scanname[len-1] != '/' && scanname[len-1] != '\\') + scanname[len++] = '/'; + scanname[len++] = '*'; + scanname[len] = '\0'; /* do the FindFirstFile call */ fh = FindFirstFile(scanname, &FindData); - if(fh == INVALID_HANDLE_VALUE) { + if (fh == INVALID_HANDLE_VALUE) { return NULL; } @@ -519,13 +530,9 @@ opendir(char *filename) */ idx = strlen(FindData.cFileName)+1; New(1304, p->start, idx, char); - if(p->start == NULL) { + if (p->start == NULL) croak("opendir: malloc failed!\n"); - } strcpy(p->start, FindData.cFileName); -/* if(downcase) - * strlwr(p->start); - */ p->nfiles++; /* loop finding all the files that match the wildcard @@ -539,20 +546,16 @@ opendir(char *filename) * new name and it's null terminator */ Renew(p->start, idx+len+1, char); - if(p->start == NULL) { + if (p->start == NULL) croak("opendir: malloc failed!\n"); - } strcpy(&p->start[idx], FindData.cFileName); -/* if (downcase) - * strlwr(&p->start[idx]); - */ - p->nfiles++; - idx += len+1; - } - FindClose(fh); - p->size = idx; - p->curr = p->start; - return p; + p->nfiles++; + idx += len+1; + } + FindClose(fh); + p->size = idx; + p->curr = p->start; + return p; } @@ -1040,14 +1043,14 @@ my_open_osfhandle(long osfhandle, int flags) /* copy relevant flags from second parameter */ fileflags = FDEV; - if(flags & O_APPEND) + if (flags & O_APPEND) fileflags |= FAPPEND; - if(flags & O_TEXT) + if (flags & O_TEXT) fileflags |= FTEXT; /* attempt to allocate a C Runtime file handle */ - if((fh = _alloc_osfhnd()) == -1) { + if ((fh = _alloc_osfhnd()) == -1) { errno = EMFILE; /* too many open files */ _doserrno = 0L; /* not an OS error */ return -1; /* return error to caller */ @@ -1182,12 +1185,12 @@ win32_strerror(int e) #endif DWORD source = 0; - if(e < 0 || e > sys_nerr) { + if (e < 0 || e > sys_nerr) { dTHR; - if(e < 0) + if (e < 0) e = GetLastError(); - if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, + if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, strerror_buffer, sizeof(strerror_buffer), NULL) == 0) strcpy(strerror_buffer, "Unknown Error"); @@ -1397,16 +1400,125 @@ win32_pipe(int *pfd, unsigned int size, int mode) return _pipe(pfd, size, mode); } +/* + * a popen() clone that respects PERL5SHELL + */ + DllExport FILE* win32_popen(const char *command, const char *mode) { +#ifdef USE_CRT_POPEN return _popen(command, mode); +#else + int p[2]; + int parent, child; + int stdfd, oldfd; + int ourmode; + int childpid; + + /* establish which ends read and write */ + if (strchr(mode,'w')) { + stdfd = 0; /* stdin */ + parent = 1; + child = 0; + } + else if (strchr(mode,'r')) { + stdfd = 1; /* stdout */ + parent = 0; + child = 1; + } + else + return NULL; + + /* set the correct mode */ + if (strchr(mode,'b')) + ourmode = O_BINARY; + else if (strchr(mode,'t')) + ourmode = O_TEXT; + else + ourmode = _fmode & (O_TEXT | O_BINARY); + + /* the child doesn't inherit handles */ + ourmode |= O_NOINHERIT; + + if (win32_pipe( p, 512, ourmode) == -1) + return NULL; + + /* save current stdfd */ + if ((oldfd = win32_dup(stdfd)) == -1) + goto cleanup; + + /* make stdfd go to child end of pipe (implicitly closes stdfd) */ + /* stdfd will be inherited by the child */ + if (win32_dup2(p[child], stdfd) == -1) + goto cleanup; + + /* close the child end in parent */ + win32_close(p[child]); + + /* start the child */ + if ((childpid = do_spawn_nowait((char*)command)) == -1) + goto cleanup; + + /* revert stdfd to whatever it was before */ + if (win32_dup2(oldfd, stdfd) == -1) + goto cleanup; + + /* close saved handle */ + win32_close(oldfd); + + w32_popen_pids[p[parent]] = childpid; + + /* we have an fd, return a file stream */ + return (win32_fdopen(p[parent], (char *)mode)); + +cleanup: + /* we don't need to check for errors here */ + win32_close(p[0]); + win32_close(p[1]); + if (oldfd != -1) { + win32_dup2(oldfd, stdfd); + win32_close(oldfd); + } + return (NULL); + +#endif /* USE_CRT_POPEN */ } +/* + * pclose() clone + */ + DllExport int win32_pclose(FILE *pf) { +#ifdef USE_CRT_POPEN return _pclose(pf); +#else + int fd, childpid, status; + + fd = win32_fileno(pf); + childpid = w32_popen_pids[fd]; + + if (!childpid) { + errno = EBADF; + return -1; + } + + win32_fclose(pf); + w32_popen_pids[fd] = 0; + + /* wait for the child */ + if (cwait(&status, childpid, WAIT_CHILD) == -1) + return (-1); + /* cwait() returns differently on Borland */ +#ifdef __BORLANDC__ + return (((status >> 8) & 0xff) | ((status << 8) & 0xff00)); +#else + return (status); +#endif + +#endif /* USE_CRT_OPEN */ } DllExport int @@ -1728,7 +1840,7 @@ XS(w32_GetCwd) */ if (SvCUR(sv)) SvPOK_on(sv); - EXTEND(sp,1); + EXTEND(SP,1); ST(0) = sv; XSRETURN(1); } @@ -1801,6 +1913,8 @@ static XS(w32_DomainName) { dXSARGS; +#ifdef __MINGW32__ + /* mingw32 doesn't have NetWksta*() yet, so do it the old way */ char name[256]; DWORD size = sizeof(name); if (GetUserName(name,&size)) { @@ -1814,6 +1928,24 @@ XS(w32_DomainName) XSRETURN_PV(dname); /* all that for this */ } } +#else + /* this way is more reliable, in case user has a local account */ + char dname[256]; + DWORD dnamelen = sizeof(dname); + PWKSTA_INFO_100 pwi; + if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) { + if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { + WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + else { + WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + NetApiBufferFree(pwi); + XSRETURN_PV(dname); + } +#endif XSRETURN_UNDEF; } @@ -1897,7 +2029,7 @@ XS(w32_Spawn) STARTUPINFO stStartInfo; BOOL bSuccess = FALSE; - if(items != 3) + if (items != 3) croak("usage: Win32::Spawn($cmdName, $args, $PID)"); cmd = SvPV(ST(0),na); @@ -1908,7 +2040,7 @@ XS(w32_Spawn) stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */ stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */ - if(CreateProcess( + if (CreateProcess( cmd, /* Image path */ args, /* Arguments for command line */ NULL, /* Default process security */ @@ -1941,7 +2073,7 @@ XS(w32_GetShortPathName) SV *shortpath; DWORD len; - if(items != 1) + if (items != 1) croak("usage: Win32::GetShortPathName($longPathName)"); shortpath = sv_mortalcopy(ST(0)); diff --git a/win32/win32.h b/win32/win32.h index 58a0ff3352..781c720ed0 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -137,6 +137,13 @@ typedef long gid_t; #define flushall _flushall #define fcloseall _fcloseall +#ifndef _O_NOINHERIT +# define _O_NOINHERIT 0x0080 +# ifndef _NO_OLDNAMES +# define O_NOINHERIT _O_NOINHERIT +# endif +#endif + #endif /* __MINGW32__ */ /* compatibility stuff for other compilers goes here */ @@ -222,6 +229,9 @@ struct thread_intern { char Wstrerror_buffer[512]; struct servent Wservent; char Wgetlogin_buffer[128]; +# ifdef USE_SOCKETS_AS_HANDLES + int Winit_socktype; +# endif # ifdef HAVE_DES_FCRYPT char Wcrypt_buffer[30]; # endif diff --git a/win32/win32sck.c b/win32/win32sck.c index 14d2e6a45f..b07d1f1918 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -32,11 +32,22 @@ # define TO_SOCKET(x) (x) #endif /* USE_SOCKETS_AS_HANDLES */ +#ifdef USE_THREADS #define StartSockets() \ STMT_START { \ if (!wsock_started) \ start_sockets(); \ + set_socktype(); \ + } STMT_END +#else +#define StartSockets() \ + STMT_START { \ + if (!wsock_started) { \ + start_sockets(); \ + set_socktype(); \ + } \ } STMT_END +#endif #define EndSockets() \ STMT_START { \ @@ -60,8 +71,10 @@ static struct servent* win32_savecopyservent(struct servent*d, #ifdef USE_THREADS #ifdef USE_DECLSPEC_THREAD __declspec(thread) struct servent myservent; +__declspec(thread) int init_socktype; #else #define myservent (thr->i.Wservent) +#define init_socktype (thr->i.Winit_socktype) #endif #else static struct servent myservent; @@ -75,7 +88,6 @@ start_sockets(void) unsigned short version; WSADATA retdata; int ret; - int iSockOpt = SO_SYNCHRONOUS_NONALERT; /* * initalize the winsock interface and insure that it is @@ -88,15 +100,28 @@ start_sockets(void) croak("Could not find version 1.1 of winsock dll\n"); /* atexit((void (*)(void)) EndSockets); */ + wsock_started = 1; +} +void +set_socktype(void) +{ #ifdef USE_SOCKETS_AS_HANDLES +#ifdef USE_THREADS + dTHR; + if(!init_socktype) { +#endif + int iSockOpt = SO_SYNCHRONOUS_NONALERT; /* * Enable the use of sockets as filehandles */ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, (char *)&iSockOpt, sizeof(iSockOpt)); +#ifdef USE_THREADS + init_socktype = 1; + } +#endif #endif /* USE_SOCKETS_AS_HANDLES */ - wsock_started = 1; } |