From: Gurusamy Sarathy Date: Mon, 9 Feb 1998 23:09:40 +0000 (+0000) Subject: [asperl] integrate win32 branch contents X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=837485b6cd4b757519a4ac6f03f3857c2fcf4844;p=p5sagit%2Fp5-mst-13.2.git [asperl] integrate win32 branch contents p4raw-id: //depot/asperl@493 --- 837485b6cd4b757519a4ac6f03f3857c2fcf4844 diff --cc intrpvar.h index 447753e,be081be..21f9076 --- a/intrpvar.h +++ b/intrpvar.h @@@ -156,14 -156,5 +156,15 @@@ PERLVAR(Iofmt, char *) /* $# * #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */ + PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ #endif /* USE_THREADS */ + +#ifdef PERL_OBJECT +PERLVARI(piMem, IPerlMem*, NULL) +PERLVARI(piENV, IPerlEnv*, NULL) +PERLVARI(piStdIO, IPerlStdIO*, NULL) +PERLVARI(piLIO, IPerlLIO*, NULL) +PERLVARI(piDir, IPerlDir*, NULL) +PERLVARI(piSock, IPerlSock*, NULL) +PERLVARI(piProc, IPerlProc*, NULL) +#endif diff --cc perl.h index 4ea9b96,9b521b9..4602537 --- a/perl.h +++ b/perl.h @@@ -1440,8 -1383,8 +1440,9 @@@ int runops_standard _((void)) #ifdef DEBUGGING int runops_debug _((void)); #endif +#endif /* PERL_OBJECT */ + /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ diff --cc sv.c index 44f4417,1ab0e31..e9e5cfb --- a/sv.c +++ b/sv.c @@@ -65,11 -59,11 +65,15 @@@ static void sv_mortalgrow _((void)) static void sv_unglob _((SV* sv)); static void sv_check_thinkfirst _((SV *sv)); + #ifndef PURIFY + static void *my_safemalloc(MEM_SIZE size); + #endif + typedef void (*SVFUNC) _((SV*)); +#define VTBL *vtbl +#define FCALL *f + +#endif /* PERL_OBJECT */ #ifdef PURIFY @@@ -204,16 -197,16 +207,16 @@@ U32 flags #ifdef DEBUGGING - #define del_SV(p) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (debug & 32768) \ - del_sv(p); \ - else \ - plant_SV(p); \ - MUTEX_UNLOCK(&sv_mutex); \ + #define del_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + UNLOCK_SV_MUTEX; \ } while (0) -static void +STATIC void del_sv(SV *p) { if (debug & 32768) { @@@ -1182,7 -1204,14 +1214,14 @@@ sv_setnv(register SV *sv, double num SvTAINT(sv); } + void + sv_setnv_mg(register SV *sv, double num) + { + sv_setnv(sv,num); + SvSETMAGIC(sv); + } + -static void +STATIC void not_a_number(SV *sv) { dTHR; @@@ -2229,7 -2279,14 +2289,14 @@@ sv_usepvn(register SV *sv, register cha SvTAINT(sv); } + void + sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len) + { + sv_usepvn_mg(sv,ptr,len); + SvSETMAGIC(sv); + } + -static void +STATIC void sv_check_thinkfirst(register SV *sv) { if (SvTHINKFIRST(sv)) { @@@ -2640,37 -2716,37 +2726,37 @@@ sv_clear(register SV *sv if (defstash) { /* Still have a symbol table? */ djSP; GV* destructor; + HV* stash; - SV ref; ++ SV tmpref; - ENTER; - SAVEFREESV(SvSTASH(sv)); - - destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); - if (destructor) { - SV tmpRef; - - Zero(&tmpRef, 1, SV); - sv_upgrade(&tmpRef, SVt_RV); - SvRV(&tmpRef) = SvREFCNT_inc(sv); - SvROK_on(&tmpRef); - SvREFCNT(&tmpRef) = 1; /* Fake, but otherwise - creating+destructing a ref - leads to disaster. */ - - EXTEND(SP, 2); - PUSHMARK(SP); - PUSHs(&tmpRef); - PUTBACK; - perl_call_sv((SV*)GvCV(destructor), - G_DISCARD|G_EVAL|G_KEEPERR); - del_XRV(SvANY(&tmpRef)); - SvREFCNT(sv)--; - } - Zero(&ref, 1, SV); - sv_upgrade(&ref, SVt_RV); - SvROK_on(&ref); - SvREADONLY_on(&ref); /* DESTROY() could be naughty */ - SvREFCNT(&ref) = 1; ++ Zero(&tmpref, 1, SV); ++ sv_upgrade(&tmpref, SVt_RV); ++ SvROK_on(&tmpref); ++ SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */ ++ SvREFCNT(&tmpref) = 1; - LEAVE; + do { + stash = SvSTASH(sv); + destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); + if (destructor) { + ENTER; - SvRV(&ref) = SvREFCNT_inc(sv); ++ SvRV(&tmpref) = SvREFCNT_inc(sv); + EXTEND(SP, 2); + PUSHMARK(SP); - PUSHs(&ref); ++ PUSHs(&tmpref); + PUTBACK; + perl_call_sv((SV*)GvCV(destructor), + G_DISCARD|G_EVAL|G_KEEPERR); + SvREFCNT(sv)--; + LEAVE; + } + } while (SvOBJECT(sv) && SvSTASH(sv) != stash); + - del_XRV(SvANY(&ref)); ++ del_XRV(SvANY(&tmpref)); } - else - SvREFCNT_dec(SvSTASH(sv)); + if (SvOBJECT(sv)) { + SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ SvOBJECT_off(sv); /* Curse the object. */ if (SvTYPE(sv) != SVt_PVIO) --sv_objcount; /* XXX Might want something more general */ diff --cc toke.c index b534fd7,28c5a42..64f0ca2 --- a/toke.c +++ b/toke.c @@@ -50,7 -49,8 +50,9 @@@ static int uni _((I32 f, char *s)) #endif static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); static void restore_rsfp _((void *f)); + static void restore_expect _((void *e)); + static void restore_lex_expect _((void *e)); +#endif /* PERL_OBJECT */ static char ident_too_long[] = "Identifier too long"; @@@ -316,7 -317,23 +319,23 @@@ restore_rsfp(void *f rsfp = fp; } -static void +STATIC void + restore_expect(e) + void *e; + { + /* a safe way to store a small integer in a pointer */ + expect = (expectation)((char *)e - tokenbuf); + } + -static void ++STATIC void + restore_lex_expect(e) + void *e; + { + /* a safe way to store a small integer in a pointer */ + lex_expect = (expectation)((char *)e - tokenbuf); + } + -static void ++STATIC void incline(char *s) { dTHR; diff --cc win32/win32iop.h index 98627e4,d77f542..7e03a9a --- a/win32/win32iop.h +++ b/win32/win32iop.h @@@ -246,8 -248,8 +254,9 @@@ END_EXTERN_ #define times win32_times #define alarm win32_alarm #define ioctl win32_ioctl + #define utime win32_utime #define wait win32_wait +#endif /* PERL_OBJECT */ #ifdef HAVE_DES_FCRYPT #undef crypt