diff options
Diffstat (limited to 'os2')
| -rw-r--r-- | os2/Changes | 3 | ||||
| -rw-r--r-- | os2/Makefile.SHs | 20 | ||||
| -rw-r--r-- | os2/OS2/PrfDB/PrfDB.xs | 2 | ||||
| -rw-r--r-- | os2/OS2/REXX/REXX.xs | 1 | ||||
| -rw-r--r-- | os2/os2.c | 165 | ||||
| -rw-r--r-- | os2/os2.sym | 18 | ||||
| -rw-r--r-- | os2/os2ish.h | 92 | ||||
| -rw-r--r-- | os2/os2thread.h | 10 |
8 files changed, 291 insertions, 20 deletions
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, @@ -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 |