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
;;
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'
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
$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
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
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)
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
os2ish.h: os2/os2ish.h
cp $< $@
+os2thread.h: os2/os2thread.h
+ cp $< $@
+
dlfcn.h: os2/dlfcn.h
cp $< $@
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);
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,
#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. */
register SV **mark;
register SV **sp;
{
+ dTHR;
register char **a;
char *tmps = NULL;
int rc;
if (sh_path[i] == '\\') sh_path[i] = '/';
}
}
+ MUTEX_INIT(&start_thread_mutex);
}
#undef tmpnam
/* 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;
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) ||
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:
}
}
// lock may block
- if (op & (LOCK_SH | LOCK_EX)) {
+ if (o & (LOCK_SH | LOCK_EX)) {
// for blocking operations
for (;;) {
rc =
--- /dev/null
+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
/* 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 **);
--- /dev/null
+#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
#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
*/
# 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 */
projects / platform / upstream / perl.git / commitdiff