Threading patches for OS/2 (missing files taken from previous patch):

	Subject: Re: 5.004_55: OS/2 patches again

p4raw-id: //depot/perl@371

11 files changed, 309 insertions, 23 deletions

diff --git a/MANIFEST b/MANIFEST
index bca11c9d9e..7585e5b4ee 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -535,6 +535,8 @@ os2/dlfcn.h		Addon for dl_open
 os2/os2.c		Additional code for OS/2
 os2/os2ish.h		Header for OS/2
 os2/perl2cmd.pl		Corrects installed binaries under OS/2
+os2/os2thread.h		pthread-like typedefs
+os2/os2.sym		Additional symbols to export
 patchlevel.h		The current patch level of perl
 perl.c			main()
 perl.h			Global declarations
diff --git a/hints/os2.sh b/hints/os2.sh
index 2a589b5cb4..a012a7317a 100644
--- a/hints/os2.sh
+++ b/hints/os2.sh
@@ -245,6 +245,15 @@ case "X$optimize" in
 	;;
 esac
 
+if [ "X$usethreads" != "X" ]; then
+    ccflags="-DUSE_THREADS -Zmt $ccflags"
+    cppflags="-DUSE_THREADS -Zmt $cppflags"
+    aout_ccflags="-DUSE_THREADS $aout_ccflags"
+    aout_cppflags="-DUSE_THREADS $aout_cppflags"
+    aout_lddlflags="-Zmt $aout_lddlflags"
+    aout_ldflags="-Zmt $aout_ldflags"
+fi
+
 # The next two are commented. pdksh handles #!, extproc gives no path part.
 # sharpbang='extproc '
 # shsharp='false'
diff --git a/os2/Changes b/os2/Changes
index 4e0c4d49b5..a46b7a52a4 100644
--- a/os2/Changes
+++ b/os2/Changes
@@ -163,3 +163,6 @@ after 5.004_03:
 	changes to errno?)
 	$0 may be edited to longer lengths (at least under OS/2).
 	OS2::REXX->loads looks in the OS/2-ish fashion too.
+
+after 5.004_53:
+	Minimal thread support added.  One needs to manually move pthread.h
diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs
index 493aeab8c5..57d42602e9 100644
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -8,7 +8,8 @@
 
 $spitshell >>Makefile <<!GROK!THIS!
 
-AOUT_CCCMD	= \$(CC) $aout_ccflags $optimize
+AOUT_OPTIMIZE = $optimize
+AOUT_CCCMD	= \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
 AOUT_AR		= $aout_ar
 AOUT_OBJ_EXT	= $aout_obj_ext
 AOUT_LIB_EXT	= $aout_lib_ext
@@ -47,16 +48,6 @@ perl5.def: perl.linkexp
 	echo CODE LOADONCALL				>>$@
 	echo DATA LOADONCALL NONSHARED MULTIPLE		>>$@
 	echo EXPORTS					>>$@
-	echo '  "ctermid"'				>>$@
-	echo '  "get_sysinfo"'				>>$@
-	echo '  "Perl_OS2_init"'			>>$@
-	echo '  "OS2_Perl_data"'			>>$@
-	echo '  "dlopen"'				>>$@
-	echo '  "dlsym"'				>>$@
-	echo '  "dlerror"'				>>$@
-	echo '  "my_tmpfile"'				>>$@
-	echo '  "my_tmpnam"'				>>$@
-	echo '  "my_flock"'				>>$@
 !NO!SUBS!
 
 if [ ! -z "$myttyname" ] ; then
@@ -78,7 +69,7 @@ perl.exports: perl.exp EXTERN.h perl.h
 		awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
 
 perl.linkexp: perl.exports perl.map
-	cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/  "\0"/' > perl.linkexp
+	cat perl.exports os2/os2.sym perl.map | sort | uniq -d | sed -e 's/\w\+/  "\0"/' > perl.linkexp
 
 # We link miniperl statically, since .DLL depends on $(DYNALOADER) 
 
@@ -88,7 +79,7 @@ perl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT)
 	rm miniperl.map
 	@./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
 
-depend: os2ish.h dlfcn.h 
+depend: os2ish.h dlfcn.h os2thread.h os2.c
 
 # Stupid make? Needed...
 os2$(OBJ_EXT) : os2.c
@@ -102,6 +93,9 @@ dl_os2.c: os2/dl_os2.c os2ish.h
 os2ish.h: os2/os2ish.h
 	cp $< $@
 
+os2thread.h: os2/os2thread.h
+	cp $< $@
+
 dlfcn.h: os2/dlfcn.h
 	cp $< $@
 
diff --git a/os2/OS2/PrfDB/PrfDB.xs b/os2/OS2/PrfDB/PrfDB.xs
index a5b2c89ca6..5465e1d136 100644
--- a/os2/OS2/PrfDB/PrfDB.xs
+++ b/os2/OS2/PrfDB/PrfDB.xs
@@ -22,7 +22,7 @@ Prf_Get(HINI hini, PSZ app, PSZ key) {
 
     if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &sv_undef;
     sv = newSVpv("", 0);
-    SvGROW(sv, len);
+    SvGROW(sv, len + 1);
     if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
 	|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
 	SvREFCNT_dec(sv);
diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs
index df7646c42e..43c92c8b46 100644
--- a/os2/OS2/REXX/REXX.xs
+++ b/os2/OS2/REXX/REXX.xs
@@ -46,6 +46,7 @@ static long incompartment;
 static SV*
 exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
 {
+    dTHR;
     HMODULE hRexx, hRexxAPI;
     BYTE    buf[200];
     LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, 
diff --git a/os2/os2.c b/os2/os2.c
index 44f99c4c24..fe7f99bb7e 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -18,6 +18,157 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef USE_THREADS
+
+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,
+};
+const char *pthreads_states[] = {
+    "uninit",
+    "running",
+    "exited",
+    "detached",
+    "waited for",
+};
+
+typedef struct {
+    void *status;
+    pthread_cond_t cond;
+    enum pthreads_state state;
+} thread_join_t;
+
+thread_join_t *thread_join_data;
+int thread_join_count;
+pthread_mutex_t start_thread_mutex;
+
+int
+pthread_join(pthread_t tid, void **status)
+{
+    MUTEX_LOCK(&start_thread_mutex);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_exited:
+	thread_join_data[tid].state = pthreads_st_none;	/* Ready to reuse */
+	MUTEX_UNLOCK(&start_thread_mutex);
+	*status = thread_join_data[tid].status;
+	break;
+    case pthreads_st_waited:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("join with a thread with a waiter");
+	break;
+    case pthreads_st_run:
+	thread_join_data[tid].state = pthreads_st_waited;
+	COND_INIT(&thread_join_data[tid].cond);
+	MUTEX_UNLOCK(&start_thread_mutex);
+	COND_WAIT(&thread_join_data[tid].cond, NULL);    
+	COND_DESTROY(&thread_join_data[tid].cond);
+	thread_join_data[tid].state = pthreads_st_none;	/* Ready to reuse */
+	*status = thread_join_data[tid].status;
+	break;
+    default:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("join: unknown thread state: '%s'", 
+	      pthreads_states[thread_join_data[tid].state]);
+	break;
+    }
+    return 0;
+}
+
+void
+pthread_startit(void *arg)
+{
+    /* Thread is already started, we need to transfer control only */
+    pthreads_startroutine start_routine = *((pthreads_startroutine*)arg);
+    int tid = pthread_self();
+    void *retval;
+    
+    arg = ((void**)arg)[1];
+    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)
+	croak("attempt to reuse thread id %i", tid);
+    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);
+    thread_join_data[tid].status = (*start_routine)(arg);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_waited:
+	COND_SIGNAL(&thread_join_data[tid].cond);    
+	break;
+    default:
+	thread_join_data[tid].state = pthreads_st_exited;
+	break;
+    }
+}
+
+int
+pthread_create(pthread_t *tid, const pthread_attr_t *attr, 
+	       void *(*start_routine)(void*), void *arg)
+{
+    void *args[2];
+
+    args[0] = (void*)start_routine;
+    args[1] = arg;
+
+    MUTEX_LOCK(&start_thread_mutex);
+    *tid = _beginthread(pthread_startit, /*stack*/ NULL, 
+			/*stacksize*/ 10*1024*1024, (void*)args);
+    MUTEX_LOCK(&start_thread_mutex);
+    MUTEX_UNLOCK(&start_thread_mutex);
+    return *tid ? 0 : EINVAL;
+}
+
+int 
+pthread_detach(pthread_t tid)
+{
+    MUTEX_LOCK(&start_thread_mutex);
+    switch (thread_join_data[tid].state) {
+    case pthreads_st_waited:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("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;
+    default:
+	MUTEX_UNLOCK(&start_thread_mutex);
+	croak("detach: unknown thread state: '%s'", 
+	      pthreads_states[thread_join_data[tid].state]);
+	break;
+    }
+    return 0;
+}
+
+/* This is a very bastardized version: */
+int
+os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m)
+{						
+    int rc;
+    if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET))
+	croak("panic: COND_WAIT-reset: rc=%i", rc);		
+    if (m) MUTEX_UNLOCK(m);					
+    if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)))
+	croak("panic: COND_WAIT: rc=%i", rc);		
+    if (m) MUTEX_LOCK(m);					
+} 
+#endif 
+
 /*****************************************************************************/
 /* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
 static PFN ExtFCN[2];			/* Labeled by ord below. */
@@ -202,6 +353,7 @@ SV *really;
 register SV **mark;
 register SV **sp;
 {
+    dTHR;
     register char **a;
     char *tmps = NULL;
     int rc;
@@ -1169,6 +1321,7 @@ Perl_OS2_init(char **env)
 	    if (sh_path[i] == '\\') sh_path[i] = '/';
 	}
     }
+    MUTEX_INIT(&start_thread_mutex);
 }
 
 #undef tmpnam
@@ -1206,7 +1359,7 @@ my_tmpfile ()
 
 /* This code was contributed by Rocco Caputo. */
 int 
-my_flock(int handle, int op)
+my_flock(int handle, int o)
 {
   FILELOCK      rNull, rFull;
   ULONG         timeout, handle_type, flag_word;
@@ -1222,7 +1375,7 @@ my_flock(int handle, int op)
 	use_my = 1;
   }
   if (!(_emx_env & 0x200) || !use_my) 
-    return flock(handle, op);	/* Delegate to EMX. */
+    return flock(handle, o);	/* Delegate to EMX. */
   
                                         // is this a file?
   if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) ||
@@ -1235,11 +1388,11 @@ my_flock(int handle, int op)
   rNull.lOffset = rNull.lRange = rFull.lOffset = 0;
   rFull.lRange = 0x7FFFFFFF;
                                         // set timeout for blocking
-  timeout = ((blocking = !(op & LOCK_NB))) ? 100 : 1;
+  timeout = ((blocking = !(o & LOCK_NB))) ? 100 : 1;
                                         // shared or exclusive?
-  shared = (op & LOCK_SH) ? 1 : 0;
+  shared = (o & LOCK_SH) ? 1 : 0;
                                         // do not block the unlock
-  if (op & (LOCK_UN | LOCK_SH | LOCK_EX)) {
+  if (o & (LOCK_UN | LOCK_SH | LOCK_EX)) {
     rc = DosSetFileLocks(handle, &rFull, &rNull, timeout, shared);
     switch (rc) {
       case 0:
@@ -1267,7 +1420,7 @@ my_flock(int handle, int op)
     }
   }
                                         // lock may block
-  if (op & (LOCK_SH | LOCK_EX)) {
+  if (o & (LOCK_SH | LOCK_EX)) {
                                         // for blocking operations
     for (;;) {
       rc =
diff --git a/os2/os2.sym b/os2/os2.sym
new file mode 100644
index 0000000000..3c794ec95e
--- /dev/null
+++ b/os2/os2.sym
@@ -0,0 +1,18 @@
+ctermid
+get_sysinfo
+Perl_OS2_init
+OS2_Perl_data
+dlopen
+dlsym
+dlerror
+my_tmpfile
+my_tmpnam
+my_flock
+malloc_mutex
+threads_mutex
+nthreads
+nthreads_cond
+os2_cond_wait
+pthread_join
+pthread_create
+pthread_detach
diff --git a/os2/os2ish.h b/os2/os2ish.h
index 9a3d267ae5..4895538d6e 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -64,6 +64,98 @@
 /* It is not working without TCPIPV4 defined. */
 # undef I_SYS_UN
 #endif 
+
+#ifdef USE_THREADS
+
+#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)))				\
+	    croak("panic: MUTEX_INIT: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_LOCK(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_request(m,_FMR_IGNINT)))		\
+	    croak("panic: MUTEX_LOCK: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_UNLOCK(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_release(m)))				\
+	    croak("panic: MUTEX_UNLOCK: rc=%i", rc);		\
+    } STMT_END
+#define MUTEX_DESTROY(m) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = _rmutex_close(m)))				\
+	    croak("panic: MUTEX_DESTROY: rc=%i", rc);		\
+    } STMT_END
+
+#define COND_INIT(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosCreateEventSem(NULL,c,0,0)))		\
+	    croak("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)		\
+	    croak("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)\
+	    croak("panic: COND_BROADCAST, rc=%i", rc);		\
+    } STMT_END
+/* #define COND_WAIT(c, m) \
+    STMT_START {						\
+	if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED)	\
+	    croak("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)))\
+	    croak("panic: COND_WAIT");				\
+	else							\
+	    MUTEX_LOCK(m);					\
+    } STMT_END
+#define COND_DESTROY(c) \
+    STMT_START {						\
+	int rc;							\
+	if ((rc = DosCloseEventSem(*(c))))			\
+	    croak("panic: COND_DESTROY, rc=%i", rc);		\
+    } STMT_END
+/*#define THR ((struct thread *) TlsGetValue(thr_key))
+#define dTHR struct thread *thr = THR
+*/
+
+#define pthread_getspecific(k)		(*_threadstore())
+#define pthread_setspecific(k,v)	(*_threadstore()=v,0)
+#define pthread_self()			_gettid()
+#define pthread_key_create(keyp,flag)	(*keyp=_gettid(),0)
+#define sched_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 
+
+#define THREADS_ELSEWHERE
+
+#endif 
  
 void Perl_OS2_init(char **);
 
diff --git a/os2/os2thread.h b/os2/os2thread.h
new file mode 100644
index 0000000000..44dec3f244
--- /dev/null
+++ b/os2/os2thread.h
@@ -0,0 +1,10 @@
+#include <sys/builtin.h>
+#include <sys/fmutex.h>
+#include <sys/rmutex.h>
+typedef int pthread_t;
+typedef _rmutex pthread_mutex_t;
+/*typedef HEV pthread_cond_t;*/
+typedef unsigned long pthread_cond_t;
+typedef int pthread_key_t;
+typedef unsigned long pthread_attr_t;
+#define PTHREADS_INCLUDED
diff --git a/perl.h b/perl.h
index 63367e0cc1..67a171afa3 100644
--- a/perl.h
+++ b/perl.h
@@ -965,8 +965,8 @@ typedef I32 (*filter_t) _((int, SV *, int));
 #endif         
 
 /* 
- * USE_THREADS needs to be after unixish.h as <pthread.h> includes <sys/signal.h>
- * which defines NSIG - which will stop inclusion of <signal.h>
+ * USE_THREADS needs to be after unixish.h as <pthread.h> includes
+ * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
  * this results in many functions being undeclared which bothers C++
  * May make sense to have threads after "*ish.h" anyway
  */
@@ -978,11 +978,15 @@ typedef I32 (*filter_t) _((int, SV *, int));
 #    ifdef WIN32
 #      include <win32thread.h>
 #    else
-#      include <pthread.h>
+#      ifdef OS2
+#        include "os2thread.h"
+#      else
+#        include <pthread.h>
 typedef pthread_t perl_os_thread;
 typedef pthread_mutex_t perl_mutex;
 typedef pthread_cond_t perl_cond;
 typedef pthread_key_t perl_key;
+#      endif /* OS2 */
 #    endif /* WIN32 */
 #  endif /* FAKE_THREADS */
 #endif /* USE_THREADS */