diff options
Diffstat (limited to 'os2')
| -rw-r--r-- | os2/Changes | 4 | ||||
| -rw-r--r-- | os2/Makefile.SHs | 36 | ||||
| -rw-r--r-- | os2/os2.c | 267 | ||||
| -rw-r--r-- | os2/os2thread.h | 16 | ||||
| -rw-r--r-- | os2/perl2cmd.pl | 2 |
5 files changed, 216 insertions, 109 deletions
diff --git a/os2/Changes b/os2/Changes index a46b7a52a4..344939c891 100644 --- a/os2/Changes +++ b/os2/Changes @@ -166,3 +166,7 @@ after 5.004_03: after 5.004_53: Minimal thread support added. One needs to manually move pthread.h + +after 5.004_64: + Make DLL names different if thread-enabled. + Emit more informative internal DLL descriptions. diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 57d42602e9..fd3766e0d6 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -6,8 +6,17 @@ # Additional rules supported: perl_, aout_test, aout_install, use them # for a.out style perl (which may fork). +perl_version="5.00${PATCHLEVEL}_$SUBVERSION" +case "$archname" in + *-thread) dll_post=_thr + perl_version="${perl_version}-threaded";; + *) dll_post='' ;; +esac + $spitshell >>Makefile <<!GROK!THIS! +PERL_VERSION = $perl_version + AOUT_OPTIMIZE = $optimize AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE) AOUT_AR = $aout_ar @@ -18,17 +27,20 @@ AOUT_CLDFLAGS = $aout_ldflags AOUT_LIBPERL_DLL = libperl_dll$aout_lib_ext AOUT_CCCMD_DLL = \$(CC) -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC -DDEBUGGING_MSTATS -DTWO_POT_OPTIMIZE -DPERL_EMERGENCY_SBRK -AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll +AOUT_CLDFLAGS_DLL = -Zexe -Zmt -Zcrtdll -Zstack 32000 LD_OPT = $optimize +PERL_DLL_BASE = perl$dll_post +PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX) + !GROK!THIS! $spitshell >>Makefile <<'!NO!SUBS!' -$(LIBPERL): perl.imp perl.dll perl5.def +$(LIBPERL): perl.imp $(PERL_DLL) perl5.def emximp -o $(LIBPERL) perl.imp -$(AOUT_LIBPERL_DLL): perl.imp perl.dll perl5.def +$(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def emximp -o $(AOUT_LIBPERL_DLL) perl.imp perl.imp: perl5.def @@ -38,12 +50,12 @@ perl.imp: perl5.def echo 'emx_malloc emxlibcm 402 ?' >> $@ echo 'emx_realloc emxlibcm 403 ?' >> $@ -perl.dll: $(obj) perl5.def perl$(OBJ_EXT) +$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT) $(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def perl5.def: perl.linkexp - echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE" > $@ - echo DESCRIPTION "'Perl interpreter, export autogenerated'" >>$@ + echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@ + echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'" >>$@ echo STACKSIZE 32768 >>$@ echo CODE LOADONCALL >>$@ echo DATA LOADONCALL NONSHARED MULTIPLE >>$@ @@ -68,7 +80,7 @@ perl.exports: perl.exp EXTERN.h perl.h $(CC) -DEMBED -E - | \ awk '{if ($$2 == "") print $$1}' | sort | uniq > $@ -perl.linkexp: perl.exports perl.map +perl.linkexp: perl.exports perl.map os2/os2.sym 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) @@ -85,19 +97,19 @@ depend: os2ish.h dlfcn.h os2thread.h os2.c os2$(OBJ_EXT) : os2.c os2.c: os2/os2.c os2ish.h - cp $< $@ + cp -f $< $@ dl_os2.c: os2/dl_os2.c os2ish.h - cp $< $@ + cp -f $< $@ os2ish.h: os2/os2ish.h - cp $< $@ + cp -f $< $@ os2thread.h: os2/os2thread.h - cp $< $@ + cp -f $< $@ dlfcn.h: os2/dlfcn.h - cp $< $@ + cp -f $< $@ # This one is compiled OMF, so cannot fork(): @@ -40,16 +40,16 @@ const char *pthreads_states[] = { typedef struct { void *status; - pthread_cond_t cond; + perl_cond cond; enum pthreads_state state; } thread_join_t; thread_join_t *thread_join_data; int thread_join_count; -pthread_mutex_t start_thread_mutex; +perl_mutex start_thread_mutex; int -pthread_join(pthread_t tid, void **status) +pthread_join(perl_os_thread tid, void **status) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -117,7 +117,7 @@ pthread_startit(void *arg) } int -pthread_create(pthread_t *tid, const pthread_attr_t *attr, +pthread_create(perl_os_thread *tid, const pthread_attr_t *attr, void *(*start_routine)(void*), void *arg) { void *args[2]; @@ -134,7 +134,7 @@ pthread_create(pthread_t *tid, const pthread_attr_t *attr, } int -pthread_detach(pthread_t tid) +pthread_detach(perl_os_thread tid) { MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { @@ -157,7 +157,7 @@ pthread_detach(pthread_t tid) /* This is a very bastardized version: */ int -os2_cond_wait(pthread_cond_t *c, pthread_mutex_t *m) +os2_cond_wait(perl_cond *c, perl_mutex *m) { int rc; if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET)) @@ -347,40 +347,37 @@ result(int flag, int pid) #endif } +#define EXECF_SPAWN 0 +#define EXECF_EXEC 1 +#define EXECF_TRUEEXEC 2 +#define EXECF_SPAWN_NOWAIT 3 + +/* Spawn/exec a program, revert to shell if needed. */ +/* global Argv[] contains arguments. */ + int -do_aspawn(really,mark,sp) +do_aspawn(really, flag, execf) SV *really; -register SV **mark; -register SV **sp; +U32 flag; +U32 execf; { dTHR; - register char **a; - char *tmps = NULL; - int rc; - int flag = P_WAIT, trueflag, err, secondtry = 0; - - if (sp > mark) { - New(1301,Argv, sp - mark + 3, char*); - a = Argv; - - if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { - ++mark; - flag = SvIVx(*mark); - } - - while (++mark <= sp) { - if (*mark) - *a++ = SvPVx(*mark, na); - else - *a++ = ""; - } - *a = Nullch; - - trueflag = flag; + int trueflag = flag; + int rc, secondtry = 0, err; + char *tmps; + char buf[256], *s = 0; + char *args[4]; + static char * fargs[4] + = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; + char **argsp = fargs; + char nargs = 4; + if (flag == P_WAIT) flag = P_NOWAIT; - if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path; + retry: + if (strEQ(Argv[0],"/bin/sh")) + Argv[0] = sh_path; if (Argv[0][0] != '/' && Argv[0][0] != '\\' && !(Argv[0][0] && Argv[0][1] == ':' @@ -388,18 +385,29 @@ register SV **sp; ) /* will swawnvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ /* We should check PERL_SH* and PERLLIB_* as well? */ - retry: - if (really && *(tmps = SvPV(really, na))) - rc = result(trueflag, spawnvp(flag,tmps,Argv)); - else - rc = result(trueflag, spawnvp(flag,Argv[0],Argv)); - + if (!really || !*(tmps = SvPV(really, na))) + tmps = Argv[0]; +#if 0 + rc = result(trueflag, spawnvp(flag,tmps,Argv)); +#else + if (execf == EXECF_TRUEEXEC) + rc = execvp(tmps,Argv); + else if (execf == EXECF_EXEC) + rc = spawnvp(trueflag | P_OVERLAY,tmps,Argv); + else if (execf == EXECF_SPAWN_NOWAIT) + rc = spawnvp(trueflag | P_NOWAIT,tmps,Argv); + else /* EXECF_SPAWN */ + rc = result(trueflag, + spawnvp(trueflag | P_NOWAIT,tmps,Argv)); +#endif if (rc < 0 && secondtry == 0 - && (!tmps || !*tmps)) { /* Cannot transfer `really' via shell. */ + && (tmps == Argv[0])) { /* Cannot transfer `really' via shell. */ err = errno; if (err == ENOENT) { /* No such file. */ /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ + that .exe-less files are automatically shellable. + It might have also been .cmd file without + extension. */ char *no_dir; (no_dir = strrchr(Argv[0], '/')) || (no_dir = strrchr(Argv[0], '\\')) @@ -409,34 +417,139 @@ register SV **sp; if (stat(Argv[0], &buffer) != -1) { /* File exists. */ /* Maybe we need to specify the full name here? */ goto doshell; + } else { + /* Try adding script extensions to the file name */ + char *scr; + if ((scr = find_script(Argv[0], TRUE, NULL, 0))) { + FILE *file = fopen(scr, "r"); + char *s = 0, *s1; + + Argv[0] = scr; + if (!file) + goto panic_file; + if (!fgets(buf, sizeof buf, file)) { + fclose(file); + goto panic_file; + } + if (fclose(file) != 0) { /* Failure */ + panic_file: + warn("Error reading \"%s\": %s", + scr, Strerror(errno)); + goto doshell; + } + if (buf[0] == '#') { + if (buf[1] == '!') + s = buf + 2; + } else if (buf[0] == 'e') { + if (strnEQ(buf, "extproc", 7) + && isSPACE(buf[7])) + s = buf + 8; + } else if (buf[0] == 'E') { + if (strnEQ(buf, "EXTPROC", 7) + && isSPACE(buf[7])) + s = buf + 8; + } + if (!s) + goto doshell; + s1 = s; + nargs = 0; + argsp = args; + while (1) { + while (isSPACE(*s)) + s++; + if (*s == 0) + break; + if (nargs == 4) { + nargs = -1; + break; + } + args[nargs++] = s; + while (*s && !isSPACE(*s)) + s++; + if (*s == 0) + break; + *s++ = 0; + } + if (nargs == -1) { + warn("Too many args on %.*s line of \"%s\"", + s1 - buf, buf, scr); + nargs = 4; + argsp = fargs; + } + goto doshell; + } } } + /* Restore errno */ + errno = err; } else if (err == ENOEXEC) { /* Need to send to shell. */ doshell: + { + char **a = Argv; + + while (a[1]) /* Get to the end */ + a++; while (a >= Argv) { - *(a + 2) = *a; + *(a + nargs) = *a; /* Argv was preallocated to be + long enough. */ a--; } - *Argv = sh_path; - *(Argv + 1) = "-c"; + while (nargs-- >= 0) + Argv[nargs] = argsp[nargs]; secondtry = 1; goto retry; + } } } if (rc < 0 && dowarn) - warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + warn("Can't %s \"%s\": %s\n", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + Argv[0], Strerror(err)); + if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) + && ((trueflag & 0xFF) == P_WAIT)) + rc = 255 << 8; /* Emulate the fork(). */ + + return rc; +} + +int +do_aspawn(really,mark,sp) +SV *really; +register SV **mark; +register SV **sp; +{ + dTHR; + register char **a; + char *tmps = NULL; + int rc; + int flag = P_WAIT, trueflag, err, secondtry = 0; + + if (sp > mark) { + New(1301,Argv, sp - mark + 3, char*); + a = Argv; + + if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { + ++mark; + flag = SvIVx(*mark); + } + + while (++mark <= sp) { + if (*mark) + *a++ = SvPVx(*mark, na); + else + *a++ = ""; + } + *a = Nullch; + + rc = do_spawn_ve(really, flag, EXECF_SPAWN); } else rc = -1; do_execfree(); return rc; } -#define EXECF_SPAWN 0 -#define EXECF_EXEC 1 -#define EXECF_TRUEEXEC 2 -#define EXECF_SPAWN_NOWAIT 3 - +/* Try converting 1-arg form to (usually shell-less) multi-arg form. */ int do_spawn2(cmd, execf) char *cmd; @@ -501,6 +614,8 @@ int execf; } else if (*s == '\\' && !seenspace) { continue; /* Allow backslashes in names */ } + /* We do not convert this to do_spawn_ve since shell + should be smart enough to start itself gloriously. */ doshell: if (execf == EXECF_TRUEEXEC) return execl(shell,shell,copt,cmd,(char*)0); @@ -523,7 +638,8 @@ int execf; } } - New(1303,Argv, (s - cmd) / 2 + 2, char*); + /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */ + New(1303,Argv, (s - cmd + 11) / 2, char*); Cmd = savepvn(cmd, s-cmd); a = Argv; for (s = Cmd; *s;) { @@ -535,44 +651,9 @@ int execf; *s++ = '\0'; } *a = Nullch; - if (Argv[0]) { - int err; - - if (execf == EXECF_TRUEEXEC) - rc = execvp(Argv[0],Argv); - else if (execf == EXECF_EXEC) - rc = spawnvp(P_OVERLAY,Argv[0],Argv); - else if (execf == EXECF_SPAWN_NOWAIT) - rc = spawnvp(P_NOWAIT,Argv[0],Argv); - else - rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv)); - if (rc < 0) { - err = errno; - if (err == ENOENT) { /* No such file. */ - /* One reason may be that EMX added .exe. We suppose - that .exe-less files are automatically shellable. */ - char *no_dir; - (no_dir = strrchr(Argv[0], '/')) - || (no_dir = strrchr(Argv[0], '\\')) - || (no_dir = Argv[0]); - if (!strchr(no_dir, '.')) { - struct stat buffer; - if (stat(Argv[0], &buffer) != -1) { /* File exists. */ - /* Maybe we need to specify the full name here? */ - goto doshell; - } - } - } else if (err == ENOEXEC) { /* Need to send to shell. */ - goto doshell; - } - } - if (rc < 0 && dowarn) - warn("Can't %s \"%s\": %s", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - Argv[0], Strerror(err)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ - } else + if (Argv[0]) + rc = do_spawn_ve(NULL, 0, execf); + else rc = -1; if (news) Safefree(news); do_execfree(); @@ -643,7 +724,8 @@ char *mode; dup2(newfd, *mode == 'r'); /* Return std* back. */ close(newfd); } - close(p[that]); + if (p[that] == (*mode == 'r')) + close(p[that]); if (pid == -1) { close(p[this]); return NULL; @@ -881,6 +963,9 @@ mod2fname(sv) } avlen --; } +#ifdef USE_THREADS + sum++; /* Avoid conflict of DLLs in memory. */ +#endif fname[pos] = 'A' + (sum % 26); fname[pos + 1] = 'A' + (sum / 26 % 26); fname[pos + 2] = '\0'; diff --git a/os2/os2thread.h b/os2/os2thread.h index 44dec3f244..d56fe160dd 100644 --- a/os2/os2thread.h +++ b/os2/os2thread.h @@ -1,10 +1,16 @@ #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 int perl_os_thread; + +typedef _rmutex perl_mutex; + +/*typedef HEV perl_cond;*/ /* Will include os2.h into all C files. */ +typedef unsigned long perl_cond; + +typedef int perl_key; + typedef unsigned long pthread_attr_t; #define PTHREADS_INCLUDED +#define pthread_attr_init(arg) 0 +#define pthread_attr_setdetachstate(arg1,arg2) 0 diff --git a/os2/perl2cmd.pl b/os2/perl2cmd.pl index e774f773d0..f9cc03bdac 100644 --- a/os2/perl2cmd.pl +++ b/os2/perl2cmd.pl @@ -23,7 +23,7 @@ foreach $file (<$idir/*>) { $base =~ s|.*/||; $file =~ s|/|\\|g ; print "Processing $file => $dir\\$base.cmd\n"; - system 'cmd.exe', '/c', "echo extproc perl -S >$dir\\$base.cmd"; + system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd"; system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd"; } |