This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
win32 build fixes
authorGurusamy Sarathy <gsar@cpan.org>
Thu, 10 Jun 1999 04:41:38 +0000 (04:41 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Thu, 10 Jun 1999 04:41:38 +0000 (04:41 +0000)
p4raw-id: //depot/perl@3525

33 files changed:
bytecode.pl
dosish.h
embed.h
embed.pl
ext/B/B.xs
ext/ByteLoader/ByteLoader.xs
ext/ByteLoader/bytecode.h
ext/ByteLoader/byterun.h
ext/SDBM_File/sdbm/sdbm.c
globals.c
mg.c
objXSUB.h
op.h
perl.c
perl.h
pp_sys.c
proto.h
sv.c
util.c
win32/Makefile
win32/config_H.bc
win32/config_H.gc
win32/config_H.vc
win32/config_h.PL
win32/dl_win32.xs
win32/makedef.pl
win32/makefile.mk
win32/perllib.c
win32/win32.c
win32/win32.h
win32/win32sck.c
win32/win32thread.c
win32/win32thread.h

index c9bb491..955db20 100644 (file)
@@ -188,9 +188,9 @@ open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $
 print BYTERUN_H $c_header, <<'EOT';
 struct bytestream {
     void *data;
-    int (*fgetc)(void *);
-    int (*fread)(char *, size_t, size_t, void *);
-    void (*freadpv)(U32, void *, XPV *);
+    int (*pfgetc)(void *);
+    int (*pfread)(char *, size_t, size_t, void *);
+    void (*pfreadpv)(U32, void *, XPV *);
 };
 
 enum {
index 4056606..4116dec 100644 (file)
--- a/dosish.h
+++ b/dosish.h
 #  define HAS_KILL
 #  define HAS_WAIT
 #  define HAS_CHOWN
-/*
- * This provides a layer of functions and macros to ensure extensions will
- * get to use the same RTL functions as the core.
- */
-#  ifndef HASATTRIBUTE
-#    ifndef PERL_OBJECT
-#      include <win32iop.h>
-#    endif
-#  endif
 #endif /* WIN32 */
diff --git a/embed.h b/embed.h
index 2db477c..17acf1e 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define do_trans_UC_trivial    S_do_trans_UC_trivial
 #define do_trans_CU_trivial    S_do_trans_CU_trivial
 #endif
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-#define do_aspawn              S_do_aspawn
-#  endif
-#endif
 #if defined(PERL_IN_GV_C)
 #define gv_init_sv             S_gv_init_sv
 #endif
 #if defined(MYMALLOC)
 #define dump_mstats(a)         Perl_dump_mstats(aTHX_ a)
 #endif
-#define safesysmalloc(a)       Perl_safesysmalloc(aTHX_ a)
-#define safesyscalloc(a,b)     Perl_safesyscalloc(aTHX_ a,b)
-#define safesysrealloc(a,b)    Perl_safesysrealloc(aTHX_ a,b)
-#define safesysfree(a)         Perl_safesysfree(aTHX_ a)
+#define safesysmalloc          Perl_safesysmalloc
+#define safesyscalloc          Perl_safesyscalloc
+#define safesysrealloc         Perl_safesysrealloc
+#define safesysfree            Perl_safesysfree
 #if defined(LEAKTEST)
-#define safexmalloc(a,b)       Perl_safexmalloc(aTHX_ a,b)
-#define safexcalloc(a,b,c)     Perl_safexcalloc(aTHX_ a,b,c)
-#define safexrealloc(a,b)      Perl_safexrealloc(aTHX_ a,b)
-#define safexfree(a)           Perl_safexfree(aTHX_ a)
+#define safexmalloc            Perl_safexmalloc
+#define safexcalloc            Perl_safexcalloc
+#define safexrealloc           Perl_safexrealloc
+#define safexfree              Perl_safexfree
 #endif
 #if defined(PERL_GLOBAL_STRUCT)
 #define GetVars()              Perl_GetVars(aTHX)
 #define do_trans_UC_trivial(a) S_do_trans_UC_trivial(aTHX_ a)
 #define do_trans_CU_trivial(a) S_do_trans_CU_trivial(aTHX_ a)
 #endif
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-#define do_aspawn(a,b,c)       S_do_aspawn(aTHX_ a,b,c)
-#  endif
-#endif
 #if defined(PERL_IN_GV_C)
 #define gv_init_sv(a,b)                S_gv_init_sv(aTHX_ a,b)
 #endif
 #define reg_add(a)             S_reg_add(aTHX_ a)
 #define reg_remove(a)          S_reg_remove(aTHX_ a)
 #  else
-#define my_safemalloc(a)       S_my_safemalloc(aTHX_ a)
+#define my_safemalloc          S_my_safemalloc
 #  endif
 #define sv_add_backref(a,b)    S_sv_add_backref(aTHX_ a,b)
 #define sv_del_backref(a)      S_sv_del_backref(aTHX_ a)
 #define S_do_trans_UC_trivial  CPerlObj::do_trans_UC_trivial
 #define S_do_trans_CU_trivial  CPerlObj::do_trans_CU_trivial
 #endif
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-#define S_do_aspawn            CPerlObj::do_aspawn
-#  endif
-#endif
 #if defined(PERL_IN_GV_C)
 #define S_gv_init_sv           CPerlObj::gv_init_sv
 #endif
index 6fad124..452a4de 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1384,15 +1384,15 @@ pno     |Malloc_t|calloc        |MEM_SIZE elements|MEM_SIZE size
 pno    |Malloc_t|realloc       |Malloc_t where|MEM_SIZE nbytes
 pno    |Free_t |mfree          |Malloc_t where
 #endif
-p      |Malloc_t|safesysmalloc |MEM_SIZE nbytes
-p      |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
-p      |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
-p      |Free_t |safesysfree    |Malloc_t where
+pn     |Malloc_t|safesysmalloc |MEM_SIZE nbytes
+pn     |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
+pn     |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
+pn     |Free_t |safesysfree    |Malloc_t where
 #if defined(LEAKTEST)
-p      |Malloc_t|safexmalloc   |I32 x|MEM_SIZE size
-p      |Malloc_t|safexcalloc   |I32 x|MEM_SIZE elements|MEM_SIZE size
-p      |Malloc_t|safexrealloc  |Malloc_t where|MEM_SIZE size
-p      |void   |safexfree      |Malloc_t where
+pn     |Malloc_t|safexmalloc   |I32 x|MEM_SIZE size
+pn     |Malloc_t|safexcalloc   |I32 x|MEM_SIZE elements|MEM_SIZE size
+pn     |Malloc_t|safexrealloc  |Malloc_t where|MEM_SIZE size
+pn     |void   |safexfree      |Malloc_t where
 #endif
 #if defined(PERL_GLOBAL_STRUCT)
 p      |struct perl_vars *|GetVars
@@ -1457,12 +1457,6 @@ s        |I32    |do_trans_UC_trivial    |SV *sv
 s      |I32    |do_trans_CU_trivial    |SV *sv
 #endif
 
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-s      |int    |do_aspawn      |void *vreally|void **vmark|void **vsp
-#  endif
-#endif
-
 #if defined(PERL_IN_GV_C)
 s      |void   |gv_init_sv     |GV *gv|I32 sv_type
 #endif
@@ -1668,7 +1662,7 @@ s |void   |visit          |SVFUNC_t f
 s      |void   |reg_add        |SV *sv
 s      |void   |reg_remove     |SV *sv
 #  else
-     |void*  |my_safemalloc  |MEM_SIZE size
+ns     |void*  |my_safemalloc  |MEM_SIZE size
 #  endif
 s      |void   |sv_add_backref |SV *tsv|SV *sv
 s      |void   |sv_del_backref |SV *sv
index f9193ae..6413a24 100644 (file)
@@ -443,19 +443,6 @@ walkoptree_debug(...)
     OUTPUT:
        RETVAL
 
-int
-byteload_fh(fp)
-       InputStream    fp
-    CODE:
-       byteload_fh(fp);
-       RETVAL = 1;
-    OUTPUT:
-       RETVAL
-
-void
-byteload_string(str)
-       char *  str
-
 #define address(sv) (IV)sv
 
 IV
index e927d16..34002f1 100644 (file)
@@ -25,9 +25,9 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     struct bytestream bs;
 
     bs.data = PL_rsfp;
-    bs.fgetc = (int(*) (void*))fgetc;
-    bs.fread = (int(*) (char*,size_t,size_t,void*))fread;
-    bs.freadpv = freadpv;
+    bs.pfgetc = (int(*) (void*))fgetc;
+    bs.pfread = (int(*) (char*,size_t,size_t,void*))fread;
+    bs.pfreadpv = freadpv;
 
     byterun(bs);
 
index e743583..8a59bb1 100644 (file)
@@ -8,8 +8,8 @@ typedef OP *opindex;
 typedef IV IV64;
 
 #define BGET_FREAD(argp, len, nelem)   \
-        bs.fread((char*)(argp),(len),(nelem),bs.data)
-#define BGET_FGETC() bs.fgetc(bs.data)
+        bs.pfread((char*)(argp),(len),(nelem),bs.data)
+#define BGET_FGETC() bs.pfgetc(bs.data)
 
 #define BGET_U32(arg)  \
        BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
@@ -22,7 +22,7 @@ typedef IV IV64;
 #define BGET_PV(arg)   STMT_START {    \
        BGET_U32(arg);                  \
        if (arg)                        \
-           bs.freadpv(arg, bs.data, &bytecode_pv);     \
+           bs.pfreadpv(arg, bs.data, &bytecode_pv);    \
        else {                          \
            bytecode_pv.xpv_pv = 0;             \
            bytecode_pv.xpv_len = 0;            \
index c293160..3c5b234 100644 (file)
@@ -10,9 +10,9 @@
  */
 struct bytestream {
     void *data;
-    int (*fgetc)(void *);
-    int (*fread)(char *, size_t, size_t, void *);
-    void (*freadpv)(U32, void *, XPV *);
+    int (*pfgetc)(void *);
+    int (*pfread)(char *, size_t, size_t, void *);
+    void (*pfreadpv)(U32, void *, XPV *);
 };
 
 enum {
index 47de0b9..c1e2e4a 100644 (file)
@@ -9,6 +9,9 @@
 
 #include "INTERN.h"
 #include "config.h"
+#ifdef WIN32
+#include "io.h"
+#endif
 #include "sdbm.h"
 #include "tune.h"
 #include "pair.h"
index 857a32c..8ac296d 100644 (file)
--- a/globals.c
+++ b/globals.c
@@ -50,18 +50,4 @@ CPerlObj::Init(void)
 {
 }
 
-#ifdef WIN32           /* XXX why are these needed? */
-bool
-Perl_do_exec(pTHX_ char *cmd)
-{
-    return PerlProc_Cmd(cmd);
-}
-
-int
-S_do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp)
-{
-    return PerlProc_aspawn(vreally, vmark, vsp);
-}
-#endif  /* WIN32 */
-
 #endif   /* PERL_OBJECT */
diff --git a/mg.c b/mg.c
index 770452f..96e4bd2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -532,7 +532,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                sv_setpvn(sv, sMsg, dwLen);
                PerlProc_FreeBuf(sMsg);
 #else
-               win32_str_os_error(sv, dwErr);
+               win32_str_os_error(aTHX_ sv, dwErr);
 #endif
            }
            else
index cdb9138..08356c0 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #endif
 #if defined(PERL_IN_DOOP_C)
 #endif
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-#  endif
-#endif
 #if defined(PERL_IN_GV_C)
 #endif
 #if defined(PERL_IN_HV_C)
diff --git a/op.h b/op.h
index 21404bc..a13df77 100644 (file)
--- a/op.h
+++ b/op.h
@@ -38,7 +38,7 @@ typedef U32 PADOFFSET;
 #define BASEOP                         \
     OP*                op_next;                \
     OP*                op_sibling;             \
-    OP*                (CPERLscope(*op_ppaddr))(ARGSproto);            \
+    OP*                (CPERLscope(*op_ppaddr))(pTHX);         \
     PADOFFSET  op_targ;                \
     OPCODE     op_type;                \
     U16                op_seq;                 \
diff --git a/perl.c b/perl.c
index c137c22..976b7b5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -947,7 +947,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (xsinit)
        (*xsinit)(aTHX);        /* in case linked C routines want magical variables */
 #if defined(VMS) || defined(WIN32) || defined(DJGPP)
-    init_os_extras();
+    init_os_extras(aTHX);
 #endif
 
     init_predump_symbols();
@@ -2916,7 +2916,7 @@ S_init_main_thread(pTHX)
     MUTEX_UNLOCK(&PL_threads_mutex);
 
 #ifdef HAVE_THREAD_INTERN
-    init_thread_intern(thr);
+    Perl_init_thread_intern(thr);
 #endif
 
 #ifdef SET_THREAD_SELF
diff --git a/perl.h b/perl.h
index 73f1dc6..4015a90 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -327,8 +327,6 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #  endif
 #endif
 
-#include "iperlsys.h"
-
 #ifdef USE_NEXT_CTYPE
 
 #if NX_CURRENT_COMPILER_RELEASE >= 500
@@ -1568,6 +1566,11 @@ typedef I32 (*filter_t) (pTHX_ int, SV *, int);
 #define FILTER_DATA(idx)          (AvARRAY(PL_rsfp_filters)[idx])
 #define FILTER_ISREADER(idx)      (idx >= AvFILLp(PL_rsfp_filters))
 
+#ifdef WIN32
+#include "win32.h"
+#endif
+
+#include "iperlsys.h"
 #include "regexp.h"
 #include "sv.h"
 #include "util.h"
@@ -2520,18 +2523,6 @@ PERLVAR(object_compatibility[30],        char)
 #undef PERLVARI
 #undef PERLVARIC
 
-#if defined(HASATTRIBUTE) && defined(WIN32) && !defined(CYGWIN32)
-/*
- * This provides a layer of functions and macros to ensure extensions will
- * get to use the same RTL functions as the core.
- * It has to go here or #define of printf messes up __attribute__
- * stuff in proto.h  
- */
-#ifndef PERL_OBJECT
-#  include <win32iop.h>
-#endif  /* PERL_OBJECT */
-#endif /* WIN32 */
-
 #ifdef DOINIT
 
 EXT MGVTBL PL_vtbl_sv =        {Perl_magic_get,
index f2d0bc3..8eee944 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3602,12 +3602,12 @@ PP(pp_system)
 #else /* ! FORK or VMS or OS/2 */
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
-       value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
+       value = (I32)do_aspawn(aTHX_ really, (void **)MARK, (void **)SP);
     }
     else if (SP - MARK != 1)
-       value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
+       value = (I32)do_aspawn(aTHX_ Nullsv, (void **)MARK, (void **)SP);
     else {
-       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+       value = (I32)do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3634,7 +3634,7 @@ PP(pp_exec)
 #else
 #  ifdef __OPEN_VM
        {
-          (void ) do_aspawn(Nullsv, MARK, SP);
+          (void ) do_aspawn(aTHX_ Nullsv, MARK, SP);
           value = 0;
        }
 #  else
@@ -3651,7 +3651,7 @@ PP(pp_exec)
        value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #else
 #  ifdef __OPEN_VM
-       (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+       (void) do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
        value = 0;
 #  else
        value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
diff --git a/proto.h b/proto.h
index dad622a..3d17fea 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -630,15 +630,15 @@ Malloc_t  Perl_calloc(MEM_SIZE elements, MEM_SIZE size);
 Malloc_t       Perl_realloc(Malloc_t where, MEM_SIZE nbytes);
 Free_t Perl_mfree(Malloc_t where);
 #endif
-Malloc_t       Perl_safesysmalloc(pTHX_ MEM_SIZE nbytes);
-Malloc_t       Perl_safesyscalloc(pTHX_ MEM_SIZE elements, MEM_SIZE size);
-Malloc_t       Perl_safesysrealloc(pTHX_ Malloc_t where, MEM_SIZE nbytes);
-Free_t Perl_safesysfree(pTHX_ Malloc_t where);
+Malloc_t       Perl_safesysmalloc(MEM_SIZE nbytes);
+Malloc_t       Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size);
+Malloc_t       Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes);
+Free_t Perl_safesysfree(Malloc_t where);
 #if defined(LEAKTEST)
-Malloc_t       Perl_safexmalloc(pTHX_ I32 x, MEM_SIZE size);
-Malloc_t       Perl_safexcalloc(pTHX_ I32 x, MEM_SIZE elements, MEM_SIZE size);
-Malloc_t       Perl_safexrealloc(pTHX_ Malloc_t where, MEM_SIZE size);
-void   Perl_safexfree(pTHX_ Malloc_t where);
+Malloc_t       Perl_safexmalloc(I32 x, MEM_SIZE size);
+Malloc_t       Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size);
+Malloc_t       Perl_safexrealloc(Malloc_t where, MEM_SIZE size);
+void   Perl_safexfree(Malloc_t where);
 #endif
 #if defined(PERL_GLOBAL_STRUCT)
 struct perl_vars *     Perl_GetVars(pTHX);
@@ -696,11 +696,6 @@ STATIC I32 S_do_trans_CU_simple(pTHX_ SV *sv);
 STATIC I32     S_do_trans_UC_trivial(pTHX_ SV *sv);
 STATIC I32     S_do_trans_CU_trivial(pTHX_ SV *sv);
 #endif
-#if defined(PERL_IN_GLOBALS_C)
-#  if defined(WIN32)
-STATIC int     S_do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp);
-#  endif
-#endif
 #if defined(PERL_IN_GV_C)
 STATIC void    S_gv_init_sv(pTHX_ GV *gv, I32 sv_type);
 #endif
@@ -889,7 +884,7 @@ STATIC void S_visit(pTHX_ SVFUNC_t f);
 STATIC void    S_reg_add(pTHX_ SV *sv);
 STATIC void    S_reg_remove(pTHX_ SV *sv);
 #  else
-STATIC void*   S_my_safemalloc(pTHX_ MEM_SIZE size);
+STATIC void*   S_my_safemalloc(MEM_SIZE size);
 #  endif
 STATIC void    S_sv_add_backref(pTHX_ SV *tsv, SV *sv);
 STATIC void    S_sv_del_backref(pTHX_ SV *sv);
diff --git a/sv.c b/sv.c
index 889d9f9..edf1f1e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -582,7 +582,7 @@ S_more_xpv(pTHX)
 #  define my_safefree(s) safefree(s)
 #else
 STATIC void* 
-S_my_safemalloc(pTHX_ MEM_SIZE size)
+S_my_safemalloc(MEM_SIZE size)
 {
     char *p;
     New(717, p, size, char);
diff --git a/util.c b/util.c
index 2c897a4..6755c48 100644 (file)
--- a/util.c
+++ b/util.c
@@ -71,18 +71,18 @@ long lastxycount[MAXXCOUNT][MAXYCOUNT];
  */
 
 Malloc_t
-Perl_safesysmalloc(pTHX_ MEM_SIZE size)
+Perl_safesysmalloc(MEM_SIZE size)
 {
     Malloc_t ptr;
 #ifdef HAS_64K_LIMIT
        if (size > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", size) FLUSH;
-               my_exit(1);
+               WITH_THX(my_exit(1));
        }
 #endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
     if ((long)size < 0)
-       Perl_croak(aTHX_ "panic: malloc");
+       Perl_croak_nocontext("panic: malloc");
 #endif
     ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
 #if !(defined(I286) || defined(atarist))
@@ -96,7 +96,7 @@ Perl_safesysmalloc(pTHX_ MEM_SIZE size)
        return Nullch;
     else {
        PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
-       my_exit(1);
+       WITH_THX(my_exit(1));
         return Nullch;
     }
     /*NOTREACHED*/
@@ -105,7 +105,7 @@ Perl_safesysmalloc(pTHX_ MEM_SIZE size)
 /* paranoid version of system's realloc() */
 
 Malloc_t
-Perl_safesysrealloc(pTHX_ Malloc_t where,MEM_SIZE size)
+Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 {
     Malloc_t ptr;
 #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
@@ -116,7 +116,7 @@ Perl_safesysrealloc(pTHX_ Malloc_t where,MEM_SIZE size)
     if (size > 0xffff) {
        PerlIO_printf(PerlIO_stderr(),
                      "Reallocation too large: %lx\n", size) FLUSH;
-       my_exit(1);
+       WITH_THX(my_exit(1));
     }
 #endif /* HAS_64K_LIMIT */
     if (!size) {
@@ -128,7 +128,7 @@ Perl_safesysrealloc(pTHX_ Malloc_t where,MEM_SIZE size)
        return safesysmalloc(size);
 #ifdef DEBUGGING
     if ((long)size < 0)
-       Perl_croak(aTHX_ "panic: realloc");
+       Perl_croak_nocontext("panic: realloc");
 #endif
     ptr = PerlMem_realloc(where,size);
 
@@ -150,7 +150,7 @@ Perl_safesysrealloc(pTHX_ Malloc_t where,MEM_SIZE size)
        return Nullch;
     else {
        PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
-       my_exit(1);
+       WITH_THX(my_exit(1));
        return Nullch;
     }
     /*NOTREACHED*/
@@ -159,7 +159,7 @@ Perl_safesysrealloc(pTHX_ Malloc_t where,MEM_SIZE size)
 /* safe version of system's free() */
 
 Free_t
-Perl_safesysfree(pTHX_ Malloc_t where)
+Perl_safesysfree(Malloc_t where)
 {
 #if !(defined(I286) || defined(atarist))
     DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,PL_an++));
@@ -175,7 +175,7 @@ Perl_safesysfree(pTHX_ Malloc_t where)
 /* safe version of system's calloc() */
 
 Malloc_t
-Perl_safesyscalloc(pTHX_ MEM_SIZE count, MEM_SIZE size)
+Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 {
     Malloc_t ptr;
 
@@ -183,12 +183,12 @@ Perl_safesyscalloc(pTHX_ MEM_SIZE count, MEM_SIZE size)
     if (size * count > 0xffff) {
        PerlIO_printf(PerlIO_stderr(),
                      "Allocation too large: %lx\n", size * count) FLUSH;
-       my_exit(1);
+       WITH_THX(my_exit(1));
     }
 #endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
     if ((long)size < 0 || (long)count < 0)
-       Perl_croak(aTHX_ "panic: calloc");
+       Perl_croak_nocontext("panic: calloc");
 #endif
     size *= count;
     ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
@@ -205,7 +205,7 @@ Perl_safesyscalloc(pTHX_ MEM_SIZE count, MEM_SIZE size)
        return Nullch;
     else {
        PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
-       my_exit(1);
+       WITH_THX(my_exit(1));
        return Nullch;
     }
     /*NOTREACHED*/
@@ -235,7 +235,7 @@ struct mem_test_strut {
                              : ((size) - 1)/4))
 
 Malloc_t
-Perl_safexmalloc(pTHX_ I32 x, MEM_SIZE size)
+Perl_safexmalloc(I32 x, MEM_SIZE size)
 {
     register char* where = (char*)safemalloc(size + ALIGN);
 
@@ -247,7 +247,7 @@ Perl_safexmalloc(pTHX_ I32 x, MEM_SIZE size)
 }
 
 Malloc_t
-Perl_safexrealloc(pTHX_ Malloc_t wh, MEM_SIZE size)
+Perl_safexrealloc(Malloc_t wh, MEM_SIZE size)
 {
     char *where = (char*)wh;
 
@@ -268,7 +268,7 @@ Perl_safexrealloc(pTHX_ Malloc_t wh, MEM_SIZE size)
 }
 
 void
-Perl_safexfree(pTHX_ Malloc_t wh)
+Perl_safexfree(Malloc_t wh)
 {
     I32 x;
     char *where = (char*)wh;
@@ -285,7 +285,7 @@ Perl_safexfree(pTHX_ Malloc_t wh)
 }
 
 Malloc_t
-Perl_safexcalloc(pTHX_ I32 x,MEM_SIZE count, MEM_SIZE size)
+Perl_safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size)
 {
     register char * where = (char*)safexmalloc(x, size * count + ALIGN);
     xcount[x] += size;
@@ -3224,7 +3224,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     MUTEX_UNLOCK(&t->mutex);
 
 #ifdef HAVE_THREAD_INTERN
-    init_thread_intern(thr);
+    Perl_init_thread_intern(thr);
 #endif /* HAVE_THREAD_INTERN */
     return thr;
 }
index e1a864f..42b8a9d 100644 (file)
@@ -379,7 +379,6 @@ XSUBPP              = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \
 
 MICROCORE_SRC  =               \
                ..\av.c         \
-               ..\byterun.c    \
                ..\deb.c        \
                ..\doio.c       \
                ..\doop.c       \
@@ -451,8 +450,6 @@ X2P_SRC             =               \
 
 CORE_NOCFG_H   =               \
                ..\av.h         \
-               ..\byterun.h    \
-               ..\bytecode.h   \
                ..\cop.h        \
                ..\cv.h         \
                ..\dosish.h     \
index 611e031..5b795f5 100644 (file)
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define PRIVLIB "c:\\perl\\5.00557\\lib"               /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00557"))     /**/
+#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557"))       /**/
 
 /* SELECT_MIN_BITS:
  *     This symbol holds the minimum number of bits operated by select.
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define SITELIB "c:\\perl\\site\\5.00557\\lib"         /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00557"))     /**/
+#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557"))       /**/
 
 /* STARTPERL:
  *     This variable contains the string to put in front of a perl
 #define Uid_t uid_t            /* UID type */
 
 #endif
-#include <win32.h>
index efae62f..783f4e2 100644 (file)
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define PRIVLIB "c:\\perl\\5.00557\\lib"               /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00557"))     /**/
+#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557"))       /**/
 
 /* SELECT_MIN_BITS:
  *     This symbol holds the minimum number of bits operated by select.
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define SITELIB "c:\\perl\\site\\5.00557\\lib"         /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00557"))     /**/
+#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557"))       /**/
 
 /* STARTPERL:
  *     This variable contains the string to put in front of a perl
 #define Uid_t uid_t            /* UID type */
 
 #endif
-#include <win32.h>
index 620afde..4f858d7 100644 (file)
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define PRIVLIB "c:\\perl\\5.00557\\lib"               /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00557"))     /**/
+#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557"))       /**/
 
 /* SELECT_MIN_BITS:
  *     This symbol holds the minimum number of bits operated by select.
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
 #define SITELIB "c:\\perl\\site\\5.00557\\lib"         /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00557"))     /**/
+#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557"))       /**/
 
 /* STARTPERL:
  *     This variable contains the string to put in front of a perl
 #define Uid_t uid_t            /* UID type */
 
 #endif
-#include <win32.h>
index 617b996..850b134 100644 (file)
@@ -51,7 +51,7 @@ while (<SH>)
   s#/[ *\*]*\*/#/**/#;
   if (/^\s*#define\s+(PRIVLIB|SITELIB)_EXP/)
    {
-     $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
+     $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(aTHX_ $patchlevel))\t/**/\n";
    }
   # incpush() handles archlibs, so disable them
   elsif (/^\s*#define\s+(ARCHLIB|SITEARCH)_EXP/)
@@ -60,7 +60,6 @@ while (<SH>)
    }
   print H;
  }
-print H "#include <win32.h>\n";
 close(H);
 close(SH);
 
index 6c1b424..5c6f627 100644 (file)
@@ -37,22 +37,22 @@ calls.
 static SV *error_sv;
 
 static char *
-OS_Error_String(CPERLarg)
+OS_Error_String(pTHX)
 {
  DWORD err = GetLastError();
  STRLEN len;
  if (!error_sv)
   error_sv = newSVpvn("",0);
- win32_str_os_error(error_sv,err);
+ win32_str_os_error(aTHX_ error_sv,err);
  return SvPV(error_sv,len);
 }
 
 #include "dlutils.c"   /* SaveError() etc      */
 
 static void
-dl_private_init(CPERLarg)
+dl_private_init(pTHX)
 {
-    (void)dl_generic_private_init(PERL_OBJECT_THIS);
+    (void)dl_generic_private_init(aTHX);
 }
 
 /* 
@@ -94,7 +94,7 @@ dl_static_linked(char *filename)
 MODULE = DynaLoader    PACKAGE = DynaLoader
 
 BOOT:
-    (void)dl_private_init(PERL_OBJECT_THIS);
+    (void)dl_private_init(aTHX);
 
 void *
 dl_load_file(filename,flags=0)
@@ -119,8 +119,8 @@ dl_load_file(filename,flags=0)
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
-       SaveError(PERL_OBJECT_THIS_ "load_file:%s",
-                 OS_Error_String(PERL_OBJECT_THIS)) ;
+       SaveError(aTHX_ "load_file:%s",
+                 OS_Error_String(aTHX)) ;
     else
        sv_setiv( ST(0), (IV)RETVAL);
   }
@@ -136,8 +136,8 @@ dl_find_symbol(libhandle, symbolname)
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref = %x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
-       SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",
-                 OS_Error_String(PERL_OBJECT_THIS)) ;
+       SaveError(aTHX_ "find_symbol:%s",
+                 OS_Error_String(aTHX)) ;
     else
        sv_setiv( ST(0), (IV)RETVAL);
 
@@ -158,7 +158,9 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     CODE:
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
                      perl_name, symref));
-    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename)));
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+                                       (void(*)(pTHX_ CV *))symref,
+                                       filename)));
 
 
 char *
index c47dc65..2071220 100644 (file)
@@ -79,6 +79,9 @@ PL_pending_ident
 PL_sortcxix
 PL_sublex_info
 PL_timesbuf
+main
+Perl_ErrorNo
+Perl_GetVars
 Perl_do_exec3
 Perl_do_ipcctl
 Perl_do_ipcget
@@ -122,6 +125,10 @@ else
  {
   skip_symbols [qw(
     Perl_dump_mstats
+    Perl_malloc
+    Perl_mfree
+    Perl_realloc
+    Perl_calloc
     Perl_malloced_size)];
  }
 
@@ -155,6 +162,20 @@ Perl_unlock_condpair
 Perl_magic_mutexfree
 )];
  }
+unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'})
+ {
+  skip_symbols [qw(
+                  Perl_croak_nocontext
+                  Perl_die_nocontext
+                  Perl_form_nocontext
+                  Perl_warn_nocontext
+                  Perl_newSVpvf_nocontext
+                  Perl_sv_catpvf_nocontext
+                  Perl_sv_setpvf_nocontext
+                  Perl_sv_catpvf_mg_nocontext
+                  Perl_sv_setpvf_mg_nocontext
+                  )];
+ }
 
 unless ($define{'FAKE_THREADS'})
  {
@@ -228,7 +249,7 @@ for my $syms ('../global.sym','../pp.sym', '../globvar.sym')
     # Functions have a Perl_ prefix
     # Variables have a PL_ prefix
     chomp($_);
-    my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "Perl_");
+    my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
     $symbol .= $_;
     emit_symbol($symbol) unless exists $skip{$symbol};
    }
@@ -303,30 +324,12 @@ sub output_symbol {
 1;
 __DATA__
 # extra globals not included above.
-perl_init_i18nl10n
 perl_alloc
-perl_atexit
 perl_construct
 perl_destruct
 perl_free
 perl_parse
 perl_run
-perl_get_sv
-perl_get_av
-perl_get_hv
-perl_get_cv
-perl_call_argv
-perl_call_pv
-perl_call_method
-perl_call_sv
-perl_require_pv
-perl_eval_pv
-perl_eval_sv
-perl_new_ctype
-perl_new_collate
-perl_new_numeric
-perl_set_numeric_standard
-perl_set_numeric_local
 boot_DynaLoader
 Perl_thread_create
 win32_errno
index 1b2fa4e..7a97dab 100644 (file)
@@ -497,7 +497,6 @@ XSUBPP              = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \
 
 MICROCORE_SRC  =               \
                ..\av.c         \
-               ..\byterun.c    \
                ..\deb.c        \
                ..\doio.c       \
                ..\doop.c       \
@@ -569,8 +568,6 @@ X2P_SRC             =               \
 
 CORE_NOCFG_H   =               \
                ..\av.h         \
-               ..\byterun.h    \
-               ..\bytecode.h   \
                ..\cop.h        \
                ..\cv.h         \
                ..\dosish.h     \
index 2494b44..255ad39 100644 (file)
@@ -7,13 +7,14 @@
 #include "perl.h"
 #include "XSUB.h"
 
-static void xs_init (void);
+static void xs_init (pTHX);
 
 DllExport int
 RunPerl(int argc, char **argv, char **env, void *iosubsystem)
 {
     int exitstatus;
     PerlInterpreter *my_perl;
+    struct perl_thread *thr;
 
 #ifdef PERL_GLOBAL_STRUCT
 #define PERLVAR(var,type) /**/
@@ -27,14 +28,14 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
 
     PERL_SYS_INIT(&argc,&argv);
 
-    perl_init_i18nl10n(1);
+    init_i18nl10n(1);
 
     if (!(my_perl = perl_alloc()))
        return (1);
     perl_construct( my_perl );
     PL_perl_destruct_level = 0;
 
-    exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
+    exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
     if (!exitstatus) {
        exitstatus = perl_run( my_perl );
     }
@@ -96,10 +97,10 @@ char *staticlinkmodules[] = {
     NULL,
 };
 
-EXTERN_C void boot_DynaLoader (CV* cv);
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
 
 static void
-xs_init()
+xs_init(pTHX)
 {
     char *file = __FILE__;
     dXSUB_SYS;
index 49a487e..694f48a 100644 (file)
@@ -90,7 +90,7 @@ int _CRT_glob = 0;
 static DWORD           os_id(void);
 static void            get_shell(void);
 static long            tokenize(char *str, char **dest, char ***destv);
-       int             do_spawn2(char *cmd, int exectype);
+       int             do_spawn2(pTHX_ char *cmd, int exectype);
 static BOOL            has_shell_metachars(char *ptr);
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
@@ -254,7 +254,7 @@ get_emd_part(char **prev_path, char *trailing_path, ...)
 }
 
 char *
-win32_get_privlib(char *pl)
+win32_get_privlib(pTHX_ char *pl)
 {
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
@@ -276,7 +276,7 @@ win32_get_privlib(char *pl)
 }
 
 char *
-win32_get_sitelib(char *pl)
+win32_get_sitelib(pTHX_ char *pl)
 {
     char *sitelib = "sitelib";
     char regstr[40];
@@ -375,7 +375,7 @@ has_shell_metachars(char *ptr)
  * the library functions will get the correct environment
  */
 PerlIO *
-my_popen(char *cmd, char *mode)
+Perl_my_popen(pTHX_ char *cmd, char *mode)
 {
 #ifdef FIXCMD
 #define fixcmd(x)      {                                       \
@@ -398,7 +398,7 @@ my_popen(char *cmd, char *mode)
 }
 
 long
-my_pclose(PerlIO *fp)
+Perl_my_pclose(pTHX_ PerlIO *fp)
 {
     return win32_pclose(fp);
 }
@@ -490,7 +490,7 @@ get_shell(void)
 }
 
 int
-do_aspawn(void *vreally, void **vmark, void **vsp)
+do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp)
 {
     SV *really = (SV*)vreally;
     SV **mark = (SV**)vmark;
@@ -541,7 +541,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     if (flag != P_NOWAIT) {
        if (status < 0) {
            if (PL_dowarn)
-               warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
+               Perl_warn(aTHX_ "Can't spawn \"%s\": %s", argv[0], strerror(errno));
            status = 255 * 256;
        }
        else
@@ -553,7 +553,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
 }
 
 int
-do_spawn2(char *cmd, int exectype)
+do_spawn2(pTHX_ char *cmd, int exectype)
 {
     char **a;
     char *s;
@@ -628,7 +628,7 @@ do_spawn2(char *cmd, int exectype)
     if (exectype != EXECF_SPAWN_NOWAIT) {
        if (status < 0) {
            if (PL_dowarn)
-               warn("Can't %s \"%s\": %s",
+               Perl_warn(aTHX_ "Can't %s \"%s\": %s",
                     (exectype == EXECF_EXEC ? "exec" : "spawn"),
                     cmd, strerror(errno));
            status = 255 * 256;
@@ -641,21 +641,21 @@ do_spawn2(char *cmd, int exectype)
 }
 
 int
-do_spawn(char *cmd)
+do_spawn(pTHX_ char *cmd)
 {
-    return do_spawn2(cmd, EXECF_SPAWN);
+    return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
 }
 
 int
-do_spawn_nowait(char *cmd)
+do_spawn_nowait(pTHX_ char *cmd)
 {
-    return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
+    return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
 }
 
 bool
-do_exec(char *cmd)
+Perl_do_exec(pTHX_ char *cmd)
 {
-    do_spawn2(cmd, EXECF_EXEC);
+    do_spawn2(aTHX_ cmd, EXECF_EXEC);
     return FALSE;
 }
 
@@ -734,7 +734,7 @@ win32_opendir(char *filename)
     idx = strlen(ptr)+1;
     New(1304, p->start, idx, char);
     if (p->start == NULL)
-       croak("opendir: malloc failed!\n");
+       Perl_croak_nocontext("opendir: malloc failed!\n");
     strcpy(p->start, ptr);
     p->nfiles++;
 
@@ -756,7 +756,7 @@ win32_opendir(char *filename)
         */
        Renew(p->start, idx+len+1, char);
        if (p->start == NULL)
-           croak("opendir: malloc failed!\n");
+           Perl_croak_nocontext("opendir: malloc failed!\n");
        strcpy(&p->start[idx], ptr);
        p->nfiles++;
        idx += len+1;
@@ -885,7 +885,7 @@ setgid(gid_t agid)
 char *
 getlogin(void)
 {
-    dTHR;
+    dTHX;
     char *buf = getlogin_buffer;
     DWORD size = sizeof(getlogin_buffer);
     if (GetUserName(buf,&size))
@@ -1540,7 +1540,7 @@ win32_alarm(unsigned int sec)
      {
       timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
       if (!timerid)
-       croak("Cannot set timer");
+       Perl_croak_nocontext("Cannot set timer");
      } 
     else
      {
@@ -1685,7 +1685,7 @@ win32_flock(int fd, int oper)
     HANDLE fh;
 
     if (!IsWinNT()) {
-       croak("flock() unimplemented on this platform");
+       Perl_croak_nocontext("flock() unimplemented on this platform");
        return -1;
     }
     fh = (HANDLE)_get_osfhandle(fd);
@@ -1783,7 +1783,7 @@ win32_strerror(int e)
     DWORD source = 0;
 
     if (e < 0 || e > sys_nerr) {
-        dTHR;
+        dTHX;
        if (e < 0)
            e = GetLastError();
 
@@ -1797,7 +1797,7 @@ win32_strerror(int e)
 }
 
 DllExport void
-win32_str_os_error(void *sv, DWORD dwErr)
+win32_str_os_error(pTHX_ void *sv, DWORD dwErr)
 {
     DWORD dwLen;
     char *sMsg;
@@ -2078,17 +2078,20 @@ win32_popen(const char *command, const char *mode)
     win32_close(p[child]);
 
     /* start the child */
-    if ((childpid = do_spawn_nowait((char*)command)) == -1)
-        goto cleanup;
+    {
+       dTHX;
+       if ((childpid = do_spawn_nowait(aTHX_ (char*)command)) == -1)
+           goto cleanup;
 
-    /* revert stdfd to whatever it was before */
-    if (win32_dup2(oldfd, stdfd) == -1)
-        goto cleanup;
+       /* revert stdfd to whatever it was before */
+       if (win32_dup2(oldfd, stdfd) == -1)
+           goto cleanup;
 
-    /* close saved handle */
-    win32_close(oldfd);
+       /* close saved handle */
+       win32_close(oldfd);
 
-    sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+       sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+    }
 
     /* we have an fd, return a file stream */
     return (win32_fdopen(p[parent], (char *)mode));
@@ -2116,7 +2119,7 @@ win32_pclose(FILE *pf)
 #ifdef USE_RTL_POPEN
     return _pclose(pf);
 #else
-
+    dTHX;
     int childpid, status;
     SV *sv;
 
@@ -2802,7 +2805,7 @@ XS(w32_SetCwd)
 {
     dXSARGS;
     if (items != 1)
-       croak("usage: Win32::SetCurrentDirectory($cwd)");
+       Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
     if (SetCurrentDirectory(SvPV_nolen(ST(0))))
        XSRETURN_YES;
 
@@ -2840,7 +2843,7 @@ XS(w32_SetLastError)
 {
     dXSARGS;
     if (items != 1)
-       croak("usage: Win32::SetLastError($error)");
+       Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
     SetLastError(SvIV(ST(0)));
     XSRETURN_EMPTY;
 }
@@ -2984,7 +2987,7 @@ XS(w32_FormatMessage)
     char msgbuf[1024];
 
     if (items != 1)
-       croak("usage: Win32::FormatMessage($errno)");
+       Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
 
     if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
                      &source, SvIV(ST(0)), 0,
@@ -3004,7 +3007,7 @@ XS(w32_Spawn)
     BOOL bSuccess = FALSE;
 
     if (items != 3)
-       croak("usage: Win32::Spawn($cmdName, $args, $PID)");
+       Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
 
     cmd = SvPV_nolen(ST(0));
     args = SvPV_nolen(ST(1));
@@ -3052,7 +3055,7 @@ XS(w32_GetShortPathName)
     DWORD len;
 
     if (items != 1)
-       croak("usage: Win32::GetShortPathName($longPathName)");
+       Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
 
     shortpath = sv_mortalcopy(ST(0));
     SvUPGRADE(shortpath, SVt_PV);
@@ -3080,7 +3083,7 @@ XS(w32_GetFullPathName)
     DWORD len;
 
     if (items != 1)
-       croak("usage: Win32::GetFullPathName($filename)");
+       Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
 
     filename = ST(0);
     fullpath = sv_mortalcopy(filename);
@@ -3115,7 +3118,7 @@ XS(w32_GetLongPathName)
     STRLEN len;
 
     if (items != 1)
-       croak("usage: Win32::GetLongPathName($pathname)");
+       Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
 
     path = ST(0);
     pathstr = SvPV(path,len);
@@ -3133,7 +3136,7 @@ XS(w32_Sleep)
 {
     dXSARGS;
     if (items != 1)
-       croak("usage: Win32::Sleep($milliseconds)");
+       Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
     Sleep(SvIV(ST(0)));
     XSRETURN_YES;
 }
@@ -3143,14 +3146,14 @@ XS(w32_CopyFile)
 {
     dXSARGS;
     if (items != 3)
-       croak("usage: Win32::CopyFile($from, $to, $overwrite)");
+       Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
     if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2))))
        XSRETURN_YES;
     XSRETURN_NO;
 }
 
 void
-Perl_init_os_extras()
+Perl_init_os_extras(pTHX)
 {
     char *file = __FILE__;
     dXSUB_SYS;
index 18f8fab..61aa223 100644 (file)
@@ -194,23 +194,23 @@ typedef unsigned short    mode_t;
 #define STRUCT_MGVTBL_DEFINITION                                       \
 struct mgvtbl {                                                                \
     union {                                                            \
-       int         (CPERLscope(*svt_get))      (SV *sv, MAGIC* mg);    \
+       int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem1[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_set))      (SV *sv, MAGIC* mg);    \
+       int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem2[16];                             \
     };                                                                 \
     union {                                                            \
-       U32         (CPERLscope(*svt_len))      (SV *sv, MAGIC* mg);    \
+       U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem3[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_clear))    (SV *sv, MAGIC* mg);    \
+       int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
        char        handle_VC_problem4[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_free))     (SV *sv, MAGIC* mg);    \
+       int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
        char        handle_VC_problem5[16];                             \
     };                                                                 \
 }
@@ -218,7 +218,7 @@ struct mgvtbl {                                                             \
 #define BASEOP_DEFINITION              \
     OP*                op_next;                \
     OP*                op_sibling;             \
-    OP*                (CPERLscope(*op_ppaddr))(ARGSproto);            \
+    OP*                (CPERLscope(*op_ppaddr))(pTHX);         \
     char       handle_VC_problem[12];  \
     PADOFFSET  op_targ;                \
     OPCODE     op_type;                \
@@ -231,7 +231,7 @@ struct mgvtbl {                                                             \
     I32                any_i32;                                \
     IV         any_iv;                                 \
     long       any_long;                               \
-    void       (CPERLscope(*any_dptr)) (void*);        \
+    void       (CPERLscope(*any_dptr)) (pTHX_ void*);  \
     char       handle_VC_problem[16];                  \
 }
 
@@ -294,19 +294,18 @@ extern    int     chown(const char *p, uid_t o, gid_t g);
 #define  init_os_extras Perl_init_os_extras
 
 DllExport void         Perl_win32_init(int *argcp, char ***argvp);
-DllExport void         Perl_init_os_extras(void);
-DllExport void         win32_str_os_error(void *sv, DWORD err);
+DllExport void         Perl_init_os_extras(pTHX);
+DllExport void         win32_str_os_error(pTHX_ void *sv, DWORD err);
 
 #ifndef USE_SOCKETS_AS_HANDLES
 extern FILE *          my_fdopen(int, char *);
 #endif
 extern int             my_fclose(FILE *);
-extern int             do_aspawn(void *really, void **mark, void **sp);
-extern int             do_spawn(char *cmd);
-extern int             do_spawn_nowait(char *cmd);
-extern char            do_exec(char *cmd);
-extern char *          win32_get_privlib(char *pl);
-extern char *          win32_get_sitelib(char *pl);
+extern int             do_aspawn(pTHX_ void *really, void **mark, void **sp);
+extern int             do_spawn(pTHX_ char *cmd);
+extern int             do_spawn_nowait(pTHX_ char *cmd);
+extern char *          win32_get_privlib(pTHX_ char *pl);
+extern char *          win32_get_sitelib(pTHX_ char *pl);
 extern int             IsWin95(void);
 extern int             IsWinNT(void);
 
@@ -406,5 +405,11 @@ struct thread_intern {
 #define USING_WIDE() 0
 #define GETINTERPMODE() CP_ACP
 
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ */
+#include "win32iop.h"
+
 #endif /* _INC_WIN32_PERL5 */
 
index 2713605..8bd6b6c 100644 (file)
@@ -103,9 +103,9 @@ start_sockets(void)
      */
     version = 0x101;
     if(ret = WSAStartup(version, &retdata))
-       croak("Unable to locate winsock library!\n");
+       Perl_croak_nocontext("Unable to locate winsock library!\n");
     if(retdata.wVersion != version)
-       croak("Could not find version 1.1 of winsock dll\n");
+       Perl_croak_nocontext("Could not find version 1.1 of winsock dll\n");
 
     /* atexit((void (*)(void)) EndSockets); */
     wsock_started = 1;
@@ -116,7 +116,7 @@ set_socktype(void)
 {
 #ifdef USE_SOCKETS_AS_HANDLES
 #ifdef USE_THREADS
-    dTHR;
+    dTHX;
     if(!init_socktype) {
 #endif
     int iSockOpt = SO_SYNCHRONOUS_NONALERT;
@@ -496,7 +496,7 @@ struct servent *
 win32_getservbyname(const char *name, const char *proto)
 {
     struct servent *r;
-    dTHR;    
+    dTHX;    
 
     SOCKET_TEST(r = getservbyname(name, proto), NULL);
     if (r) {
@@ -509,7 +509,7 @@ struct servent *
 win32_getservbyport(int port, const char *proto)
 {
     struct servent *r;
-    dTHR
+    dTHX
 
     SOCKET_TEST(r = getservbyport(port, proto), NULL);
     if (r) {
@@ -525,14 +525,14 @@ win32_ioctl(int i, unsigned int u, char *data)
     int retval;
 
     if (!wsock_started) {
-       croak("ioctl implemented only on sockets");
+       Perl_croak_nocontext("ioctl implemented only on sockets");
        /* NOTREACHED */
     }
 
     retval = ioctlsocket(TO_SOCKET(i), (long)u, &argp);
     if (retval == SOCKET_ERROR) {
        if (WSAGetLastError() == WSAENOTSOCK) {
-           croak("ioctl implemented only on sockets");
+           Perl_croak_nocontext("ioctl implemented only on sockets");
            /* NOTREACHED */
        }
        errno = WSAGetLastError();
@@ -561,88 +561,88 @@ win32_inet_addr(const char FAR *cp)
 void
 win32_endhostent() 
 {
-    croak("endhostent not implemented!\n");
+    Perl_croak_nocontext("endhostent not implemented!\n");
 }
 
 void
 win32_endnetent()
 {
-    croak("endnetent not implemented!\n");
+    Perl_croak_nocontext("endnetent not implemented!\n");
 }
 
 void
 win32_endprotoent()
 {
-    croak("endprotoent not implemented!\n");
+    Perl_croak_nocontext("endprotoent not implemented!\n");
 }
 
 void
 win32_endservent()
 {
-    croak("endservent not implemented!\n");
+    Perl_croak_nocontext("endservent not implemented!\n");
 }
 
 
 struct netent *
 win32_getnetent(void) 
 {
-    croak("getnetent not implemented!\n");
+    Perl_croak_nocontext("getnetent not implemented!\n");
     return (struct netent *) NULL;
 }
 
 struct netent *
 win32_getnetbyname(char *name) 
 {
-    croak("getnetbyname not implemented!\n");
+    Perl_croak_nocontext("getnetbyname not implemented!\n");
     return (struct netent *)NULL;
 }
 
 struct netent *
 win32_getnetbyaddr(long net, int type) 
 {
-    croak("getnetbyaddr not implemented!\n");
+    Perl_croak_nocontext("getnetbyaddr not implemented!\n");
     return (struct netent *)NULL;
 }
 
 struct protoent *
 win32_getprotoent(void) 
 {
-    croak("getprotoent not implemented!\n");
+    Perl_croak_nocontext("getprotoent not implemented!\n");
     return (struct protoent *) NULL;
 }
 
 struct servent *
 win32_getservent(void) 
 {
-    croak("getservent not implemented!\n");
+    Perl_croak_nocontext("getservent not implemented!\n");
     return (struct servent *) NULL;
 }
 
 void
 win32_sethostent(int stayopen)
 {
-    croak("sethostent not implemented!\n");
+    Perl_croak_nocontext("sethostent not implemented!\n");
 }
 
 
 void
 win32_setnetent(int stayopen)
 {
-    croak("setnetent not implemented!\n");
+    Perl_croak_nocontext("setnetent not implemented!\n");
 }
 
 
 void
 win32_setprotoent(int stayopen)
 {
-    croak("setprotoent not implemented!\n");
+    Perl_croak_nocontext("setprotoent not implemented!\n");
 }
 
 
 void
 win32_setservent(int stayopen)
 {
-    croak("setservent not implemented!\n");
+    Perl_croak_nocontext("setservent not implemented!\n");
 }
 
 static struct servent*
index b40c5aa..543fc13 100644 (file)
@@ -44,7 +44,7 @@ Perl_alloc_thread_key(void)
     static int key_allocated = 0;
     if (!key_allocated) {
        if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
-           croak("panic: TlsAlloc");
+           Perl_croak_nocontext("panic: TlsAlloc");
        key_allocated = 1;
     }
 #endif
index 1fddc9e..4fa3e2f 100644 (file)
@@ -1,5 +1,9 @@
 #ifndef _WIN32THREAD_H
 #define _WIN32THREAD_H
+
+#define  WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
 typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
 typedef DWORD perl_key;
 typedef HANDLE perl_os_thread;
@@ -14,6 +18,8 @@ typedef CRITICAL_SECTION perl_mutex;
 #define MUTEX_INIT(m) InitializeCriticalSection(m)
 #define MUTEX_LOCK(m) EnterCriticalSection(m)
 #define MUTEX_UNLOCK(m) LeaveCriticalSection(m)
+#define MUTEX_LOCK_NOCONTEXT(m) EnterCriticalSection(m)
+#define MUTEX_UNLOCK_NOCONTEXT(m) LeaveCriticalSection(m)
 #define MUTEX_DESTROY(m) DeleteCriticalSection(m)
 
 #else
@@ -22,22 +28,32 @@ typedef HANDLE perl_mutex;
 #define MUTEX_INIT(m) \
     STMT_START {                                               \
        if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL)      \
-           croak("panic: MUTEX_INIT");                         \
+           Perl_croak(aTHX_ "panic: MUTEX_INIT");                              \
     } STMT_END
 #define MUTEX_LOCK(m) \
     STMT_START {                                               \
        if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED)  \
-           croak("panic: MUTEX_LOCK");                         \
+           Perl_croak(aTHX_ "panic: MUTEX_LOCK");              \
     } STMT_END
 #define MUTEX_UNLOCK(m) \
     STMT_START {                                               \
        if (ReleaseMutex(*(m)) == 0)                            \
-           croak("panic: MUTEX_UNLOCK");                       \
+           Perl_croak(aTHX_ "panic: MUTEX_UNLOCK");            \
+    } STMT_END
+#define MUTEX_LOCK_NOCONTEXT(m) \
+    STMT_START {                                               \
+       if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED)  \
+           Perl_croak_nocontext("panic: MUTEX_LOCK");          \
+    } STMT_END
+#define MUTEX_UNLOCK_NOCONTEXT(m) \
+    STMT_START {                                               \
+       if (ReleaseMutex(*(m)) == 0)                            \
+           Perl_croak_nocontext("panic: MUTEX_UNLOCK");        \
     } STMT_END
 #define MUTEX_DESTROY(m) \
     STMT_START {                                               \
        if (CloseHandle(*(m)) == 0)                             \
-           croak("panic: MUTEX_DESTROY");                      \
+           Perl_croak(aTHX_ "panic: MUTEX_DESTROY");           \
     } STMT_END
 
 #endif
@@ -51,21 +67,21 @@ typedef HANDLE perl_mutex;
        (c)->waiters = 0;                                       \
        (c)->sem = CreateSemaphore(NULL,0,LONG_MAX,NULL);       \
        if ((c)->sem == NULL)                                   \
-           croak("panic: COND_INIT (%ld)",GetLastError());     \
+           Perl_croak(aTHX_ "panic: COND_INIT (%ld)",GetLastError());  \
     } STMT_END
 
 #define COND_SIGNAL(c) \
     STMT_START {                                               \
        if ((c)->waiters > 0 &&                                 \
            ReleaseSemaphore((c)->sem,1,NULL) == 0)             \
-           croak("panic: COND_SIGNAL (%ld)",GetLastError());   \
+           Perl_croak(aTHX_ "panic: COND_SIGNAL (%ld)",GetLastError());        \
     } STMT_END
 
 #define COND_BROADCAST(c) \
     STMT_START {                                               \
        if ((c)->waiters > 0 &&                                 \
            ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0)  \
-           croak("panic: COND_BROADCAST (%ld)",GetLastError());\
+           Perl_croak(aTHX_ "panic: COND_BROADCAST (%ld)",GetLastError());\
     } STMT_END
 
 #define COND_WAIT(c, m) \
@@ -76,7 +92,7 @@ typedef HANDLE perl_mutex;
         * COND_BROADCAST() on another thread will have seen the\
         * right number of waiters (i.e. including this one) */ \
        if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
-           croak("panic: COND_WAIT (%ld)",GetLastError());     \
+           Perl_croak(aTHX_ "panic: COND_WAIT (%ld)",GetLastError());  \
        /* XXX there may be an inconsequential race here */     \
        MUTEX_LOCK(m);                                          \
        (c)->waiters--;                                         \
@@ -86,14 +102,14 @@ typedef HANDLE perl_mutex;
     STMT_START {                                               \
        (c)->waiters = 0;                                       \
        if (CloseHandle((c)->sem) == 0)                         \
-           croak("panic: COND_DESTROY (%ld)",GetLastError());  \
+           Perl_croak(aTHX_ "panic: COND_DESTROY (%ld)",GetLastError());       \
     } STMT_END
 
 #define DETACH(t) \
     STMT_START {                                               \
        if (CloseHandle((t)->self) == 0) {                      \
            MUTEX_UNLOCK(&(t)->mutex);                          \
-           croak("panic: DETACH");                             \
+           Perl_croak(aTHX_ "panic: DETACH");                          \
        }                                                       \
     } STMT_END
 
@@ -168,7 +184,7 @@ END_EXTERN_C
        if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED)    \
             || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0)      \
             || (CloseHandle((t)->self) == 0))                          \
-           croak("panic: JOIN");                                       \
+           Perl_croak(aTHX_ "panic: JOIN");                                    \
        *avp = (AV *)((t)->i.retv);                                     \
     } STMT_END
 #else  /* !USE_RTL_THREAD_API || _MSC_VER */
@@ -177,7 +193,7 @@ END_EXTERN_C
        if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED)    \
             || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0)      \
             || (CloseHandle((t)->self) == 0))                          \
-           croak("panic: JOIN");                                       \
+           Perl_croak(aTHX_ "panic: JOIN");                                    \
     } STMT_END
 #endif /* !USE_RTL_THREAD_API || _MSC_VER */