summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1999-05-11 09:34:13 +0000
committerGurusamy Sarathy <gsar@cpan.org>1999-05-11 09:34:13 +0000
commita6c403648ecd5cc72235fdb1e7535523a8ff2ac9 (patch)
treeae379cb0349ea1800627a86bc0ddf04fea4403ec
parent312caa8e97f1c7ee342a9895c2f0e749625b4929 (diff)
downloadperl-a6c403648ecd5cc72235fdb1e7535523a8ff2ac9.tar.gz
various fixes for clean build and test on win32; configpm broken,
needed to open myconfig.SH rather than myconfig; sundry adjustments to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it work under win32; getenv_sv() changed to getenv_len() since SVs aren't visible in the lower echelons; remove bogus exports from config.sym; PERL_OBJECT-ness for C++ exception support; null out IoDIRP in filter_del() or sv_free() will attempt to close it p4raw-id: //depot/perl@3387
-rw-r--r--Changes35
-rw-r--r--bytecode.pl2
-rw-r--r--byterun.c2
-rw-r--r--byterun.h4
-rwxr-xr-xconfigpm4
-rw-r--r--embed.h15
-rwxr-xr-xembed.pl9
-rw-r--r--ext/B/B/Asmdata.pm2
-rw-r--r--ext/ByteLoader/ByteLoader.xs6
-rw-r--r--ext/DynaLoader/dlutils.c8
-rw-r--r--global.sym3
-rw-r--r--hv.c50
-rw-r--r--iperlsys.h20
-rw-r--r--objXSUB.h24
-rw-r--r--op.c8
-rw-r--r--perl.c28
-rw-r--r--perl.h11
-rw-r--r--pp.c2
-rw-r--r--pp_ctl.c41
-rw-r--r--proto.h14
-rw-r--r--scope.c6
-rw-r--r--scope.h5
-rwxr-xr-xt/io/open.t3
-rwxr-xr-xt/op/magic.t2
-rw-r--r--toke.c1
-rw-r--r--util.c20
-rw-r--r--vms/vms.c22
-rw-r--r--vms/vmsish.h8
-rw-r--r--win32/GenCAPI.pl11
-rw-r--r--win32/Makefile2
-rw-r--r--win32/config.bc2
-rw-r--r--win32/config.gc2
-rw-r--r--win32/config.vc2
-rw-r--r--win32/makedef.pl2
-rw-r--r--win32/makefile.mk2
-rw-r--r--win32/perlhost.h7
-rw-r--r--win32/runperl.c5
-rw-r--r--win32/win32.c7
-rw-r--r--win32/win32.h2
39 files changed, 238 insertions, 161 deletions
diff --git a/Changes b/Changes
index dd39e11e6c..a19392fb2a 100644
--- a/Changes
+++ b/Changes
@@ -79,6 +79,41 @@ Version 5.005_57 Development release working toward 5.006
----------------
____________________________________________________________________________
+[ 3385] By: gsar on 1999/05/10 19:33:36
+ Log: "weak" references internals, still needs perlguts documentation
+ (somewhat modified version of patch suggested by Tuomas J. Lukka
+ <lukka@fas.harvard.edu>)
+ Branch: perl
+ ! dump.c embed.h embed.pl global.sym mg.c objXSUB.h perl.h
+ ! pod/perldiag.pod proto.h sv.c sv.h util.c
+____________________________________________________________________________
+[ 3384] By: jhi on 1999/05/10 18:21:43
+ Log: Circumnavigate Digital UNIX 4.0D miniperl core dump
+ (due to QAR 56761) (the bug has been fixed in 4.0E or better)
+ Branch: cfgperl
+ ! INSTALL hints/dec_osf.sh
+____________________________________________________________________________
+[ 3381] By: jhi on 1999/05/10 14:39:28
+ Log: Integrate from mainperl.
+ Branch: cfgperl
+ +> cygwin32/Makefile.SHs cygwin32/build-instructions.READFIRST
+ +> cygwin32/build-instructions.charles-wilson
+ +> cygwin32/build-instructions.sebastien-barre
+ +> cygwin32/build-instructions.steven-morlock
+ +> cygwin32/build-instructions.steven-morlock2
+ +> cygwin32/impure_ptr.c cygwin32/ld2.in cygwin32/perlld.in
+ +> ext/ByteLoader/ByteLoader.pm ext/ByteLoader/ByteLoader.xs
+ +> ext/ByteLoader/Makefile.PL pod/Win32.pod t/lib/io_linenum.t
+ +> t/op/numconvert.t utils/perlbc.PL
+ - cygwin32/cw32imp.h cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc
+ - cygwin32/perlld
+ !> (integrate 105 files)
+____________________________________________________________________________
+[ 3380] By: gsar on 1999/05/10 12:27:14
+ Log: regen regnodes.h
+ Branch: perl
+ ! Changes regnodes.h
+____________________________________________________________________________
[ 3379] By: gsar on 1999/05/10 12:17:26
Log: From: jan.dubois@ibm.net (Jan Dubois)
Date: Sat, 01 May 1999 22:55:36 +0200
diff --git a/bytecode.pl b/bytecode.pl
index c61b7aa04e..f53b0cef4b 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -169,8 +169,6 @@ struct bytestream {
};
#endif /* INDIRECT_BGET_MACROS */
-void *bset_obj_store _((void *, I32));
-
enum {
EOT
diff --git a/byterun.c b/byterun.c
index f6c523220c..f8c07f9725 100644
--- a/byterun.c
+++ b/byterun.c
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 1996-1998 Malcolm Beattie
+ * Copyright (c) 1996-1999 Malcolm Beattie
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff --git a/byterun.h b/byterun.h
index 430de55e43..3aac6fa9b9 100644
--- a/byterun.h
+++ b/byterun.h
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 1996-1998 Malcolm Beattie
+ * Copyright (c) 1996-1999 Malcolm Beattie
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -17,8 +17,6 @@ struct bytestream {
};
#endif /* INDIRECT_BGET_MACROS */
-void *bset_obj_store _((void *, I32));
-
enum {
INSN_RET, /* 0 */
INSN_LDSV, /* 1 */
diff --git a/configpm b/configpm
index 4c9eb121aa..dd9e85803d 100755
--- a/configpm
+++ b/configpm
@@ -81,11 +81,11 @@ print CONFIG "\n",
join("", @v_fast, sort @v_others),
"!END!\n\n";
-# copy config summary format from the myconfig script
+# copy config summary format from the myconfig.SH script
print CONFIG "my \$summary = <<'!END!';\n";
-open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
+open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
close(MYCONFIG);
diff --git a/embed.h b/embed.h
index cabef9529b..aba2f59129 100644
--- a/embed.h
+++ b/embed.h
@@ -137,8 +137,6 @@
#define do_vecset Perl_do_vecset
#define do_vop Perl_do_vop
#define dofile Perl_dofile
-#define dofindlabel Perl_dofindlabel
-#define dopoptoeval Perl_dopoptoeval
#define dounwind Perl_dounwind
#define dowantarray Perl_dowantarray
#define dump_all Perl_dump_all
@@ -205,7 +203,6 @@
#define hv_iterval Perl_hv_iterval
#define hv_ksplit Perl_hv_ksplit
#define hv_magic Perl_hv_magic
-#define hv_stashpv Perl_hv_stashpv
#define hv_store Perl_hv_store
#define hv_store_ent Perl_hv_store_ent
#define hv_undef Perl_hv_undef
@@ -1012,10 +1009,10 @@
#define block_start CPerlObj::Perl_block_start
#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL
#define bset_obj_store CPerlObj::Perl_bset_obj_store
-#define bset_obj_store CPerlObj::Perl_bset_obj_store
#define byterun CPerlObj::Perl_byterun
#define cache_re CPerlObj::Perl_cache_re
#define call_list CPerlObj::Perl_call_list
+#define call_list_body CPerlObj::Perl_call_list_body
#define cando CPerlObj::Perl_cando
#define cast_i32 CPerlObj::Perl_cast_i32
#define cast_iv CPerlObj::Perl_cast_iv
@@ -1137,16 +1134,15 @@
#define do_vecset CPerlObj::Perl_do_vecset
#define do_vop CPerlObj::Perl_do_vop
#define docatch CPerlObj::Perl_docatch
+#define docatch_body CPerlObj::Perl_docatch_body
#define doencodes CPerlObj::Perl_doencodes
#define doeval CPerlObj::Perl_doeval
#define dofile CPerlObj::Perl_dofile
#define dofindlabel CPerlObj::Perl_dofindlabel
-#define dofindlabel CPerlObj::Perl_dofindlabel
#define doform CPerlObj::Perl_doform
-#define doopen CPerlObj::Perl_doopen
+#define doopen_pmc CPerlObj::Perl_doopen_pmc
#define doparseform CPerlObj::Perl_doparseform
#define dopoptoeval CPerlObj::Perl_dopoptoeval
-#define dopoptoeval CPerlObj::Perl_dopoptoeval
#define dopoptolabel CPerlObj::Perl_dopoptolabel
#define dopoptoloop CPerlObj::Perl_dopoptoloop
#define dopoptosub CPerlObj::Perl_dopoptosub
@@ -1233,7 +1229,6 @@
#define hv_iterval CPerlObj::Perl_hv_iterval
#define hv_ksplit CPerlObj::Perl_hv_ksplit
#define hv_magic CPerlObj::Perl_hv_magic
-#define hv_stashpv CPerlObj::Perl_hv_stashpv
#define hv_store CPerlObj::Perl_hv_store
#define hv_store_ent CPerlObj::Perl_hv_store_ent
#define hv_undef CPerlObj::Perl_hv_undef
@@ -1480,9 +1475,11 @@
#define peep CPerlObj::Perl_peep
#define perl_atexit CPerlObj::perl_atexit
#define perl_call_argv CPerlObj::perl_call_argv
+#define perl_call_body CPerlObj::perl_call_body
#define perl_call_method CPerlObj::perl_call_method
#define perl_call_pv CPerlObj::perl_call_pv
#define perl_call_sv CPerlObj::perl_call_sv
+#define perl_call_xbody CPerlObj::perl_call_xbody
#define perl_construct CPerlObj::perl_construct
#define perl_destruct CPerlObj::perl_destruct
#define perl_eval_pv CPerlObj::perl_eval_pv
@@ -1498,8 +1495,10 @@
#define perl_new_ctype CPerlObj::perl_new_ctype
#define perl_new_numeric CPerlObj::perl_new_numeric
#define perl_parse CPerlObj::perl_parse
+#define perl_parse_body CPerlObj::perl_parse_body
#define perl_require_pv CPerlObj::perl_require_pv
#define perl_run CPerlObj::perl_run
+#define perl_run_body CPerlObj::perl_run_body
#define perl_set_numeric_local CPerlObj::perl_set_numeric_local
#define perl_set_numeric_standard CPerlObj::perl_set_numeric_standard
#define pidgone CPerlObj::Perl_pidgone
diff --git a/embed.pl b/embed.pl
index 19f68a9521..2fde0dddfb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -245,6 +245,12 @@ my @staticfuncs = qw(
refto
seed
docatch
+ docatch_body
+ perl_parse_body
+ perl_run_body
+ perl_call_body
+ perl_call_xbody
+ call_list_body
dofindlabel
doparseform
dopoptoeval
@@ -254,7 +260,7 @@ my @staticfuncs = qw(
dopoptosub_at
save_lines
doeval
- doopen
+ doopen_pmc
sv_ncmp
sv_i_ncmp
amagic_ncmp
@@ -372,7 +378,6 @@ my @staticfuncs = qw(
dump
do_aspawn
debprof
- bset_obj_store
new_logop
simplify_sort
is_handle_constructor
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index ddc391b388..d4128b67ea 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -1,5 +1,5 @@
#
-# Copyright (c) 1996-1998 Malcolm Beattie
+# Copyright (c) 1996-1999 Malcolm Beattie
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 98053c7918..24c3ae8492 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -2,7 +2,10 @@
#include "perl.h"
#include "XSUB.h"
-#include "byterun.c"
+#ifndef WIN32
+/* this is probably not needed manywhere */
+# include "byterun.c"
+#endif
/* defgv must be accessed differently under threaded perl */
/* DEFSV et al are in 5.004_56 */
@@ -17,6 +20,7 @@ byteloader_filter(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
byteloader_filter(int idx, SV *buf_sv, int maxlen)
#endif
{
+ dTHR;
OP *saveroot = PL_main_root;
OP *savestart = PL_main_start;
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index bfa1f78ac0..3bd58ed9b3 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -48,16 +48,18 @@ static void
SaveError(CPERLarg_ char* pat, ...)
{
va_list args;
+ SV *msv;
char *message;
- int len;
+ STRLEN len;
/* This code is based on croak/warn, see mess() in util.c */
va_start(args, pat);
- message = mess(pat, &args);
+ msv = mess(pat, &args);
va_end(args);
- len = strlen(message) + 1 ; /* include terminating null char */
+ message = SvPV(msv,len);
+ len++; /* include terminating null char */
/* Allocate some memory for the error message */
if (LastError)
diff --git a/global.sym b/global.sym
index b46c106b3d..1e739bc773 100644
--- a/global.sym
+++ b/global.sym
@@ -128,8 +128,6 @@ do_trans
do_vecset
do_vop
dofile
-dofindlabel
-dopoptoeval
dounwind
dowantarray
dump_all
@@ -196,7 +194,6 @@ hv_iternextsv
hv_iterval
hv_ksplit
hv_magic
-hv_stashpv
hv_store
hv_store_ent
hv_undef
diff --git a/hv.c b/hv.c
index e7a73ce852..d21af5c4c7 100644
--- a/hv.c
+++ b/hv.c
@@ -150,10 +150,13 @@ hv_fetch(HV *hv, const char *key, U32 klen, I32 lval)
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
- if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
- SvTAINTED_on(sv);
- return hv_store(hv,key,klen,sv,hash);
- }
+ unsigned long len;
+ char *env = PerlEnv_ENVgetenv_len(key,&len);
+ if (env) {
+ sv = newSVpvn(env,len);
+ SvTAINTED_on(sv);
+ return hv_store(hv,key,klen,sv,hash);
+ }
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
@@ -238,10 +241,13 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
- if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
- SvTAINTED_on(sv);
- return hv_store_ent(hv,keysv,sv,hash);
- }
+ unsigned long len;
+ char *env = PerlEnv_ENVgetenv_len(key,&len);
+ if (env) {
+ sv = newSVpvn(env,len);
+ SvTAINTED_on(sv);
+ return hv_store_ent(hv,keysv,sv,hash);
+ }
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
@@ -613,11 +619,15 @@ hv_exists(HV *hv, const char *key, U32 klen)
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
- if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
- (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
- SvTAINTED_on(sv);
- hv_store(hv,key,klen,sv,hash);
- return TRUE;
+ if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+ unsigned long len;
+ char *env = PerlEnv_ENVgetenv_len(key,&len);
+ if (env) {
+ sv = newSVpvn(env,len);
+ SvTAINTED_on(sv);
+ (void)hv_store(hv,key,klen,sv,hash);
+ return TRUE;
+ }
}
#endif
return FALSE;
@@ -680,11 +690,15 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
- if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
- (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
- SvTAINTED_on(sv);
- hv_store_ent(hv,keysv,sv,hash);
- return TRUE;
+ if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+ unsigned long len;
+ char *env = PerlEnv_ENVgetenv_len(key,&len);
+ if (env) {
+ sv = newSVpvn(env,len);
+ SvTAINTED_on(sv);
+ (void)hv_store_ent(hv,keysv,sv,hash);
+ return TRUE;
+ }
}
#endif
return FALSE;
diff --git a/iperlsys.h b/iperlsys.h
index 7251e8f945..5f0ed0c92a 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -447,24 +447,26 @@ class IPerlEnv
{
public:
virtual char * Getenv(const char *varname, int &err) = 0;
-#ifdef HAS_ENVGETENV
- virtual char * ENVGetenv(const char *varname, int &err) = 0;
-#endif
virtual int Putenv(const char *envstring, int &err) = 0;
virtual char * LibPath(char *patchlevel) =0;
virtual char * SiteLibPath(char *patchlevel) =0;
virtual int Uname(struct utsname *name, int &err) =0;
+ virtual char * Getenv_len(const char *varname, unsigned long *len, int &err) = 0;
+#ifdef HAS_ENVGETENV
+ virtual char * ENVGetenv(const char *varname, int &err) = 0;
+ virtual char * ENVGetenv_len(const char *varname, unsigned long *len, int &err) = 0;
+#endif
};
#define PerlEnv_putenv(str) PL_piENV->Putenv((str), ErrorNo())
#define PerlEnv_getenv(str) PL_piENV->Getenv((str), ErrorNo())
-#define PerlEnv_getenv_sv(str) PL_piENV->getenv_sv((str))
+#define PerlEnv_getenv_len(str,l) PL_piENV->Getenv_len((str), (l), ErrorNo())
#ifdef HAS_ENVGETENV
# define PerlEnv_ENVgetenv(str) PL_piENV->ENVGetenv((str), ErrorNo())
-# define PerlEnv_ENVgetenv_sv(str) PL_piENV->ENVgetenv_sv((str))
+# define PerlEnv_ENVgetenv_len(str,l) PL_piENV->ENVGetenv_len((str), (l), ErrorNo())
#else
# define PerlEnv_ENVgetenv(str) PerlEnv_getenv((str))
-# define PerlEnv_ENVgetenv_sv(str) PerlEnv_getenv_sv((str))
+# define PerlEnv_ENVgetenv_len(str,l) PerlEnv_getenv_len((str),(l))
#endif
#define PerlEnv_uname(name) PL_piENV->Uname((name), ErrorNo())
#ifdef WIN32
@@ -476,13 +478,13 @@ public:
#define PerlEnv_putenv(str) putenv((str))
#define PerlEnv_getenv(str) getenv((str))
-#define PerlEnv_getenv_sv(str) getenv_sv((str))
+#define PerlEnv_getenv_len(str,l) getenv_len((str), (l))
#ifdef HAS_ENVGETENV
# define PerlEnv_ENVgetenv(str) ENVgetenv((str))
-# define PerlEnv_ENVgetenv_sv(str) ENVgetenv_sv((str))
+# define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l))
#else
# define PerlEnv_ENVgetenv(str) PerlEnv_getenv((str))
-# define PerlEnv_ENVgetenv_sv(str) PerlEnv_getenv_sv((str))
+# define PerlEnv_ENVgetenv_len(str,l) PerlEnv_getenv_len((str), (l))
#endif
#define PerlEnv_uname(name) uname((name))
diff --git a/objXSUB.h b/objXSUB.h
index 53ad4e2b30..0305bf00cf 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -881,14 +881,14 @@
#define boot_core_UNIVERSAL pPerl->Perl_boot_core_UNIVERSAL
#undef bset_obj_store
#define bset_obj_store pPerl->Perl_bset_obj_store
-#undef bset_obj_store
-#define bset_obj_store pPerl->Perl_bset_obj_store
#undef byterun
#define byterun pPerl->Perl_byterun
#undef cache_re
#define cache_re pPerl->Perl_cache_re
#undef call_list
#define call_list pPerl->Perl_call_list
+#undef call_list_body
+#define call_list_body pPerl->Perl_call_list_body
#undef cando
#define cando pPerl->Perl_cando
#undef cast_i32
@@ -1131,6 +1131,8 @@
#define do_vop pPerl->Perl_do_vop
#undef docatch
#define docatch pPerl->Perl_docatch
+#undef docatch_body
+#define docatch_body pPerl->Perl_docatch_body
#undef doencodes
#define doencodes pPerl->Perl_doencodes
#undef doeval
@@ -1139,18 +1141,14 @@
#define dofile pPerl->Perl_dofile
#undef dofindlabel
#define dofindlabel pPerl->Perl_dofindlabel
-#undef dofindlabel
-#define dofindlabel pPerl->Perl_dofindlabel
#undef doform
#define doform pPerl->Perl_doform
-#undef doopen
-#define doopen pPerl->Perl_doopen
+#undef doopen_pmc
+#define doopen_pmc pPerl->Perl_doopen_pmc
#undef doparseform
#define doparseform pPerl->Perl_doparseform
#undef dopoptoeval
#define dopoptoeval pPerl->Perl_dopoptoeval
-#undef dopoptoeval
-#define dopoptoeval pPerl->Perl_dopoptoeval
#undef dopoptolabel
#define dopoptolabel pPerl->Perl_dopoptolabel
#undef dopoptoloop
@@ -1323,8 +1321,6 @@
#define hv_ksplit pPerl->Perl_hv_ksplit
#undef hv_magic
#define hv_magic pPerl->Perl_hv_magic
-#undef hv_stashpv
-#define hv_stashpv pPerl->Perl_hv_stashpv
#undef hv_store
#define hv_store pPerl->Perl_hv_store
#undef hv_store_ent
@@ -1817,12 +1813,16 @@
#define perl_atexit pPerl->perl_atexit
#undef perl_call_argv
#define perl_call_argv pPerl->perl_call_argv
+#undef perl_call_body
+#define perl_call_body pPerl->perl_call_body
#undef perl_call_method
#define perl_call_method pPerl->perl_call_method
#undef perl_call_pv
#define perl_call_pv pPerl->perl_call_pv
#undef perl_call_sv
#define perl_call_sv pPerl->perl_call_sv
+#undef perl_call_xbody
+#define perl_call_xbody pPerl->perl_call_xbody
#undef perl_construct
#define perl_construct pPerl->perl_construct
#undef perl_destruct
@@ -1853,10 +1853,14 @@
#define perl_new_numeric pPerl->perl_new_numeric
#undef perl_parse
#define perl_parse pPerl->perl_parse
+#undef perl_parse_body
+#define perl_parse_body pPerl->perl_parse_body
#undef perl_require_pv
#define perl_require_pv pPerl->perl_require_pv
#undef perl_run
#define perl_run pPerl->perl_run
+#undef perl_run_body
+#define perl_run_body pPerl->perl_run_body
#undef perl_set_numeric_local
#define perl_set_numeric_local pPerl->perl_set_numeric_local
#undef perl_set_numeric_standard
diff --git a/op.c b/op.c
index 13f2a1595c..919d9d8170 100644
--- a/op.c
+++ b/op.c
@@ -4782,7 +4782,7 @@ ck_fun(OP *o)
}
else {
I32 flags = OPf_SPECIAL;
- I32 private = 0;
+ I32 priv = 0;
/* is this op a FH constructor? */
if (is_handle_constructor(o,numargs)) {
flags = 0;
@@ -4790,7 +4790,7 @@ ck_fun(OP *o)
* need to "prove" flag does not mean something
* else already - NI-S 1999/05/07
*/
- private = OPpDEREF;
+ priv = OPpDEREF;
#if 0
/* Helps with open($array[$n],...)
but is too simplistic - need to do selectively
@@ -4800,8 +4800,8 @@ ck_fun(OP *o)
}
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, flags, scalar(kid));
- if (private) {
- kid->op_private |= private;
+ if (priv) {
+ kid->op_private |= priv;
}
}
kid->op_sibling = sibl;
diff --git a/perl.c b/perl.c
index daa15cc567..a08b95e7ab 100644
--- a/perl.c
+++ b/perl.c
@@ -630,11 +630,17 @@ perl_atexit(void (*fn) (void *), void *ptr)
++PL_exitlistlen;
}
+#ifdef PERL_OBJECT
+ typedef void (*xs_init_t)(CPerlObj*);
+#else
+ typedef void (*xs_init_t)(void);
+#endif
+
int
#ifdef PERL_OBJECT
-perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
+perl_parse(xs_init_t xsinit, int argc, char **argv, char **env)
#else
-perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
+perl_parse(PerlInterpreter *sv_interp, xs_init_t xsinit, int argc, char **argv, char **env)
#endif
{
dTHR;
@@ -690,11 +696,7 @@ setuid perl scripts securely.\n");
oldscope = PL_scopestack_ix;
PL_dowarn = G_WARN_OFF;
- CALLPROTECT(&ret, perl_parse_body, env
-#ifndef PERL_OBJECT
- , xsinit
-#endif
- );
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_parse_body), env, xsinit);
switch (ret) {
case 0:
return 0;
@@ -714,6 +716,7 @@ setuid perl scripts securely.\n");
PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");
return 1;
}
+ return 0;
}
STATIC void *
@@ -731,10 +734,7 @@ perl_parse_body(va_list args)
register SV *sv;
register char *s;
-#ifndef PERL_OBJECT
- typedef void (*xs_init_t)(void);
xs_init_t xsinit = va_arg(args, xs_init_t);
-#endif
sv_setpvn(PL_linestr,"",0);
sv = newSVpvn("",0); /* first used for -I flags */
@@ -1071,7 +1071,7 @@ perl_run(PerlInterpreter *sv_interp)
oldscope = PL_scopestack_ix;
redo_body:
- CALLPROTECT(&ret, perl_run_body, oldscope);
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_run_body), oldscope);
switch (ret) {
case 1:
cxstack_ix = -1; /* start context stack again */
@@ -1321,7 +1321,7 @@ perl_call_sv(SV *sv, I32 flags)
PL_markstack_ptr++;
redo_body:
- CALLPROTECT(&ret, perl_call_body, (OP*)&myop, FALSE);
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_call_body), (OP*)&myop, FALSE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -1443,7 +1443,7 @@ perl_eval_sv(SV *sv, I32 flags)
myop.op_flags |= OPf_SPECIAL;
redo_body:
- CALLPROTECT(&ret, perl_call_body, (OP*)&myop, TRUE);
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_call_body), (OP*)&myop, TRUE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -3005,7 +3005,7 @@ call_list(I32 oldscope, AV *paramList)
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
SAVEFREESV(cv);
- CALLPROTECT(&ret, call_list_body, cv);
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(call_list_body), cv);
switch (ret) {
case 0:
(void)SvPV(atsv, len);
diff --git a/perl.h b/perl.h
index 14e891cfe6..5cbecd2380 100644
--- a/perl.h
+++ b/perl.h
@@ -1903,12 +1903,13 @@ EXT char *** environ_pointer;
# endif
#else
/* VMS and some other platforms don't use the environ array */
-# if !defined(VMS) || \
- !defined(DONT_DECLARE_STD) || \
- (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
- defined(__sgi) || \
- defined(__DGUX)
+# if !defined(VMS)
+# if !defined(DONT_DECLARE_STD) || \
+ (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+ defined(__sgi) || \
+ defined(__DGUX)
extern char ** environ; /* environment variables supplied via exec */
+# endif
# endif
#endif
diff --git a/pp.c b/pp.c
index 34fffefc67..431dc9ac7b 100644
--- a/pp.c
+++ b/pp.c
@@ -531,7 +531,7 @@ refto(SV *sv)
if (!(sv = LvTARG(sv)))
sv = &PL_sv_undef;
else
- SvREFCNT_inc(sv);
+ (void)SvREFCNT_inc(sv);
}
else if (SvPADTMP(sv))
sv = newSVsv(sv);
diff --git a/pp_ctl.c b/pp_ctl.c
index 9d6d063bd0..621024a97d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -42,7 +42,7 @@ static void save_lines _((AV *array, SV *sv));
static I32 sortcv _((SV *a, SV *b));
static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
static OP *doeval _((int gimme, OP** startop));
-static PerlIO *doopen _((const char *name, const char *mode));
+static PerlIO *doopen_pmc _((const char *name, const char *mode));
static I32 sv_ncmp _((SV *a, SV *b));
static I32 sv_i_ncmp _((SV *a, SV *b));
static I32 amagic_ncmp _((SV *a, SV *b));
@@ -2511,7 +2511,7 @@ docatch(OP *o)
#endif
PL_op = o;
redo_body:
- CALLPROTECT(&ret, docatch_body);
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(docatch_body));
switch (ret) {
case 0:
break;
@@ -2776,32 +2776,35 @@ doeval(int gimme, OP** startop)
RETURNOP(PL_eval_start);
}
-static PerlIO *
-doopen(const char *name, const char *mode)
+STATIC PerlIO *
+doopen_pmc(const char *name, const char *mode)
{
STRLEN namelen = strlen(name);
PerlIO *fp;
if (namelen > 3 && strcmp(name + namelen - 3, ".pm") == 0) {
- SV *pmcsv = newSVpvf("%s%c", name, 'c');
+ SV *pmcsv = newSVpvf("%s%c", name, 'c');
char *pmc = SvPV_nolen(pmcsv);
Stat_t pmstat;
- Stat_t pmcstat;
- if (PerlLIO_stat(pmc, &pmcstat) < 0) {
+ Stat_t pmcstat;
+ if (PerlLIO_stat(pmc, &pmcstat) < 0) {
fp = PerlIO_open(name, mode);
- } else {
+ }
+ else {
if (PerlLIO_stat(name, &pmstat) < 0 ||
- pmstat.st_mtime < pmcstat.st_mtime) {
- fp = PerlIO_open(pmc, mode);
- } else {
- fp = PerlIO_open(name, mode);
- }
+ pmstat.st_mtime < pmcstat.st_mtime)
+ {
+ fp = PerlIO_open(pmc, mode);
+ }
+ else {
+ fp = PerlIO_open(name, mode);
+ }
}
- SvREFCNT_dec(pmcsv);
- } else {
- fp = PerlIO_open(name, mode);
+ SvREFCNT_dec(pmcsv);
+ }
+ else {
+ fp = PerlIO_open(name, mode);
}
-
return fp;
}
@@ -2855,7 +2858,7 @@ PP(pp_require)
)
{
tryname = name;
- tryrsfp = doopen(name,PERL_SCRIPT_MODE);
+ tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
}
else {
AV *ar = GvAVn(PL_incgv);
@@ -2879,7 +2882,7 @@ PP(pp_require)
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
- tryrsfp = doopen(tryname, PERL_SCRIPT_MODE);
+ tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
tryname += 2;
diff --git a/proto.h b/proto.h
index 526a0ff237..f2f45a7b9c 100644
--- a/proto.h
+++ b/proto.h
@@ -99,7 +99,9 @@ VIRTUAL void do_chop _((SV* asv, SV* sv));
VIRTUAL bool do_close _((GV* gv, bool not_implicit));
VIRTUAL bool do_eof _((GV* gv));
VIRTUAL bool do_exec _((char* cmd));
+#ifndef WIN32
VIRTUAL bool do_exec3 _((char* cmd, int fd, int flag));
+#endif
VIRTUAL void do_execfree _((void));
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32 do_ipcctl _((I32 optype, SV** mark, SV** sp));
@@ -155,8 +157,8 @@ VIRTUAL OP* fold_constants _((OP* arg));
VIRTUAL char* form _((const char* pat, ...));
VIRTUAL void free_tmps _((void));
VIRTUAL OP* gen_constant_list _((OP* o));
-#ifndef HAS_GETENV_SV
-VIRTUAL SV* getenv_sv _((char* key));
+#ifndef HAS_GETENV_LEN
+VIRTUAL char* getenv_len _((char* key, unsigned long *len));
#endif
VIRTUAL void gp_free _((GV* gv));
VIRTUAL GP* gp_ref _((GP* gp));
@@ -759,7 +761,7 @@ I32 dopoptosub _((I32 startingblock));
I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock));
void save_lines _((AV *array, SV *sv));
OP *doeval _((int gimme, OP** startop));
-PerlIO *doopen _((const char *name, const char *mode));
+PerlIO *doopen_pmc _((const char *name, const char *mode));
I32 sv_ncmp _((SV *a, SV *b));
I32 sv_i_ncmp _((SV *a, SV *b));
I32 amagic_ncmp _((SV *a, SV *b));
@@ -896,7 +898,6 @@ void del_sv _((SV *p));
#endif
void debprof _((OP *o));
-void *bset_obj_store _((void *obj, I32 ix));
OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
void simplify_sort _((OP *o));
bool is_handle_constructor _((OP *o, I32 argnum));
@@ -975,12 +976,13 @@ VIRTUAL void do_op_dump _((I32 level, PerlIO *file, OP *o));
VIRTUAL void do_pmop_dump _((I32 level, PerlIO *file, PMOP *pm));
VIRTUAL void do_sv_dump _((I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim));
VIRTUAL void magic_dump _((MAGIC *mg));
-VIRTUAL void* default_protect _((int *except, protect_body_t, ...));
+VIRTUAL void* default_protect _((int *excpt, protect_body_t body, ...));
VIRTUAL void reginitcolors _((void));
VIRTUAL char* sv_2pv_nolen _((SV* sv));
VIRTUAL char* sv_pv _((SV *sv));
VIRTUAL void sv_force_normal _((SV *sv));
VIRTUAL void tmps_grow _((I32 n));
+VIRTUAL void *bset_obj_store _((void *obj, I32 ix));
-VIRTUAL SV* sv_rvweaken _((SV *));
+VIRTUAL SV* sv_rvweaken _((SV *sv));
VIRTUAL int magic_killbackrefs _((SV *sv, MAGIC *mg));
diff --git a/scope.c b/scope.c
index 6c9c427670..ad7fe29c01 100644
--- a/scope.c
+++ b/scope.c
@@ -16,7 +16,7 @@
#include "perl.h"
void *
-default_protect(int *except, protect_body_t body, ...)
+default_protect(int *excpt, protect_body_t body, ...)
{
dTHR;
dJMPENV;
@@ -31,10 +31,10 @@ default_protect(int *except, protect_body_t body, ...)
ret = NULL;
else {
va_start(args, body);
- ret = body(args);
+ ret = CALL_FPTR(body)(args);
va_end(args);
}
- *except = ex;
+ *excpt = ex;
JMPENV_POP;
return ret;
}
diff --git a/scope.h b/scope.h
index 1502d4f083..b217fea6b3 100644
--- a/scope.h
+++ b/scope.h
@@ -159,9 +159,8 @@ typedef struct jmpenv JMPENV;
* Function that catches/throws, and its callback for the
* body of protected processing.
*/
-typedef void *(CPERLscope(*protect_body_t)) _((va_list args));
-typedef void *(CPERLscope(*protect_proc_t))
- _((int *except, protect_body_t, ...));
+typedef void *(CPERLscope(*protect_body_t)) _((va_list));
+typedef void *(CPERLscope(*protect_proc_t)) _((int *, protect_body_t, ...));
/*
* How to build the first jmpenv.
diff --git a/t/io/open.t b/t/io/open.t
index 50ae38dff1..63079c8b77 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -8,9 +8,10 @@ print "1..9\n";
# my $file tests
-unlink("afile.new") if -f "afile";
+unlink("afile") if -f "afile";
print "$!\nnot " unless open(my $f,"+>afile");
print "ok 1\n";
+binmode $f;
print "not " unless -f "afile";
print "ok 2\n";
print "not " unless print $f "SomeData\n";
diff --git a/t/op/magic.t b/t/op/magic.t
index 8486512b35..17246f6b8a 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -155,9 +155,11 @@ EOF
s/\.exe//i if $Is_Dos;
s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
s{is perl}{is $perl}; # for systems where $^X is only a basename
+ s{\\}{/}g;
ok 23, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1:";
$_ = `$perl $script`;
s/\.exe//i if $Is_Dos;
+ s{\\}{/}g;
ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
ok 25, unlink($script), $!;
}
diff --git a/toke.c b/toke.c
index e9234f61cd..6f846dc37d 100644
--- a/toke.c
+++ b/toke.c
@@ -1487,6 +1487,7 @@ filter_del(filter_t funcp)
return;
/* if filter is on top of stack (usual case) just pop it off */
if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
+ IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
diff --git a/util.c b/util.c
index ba77288697..9ea0851204 100644
--- a/util.c
+++ b/util.c
@@ -3079,18 +3079,14 @@ get_specialsv_list(void)
return PL_specialsv_list;
}
-#ifndef HAS_GETENV_SV
-SV *
-getenv_sv(char *env_elem)
-{
- char *env_trans;
- SV *temp_sv;
- if ((env_trans = PerlEnv_getenv(env_elem)) != Nullch) {
- temp_sv = newSVpv(env_trans, strlen(env_trans));
- return temp_sv;
- } else {
- return &PL_sv_undef;
- }
+#ifndef HAS_GETENV_LEN
+char *
+getenv_len(char *env_elem, unsigned long *len)
+{
+ char *env_trans = PerlEnv_getenv(env_elem);
+ if (env_trans)
+ *len = strlen(env_trans);
+ return env_trans;
}
#endif
diff --git a/vms/vms.c b/vms/vms.c
index 1212555d04..ebb05a142a 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -207,7 +207,7 @@ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
* Note: Uses Perl temp to store result so char * can be returned to
* caller; this pointer will be invalidated at next Perl statement
* transition.
- * We define this as a function rather than a macro in terms of my_getenv_sv()
+ * We define this as a function rather than a macro in terms of my_getenv_len()
* so that it'll work when PL_curinterp is undefined (and we therefore can't
* allocate SVs).
*/
@@ -256,17 +256,18 @@ my_getenv(const char *lnm, bool sys)
/*}}}*/
-/*{{{ SV *my_getenv_sv(const char *lnm, bool sys)*/
-SV *
-my_getenv_sv(const char *lnm, bool sys)
+/*{{{ SV *my_getenv_len(const char *lnm, bool sys)*/
+char *
+my_getenv_len(const char *lnm, unsigned long *len, bool sys)
{
char buf[LNM$C_NAMLENGTH+1], *cp1, *cp2;
- unsigned long int len, idx = 0;
+ unsigned long idx = 0;
for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
getcwd(buf,LNM$C_NAMLENGTH);
- return newSVpv(buf,0);
+ *len = strlen(buf);
+ return buf;
}
else {
if ((cp2 = strchr(lnm,';')) != NULL) {
@@ -275,18 +276,19 @@ my_getenv_sv(const char *lnm, bool sys)
idx = strtoul(cp2+1,NULL,0);
lnm = buf;
}
- if ((len = vmstrnenv(lnm,buf,idx,
+ if ((*len = vmstrnenv(lnm,buf,idx,
sys ? fildev : NULL,
#ifdef SECURE_INTERNAL_GETENV
sys ? PERL__TRNENV_SECURE : 0
#else
0
#endif
- ))) return newSVpv(buf,len);
- else return &PL_sv_undef;
+ )))
+ return buf;
+ else return Nullch;
}
-} /* end of my_getenv_sv() */
+} /* end of my_getenv_len() */
/*}}}*/
static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 4b45cf4968..5398bcccb0 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -74,7 +74,7 @@
/* getenv used for regular logical names */
# define getenv(v) my_getenv(v,TRUE)
#endif
-#define getenv_sv(v) my_getenv_sv(v,TRUE)
+#define getenv_len(v,l) my_getenv_len(v,l,TRUE)
/* DECC introduces this routine in the RTL as of VMS 7.0; for now,
* we'll use ours, since it gives us the full VMS exit status. */
@@ -90,7 +90,7 @@
#define vmstrnenv Perl_vmstrnenv
#define my_trnlnm Perl_my_trnlnm
#define my_getenv Perl_my_getenv
-#define my_getenv_sv Perl_my_getenv_sv
+#define my_getenv_len Perl_my_getenv_len
#define prime_env_iter Perl_prime_env_iter
#define vmssetenv Perl_vmssetenv
#define my_setenv Perl_my_setenv
@@ -413,7 +413,7 @@ struct utimbuf {
#define ENV_HV_NAME "%EnV%VmS%"
/* Special getenv function for retrieving %ENV elements. */
#define ENVgetenv(v) my_getenv(v,FALSE)
-#define ENVgetenv_sv(v) my_getenv_sv(v,FALSE)
+#define ENVgetenv_len(v,l) my_getenv_len(v,l,FALSE)
/* Thin jacket around cuserid() tomatch Unix' calling sequence */
@@ -581,7 +581,7 @@ typedef char __VMS_PROTOTYPES__;
int vmstrnenv _((const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int));
int my_trnlnm _((const char *, char *, unsigned long int));
char * my_getenv _((const char *, bool));
-SV * my_getenv_sv _((const char *, bool));
+char * my_getenv_len _((const char *, unsigned long *, bool));
int vmssetenv _((char *, char *, struct dsc$descriptor_s **));
char * my_crypt _((const char *, const char *));
Pid_t my_waitpid _((Pid_t, int *, int));
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
index 77e7aad8b8..82e0b32fc7 100644
--- a/win32/GenCAPI.pl
+++ b/win32/GenCAPI.pl
@@ -73,6 +73,8 @@ safexrealloc
safexfree
Perl_GetVars
malloced_size
+do_exec3
+getenv_len
)];
@@ -155,14 +157,11 @@ while () {
#undef $name
extern "C" $type $funcName ($args)
{
- char *pstr;
- char *pmsg;
+ SV *pmsg;
va_list args;
va_start(args, $arg);
- pmsg = pPerl->Perl_mess($arg, &args);
- New(0, pstr, strlen(pmsg)+1, char);
- strcpy(pstr, pmsg);
-$return pPerl->Perl_$name($start pstr);
+ pmsg = pPerl->Perl_sv_2mortal(pPerl->Perl_newSVsv(pPerl->Perl_mess($arg, &args)));
+$return pPerl->Perl_$name($start SvPV_nolen(pmsg));
va_end(args);
}
ENDCODE
diff --git a/win32/Makefile b/win32/Makefile
index ffa8c6b1a4..41d88ed042 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -527,7 +527,7 @@ RE = $(EXTDIR)\re\re
DUMPER = $(EXTDIR)\Data\Dumper\Dumper
ERRNO = $(EXTDIR)\Errno\Errno
PEEK = $(EXTDIR)\Devel\Peek\Peek
-BYTELOADER = $(EXTDIR)\ByteLoader
+BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader
SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll
FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll
diff --git a/win32/config.bc b/win32/config.bc
index 691dfbbcd4..6936dcc98f 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -1,7 +1,7 @@
## Configured by: ~cf_email~
## Target system: WIN32
Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
Date='$Date'
Header=''
Id='$Id'
diff --git a/win32/config.gc b/win32/config.gc
index 39b77015ae..200b10c33c 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -1,7 +1,7 @@
## Configured by: ~cf_email~
## Target system: WIN32
Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
Date='$Date'
Header=''
Id='$Id'
diff --git a/win32/config.vc b/win32/config.vc
index ea86e5f530..09fa5af202 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -1,7 +1,7 @@
## Configured by: ~cf_email~
## Target system: WIN32
Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
Date='$Date'
Header=''
Id='$Id'
diff --git a/win32/makedef.pl b/win32/makedef.pl
index f13c1da0a7..212f0000fd 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -79,6 +79,7 @@ PL_pending_ident
PL_sortcxix
PL_sublex_info
PL_timesbuf
+Perl_do_exec3
Perl_do_ipcctl
Perl_do_ipcget
Perl_do_msgrcv
@@ -302,7 +303,6 @@ sub output_symbol {
__DATA__
# extra globals not included above.
perl_init_i18nl10n
-perl_init_ext
perl_alloc
perl_atexit
perl_construct
diff --git a/win32/makefile.mk b/win32/makefile.mk
index bee351ce03..7f2b515024 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -642,7 +642,7 @@ RE = $(EXTDIR)\re\re
DUMPER = $(EXTDIR)\Data\Dumper\Dumper
ERRNO = $(EXTDIR)\Errno\Errno
PEEK = $(EXTDIR)\Devel\Peek\Peek
-BYTELOADER = $(EXTDIR)\ByteLoader
+BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader
SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll
FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll
diff --git a/win32/perlhost.h b/win32/perlhost.h
index cc5b5e5cd4..458ff9afc9 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -102,6 +102,13 @@ public:
{
return win32_uname(name);
};
+ virtual char *Getenv_len(const char *varname, unsigned long *len, int &err)
+ {
+ char *e = win32_getenv(varname);
+ if (e)
+ *len = strlen(e);
+ return e;
+ };
};
class CPerlSock : public IPerlSock
diff --git a/win32/runperl.c b/win32/runperl.c
index 1b569d2557..336f2a87a5 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -28,9 +28,6 @@ xs_init(CPERLarg)
CPerlObj *pPerl;
-#undef PERL_SYS_INIT
-#define PERL_SYS_INIT(a, c)
-
int
main(int argc, char **argv, char **env)
{
@@ -48,6 +45,8 @@ main(int argc, char **argv, char **env)
argv[0] = szModuleName;
#endif
+ PERL_SYS_INIT(&argc,&argv);
+
if (!host.PerlCreate())
exit(exitstatus);
diff --git a/win32/win32.c b/win32/win32.c
index 414e4c5dfc..4988e31648 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1307,7 +1307,12 @@ win32_uname(struct utsname *name)
SYSTEM_INFO info;
char *arch;
GetSystemInfo(&info);
+
+#ifdef __BORLANDC__
+ switch (info.u.s.wProcessorArchitecture) {
+#else
switch (info.wProcessorArchitecture) {
+#endif
case PROCESSOR_ARCHITECTURE_INTEL:
arch = "x86"; break;
case PROCESSOR_ARCHITECTURE_MIPS:
@@ -2860,8 +2865,8 @@ static
XS(w32_GetTickCount)
{
dXSARGS;
- EXTEND(SP,1);
DWORD msec = GetTickCount();
+ EXTEND(SP,1);
if ((IV)msec > 0)
XSRETURN_IV(msec);
XSRETURN_NV(msec);
diff --git a/win32/win32.h b/win32/win32.h
index a072b875c9..f712928cf0 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -12,6 +12,7 @@
#ifdef PERL_OBJECT
# define DYNAMIC_ENV_FETCH
# define ENV_HV_NAME "___ENV_HV_NAME___"
+# define HAS_GETENV_LEN
# define prime_env_iter()
# define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */
# ifdef PERL_GLOBAL_STRUCT
@@ -184,6 +185,7 @@ struct utsname {
typedef long uid_t;
typedef long gid_t;
+typedef unsigned short mode_t;
#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
#ifndef PERL_OBJECT