From: Ilya Zakharevich Date: Mon, 9 Jun 1997 04:52:06 +0000 (+1200) Subject: Assorted OS/2 fixes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=367f3c247e808d76465803ec861b19fd55ffd90d;p=p5sagit%2Fp5-mst-13.2.git Assorted OS/2 fixes In article <9706131709.AA05526@toad.ig.co.uk>, Tim Bunce wrote: > It give me great pleasure to announce the arrival of perl5.004_01. Thank you for a great job! You even corrected os2/diff.configure! Unfortunately, several sections of os2/diff.configure were erroneously removed, so it will not create a valid config.sh any more (ar used instead of $ar, and one extra method to extract symbols is not tried). Unfortunately, I was away from my development machine, so could not try it earlier. A patch to correct this problem, and some other ones, follows. a) Missing sections restored; os2/diff.configure b) my_flock added to os2/os2.c (libc contains a dummy implementation only) (switchable off in case CRT DLL is fixed in this respect); os2/os2ish.h os2/Makefile.SHs os2/os2.c c) depending on architecture, waitpid may be implemented or not. New define HAS_WAITPID_RUNTIME is added and wait4pid corrected correspondingly; os2/os2ish.h util.c d) if -S was given and the file name contained \ , it was nevertheless searched on path; perl.c e) updated: os2/Changes README.os2 f) by default use better gcc optimization options (as mbeattie advices): hints/os2.sh [editor's note: this was applied in the reverse order to one a couple of commits ago] p5p-msgid: 1997Jun16.163234.2091727@hmivax.humgen.upenn.edu --- diff --git a/README.os2 b/README.os2 index 947a569..667423c 100644 --- a/README.os2 +++ b/README.os2 @@ -1085,8 +1085,13 @@ eventually). =item -Since L is present in EMX, but is not functional, the same is -true for perl. Here is the list of things which may be "broken" on +Since L is present in EMX, but is not functional, it is +emulated by perl. To disable the emulations, set environment variable +C. + +=item + +Here is the list of things which may be "broken" on EMX (from EMX docs): =over @@ -1102,7 +1107,7 @@ L is not required and not implemented. =item * -L is not yet implemented (dummy function). +L is not yet implemented (dummy function). (Perl has a workaround.) =item * @@ -1158,6 +1163,12 @@ a dummy implementation. C special-cases F and F. +=item C + +Since L is present in EMX, but is not functional, it is +emulated by perl. To disable the emulations, set environment variable +C. + =back =head1 Perl flavors @@ -1337,6 +1348,12 @@ memory handling code is buggy. Specific for EMX port. Gives the directory part of the location for F. +=head2 C + +Specific for EMX port. Since L is present in EMX, but is not +functional, it is emulated by perl. To disable the emulations, set +environment variable C. + =head2 C or C Specific for EMX port. Used as storage place for temporary files, most diff --git a/hints/os2.sh b/hints/os2.sh index c442a08..adbb7f1 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -189,6 +189,15 @@ nm_opt='-p' d_getprior='define' d_setprior='define' +# Make denser object files and DLL +case "X$optimize" in + X) + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2" + lddlflags="$lddlflags -s" # Strip symbol table + aout_ldflags="$aout_ldflags -s" # Strip symbol table + ;; +esac + ####### All the rest is commented # The next two are commented. pdksh handles #! diff --git a/os2/Changes b/os2/Changes index 9678ea6..c69fb73 100644 --- a/os2/Changes +++ b/os2/Changes @@ -144,6 +144,12 @@ after 5.003_27: returns immediately, thus Perl cannot wait for completion of started programs. +after 5.004_01: + flock emulation added (disable by setting env PERL_USE_FLOCK=0), + thanks to Rocco Caputo; + RSX bug with missing waitpid circomvented; + -S bug with full path with \ corrected. + before 5.004_02: -S switch to perl enables a search with additional extensions .cmd, .btm, .bat, .pl as well. This means that if you have diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index 6b07e72..32af9cc 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -54,6 +54,7 @@ perl5.def: perl.linkexp echo ' "dlerror"' >>$@ echo ' "my_tmpfile"' >>$@ echo ' "my_tmpnam"' >>$@ + echo ' "my_flock"' >>$@ !NO!SUBS! if [ ! -z "$myttyname" ] ; then diff --git a/os2/diff.configure b/os2/diff.configure index 6d108c7..a649869 100644 --- a/os2/diff.configure +++ b/os2/diff.configure @@ -51,7 +51,16 @@ case "$libs" in '') ;; *) for thislib in $libs; do -@@ -4136,6 +4144,10 @@ +@@ -3968,6 +3976,8 @@ + : + elif try=`./loc $thislib X $libpth`; $test -f "$try"; then + : ++ elif try=`./loc $thislib$lib_ext X $libpth`; $test -f "$try"; then ++ : + elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then + : + else +@@ -4152,6 +4162,10 @@ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun @@ -194,7 +203,31 @@ dflt=`./try` case "$dflt" in [1-4][1-4][1-4][1-4]|12345678|87654321) -@@ -8692,7 +8714,7 @@ +@@ -8707,18 +8731,18 @@ + $cc $ccflags -c bar1.c >/dev/null 2>&1 + $cc $ccflags -c bar2.c >/dev/null 2>&1 + $cc $ccflags -c foo.c >/dev/null 2>&1 +-ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1 ++$ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1 + if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && + ./foobar >/dev/null 2>&1; then +- echo "ar appears to generate random libraries itself." ++ echo "$ar appears to generate random libraries itself." + orderlib=false + ranlib=":" +-elif ar ts bar$lib_ext >/dev/null 2>&1 && ++elif $ar ts bar$lib_ext >/dev/null 2>&1 && + $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && + ./foobar >/dev/null 2>&1; then +- echo "a table of contents needs to be added with 'ar ts'." ++ echo "a table of contents needs to be added with '$ar ts'." + orderlib=false +- ranlib="ar ts" ++ ranlib="$ar ts" + else + case "$ranlib" in + :) ranlib='';; +@@ -8790,7 +8814,7 @@ '') $echo $n ".$c" if $cc $ccflags \ $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ diff --git a/os2/os2.c b/os2/os2.c index c45dfec..8074242 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -1196,3 +1196,116 @@ my_tmpfile () return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but grants TMP. */ } + +#undef flock + +/* This code was contributed by Rocco Caputo. */ +int +my_flock(int handle, int op) +{ + FILELOCK rNull, rFull; + ULONG timeout, handle_type, flag_word; + APIRET rc; + int blocking, shared; + static int use_my = -1; + + if (use_my == -1) { + char *s = getenv("USE_PERL_FLOCK"); + if (s) + use_my = atoi(s); + else + use_my = 1; + } + if (!(_emx_env & 0x200) || !use_my) + return flock(handle, op); /* Delegate to EMX. */ + + // is this a file? + if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) || + (handle_type & 0xFF)) + { + errno = EBADF; + return -1; + } + // set lock/unlock ranges + rNull.lOffset = rNull.lRange = rFull.lOffset = 0; + rFull.lRange = 0x7FFFFFFF; + // set timeout for blocking + timeout = ((blocking = !(op & LOCK_NB))) ? 100 : 1; + // shared or exclusive? + shared = (op & LOCK_SH) ? 1 : 0; + // do not block the unlock + if (op & (LOCK_UN | LOCK_SH | LOCK_EX)) { + rc = DosSetFileLocks(handle, &rFull, &rNull, timeout, shared); + switch (rc) { + case 0: + errno = 0; + return 0; + case ERROR_INVALID_HANDLE: + errno = EBADF; + return -1; + case ERROR_SHARING_BUFFER_EXCEEDED: + errno = ENOLCK; + return -1; + case ERROR_LOCK_VIOLATION: + break; // not an error + case ERROR_INVALID_PARAMETER: + case ERROR_ATOMIC_LOCK_NOT_SUPPORTED: + case ERROR_READ_LOCKS_NOT_SUPPORTED: + errno = EINVAL; + return -1; + case ERROR_INTERRUPT: + errno = EINTR; + return -1; + default: + errno = EINVAL; + return -1; + } + } + // lock may block + if (op & (LOCK_SH | LOCK_EX)) { + // for blocking operations + for (;;) { + rc = + DosSetFileLocks( + handle, + &rNull, + &rFull, + timeout, + shared + ); + switch (rc) { + case 0: + errno = 0; + return 0; + case ERROR_INVALID_HANDLE: + errno = EBADF; + return -1; + case ERROR_SHARING_BUFFER_EXCEEDED: + errno = ENOLCK; + return -1; + case ERROR_LOCK_VIOLATION: + if (!blocking) { + errno = EWOULDBLOCK; + return -1; + } + break; + case ERROR_INVALID_PARAMETER: + case ERROR_ATOMIC_LOCK_NOT_SUPPORTED: + case ERROR_READ_LOCKS_NOT_SUPPORTED: + errno = EINVAL; + return -1; + case ERROR_INTERRUPT: + errno = EINTR; + return -1; + default: + errno = EINVAL; + return -1; + } + // give away timeslice + DosSleep(1); + } + } + + errno = 0; + return 0; +} diff --git a/os2/os2ish.h b/os2/os2ish.h index a1b6db9..b62e3d0 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -15,6 +15,7 @@ #define HAS_KILL #define HAS_WAIT #define HAS_DLERROR +#define HAS_WAITPID_RUNTIME (_emx_env & 0x200) /* USEMYBINMODE * This symbol, if defined, indicates that the program should @@ -125,6 +126,7 @@ char *my_tmpnam (char *); #define fwrite1 fwrite #define my_getenv(var) getenv(var) +#define flock my_flock void *emx_calloc (size_t, size_t); void emx_free (void *); diff --git a/util.c b/util.c index fb6c0c0..fc5cd5d 100644 --- a/util.c +++ b/util.c @@ -2087,11 +2087,17 @@ int flags; } } #ifdef HAS_WAITPID +# ifdef HAS_WAITPID_RUNTIME + if (!HAS_WAITPID_RUNTIME) + goto hard_way; +# endif return waitpid(pid,statusp,flags); -#else -#ifdef HAS_WAIT4 +#endif +#if !defined(HAS_WAITPID) && defined(HAS_WAIT4) return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *)); -#else +#endif +#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) + hard_way: { I32 result; if (flags) @@ -2105,7 +2111,6 @@ int flags; return result; } #endif -#endif } #endif /* !DOSISH */