From: Gurusamy Sarathy <gsar@cpan.org>
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