Integrate:

[ 19106]
Subject: [PATCH 5.8.1 @19053] OS/2-related patches
Message-ID: <20030331204337.GA3634@math.berkeley.edu>

and regen Configure.
p4raw-link: @19106 on //depot/maint-5.8/perl: 8257dec7ed17c0d4d721411d2a781ceadf724da5

p4raw-id: //depot/perl@19120
p4raw-edited: from //depot/maint-5.8/perl@19118 'edit in' embedvar.h
	(@18804..)
p4raw-integrated: from //depot/maint-5.8/perl@19118 'copy in'
	os2/Makefile.SHs os2/OS2/ExtAttr/Changes
	os2/OS2/ExtAttr/ExtAttr.pm os2/OS2/PrfDB/Changes
	os2/OS2/PrfDB/PrfDB.pm os2/OS2/REXX/DLL/DLL.pm
	os2/OS2/REXX/REXX.pm os2/dl_os2.c os2/os2thread.h (@17645..)
	ext/threads/threads.xs (@18619..) perlio.c (@18948..)
	Makefile.SH (@19061..) 'ignore' embed.pl (@18872..) embed.h
	(@19011..) embed.fnc (@19030..) 'merge in' os2/os2ish.h
	(@17645..) os2/os2.c (@18347..) perlapi.h (@18804..) perlvars.h
	(@18808..) makedef.pl (@18896..) intrpvar.h (@18920..) sv.c
	(@18961..)
p4raw-edited: from //depot/maint-5.8/perl@19106 'edit in' Configure
	(@19040..)
p4raw-integrated: from //depot/maint-5.8/perl@19106 'copy in' reentr.h
	(@18850..) reentr.c reentr.pl (@18922..)

11 files changed, 555 insertions, 53 deletions

diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs
index ba3744457f..baefec987f 100644
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -27,7 +27,6 @@ $spitshell >>Makefile <<!GROK!THIS!
 
 PERL_FULLVERSION = $perl_fullversion
 
-OPTIMIZE	= $optimize
 AOUT_OPTIMIZE	= \$(OPTIMIZE)
 AOUT_CCCMD	= \$(CC) -DPERL_CORE $aout_ccflags \$(AOUT_OPTIMIZE)
 AOUT_AR		= $aout_ar
diff --git a/os2/OS2/ExtAttr/Changes b/os2/OS2/ExtAttr/Changes
index 55fdc5f6d5..92b51826cc 100644
--- a/os2/OS2/ExtAttr/Changes
+++ b/os2/OS2/ExtAttr/Changes
@@ -3,3 +3,5 @@ Revision history for Perl extension OS2::ExtAttr.
 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.
diff --git a/os2/OS2/ExtAttr/ExtAttr.pm b/os2/OS2/ExtAttr/ExtAttr.pm
index bebbcc963e..c49f1d4de5 100644
--- a/os2/OS2/ExtAttr/ExtAttr.pm
+++ b/os2/OS2/ExtAttr/ExtAttr.pm
@@ -1,21 +1,10 @@
 package OS2::ExtAttr;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT);
+use XSLoader;
 
-require Exporter;
-require DynaLoader;
-
-@ISA = 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.
-@EXPORT = qw(
-	
-);
-$VERSION = '0.01';
-
-bootstrap OS2::ExtAttr $VERSION;
+our $VERSION = '0.02';
+XSLoader::load 'OS2::ExtAttr', $VERSION;
 
 # Preloaded methods go here.
 
diff --git a/os2/OS2/PrfDB/Changes b/os2/OS2/PrfDB/Changes
index 3e8bf3f580..49ac8c1a43 100644
--- a/os2/OS2/PrfDB/Changes
+++ b/os2/OS2/PrfDB/Changes
@@ -3,3 +3,4 @@ Revision history for Perl extension OS2::PrfDB.
 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'.
diff --git a/os2/OS2/PrfDB/PrfDB.pm b/os2/OS2/PrfDB/PrfDB.pm
index 41d7dba2f1..328f4dcd5d 100644
--- a/os2/OS2/PrfDB/PrfDB.pm
+++ b/os2/OS2/PrfDB/PrfDB.pm
@@ -1,21 +1,22 @@
 package OS2::PrfDB;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT);
 
 require Exporter;
-require DynaLoader;
+use XSLoader;
+use Tie::Hash;
 
-@ISA = 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.
-@EXPORT = 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 @@ sub SystemIni {
   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 @@ sub DESTROY {
 }
 
 package OS2::PrfDB::Sub;
-use vars qw{$debug @ISA};
 use Tie::Hash;
-@ISA = qw{Tie::Hash};
+
+our $debug;
+our @ISA = qw{Tie::Hash};
 
 # Internal structure 0 => HINI, 1 => array of entries, 2 => iterator,
 # 3 => appname.
diff --git a/os2/OS2/REXX/DLL/DLL.pm b/os2/OS2/REXX/DLL/DLL.pm
index f9be9e433c..09e3e37a08 100644
--- a/os2/OS2/REXX/DLL/DLL.pm
+++ b/os2/OS2/REXX/DLL/DLL.pm
@@ -3,9 +3,7 @@ package OS2::DLL;
 our $VERSION = '1.00';
 
 use Carp;
-use DynaLoader;
-
-@ISA = qw(DynaLoader);
+use XSLoader;
 
 sub AUTOLOAD {
     $AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/
@@ -86,7 +84,7 @@ EOE
 	return 1;
 }
 
-bootstrap OS2::DLL;
+XSLoader::load 'OS2::DLL';
 
 1;
 __END__
diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm
index 57e6d6d1a4..88b624f233 100644
--- a/os2/OS2/REXX/REXX.pm
+++ b/os2/OS2/REXX/REXX.pm
@@ -1,18 +1,17 @@
 package OS2::REXX;
 
-use Carp;
 require Exporter;
-require DynaLoader;
+use XSLoader;
 require OS2::DLL;
 
-@ISA = qw(Exporter DynaLoader);
+@ISA = 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 @@ $VERSION = '1.01';
 *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.
diff --git a/os2/dl_os2.c b/os2/dl_os2.c
index 5c8b6e6871..b698451b08 100644
--- a/os2/dl_os2.c
+++ b/os2/dl_os2.c
@@ -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;
diff --git a/os2/os2.c b/os2/os2.c
index 49b1736ab8..0490449f0d 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -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 @@ int	setgid(x)	{ errno = EINVAL; return -1; }
 
 #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;
-
-    if (stricmp(name, "/dev/con") != 0
-     && stricmp(name, "/dev/tty") != 0)
-	return stat(name, st);
+    STRLEN l = strlen(name);
+
+    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 @@ os2_stat(const char *name, struct stat *st)
     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 @@ XS(XS_DynaLoader_mod2fname)
 char *
 os2error(int rc)
 {
+	dTHX;
 	static char buf[300];
 	ULONG len;
 	char *s;
@@ -1334,8 +1698,11 @@ void
 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 @@ Perl_Register_MQ(int serve)
     /* 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 @@ enum module_name_how { mod_name_handle, mod_name_shortname, mod_name_full};
 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 @@ module_name_at(void *pp, enum module_name_how how)
 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 @@ XS(XS_OS2__control87)
 {
     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 @@ XS(XS_OS2_get_control87)
 {
     dXSARGS;
     if (items != 0)
-	croak("Usage: OS2::get_control87()");
+	Perl_croak(aTHX_ "Usage: OS2::get_control87()");
     {
 	unsigned	RETVAL;
 
@@ -2178,7 +2550,7 @@ XS(XS_OS2_set_control87)
 {
     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 @@ Perl_OS2_init3(char **env, void **preg, int flags)
 	    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);
@@ -2911,3 +3285,22 @@ 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;
+}
diff --git a/os2/os2ish.h b/os2/os2ish.h
index 20e413a837..c6baad554a 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -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 @@ char *ctermid(char *s);
 #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 @@ void CroakWinError(int die, char *name);
 #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);
 
diff --git a/os2/os2thread.h b/os2/os2thread.h
index 9516ddda0b..e4f8360f9c 100644
--- a/os2/os2thread.h
+++ b/os2/os2thread.h
@@ -7,6 +7,7 @@ typedef _rmutex perl_mutex;
 
 /*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;