various fixes for clean build and test on win32; configpm broken,
Gurusamy Sarathy [Tue, 11 May 1999 09:34:13 +0000 (09:34 +0000)]
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

39 files changed:
Changes
bytecode.pl
byterun.c
byterun.h
configpm
embed.h
embed.pl
ext/B/B/Asmdata.pm
ext/ByteLoader/ByteLoader.xs
ext/DynaLoader/dlutils.c
global.sym
hv.c
iperlsys.h
objXSUB.h
op.c
perl.c
perl.h
pp.c
pp_ctl.c
proto.h
scope.c
scope.h
t/io/open.t
t/op/magic.t
toke.c
util.c
vms/vms.c
vms/vmsish.h
win32/GenCAPI.pl
win32/Makefile
win32/config.bc
win32/config.gc
win32/config.vc
win32/makedef.pl
win32/makefile.mk
win32/perlhost.h
win32/runperl.c
win32/win32.c
win32/win32.h

diff --git a/Changes b/Changes
index dd39e11..a19392f 100644 (file)
--- 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
index c61b7aa..f53b0ce 100644 (file)
@@ -169,8 +169,6 @@ struct bytestream {
 };
 #endif /* INDIRECT_BGET_MACROS */
 
-void *bset_obj_store _((void *, I32));
-
 enum {
 EOT
 
index f6c5232..f8c07f9 100644 (file)
--- 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.
index 430de55..3aac6fa 100644 (file)
--- 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 */
index 4c9eb12..dd9e858 100755 (executable)
--- 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 cabef95..aba2f59 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
 #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
 #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
 #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
 #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
 #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
index 19f68a9..2fde0dd 100755 (executable)
--- 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
index ddc391b..d4128b6 100644 (file)
@@ -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.
index 98053c7..24c3ae8 100644 (file)
@@ -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;
 
index bfa1f78..3bd58ed 100644 (file)
@@ -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)
index b46c106..1e739bc 100644 (file)
@@ -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 e7a73ce..d21af5c 100644 (file)
--- 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;
index 7251e8f..5f0ed0c 100644 (file)
@@ -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))
 
index 53ad4e2..0305bf0 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #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
 #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
 #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
 #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
 #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
 #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 13f2a15..919d9d8 100644 (file)
--- 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 daa15cc..a08b95e 100644 (file)
--- 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 14e891c..5cbecd2 100644 (file)
--- 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 34fffef..431dc9a 100644 (file)
--- 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);
index 9d6d063..621024a 100644 (file)
--- 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 526a0ff..f2f45a7 100644 (file)
--- 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 6c9c427..ad7fe29 100644 (file)
--- 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 1502d4f..b217fea 100644 (file)
--- 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.
index 50ae38d..63079c8 100755 (executable)
@@ -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";
index 8486512..17246f6 100755 (executable)
@@ -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 e9234f6..6f846dc 100644 (file)
--- 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 ba77288..9ea0851 100644 (file)
--- 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
 
index 1212555..ebb05a1 100644 (file)
--- 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 *);
index 4b45cf4..5398bcc 100644 (file)
@@ -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));
index 77e7aad..82e0b32 100644 (file)
@@ -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
index ffa8c6b..41d88ed 100644 (file)
@@ -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
index 691dfbb..6936dcc 100644 (file)
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
index 39b7701..200b10c 100644 (file)
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
index ea86e5f..09fa5af 100644 (file)
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
index f13c1da..212f000 100644 (file)
@@ -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
index bee351c..7f2b515 100644 (file)
@@ -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
index cc5b5e5..458ff9a 100644 (file)
@@ -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
index 1b569d2..336f2a8 100644 (file)
@@ -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);
 
index 414e4c5..4988e31 100644 (file)
@@ -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);
index a072b87..f712928 100644 (file)
@@ -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