[asperl] integrate win32 branch contents
Gurusamy Sarathy [Mon, 9 Feb 1998 23:09:40 +0000 (23:09 +0000)]
p4raw-id: //depot/asperl@493

21 files changed:
1  2 
dosish.h
embedvar.h
gv.c
hv.c
intrpvar.h
op.c
perl.c
perl.h
perly.c
pp.c
pp_ctl.c
pp_hot.c
regcomp.c
scope.c
sv.c
sv.h
thread.h
toke.c
util.c
win32/makedef.pl
win32/win32iop.h

diff --cc dosish.h
Simple merge
diff --cc embedvar.h
Simple merge
diff --cc gv.c
Simple merge
diff --cc hv.c
Simple merge
diff --cc 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 op.c
Simple merge
diff --cc perl.c
Simple merge
diff --cc perl.h
--- 1/perl.h
--- 2/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 perly.c
Simple merge
diff --cc pp.c
Simple merge
diff --cc pp_ctl.c
Simple merge
diff --cc pp_hot.c
Simple merge
diff --cc regcomp.c
Simple merge
diff --cc scope.c
Simple merge
diff --cc sv.c
--- 1/sv.c
--- 2/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 sv.h
Simple merge
diff --cc thread.h
Simple merge
diff --cc toke.c
--- 1/toke.c
--- 2/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 util.c
Simple merge
Simple merge
@@@ -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