Change 19120 by [EMAIL PROTECTED] on 2003/04/01 16:32:03
Integrate:
[ 19106]
Subject: [PATCH 5.8.1 @19053] OS/2-related patches
From: Ilya Zakharevich <[EMAIL PROTECTED]>
Date: Mon, 31 Mar 2003 12:43:37 -0800
Message-ID: <[EMAIL PROTECTED]>
and regen Configure.
Affected files ...
... //depot/perl/Configure#510 edit
... //depot/perl/Makefile.SH#264 integrate
... //depot/perl/config_h.SH#270 edit
... //depot/perl/embed.fnc#75 integrate
... //depot/perl/embed.h#392 integrate
... //depot/perl/embed.pl#334 integrate
... //depot/perl/embedvar.h#162 edit
... //depot/perl/ext/threads/threads.xs#59 integrate
... //depot/perl/intrpvar.h#119 integrate
... //depot/perl/makedef.pl#141 integrate
... //depot/perl/os2/Makefile.SHs#32 integrate
... //depot/perl/os2/OS2/ExtAttr/Changes#6 integrate
... //depot/perl/os2/OS2/ExtAttr/ExtAttr.pm#8 integrate
... //depot/perl/os2/OS2/PrfDB/Changes#6 integrate
... //depot/perl/os2/OS2/PrfDB/PrfDB.pm#6 integrate
... //depot/perl/os2/OS2/REXX/DLL/DLL.pm#5 integrate
... //depot/perl/os2/OS2/REXX/REXX.pm#11 integrate
... //depot/perl/os2/dl_os2.c#11 integrate
... //depot/perl/os2/os2.c#65 integrate
... //depot/perl/os2/os2ish.h#41 integrate
... //depot/perl/os2/os2thread.h#5 integrate
... //depot/perl/perlapi.h#84 integrate
... //depot/perl/perlio.c#205 integrate
... //depot/perl/perlvars.h#49 integrate
... //depot/perl/reentr.c#12 integrate
... //depot/perl/reentr.h#13 integrate
... //depot/perl/reentr.pl#26 integrate
... //depot/perl/sv.c#648 integrate
Differences ...
==== //depot/perl/Configure#510 (xtext) ====
Index: perl/Configure
--- perl/Configure#509~19021~ Mon Mar 17 22:56:26 2003
+++ perl/Configure Tue Apr 1 08:32:03 2003
@@ -20,7 +20,7 @@
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Tue Mar 18 09:54:18 EET 2003 [metaconfig 3.0 PL70]
+# Generated on Tue Apr 1 20:39:33 EET DST 2003 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by [EMAIL PROTECTED])
cat >c1$$ <<EOF
@@ -71,11 +71,12 @@
: Proper separator for the PATH environment variable
p_=:
: On OS/2 this directory should exist if this is not floppy only system :-]
-if test -d c:/. ; then
+if test -d c:/. || ( uname -a | grep -i 'os\(/\|\)2' ) 2>&1 >/dev/null ; then
if test -n "$OS2_SHELL"; then
p_=\;
PATH=`cmd /c "echo %PATH%" | tr '\\\\' / `
OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]'
'[a-z]'`
+ is_os2=yes
elif test -n "$DJGPP"; then
case "X${MACHTYPE:-nonesuchmach}" in
*cygwin) ;;
@@ -1195,7 +1196,7 @@
elif test -n "$DJGPP"; then
: DOS DJGPP
_exe=".exe"
-elif test -d c:/. ; then
+elif test -d c:/. -o -n "$is_os2" ; then
: OS/2 or cygwin
_exe=".exe"
fi
@@ -3137,6 +3138,9 @@
openbsd) osname=openbsd
osvers="$3"
;;
+ os2) osname=os2
+ osvers="$4"
+ ;;
POSIX-BC | posix-bc ) osname=posix-bc
osvers="$3"
;;
@@ -3255,7 +3259,7 @@
osname=news_os
fi
$rm -f UU/kernel.what
- elif test -d c:/.; then
+ elif test -d c:/. -o -n "$is_os2" ; then
set X $myuname
osname=os2
osvers="$5"
@@ -4978,6 +4982,7 @@
case "$osname" in
vos) cppfilter="tr '\\\\>' '/' |" ;; # path component separator is >
+os2) cppfilter="sed -e 's|\\\\\\\\|/|g' |" ;; # path component separator is \
*) cppfilter='' ;;
esac
: locate header file
==== //depot/perl/Makefile.SH#264 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#263~19059~ Mon Mar 24 13:43:03 2003
+++ perl/Makefile.SH Tue Apr 1 08:32:03 2003
@@ -457,7 +457,7 @@
esac
$spitshell >>Makefile <<'!NO!SUBS!'
perl.exp: $(MINIPERLEXP) makedef.pl config.sh $(SYM) $(SYMH)
- ./$(MINIPERLEXP) makedef.pl PLATFORM=aix | sort -u | sort -f > perl.exp.tmp
+ ./$(MINIPERLEXP) makedef.pl PLATFORM=aix CC_FLAGS="$(OPTIMIZE)" | sort -u |
sort -f > perl.exp.tmp
sh mv-if-diff perl.exp.tmp perl.exp
!NO!SUBS!
@@ -467,7 +467,7 @@
MINIPERLEXP = miniperl
perl5.def: $(MINIPERLEXP) makedef.pl config.sh $(SYM) $(SYMH) miniperl.map
- ./$(MINIPERLEXP) makedef.pl PLATFORM=os2 -DPERL_DLL=$(PERL_DLL) > perl.exp.tmp
+ ./$(MINIPERLEXP) makedef.pl PLATFORM=os2 -DPERL_DLL=$(PERL_DLL)
CC_FLAGS="$(OPTIMIZE)" > perl.exp.tmp
sh mv-if-diff perl.exp.tmp perl5.def
!NO!SUBS!
==== //depot/perl/embedvar.h#162 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#161~18801~ Sun Mar 2 07:24:22 2003
+++ perl/embedvar.h Tue Apr 1 08:32:03 2003
@@ -366,7 +366,7 @@
#define PL_runops (vTHX->Irunops)
#define PL_savebegin (vTHX->Isavebegin)
#define PL_sawampersand (vTHX->Isawampersand)
-#define PL_sh_path (vTHX->Ish_path)
+#define PL_sh_path_compat (vTHX->Ish_path_compat)
#define PL_sig_pending (vTHX->Isig_pending)
#define PL_sighandlerp (vTHX->Isighandlerp)
#define PL_signals (vTHX->Isignals)
@@ -658,7 +658,7 @@
#define PL_Irunops PL_runops
#define PL_Isavebegin PL_savebegin
#define PL_Isawampersand PL_sawampersand
-#define PL_Ish_path PL_sh_path
+#define PL_Ish_path_compat PL_sh_path_compat
#define PL_Isig_pending PL_sig_pending
#define PL_Isighandlerp PL_sighandlerp
#define PL_Isignals PL_signals
@@ -883,6 +883,7 @@
#define PL_ppid (PL_Vars.Gppid)
#define PL_runops_dbg (PL_Vars.Grunops_dbg)
#define PL_runops_std (PL_Vars.Grunops_std)
+#define PL_sh_path (PL_Vars.Gsh_path)
#define PL_sharehook (PL_Vars.Gsharehook)
#define PL_thr_key (PL_Vars.Gthr_key)
#define PL_threadhook (PL_Vars.Gthreadhook)
@@ -903,6 +904,7 @@
#define PL_Gppid PL_ppid
#define PL_Grunops_dbg PL_runops_dbg
#define PL_Grunops_std PL_runops_std
+#define PL_Gsh_path PL_sh_path
#define PL_Gsharehook PL_sharehook
#define PL_Gthr_key PL_thr_key
#define PL_Gthreadhook PL_threadhook
==== //depot/perl/ext/threads/threads.xs#59 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#58~18618~ Sat Feb 1 13:04:36 2003
+++ perl/ext/threads/threads.xs Tue Apr 1 08:32:03 2003
@@ -18,7 +18,11 @@
}\
} STMT_END
#else
+#ifdef OS2
+typedef perl_os_thread pthread_t;
+#else
#include <pthread.h>
+#endif
#include <thread.h>
#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
==== //depot/perl/intrpvar.h#119 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#118~18907~ Mon Mar 10 22:01:28 2003
+++ perl/intrpvar.h Tue Apr 1 08:32:03 2003
@@ -242,7 +242,10 @@
PERLVAR(Ipidstatus, HV *) /* pid-to-status mappings for waitpid */
PERLVARI(Imaxo, int, MAXO) /* maximum number of ops */
PERLVAR(Iosname, char *) /* operating system */
-PERLVARI(Ish_path, char *, SH_PATH)/* full path of shell */
+
+/* For binary compatibility with older versions only */
+PERLVARI(Ish_path_compat, char *, SH_PATH)/* full path of shell */
+
PERLVAR(Isighandlerp, Sighandler_t)
PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */
==== //depot/perl/makedef.pl#141 (text) ====
Index: perl/makedef.pl
--- perl/makedef.pl#140~18795~ Sat Mar 1 23:27:44 2003
+++ perl/makedef.pl Tue Apr 1 08:32:03 2003
@@ -6,13 +6,20 @@
# and by MacOS Classic.
#
# reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h
-# On OS/2 reads miniperl.map as well
+# On OS/2 reads miniperl.map and the previous version of perl5.def as well
my $PLATFORM;
my $CCTYPE;
while (@ARGV) {
my $flag = shift;
+ if ($flag =~ s/^CC_FLAGS=/ /) {
+ for my $fflag ($flag =~ /(?:^|\s)-D(\S+)/g) {
+ $fflag .= '=1' unless $fflag =~ /^(\w+)=/;
+ $define{$1} = $2 if $fflag =~ /^(\w+)=(.+)$/;
+ }
+ next;
+ }
$define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
$define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/);
$CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
@@ -417,7 +424,14 @@
os2error
ResetWinError
CroakWinError
+ PL_do_undump
)]);
+ emit_symbols([qw(os2_cond_wait
+ pthread_join
+ pthread_create
+ pthread_detach
+ )])
+ if $define{'USE_5005THREADS'} or $define{'USE_ITHREADS'};
}
elsif ($PLATFORM eq 'MacOS') {
skip_symbols [qw(
@@ -947,7 +961,7 @@
emit_symbols $glob;
}
# XXX AIX seems to want the perlvars.h symbols, for some reason
- if ($PLATFORM eq 'aix') {
+ if ($PLATFORM eq 'aix' or $PLATFORM eq 'os2') { # OS/2 needs PL_thr_key
my $glob = readvar($perlvars_h);
emit_symbols $glob;
}
==== //depot/perl/os2/Makefile.SHs#32 (text) ====
Index: perl/os2/Makefile.SHs
--- perl/os2/Makefile.SHs#31~15619~ Fri Mar 29 14:15:37 2002
+++ perl/os2/Makefile.SHs Tue Apr 1 08:32:03 2003
@@ -27,7 +27,6 @@
PERL_FULLVERSION = $perl_fullversion
-OPTIMIZE = $optimize
AOUT_OPTIMIZE = \$(OPTIMIZE)
AOUT_CCCMD = \$(CC) -DPERL_CORE $aout_ccflags \$(AOUT_OPTIMIZE)
AOUT_AR = $aout_ar
==== //depot/perl/os2/OS2/ExtAttr/Changes#6 (text) ====
Index: perl/os2/OS2/ExtAttr/Changes
--- perl/os2/OS2/ExtAttr/Changes#5~1575~ Sun Jul 19 18:27:14 1998
+++ perl/os2/OS2/ExtAttr/Changes Tue Apr 1 08:32:03 2003
@@ -3,3 +3,5 @@
0.01 Sun Apr 21 11:07:04 1996
- original version; created by h2xs 1.16
+0.02 Update to XSLoader and 'our'.
+ Remove Exporter.
==== //depot/perl/os2/OS2/ExtAttr/ExtAttr.pm#8 (text) ====
Index: perl/os2/OS2/ExtAttr/ExtAttr.pm
--- perl/os2/OS2/ExtAttr/ExtAttr.pm#7~9206~ Sun Mar 18 12:04:24 2001
+++ perl/os2/OS2/ExtAttr/ExtAttr.pm Tue Apr 1 08:32:03 2003
@@ -1,21 +1,10 @@
package OS2::ExtAttr;
use strict;
-use vars qw($VERSION @ISA @EXPORT);
+use XSLoader;
-require Exporter;
-require DynaLoader;
-
[EMAIL PROTECTED] = qw(Exporter DynaLoader);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
[EMAIL PROTECTED] = qw(
-
-);
-$VERSION = '0.01';
-
-bootstrap OS2::ExtAttr $VERSION;
+our $VERSION = '0.02';
+XSLoader::load 'OS2::ExtAttr', $VERSION;
# Preloaded methods go here.
==== //depot/perl/os2/OS2/PrfDB/Changes#6 (text) ====
Index: perl/os2/OS2/PrfDB/Changes
--- perl/os2/OS2/PrfDB/Changes#5~1575~ Sun Jul 19 18:27:14 1998
+++ perl/os2/OS2/PrfDB/Changes Tue Apr 1 08:32:03 2003
@@ -3,3 +3,4 @@
0.01 Tue Mar 26 19:35:27 1996
- original version; created by h2xs 1.16
0.02: Field do-not-close added to OS2::Prf::Hini.
+0.03: Update to XSLoader and 'our'.
==== //depot/perl/os2/OS2/PrfDB/PrfDB.pm#6 (text) ====
Index: perl/os2/OS2/PrfDB/PrfDB.pm
--- perl/os2/OS2/PrfDB/PrfDB.pm#5~1575~ Sun Jul 19 18:27:14 1998
+++ perl/os2/OS2/PrfDB/PrfDB.pm Tue Apr 1 08:32:03 2003
@@ -1,21 +1,22 @@
package OS2::PrfDB;
use strict;
-use vars qw($VERSION @ISA @EXPORT);
require Exporter;
-require DynaLoader;
+use XSLoader;
+use Tie::Hash;
[EMAIL PROTECTED] = qw(Exporter DynaLoader);
+our $debug;
+our @ISA = qw(Exporter Tie::Hash);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
[EMAIL PROTECTED] = qw(
- AnyIni UserIni SystemIni
- );
-$VERSION = '0.02';
+our @EXPORT = qw(
+ AnyIni UserIni SystemIni
+ );
+our $VERSION = '0.03';
-bootstrap OS2::PrfDB $VERSION;
+XSLoader::load 'OS2::PrfDB', $VERSION;
# Preloaded methods go here.
@@ -32,10 +33,6 @@
new_from_int OS2::PrfDB::Hini OS2::Prf::System(2),'System settings database',1;
}
-use vars qw{$debug @ISA};
-use Tie::Hash;
-push @ISA, qw{Tie::Hash};
-
# Internal structure 0 => HINI, 1 => array of entries, 2 => iterator.
sub TIEHASH {
@@ -127,9 +124,10 @@
}
package OS2::PrfDB::Sub;
-use vars qw{$debug @ISA};
use Tie::Hash;
[EMAIL PROTECTED] = qw{Tie::Hash};
+
+our $debug;
+our @ISA = qw{Tie::Hash};
# Internal structure 0 => HINI, 1 => array of entries, 2 => iterator,
# 3 => appname.
==== //depot/perl/os2/OS2/REXX/DLL/DLL.pm#5 (text) ====
Index: perl/os2/OS2/REXX/DLL/DLL.pm
--- perl/os2/OS2/REXX/DLL/DLL.pm#4~13034~ Thu Nov 15 16:38:41 2001
+++ perl/os2/OS2/REXX/DLL/DLL.pm Tue Apr 1 08:32:03 2003
@@ -3,9 +3,7 @@
our $VERSION = '1.00';
use Carp;
-use DynaLoader;
-
[EMAIL PROTECTED] = qw(DynaLoader);
+use XSLoader;
sub AUTOLOAD {
$AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/
@@ -86,7 +84,7 @@
return 1;
}
-bootstrap OS2::DLL;
+XSLoader::load 'OS2::DLL';
1;
__END__
==== //depot/perl/os2/OS2/REXX/REXX.pm#11 (text) ====
Index: perl/os2/OS2/REXX/REXX.pm
--- perl/os2/OS2/REXX/REXX.pm#10~13183~ Wed Nov 21 14:33:20 2001
+++ perl/os2/OS2/REXX/REXX.pm Tue Apr 1 08:32:03 2003
@@ -1,18 +1,17 @@
package OS2::REXX;
-use Carp;
require Exporter;
-require DynaLoader;
+use XSLoader;
require OS2::DLL;
[EMAIL PROTECTED] = qw(Exporter DynaLoader);
[EMAIL PROTECTED] = qw(Exporter);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = qw(REXX_call REXX_eval REXX_eval_with);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(drop register);
-$VERSION = '1.01';
+$VERSION = '1.02';
# We cannot just put OS2::DLL in @ISA, since some scripts would use
# function interface, not method interface...
@@ -21,7 +20,7 @@
*load = \&OS2::DLL::load;
*find = \&OS2::DLL::find;
-bootstrap OS2::REXX;
+XSLoader::load 'OS2::REXX';
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
==== //depot/perl/os2/dl_os2.c#11 (text) ====
Index: perl/os2/dl_os2.c
--- perl/os2/dl_os2.c#10~11010~ Thu Jun 28 12:10:54 2001
+++ perl/os2/dl_os2.c Tue Apr 1 08:32:03 2003
@@ -8,13 +8,23 @@
static ULONG retcode;
static char fail[300];
+#ifdef PERL_CORE
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#else
+
char *os2error(int rc);
+#endif
+
void *
dlopen(const char *path, int mode)
{
HMODULE handle;
- char tmp[260], *beg, *dot;
+ char tmp[260];
+ const char *beg, *dot;
ULONG rc;
fail[0] = 0;
==== //depot/perl/os2/os2.c#65 (text) ====
Index: perl/os2/os2.c
--- perl/os2/os2.c#64~18316~ Mon Dec 16 18:17:16 2002
+++ perl/os2/os2.c Tue Apr 1 08:32:03 2003
@@ -9,6 +9,7 @@
#define SPU_ENABLESUPPRESSION 1
#include <os2.h>
#include "dlfcn.h"
+#include <emx/syscalls.h>
#include <sys/uflags.h>
@@ -29,6 +30,292 @@
#include "EXTERN.h"
#include "perl.h"
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+
+typedef void (*emx_startroutine)(void *);
+typedef void* (*pthreads_startroutine)(void *);
+
+enum pthreads_state {
+ pthreads_st_none = 0,
+ pthreads_st_run,
+ pthreads_st_exited,
+ pthreads_st_detached,
+ pthreads_st_waited,
+ pthreads_st_norun,
+ pthreads_st_exited_waited,
+};
+const char *pthreads_states[] = {
+ "uninit",
+ "running",
+ "exited",
+ "detached",
+ "waited for",
+ "could not start",
+ "exited, then waited on",
+};
+
+enum pthread_exists { pthread_not_existant = -0xff };
+
+static const char*
+pthreads_state_string(enum pthreads_state state)
+{
+ if (state < 0 || state >= sizeof(pthreads_states)/sizeof(*pthreads_states)) {
+ static char buf[80];
+
+ snprintf(buf, sizeof(buf), "unknown thread state %d", (int)state);
+ return buf;
+ }
+ return pthreads_states[state];
+}
+
+typedef struct {
+ void *status;
+ perl_cond cond;
+ enum pthreads_state state;
+} thread_join_t;
+
+thread_join_t *thread_join_data;
+int thread_join_count;
+perl_mutex start_thread_mutex;
+
+int
+pthread_join(perl_os_thread tid, void **status)
+{
+ MUTEX_LOCK(&start_thread_mutex);
+ if (tid < 1 || tid >= thread_join_count) {
+ MUTEX_UNLOCK(&start_thread_mutex);
+ if (tid != pthread_not_existant)
+ Perl_croak_nocontext("panic: join with a thread with strange ordinal %d",
(int)tid);
+ Perl_warn_nocontext("panic: join with a thread which could not start");
+ *status = 0;
+ return 0;
+ }
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_exited:
+ thread_join_data[tid].state = pthreads_st_exited_waited;
+ *status = thread_join_data[tid].status;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ COND_SIGNAL(&thread_join_data[tid].cond);
+ break;
+ case pthreads_st_waited:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("join with a thread with a waiter");
+ break;
+ case pthreads_st_norun:
+ {
+ int state = (int)thread_join_data[tid].status;
+
+ thread_join_data[tid].state = pthreads_st_none;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("panic: join with a thread which could not run"
+ " due to attempt of tid reuse (state='%s')",
+ pthreads_state_string(state));
+ break;
+ }
+ case pthreads_st_run:
+ {
+ perl_cond cond;
+
+ thread_join_data[tid].state = pthreads_st_waited;
+ thread_join_data[tid].status = (void *)status;
+ COND_INIT(&thread_join_data[tid].cond);
+ cond = thread_join_data[tid].cond;
+ COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex);
+ COND_DESTROY(&cond);
+ MUTEX_UNLOCK(&start_thread_mutex);
+ break;
+ }
+ default:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("panic: join with thread in unknown thread state: '%s'",
+ pthreads_state_string(thread_join_data[tid].state));
+ break;
+ }
+ return 0;
+}
+
+typedef struct {
+ pthreads_startroutine sub;
+ void *arg;
+ void *ctx;
+} pthr_startit;
+
+/* The lock is used:
+ a) Since we temporarily usurp the caller interp, so malloc() may
+ use it to decide on debugging the call;
+ b) Since *args is on the caller's stack.
+ */
+void
+pthread_startit(void *arg1)
+{
+ /* Thread is already started, we need to transfer control only */
+ pthr_startit args = *(pthr_startit *)arg1;
+ int tid = pthread_self();
+ void *rc;
+ int state;
+
+ if (tid <= 1) {
+ /* Can't croak, the setjmp() is not in scope... */
+ char buf[80];
+
+ snprintf(buf, sizeof(buf),
+ "panic: thread with strange ordinal %d created\n\r", tid);
+ write(2,buf,strlen(buf));
+ MUTEX_UNLOCK(&start_thread_mutex);
+ return;
+ }
+ /* Until args.sub resets it, makes debugging Perl_malloc() work: */
+ PERL_SET_CONTEXT(0);
+ if (tid >= thread_join_count) {
+ int oc = thread_join_count;
+
+ thread_join_count = tid + 5 + tid/5;
+ if (thread_join_data) {
+ Renew(thread_join_data, thread_join_count, thread_join_t);
+ Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t);
+ } else {
+ Newz(1323, thread_join_data, thread_join_count, thread_join_t);
+ }
+ }
+ if (thread_join_data[tid].state != pthreads_st_none) {
+ /* Can't croak, the setjmp() is not in scope... */
+ char buf[80];
+
+ snprintf(buf, sizeof(buf),
+ "panic: attempt to reuse thread id %d (state='%s')\n\r",
+ tid, pthreads_state_string(thread_join_data[tid].state));
+ write(2,buf,strlen(buf));
+ thread_join_data[tid].status = (void*)thread_join_data[tid].state;
+ thread_join_data[tid].state = pthreads_st_norun;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ return;
+ }
+ thread_join_data[tid].state = pthreads_st_run;
+ /* Now that we copied/updated the guys, we may release the caller... */
+ MUTEX_UNLOCK(&start_thread_mutex);
+ rc = (*args.sub)(args.arg);
+ MUTEX_LOCK(&start_thread_mutex);
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_waited:
+ COND_SIGNAL(&thread_join_data[tid].cond);
+ thread_join_data[tid].state = pthreads_st_none;
+ *((void**)thread_join_data[tid].status) = rc;
+ break;
+ case pthreads_st_detached:
+ thread_join_data[tid].state = pthreads_st_none;
+ break;
+ case pthreads_st_run:
+ /* Somebody can wait on us; cannot exit, since OS can reuse the tid
+ and our waiter will get somebody else's status. */
+ thread_join_data[tid].state = pthreads_st_exited;
+ thread_join_data[tid].status = rc;
+ COND_INIT(&thread_join_data[tid].cond);
+ COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex);
+ COND_DESTROY(&thread_join_data[tid].cond);
+ thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */
+ break;
+ default:
+ state = thread_join_data[tid].state;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("panic: unexpected thread state on exit: '%s'",
+ pthreads_state_string(state));
+ }
+ MUTEX_UNLOCK(&start_thread_mutex);
+}
+
+int
+pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr,
+ void *(*start_routine)(void*), void *arg)
+{
+ dTHX;
+ pthr_startit args;
+
+ args.sub = (void*)start_routine;
+ args.arg = arg;
+ args.ctx = PERL_GET_CONTEXT;
+
+ MUTEX_LOCK(&start_thread_mutex);
+ /* Test suite creates 31 extra threads;
+ on machine without shared-memory-hogs this stack sizeis OK with 31: */
+ *tidp = _beginthread(pthread_startit, /*stack*/ NULL,
+ /*stacksize*/ 4*1024*1024, (void*)&args);
+ if (*tidp == -1) {
+ *tidp = pthread_not_existant;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ return EINVAL;
+ }
+ MUTEX_LOCK(&start_thread_mutex); /* Wait for init to proceed */
+ MUTEX_UNLOCK(&start_thread_mutex);
+ return 0;
+}
+
+int
+pthread_detach(perl_os_thread tid)
+{
+ MUTEX_LOCK(&start_thread_mutex);
+ if (tid < 1 || tid >= thread_join_count) {
+ MUTEX_UNLOCK(&start_thread_mutex);
+ if (tid != pthread_not_existant)
+ Perl_croak_nocontext("panic: detach of a thread with strange ordinal %d",
(int)tid);
+ Perl_warn_nocontext("detach of a thread which could not start");
+ return 0;
+ }
+ switch (thread_join_data[tid].state) {
+ case pthreads_st_waited:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("detach on a thread with a waiter");
+ break;
+ case pthreads_st_run:
+ thread_join_data[tid].state = pthreads_st_detached;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ break;
+ case pthreads_st_exited:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ COND_SIGNAL(&thread_join_data[tid].cond);
+ break;
+ case pthreads_st_detached:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_warn_nocontext("detach on an already detached thread");
+ break;
+ case pthreads_st_norun:
+ {
+ int state = (int)thread_join_data[tid].status;
+
+ thread_join_data[tid].state = pthreads_st_none;
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("panic: detaching thread which could not run"
+ " due to attempt of tid reuse (state='%s')",
+ pthreads_state_string(state));
+ break;
+ }
+ default:
+ MUTEX_UNLOCK(&start_thread_mutex);
+ Perl_croak_nocontext("panic: detach of a thread with unknown thread state:
'%s'",
+ pthreads_state_string(thread_join_data[tid].state));
+ break;
+ }
+ return 0;
+}
+
+/* This is a very bastardized version; may be OK due to edge trigger of Wait */
+int
+os2_cond_wait(perl_cond *c, perl_mutex *m)
+{
+ int rc;
+ STRLEN n_a;
+ if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
+ Perl_croak_nocontext("panic: COND_WAIT-reset: rc=%i", rc);
+ if (m) MUTEX_UNLOCK(m);
+ if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
+ && (rc != ERROR_INTERRUPT))
+ Perl_croak_nocontext("panic: COND_WAIT: rc=%i", rc);
+ if (rc == ERROR_INTERRUPT)
+ errno = EINTR;
+ if (m) MUTEX_LOCK(m);
+ return 0;
+}
+#endif
+
static int exe_is_aout(void);
/*****************************************************************************/
@@ -1125,17 +1412,51 @@
#if OS2_STAT_HACK
+enum os2_stat_extra { /* EMX 0.9d fix 4 defines up to 0100000 */
+ os2_stat_archived = 0x1000000, /* 0100000000 */
+ os2_stat_hidden = 0x2000000, /* 0200000000 */
+ os2_stat_system = 0x4000000, /* 0400000000 */
+ os2_stat_force = 0x8000000, /* Do not ignore flags on chmod */
+};
+
+#define OS2_STAT_SPECIAL (os2_stat_system | os2_stat_archived | os2_stat_hidden)
+
+static void
+massage_os2_attr(struct stat *st)
+{
+ if ( ((st->st_mode & S_IFMT) != S_IFREG
+ && (st->st_mode & S_IFMT) != S_IFDIR)
+ || !(st->st_attr & (FILE_ARCHIVED | FILE_HIDDEN | FILE_SYSTEM)))
+ return;
+
+ if ( st->st_attr & FILE_ARCHIVED )
+ st->st_mode |= (os2_stat_archived | os2_stat_force);
+ if ( st->st_attr & FILE_HIDDEN )
+ st->st_mode |= (os2_stat_hidden | os2_stat_force);
+ if ( st->st_attr & FILE_SYSTEM )
+ st->st_mode |= (os2_stat_system | os2_stat_force);
+}
+
/* First attempt used DosQueryFSAttach which crashed the system when
used with 5.001. Now just look for /dev/. */
-
int
os2_stat(const char *name, struct stat *st)
{
static int ino = SHRT_MAX;
+ STRLEN l = strlen(name);
- if (stricmp(name, "/dev/con") != 0
- && stricmp(name, "/dev/tty") != 0)
- return stat(name, st);
+ if ( ( l < 8 || l > 9) || strnicmp(name, "/dev/", 5) != 0
+ || ( stricmp(name + 5, "con") != 0
+ && stricmp(name + 5, "tty") != 0
+ && stricmp(name + 5, "nul") != 0
+ && stricmp(name + 5, "null") != 0) ) {
+ int s = stat(name, st);
+
+ if (s)
+ return s;
+ massage_os2_attr(st);
+ return 0;
+ }
memset(st, 0, sizeof *st);
st->st_mode = S_IFCHR|0666;
@@ -1144,6 +1465,48 @@
return 0;
}
+int
+os2_fstat(int handle, struct stat *st)
+{
+ int s = fstat(handle, st);
+
+ if (s)
+ return s;
+ massage_os2_attr(st);
+ return 0;
+}
+
+#undef chmod
+int
+os2_chmod (const char *name, int pmode) /* Modelled after EMX
src/lib/io/chmod.c */
+{
+ int attr, rc;
+
+ if (!(pmode & os2_stat_force))
+ return chmod(name, pmode);
+
+ attr = __chmod (name, 0, 0); /* Get attributes */
+ if (attr < 0)
+ return -1;
+ if (pmode & S_IWRITE)
+ attr &= ~FILE_READONLY;
+ else
+ attr |= FILE_READONLY;
+ /* New logic */
+ attr &= ~(FILE_ARCHIVED | FILE_HIDDEN | FILE_SYSTEM);
+
+ if ( pmode & os2_stat_archived )
+ attr |= FILE_ARCHIVED;
+ if ( pmode & os2_stat_hidden )
+ attr |= FILE_HIDDEN;
+ if ( pmode & os2_stat_system )
+ attr |= FILE_SYSTEM;
+
+ rc = __chmod (name, 1, attr);
+ if (rc >= 0) rc = 0;
+ return rc;
+}
+
#endif
#ifdef USE_PERL_SBRK
@@ -1288,6 +1651,7 @@
char *
os2error(int rc)
{
+ dTHX;
static char buf[300];
ULONG len;
char *s;
@@ -1334,8 +1698,11 @@
CroakWinError(int die, char *name)
{
FillWinError;
- if (die && Perl_rc)
- croak("%s: %s", (name ? name : "Win* API call"), os2error(Perl_rc));
+ if (die && Perl_rc) {
+ dTHX;
+
+ Perl_croak(aTHX_ "%s: %s", (name ? name : "Win* API call"), os2error(Perl_rc));
+ }
}
char *
@@ -1443,6 +1810,7 @@
/* 64 messages if before OS/2 3.0, ignored otherwise */
Perl_hmq = (*PMWIN_entries.CreateMsgQueue)(perl_hab_GET(), 64);
if (!Perl_hmq) {
+ dTHX;
static int cnt;
SAVEINT(cnt); /* Allow catch()ing. */
@@ -2082,6 +2450,7 @@
static SV*
module_name_at(void *pp, enum module_name_how how)
{
+ dTHX;
char buf[MAXPATHLEN];
char *p = buf;
HMODULE mod;
@@ -2106,8 +2475,11 @@
static SV*
module_name_of_cv(SV *cv, enum module_name_how how)
{
- if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVCV || !CvXSUB(SvRV(cv)))
- croak("Not an XSUB reference");
+ if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVCV || !CvXSUB(SvRV(cv))) {
+ dTHX;
+
+ Perl_croak(aTHX_ "Not an XSUB reference");
+ }
return module_name_at(CvXSUB(SvRV(cv)), how);
}
@@ -2145,7 +2517,7 @@
{
dXSARGS;
if (items != 2)
- croak("Usage: OS2::_control87(new,mask)");
+ Perl_croak(aTHX_ "Usage: OS2::_control87(new,mask)");
{
unsigned new = (unsigned)SvIV(ST(0));
unsigned mask = (unsigned)SvIV(ST(1));
@@ -2162,7 +2534,7 @@
{
dXSARGS;
if (items != 0)
- croak("Usage: OS2::get_control87()");
+ Perl_croak(aTHX_ "Usage: OS2::get_control87()");
{
unsigned RETVAL;
@@ -2178,7 +2550,7 @@
{
dXSARGS;
if (items < 0 || items > 2)
- croak("Usage: OS2::set_control87(new=MCW_EM, mask=MCW_EM)");
+ Perl_croak(aTHX_ "Usage: OS2::set_control87(new=MCW_EM, mask=MCW_EM)");
{
unsigned new;
unsigned mask;
@@ -2599,7 +2971,9 @@
if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/';
}
}
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
MUTEX_INIT(&start_thread_mutex);
+#endif
os2_mytype = my_type(); /* Do it before morphing. Needed? */
/* Some DLLs reset FP flags on load. We may have been linked with them */
_control87(MCW_EM, MCW_EM);
@@ -2910,4 +3284,23 @@
gcvt_os2 (double value, int digits, char *buffer)
{
return gcvt (value, digits, buffer);
+}
+
+#undef fork
+int fork_with_resources()
+{
+#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) &&
!defined(USE_SLOW_THREAD_SPECIFIC)
+ dTHX;
+ void *ctx = PERL_GET_CONTEXT;
+#endif
+
+ int rc = fork();
+
+#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) &&
!defined(USE_SLOW_THREAD_SPECIFIC)
+ if (rc == 0) { /* child */
+ ALLOC_THREAD_KEY; /* Acquire the thread-local memory */
+ PERL_SET_CONTEXT(ctx); /* Reinit the thread-local memory */
+ }
+#endif
+ return rc;
}
==== //depot/perl/os2/os2ish.h#41 (text) ====
Index: perl/os2/os2ish.h
--- perl/os2/os2ish.h#40~18030~ Sat Oct 19 07:10:21 2002
+++ perl/os2/os2ish.h Tue Apr 1 08:32:03 2003
@@ -99,6 +99,111 @@
# undef I_SYS_UN
#endif
+#ifdef USE_ITHREADS
+
+#define do_spawn(a) os2_do_spawn(aTHX_ (a))
+#define do_aspawn(a,b,c) os2_do_aspawn(aTHX_ (a),(b),(c))
+
+#define OS2_ERROR_ALREADY_POSTED 299 /* Avoid os2.h */
+
+extern int rc;
+
+#define MUTEX_INIT(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_create(m,0))) \
+ Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_LOCK(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_request(m,_FMR_IGNINT))) \
+ Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_UNLOCK(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_release(m))) \
+ Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \
+ } STMT_END
+#define MUTEX_DESTROY(m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = _rmutex_close(m))) \
+ Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \
+ } STMT_END
+
+#define COND_INIT(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosCreateEventSem(NULL,c,0,0))) \
+ Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \
+ } STMT_END
+#define COND_SIGNAL(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
+ Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \
+ } STMT_END
+#define COND_BROADCAST(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\
+ Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \
+ } STMT_END
+/* #define COND_WAIT(c, m) \
+ STMT_START { \
+ if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
+ Perl_croak_nocontext("panic: COND_WAIT"); \
+ } STMT_END
+*/
+#define COND_WAIT(c, m) os2_cond_wait(c,m)
+
+#define COND_WAIT_win32(c, m) \
+ STMT_START { \
+ int rc; \
+ if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \
+ Perl_croak_nocontext("panic: COND_WAIT"); \
+ else \
+ MUTEX_LOCK(m); \
+ } STMT_END
+#define COND_DESTROY(c) \
+ STMT_START { \
+ int rc; \
+ if ((rc = DosCloseEventSem(*(c)))) \
+ Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \
+ } STMT_END
+/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
+*/
+
+#ifdef USE_SLOW_THREAD_SPECIFIC
+# define pthread_getspecific(k) (*_threadstore())
+# define pthread_setspecific(k,v) (*_threadstore()=v,0)
+# define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
+#else /* USE_SLOW_THREAD_SPECIFIC */
+# define pthread_getspecific(k) (*(k))
+# define pthread_setspecific(k,v) (*(k)=(v),0)
+# define pthread_key_create(keyp,flag) \
+ ( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \
+ ? Perl_croak_nocontext("LocalMemory"),1 \
+ : 0 \
+ )
+#endif /* USE_SLOW_THREAD_SPECIFIC */
+#define pthread_key_delete(keyp)
+#define pthread_self() _gettid()
+#define YIELD DosSleep(0)
+
+#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
+int pthread_join(pthread_t tid, void **status);
+int pthread_detach(pthread_t tid);
+int pthread_create(pthread_t *tid, const pthread_attr_t *attr,
+ void *(*start_routine)(void*), void *arg);
+#endif /* PTHREAD_INCLUDED */
+
+#define THREADS_ELSEWHERE
+
+#else /* USE_ITHREADS */
+
#define do_spawn(a) os2_do_spawn(a)
#define do_aspawn(a,b,c) os2_do_aspawn((a),(b),(c))
@@ -294,15 +399,19 @@
#if OS2_STAT_HACK
#define Stat(fname,bufptr) os2_stat((fname),(bufptr))
-#define Fstat(fd,bufptr) fstat((fd),(bufptr))
+#define Fstat(fd,bufptr) os2_fstat((fd),(bufptr))
#define Fflush(fp) fflush(fp)
#define Mkdir(path,mode) mkdir((path),(mode))
+#define chmod(path,mode) os2_chmod((path),(mode))
#undef S_IFBLK
#undef S_ISBLK
-#define S_IFBLK 0120000
+#define S_IFBLK 0120000 /* Hacks to make things compile... */
#define S_ISBLK(mode) (((mode) & S_IFMT) == S_IFBLK)
+int os2_chmod(const char *name, int pmode);
+int os2_fstat(int handle, struct stat *st);
+
#else
#define Stat(fname,bufptr) stat((fname),(bufptr))
@@ -563,11 +672,14 @@
#define PERLLIB_MANGLE(s, n) perllib_mangle((s), (n))
char *perllib_mangle(char *, unsigned int);
+#define fork fork_with_resources
+
typedef int (*Perl_PFN)();
Perl_PFN loadByOrdinal(enum entries_ordinals ord, int fail);
extern const Perl_PFN * const pExtFCN;
char *os2error(int rc);
int os2_stat(const char *name, struct stat *st);
+int fork_with_resources();
int setpriority(int which, int pid, int val);
int getpriority(int which /* ignored */, int pid);
==== //depot/perl/os2/os2thread.h#5 (text) ====
Index: perl/os2/os2thread.h
--- perl/os2/os2thread.h#4~3369~ Mon May 10 03:35:22 1999
+++ perl/os2/os2thread.h Tue Apr 1 08:32:03 2003
@@ -7,6 +7,7 @@
/*typedef HEV perl_cond;*/ /* Will include os2.h into all C files. */
typedef unsigned long perl_cond;
+int os2_cond_wait(perl_cond *c, perl_mutex *m);
#ifdef USE_SLOW_THREAD_SPECIFIC
typedef int perl_key;
==== //depot/perl/perlapi.h#84 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#83~18801~ Sun Mar 2 07:24:22 2003
+++ perl/perlapi.h Tue Apr 1 08:32:03 2003
@@ -490,8 +490,8 @@
#define PL_savebegin (*Perl_Isavebegin_ptr(aTHX))
#undef PL_sawampersand
#define PL_sawampersand (*Perl_Isawampersand_ptr(aTHX))
-#undef PL_sh_path
-#define PL_sh_path (*Perl_Ish_path_ptr(aTHX))
+#undef PL_sh_path_compat
+#define PL_sh_path_compat (*Perl_Ish_path_compat_ptr(aTHX))
#undef PL_sig_pending
#define PL_sig_pending (*Perl_Isig_pending_ptr(aTHX))
#undef PL_sighandlerp
@@ -928,6 +928,8 @@
#define PL_runops_dbg (*Perl_Grunops_dbg_ptr(NULL))
#undef PL_runops_std
#define PL_runops_std (*Perl_Grunops_std_ptr(NULL))
+#undef PL_sh_path
+#define PL_sh_path (*Perl_Gsh_path_ptr(NULL))
#undef PL_sharehook
#define PL_sharehook (*Perl_Gsharehook_ptr(NULL))
#undef PL_thr_key
==== //depot/perl/perlio.c#205 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#204~18935~ Tue Mar 11 14:00:54 2003
+++ perl/perlio.c Tue Apr 1 08:32:03 2003
@@ -3343,7 +3343,7 @@
#ifdef PERLIO_USING_CRLF
# ifdef PERLIO_IS_BINMODE_FD
if (PERLIO_IS_BINMODE_FD(fd))
- PerlIO_binmode(f, '<'/*not used*/, O_BINARY, Nullch);
+ PerlIO_binmode(aTHX_ f, '<'/*not used*/, O_BINARY, Nullch);
else
# endif
/*
==== //depot/perl/perlvars.h#49 (text) ====
Index: perl/perlvars.h
--- perl/perlvars.h#48~18807~ Sun Mar 2 13:22:56 2003
+++ perl/perlvars.h Tue Apr 1 08:32:03 2003
@@ -66,3 +66,6 @@
#ifdef USE_ITHREADS
PERLVAR(Gdollarzero_mutex, perl_mutex) /* Modifying $0 */
#endif
+
+/* This is constant on most architectures, a global on OS/2 */
+PERLVARI(Gsh_path, char *, SH_PATH)/* full path of shell */
==== //depot/perl/reentr.c#12 (text) ====
Index: perl/reentr.c
--- perl/reentr.c#11~18919~ Tue Mar 11 09:43:10 2003
+++ perl/reentr.c Tue Apr 1 08:32:03 2003
@@ -146,7 +146,7 @@
New(31338, PL_reentrant_buffer->_asctime_buffer,
PL_reentrant_buffer->_asctime_size, char);
#endif /* HAS_ASCTIME_R */
#ifdef HAS_CRYPT_R
-#ifdef __GLIBC__
+#if defined(__GLIBC__) || defined(__EMX__)
PL_reentrant_buffer->_crypt_struct.initialized = 0;
/* work around glibc-2.2.5 bug */
PL_reentrant_buffer->_crypt_struct.current_saltbits = 0;
==== //depot/perl/reentr.pl#26 (text) ====
Index: perl/reentr.pl
--- perl/reentr.pl#25~18919~ Tue Mar 11 09:43:10 2003
+++ perl/reentr.pl Tue Apr 1 08:32:03 2003
@@ -457,7 +457,7 @@
#endif
EOF
push @init, <<EOF;
-#ifdef __GLIBC__
+#if defined(__GLIBC__) || defined(__EMX__)
PL_reentrant_buffer->_${func}_struct.initialized = 0;
/* work around glibc-2.2.5 bug */
PL_reentrant_buffer->_${func}_struct.current_saltbits = 0;
==== //depot/perl/sv.c#648 (text) ====
Index: perl/sv.c
--- perl/sv.c#647~19083~ Sat Mar 29 23:49:46 2003
+++ perl/sv.c Tue Apr 1 08:32:03 2003
@@ -11027,7 +11027,7 @@
PL_origalen = proto_perl->Iorigalen;
PL_pidstatus = newHV(); /* XXX flag for cloning? */
PL_osname = SAVEPV(proto_perl->Iosname);
- PL_sh_path = proto_perl->Ish_path; /* XXX never deallocated */
+ PL_sh_path_compat = proto_perl->Ish_path_compat; /* XXX never deallocated */
PL_sighandlerp = proto_perl->Isighandlerp;
End of Patch.
