Change 23661 by [EMAIL PROTECTED] on 2004/12/17 09:08:23

        Subject: Re: [perl #32717] BeOS specific Updates
        From: [EMAIL PROTECTED]
        Date: Fri, 17 Dec 2004 01:17:40 +0100
        Message-Id: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/MANIFEST#1202 edit
... //depot/perl/Makefile.SH#314 edit
... //depot/perl/README.beos#11 edit
... //depot/perl/beos/beos.c#7 edit
... //depot/perl/beos/beos_flock_server.cpp#2 delete
... //depot/perl/beos/beos_flock_server.h#2 delete
... //depot/perl/beos/beosish.h#4 edit
... //depot/perl/hints/beos.sh#11 edit

Differences ...

==== //depot/perl/MANIFEST#1202 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1201~23654~   Wed Dec 15 05:16:06 2004
+++ perl/MANIFEST       Fri Dec 17 01:08:23 2004
@@ -6,8 +6,6 @@
 av.h                   Array value header
 beos/beos.c            BeOS port
 beos/beosish.h         BeOS port
-beos/beos_flock_server.cpp     BeOS port
-beos/beos_flock_server.h       BeOS port
 beos/nm.c              BeOS port
 bytecode.pl            Produces ext/ByteLoader/byterun.h, 
ext/ByteLoader/byterun.c and ext/B/Asmdata.pm
 cc_runtime.h           Macros need by runtime of compiler-generated code

==== //depot/perl/Makefile.SH#314 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#313~23592~ Wed Dec  1 10:54:14 2004
+++ perl/Makefile.SH    Fri Dec 17 01:08:23 2004
@@ -548,7 +548,7 @@
 !NO!SUBS!
 
        case "${osname}${osvers}" in
-       aix*)
+       aix*|beos*)
                $spitshell >>Makefile <<'!NO!SUBS!'
 miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT)
        $(CC) -o miniperl $(CLDFLAGS) \
@@ -557,7 +557,7 @@
        $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest
 !NO!SUBS!
                ;;
-       beos*|next4*)
+       next4*)
                $spitshell >>Makefile <<'!NO!SUBS!'
 miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT)
        $(CC) -o miniperl `echo $(obj) | sed 's/ op$(OBJ_EXT) / /'` \

==== //depot/perl/README.beos#11 (text) ====
Index: perl/README.beos
--- perl/README.beos#10~17496~  Thu Jul 11 17:03:03 2002
+++ perl/README.beos    Fri Dec 17 01:08:23 2004
@@ -4,110 +4,106 @@
 
 =head1 NAME
 
-README.beos - Perl version 5 on BeOS
+README.beos - Perl version 5.8+ on BeOS
 
 =head1 DESCRIPTION
 
-Notes for building Perl under BeOS.
+This file contains instructions how to build Perl under BeOS and lists
+known problems.
 
-=head2 General Issues with Perl on BeOS
+=head1 BUILD AND INSTALL
 
-To compile perl under BeOS R4 x86:
+=head2 Requirements
 
-       ./Configure -d
+I have built and tested Perl 5.8.6 and 5.9.1 under BeOS R5 x86 net server.
+I can't say anything with regard to PPC. Since Perl 5.8.0 had been released
+for BeOS BONE, I suspect, there is a good chance, that it still compiles on
+a BONE system. The only change I've made, that affects BONE systems is the
+recognition of whether it is a BONE system or not in C<hints/beos.sh>. Now
+network socket support should remain enabled on BONE systems. This might
+as well break the build, though.
 
-and hit ^C when it asks you if you want to make changes to config.sh;
-edit config.sh and do the following:
-change d_socket='define' to ='undef';
-remove SDBM, Errno, and Socket from dynamic_ext= and nonxs_ext=;
-add '#define bool short' to x2p/a2p.h;
+As more recent versions of autoconf require flock() support, I wrote a flock()
+emulation (flock_server) and released it on BeBits:
 
-       ../Configure -S; make; make install
+       http://www.bebits.com/app/4030
 
-       cd ~/config/lib; ln -s 5.00502/BeOS-BePC/CORE/libperl.so .
+If you want to build a Perl with flock() support, you have to install this
+package first.
 
-(substitute 5.00502 with the appropriate filename)
+=head2 Configure
 
-=head2 BeOS Release-specific Notes
+With flock() support:
 
-=over 4
+       CFLAGS=-I/path/to/flock/server/headers ./configure.gnu \
+               --prefix=/boot/home/config
 
-=item R4 x86
+Replace C</path/to/flock/server/headers> with the path to the directory
+containing the C<flock.h> header.
 
-Dynamic loading finally works! Yay! This means you can compile your
-own modules into perl. However, Sockets and Errno still don't work.
-(Hopefully, sockets will at least work by R5, if not sooner.)
-
-=item R4 PPC
-
-I have not tested this. I rather severely doubt that dynamic loading
-will work. (My BeBox is in pieces right now, following a nasty disk
-crash.) You may have to disable dynamic loading to get the thing to
-compile at all. (use `./Configure` without -d, and say 'no' to 'Build
-a shared libperl.so'.)
+Without flock() support:
 
-=back
+       ./configure.gnu --prefix=/boot/home/config
 
-=head2 Contact Information
+=head2 Build
 
-If you have comments, problem reports, or even patches or bugfixes (gasp!)
-please email me.
+With flock() support:
 
-28 Jan 1999
-Tom Spindler
[EMAIL PROTECTED]
+       make LDLOADLIBS="-lnet -lflock"
 
-=head2 Update 2002-05-30
+Without flock() support:
 
-The following tests fail on 5.8.0 Perl in BeOS Personal 5.03:
+       make LDLOADLIBS="-lnet"
 
- t/op/lfs............................FAILED at test 17
- t/op/magic..........................FAILED at test 24
- ext/Fcntl/t/syslfs..................FAILED at test 17
- ext/File/Glob/t/basic...............FAILED at test 3
- ext/POSIX/t/sigaction...............FAILED at test 13
- ext/POSIX/t/waitpid.................FAILED at test 1
+C<-lnet> is needed on net server systems only and if the compiler doesn't
+add it automatically (Be's R5 gcc does, Oliver Tappe's gcc 2.95.3 does not).
 
-The reasons for the failures are as follows: 
+=head2 Install
 
-=over 4
+Install all perl files:
 
-=item *
+       make install
+
+Create a symlink for libperl:
 
-The t/op/lfs and ext/Fcntl/t/syslfs failures indicate that the
-LFS (large file support, files larger than 2 gigabytes) doesn't
-work from Perl (BeFS itself is well capable of supporting large
-files).  What fails is that trying to position the file pointer
-past 2 gigabytes doesn't work right, the position gets truncated
-to its lower 32 bits.
+       cd ~/config/lib; ln -s perl5/5.8.6/BePC-beos/CORE/libperl.so .
+
+Replace C<5.8.6> with your respective version of Perl.
+
+=head1 KNOWN PROBLEMS
+
+=over 4
 
 =item *
 
-The op/magic failures look like something funny going on with $0 and
-$^X that I can't now figure out: none of the generated pathnames are
-wrong as such, they just seem to accumulate "./" prefixes and infixes
-in ways that define logic.
+Network socket support is disabled for BeOS R5 net server. I didn't dare yet
+to try enabling it and see what problems occur.
 
 =item *
 
-The Glob/t/basic indicates a bug in the getpw*() functions:
-they do not always return the correct user db entries.
+The LFS (large file support) tests (C<t/op/lfs> and C<xt/Fcntl/t/syslfs>) are
+disabled as seeking beyond 2 GB is broken according to [EMAIL PROTECTED] who 
was the
+last one checking the BeOS port and updating this file before me. Haven't
+checked this myself.
 
 =item *
 
-The sigaction #13 means that signal mask doesn't get properly restored
-if sigaction returns early.
+The C<t/io/fflush> test fails at #6. As far as I can tell, this is caused by
+a bug in the BeOS pipes implementation that occurs when starting other child
+processes. In the particular test case a C<system("perl -e 0")> flushes the
+stdout pipe of another child process.
 
 =item *
 
-The waitpid failure means that after there are no more child
-processes, waitpid is supposed to start returning -1 (and set
-errno to ECHILD).  In BeOS, it doesn't seem to.
+The C<ext/POSIX/t/waitpid> test fails at #1. After all child processes are
+gone BeOS' waitpid(-1,...) returns 0 instead of -1 (as it should). No idea
+how to fix this.
 
 =back
 
-Disclaimer: I just installed BeOS Personal Edition 5.0 and the
-Developer Tools, that is the whole extent of my BeOS expertise,
-so please don't ask me for further help in BeOS Perl problems.
+=head1 CONTACT
+
+For BeOS specifics problems feel free to mail to:
+Ingo Weinhold <[EMAIL PROTECTED]>
 
[EMAIL PROTECTED]
+Last update: 2004-12-16

==== //depot/perl/beos/beos.c#7 (text) ====
Index: perl/beos/beos.c
--- perl/beos/beos.c#6~23584~   Wed Dec  1 05:44:24 2004
+++ perl/beos/beos.c    Fri Dec 17 01:08:23 2004
@@ -1,9 +1,8 @@
 #include "beos/beosish.h"
-#include "beos/beos_flock_server.h"
 
 #undef waitpid
-#undef close
 #undef kill
+#undef sigaction
 
 #include <errno.h>
 #include <signal.h>
@@ -14,11 +13,6 @@
 
 #include <OS.h>
 
-/* We cache, for which FDs we got a lock. This will especially speed up 
close(),
-   since we won't have to contact the server. */
-#define FLOCK_TABLE_SIZE 256
-static int flockTable[FLOCK_TABLE_SIZE];
-
 /* In BeOS 5.0 the waitpid() seems to misbehave in that the status
  * has the upper and lower bytes swapped compared with the usual
  * POSIX/UNIX implementations.  To undo the surpise effect to the
@@ -34,162 +28,6 @@
     return got;
 }
 
-/* The flock() emulation worker function. */
-
-static status_t beos_flock(int fd, int operation) {
-    static int serverPortInitialized = 0;
-    static port_id serverPort = -1;
-
-    struct stat st;
-    int blocking;
-    port_id replyPort;
-    sem_id lockSem = -1;
-    status_t error;
-    flock_server_request request;
-    flock_server_reply *reply = NULL;
-
-    if (fd < 0)
-        return B_BAD_VALUE;
-
-    blocking = !(operation & LOCK_NB);
-    operation &= LOCK_SH | LOCK_EX | LOCK_UN;
-
-    /* don't try to unlock something that isn't locked */
-    if (operation == LOCK_UN && fd < FLOCK_TABLE_SIZE && !flockTable[fd])
-        return B_OK;
-
-    /* if not yet initialized, get the server port */
-    if (!serverPortInitialized) {
-        serverPort = find_port(FLOCK_SERVER_PORT_NAME);
-        /* bonefish: If the port wasn't present at this point, we could start
-         * the server. In fact, I tried this and in works, but unfortunately
-         * it also seems to confuse our pipes (with both load_image() and
-         * system()). So, we can't help it, the server has to be started
-         * manually. */
-        serverPortInitialized = ~0;
-    }
-    if (serverPort < 0)
-        return B_ERROR;
-
-    /* stat() the file to get the node_ref */
-    if (fstat(fd, &st) < 0)
-        return errno;
-
-    /* create a reply port */
-    replyPort = create_port(1, "flock reply port");
-    if (replyPort < 0)
-        return replyPort;
-
-    /* create a semaphore others will wait on while we own the lock */
-    if (operation != LOCK_UN) {
-        char semName[64];
-        sprintf(semName, "flock %ld:%lld\n", st.st_dev, st.st_ino);
-        lockSem = create_sem(0, semName);
-        if (lockSem < 0) {
-            delete_port(replyPort);
-            return lockSem;
-        }
-    }
-
-    /* prepare the request */
-    request.replyPort = replyPort;
-    request.lockSem = lockSem;
-    request.device = st.st_dev;
-    request.node = st.st_ino;
-    request.fd = fd;
-    request.operation = operation;
-    request.blocking = blocking;
-
-    /* We ask the server to get us the requested lock for the file.
-     * The server returns semaphores for all existing locks (or will exist
-     * before it's our turn) that prevent us from getting the lock just now.
-     * We block on them one after the other and after that officially own the
-     * lock. If we told the server that we don't want to block, it will send
-     * an error code, if that is not possible. */
-
-    /* send the request */
-    error = write_port(serverPort, 0, &request, sizeof(request));
-
-    if (error == B_OK) {
-        /* get the reply size */
-        int replySize = port_buffer_size(replyPort);
-        if (replySize < 0)
-            error = replySize;
-
-        /* allocate reply buffer */
-        if (error == B_OK) {
-            reply = (flock_server_reply*)malloc(replySize);
-            if (!reply)
-                error = B_NO_MEMORY;
-        }
-
-        /* read the reply */
-        if (error == B_OK) {
-            int32 code;
-            ssize_t bytesRead = read_port(replyPort, &code, reply, replySize);
-            if (bytesRead < 0) {
-                error = bytesRead;
-            } else if (bytesRead != replySize) {
-                error = B_ERROR;
-            }
-        }
-    }
-
-    /* get the error returned by the server */
-    if (error == B_OK)
-        error = reply->error;
-
-    /* wait for all lockers before us */
-    if (error == B_OK) {
-        int i;
-        for (i = 0; i < reply->semaphoreCount; i++)
-            while (acquire_sem(reply->semaphores[i]) == B_INTERRUPTED);
-    }
-
-    /* free the reply buffer */
-    free(reply);
-
-    /* delete the reply port */
-    delete_port(replyPort);
-
-    /* on failure delete the semaphore */
-    if (error != B_OK)
-        delete_sem(lockSem);
-
-    /* update the entry in the flock table */
-    if (error == B_OK && fd < FLOCK_TABLE_SIZE) {
-        if (operation == LOCK_UN)
-            flockTable[fd] = 0;
-        else
-            flockTable[fd] = 1;
-    }
-
-    return error;
-}
-
-/* We implement flock() using a server. It is not really compliant with, since
- * it would be very hard to track dup()ed FDs and those cloned as side-effect
- * of fork(). Our locks are bound to the process (team) and a particular FD.
- * I.e. a lock acquired by a team using a FD can only be unlocked by the same
- * team using exactly the same FD (no other one pointing to the same file, not
- * even when dup()ed from the original one). close()ing the FD releases the
- * lock (that's why we need to override close()). On termination of the team
- * all locks owned by the team will automatically be released. */
-
-int flock(int fd, int operation) {
-    status_t error = beos_flock(fd, operation);
-    return (error == B_OK ? 0 : (errno = error, -1));
-}
-
-/* We need to override close() to release a potential lock on the FD. See
-   flock() for details */
-
-int beos_close(int fd) {
-    flock(fd, LOCK_UN);
-
-    return close(fd);
-}
-
 
 /* BeOS kill() doesn't like the combination of the pseudo-signal 0 and
  * specifying a process group (i.e. pid < -1 || pid == 0). We work around
@@ -209,4 +47,21 @@
     }
 
     return kill(pid, sig);
+}
+
+/* sigaction() should fail, if trying to ignore or install a signal handler
+ * for a signal that cannot be caught or ignored. The BeOS R5 sigaction()
+ * doesn't return an error, though. */
+int beos_sigaction(int sig, const struct sigaction *act,
+                   struct sigaction *oact)
+{
+    int result = sigaction(sig, act, oact);
+
+    if (result == 0 && act && act->sa_handler != SIG_DFL
+        && act->sa_handler != SIG_ERR && (sig == SIGKILL || sig == SIGSTOP)) {
+        result = -1;
+        errno = EINVAL;
+    }
+
+    return result;
 }

==== //depot/perl/beos/beosish.h#4 (text) ====
Index: perl/beos/beosish.h
--- perl/beos/beosish.h#3~23584~        Wed Dec  1 05:44:24 2004
+++ perl/beos/beosish.h Fri Dec 17 01:08:23 2004
@@ -11,24 +11,28 @@
 /* This seems to be protoless. */
 char *gcvt(double value, int num_digits, char *buffer);
 
+/* flock support, if available */
+#ifdef HAS_FLOCK
 
-/* flock() operation flags */
-#define LOCK_SH        (0x00)
-#define LOCK_EX        (0x01)
-#define LOCK_UN        (0x02)
-#define LOCK_NB        (0x04)
-
-int flock(int fd, int operation);
+#include <flock.h>
 
 #undef close
-#define close beos_close
+#define close flock_close
+
+#undef dup2
+#define dup2 flock_dup2
 
-int beos_close(int fd);
+#endif /* HAS_FLOCK */
 
 
 #undef kill
 #define kill beos_kill
 int beos_kill(pid_t pid, int sig);
+
+#undef sigaction
+#define sigaction(sig, act, oact) beos_sigaction((sig), (act), (oact))
+int beos_sigaction(int sig, const struct sigaction *act,
+                   struct sigaction *oact);
 
 #endif
 

==== //depot/perl/hints/beos.sh#11 (text) ====
Index: perl/hints/beos.sh
--- perl/hints/beos.sh#10~23584~        Wed Dec  1 05:44:24 2004
+++ perl/hints/beos.sh  Fri Dec 17 01:08:23 2004
@@ -48,9 +48,27 @@
        libs='-lnet'
 fi
 
-# We provide a flock() emulation.
-d_flock='define'
-d_flockproto='define'
+# There's a third party flock() emulation. Check, if it is available.
+echo "#include <flock.h>" > try.c
+if cc -E $CFLAGS try.c 2> /dev/null | grep "flock.*("; then
+    d_flock='define'
+    d_flockproto='define'
+    libs="$libs -lflock"
+    ldflags="$ldflags -L/boot/home/config/lib"
+else
+       cat << 'EOM' >&4
+
+I couldn't find a <flock.h> header defining a flock() prototype. That header
+comes with the flock server package (available on BeBits). You have to add
+the path to the directory containing the header via the environment variable
+CFLAGS (should contain -I</path/to/dir/of/flock/header>). Perl will be compiled
+without flock() support, if the flock server package is not installed or the
+header not found.
+
+EOM
+
+fi
+rm try.c
 
 ld='gcc'
 
End of Patch.

Reply via email to