First pass of integrating the Rhapsody port,

Subject: Keeping the world in sync.
Reply-To: wsanchez@apple.com 
To: perlbug@perl.com 
Message-Id: <199811140111.RAA41784@scv4.apple.com>

p4raw-id: //depot/cfgperl@3108

14 files changed, 377 insertions, 53 deletions

diff --git a/Configure b/Configure
index 8224931400..45c47617b7 100755
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Tue Mar  9 14:37:57 EET 1999 [metaconfig 3.0 PL70]
+# Generated on Mon Mar 15 18:36:13 EET 1999 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.com)
 
 cat >/tmp/c1$$ <<EOF
@@ -5313,7 +5313,8 @@ EOM
 		useshrplib='true'
 		# Why does next4 have to be so different?
 		case "${osname}${osvers}" in
-		next4*)	xxx='DYLD_LIBRARY_PATH' ;;
+		next4*|rhapsody*)
+			xxx='DYLD_LIBRARY_PATH' ;;
 		os2*)	xxx='' ;; # Nothing special needed.
 		beos*)  xxx='' ;;
 		*)		xxx='LD_LIBRARY_PATH' ;;
@@ -10302,7 +10303,7 @@ case "$crosscompile" in
 esac
 
 case "$osname" in
-next) multiarch="$define" ;;
+next|rhapsody) multiarch="$define" ;;
 esac
 case "$multiarch" in
 ''|[nN]*) multiarch="$undef" ;;
diff --git a/Makefile.SH b/Makefile.SH
index 2530d4fdc5..22f70aee7d 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -43,6 +43,9 @@ true)
 		# NeXT uses a different name.
 		ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH"
 		;;
+	rhapsody*)
+		ldlibpth="DYLD_LIBRARY_PATH=`pwd`/Perl:$DYLD_LIBRARY_PATH"
+		;;
 	os2*)	# OS/2 doesn't need anything special for LD_LIBRARY_PATH.
 		ldlibpth=''
 		;;
diff --git a/config_h.SH b/config_h.SH
index 06b7c8c688..1f607e2810 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -1026,22 +1026,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
  */
 #define STDCHAR $stdchar	/**/
 
-/* INTSIZE:
- *	This symbol contains the value of sizeof(int) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* LONGSIZE:
- *	This symbol contains the value of sizeof(long) so that the C
- *	preprocessor can make decisions based on it.
- */
-/* SHORTSIZE:
- *	This symbol contains the value of sizeof(short) so that the C
- *	preprocessor can make decisions based on it.
- */
-#define INTSIZE $intsize		/**/
-#define LONGSIZE $longsize		/**/
-#define SHORTSIZE $shortsize		/**/
-
 /* HAS_ACCESSX:
  *	This symbol, if defined, indicates that the accessx routine is
  *	available to do extended access checks.
@@ -1072,6 +1056,22 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
  */
 #$crosscompile CROSSCOMPILE		/**/
 
+/* INTSIZE:
+ *	This symbol contains the value of sizeof(int) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+#define INTSIZE $intsize		/**/
+#define LONGSIZE $longsize		/**/
+#define SHORTSIZE $shortsize		/**/
+
 /* MULTIARCH:
  *	This symbol, if defined, signifies that the build
  *	process will produce some binary files that are going to be
diff --git a/configure.gnu b/configure.gnu
index fa46532094..2ef8331833 100755
--- a/configure.gnu
+++ b/configure.gnu
@@ -111,6 +111,14 @@ case "$ccflags" in
 '') ;;
 *) opts="$opts -Dccflags='$ccflags'";;
 esac
+case "$LDFLAGS" in
+'') ;;
+*) ldflags="$ldflags $LDFLAGS";;
+esac
+case "$ldflags" in
+'') ;;
+*) opts="$opts -Dldflags='$ldflags'";;
+esac
 
 # Don't use -s if they want verbose mode
 case "$verbose" in
diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs
new file mode 100644
index 0000000000..7513bf2620
--- /dev/null
+++ b/ext/DynaLoader/dl_rhapsody.xs
@@ -0,0 +1,216 @@
+/* dl_rhapsody.xs
+ *
+ * Platform:	Apple Rhapsody 5.0
+ * Based on:	dl_next.xs by Paul Marquess
+ * Based on:	dl_dlopen.xs by Anno Siegel
+ * Created:	Aug 15th, 1994
+ *
+ */
+
+/*
+    And Gandalf said: 'Many folk like to know beforehand what is to
+    be set on the table; but those who have laboured to prepare the
+    feast like to keep their secret; for wonder makes the words of
+    praise louder.'
+*/
+
+/* Porting notes:
+
+dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
+should not be used as a base for further ports though it may be used
+as an example for how dl_dlopen.xs can be ported to other platforms.
+
+The method used here is just to supply the sun style dlopen etc.
+functions in terms of NeXTs rld_*.  The xs code proper is unchanged
+from Paul's original.
+
+The port could use some streamlining.  For one, error handling could
+be simplified.
+
+Anno Siegel
+
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define DL_LOADONCEONLY
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+#undef environ
+#import <mach-o/dyld.h>
+
+static char * dl_last_error = (char *) 0;
+static AV *dl_resolve_using = Nullav;
+
+static char *dlerror()
+{
+    return dl_last_error;
+}
+
+int dlclose(handle) /* stub only */
+void *handle;
+{
+    return 0;
+}
+
+enum dyldErrorSource
+{
+    OFImage,
+};
+
+static void TranslateError
+    (const char *path, enum dyldErrorSource type, int number)
+{
+    char *error;
+    unsigned int index;
+    static char *OFIErrorStrings[] =
+    {
+	"%s(%d): Object Image Load Failure\n",
+	"%s(%d): Object Image Load Success\n",
+	"%s(%d): Not an recognisable object file\n",
+	"%s(%d): No valid architecture\n",
+	"%s(%d): Object image has an invalid format\n",
+	"%s(%d): Invalid access (permissions?)\n",
+	"%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
+    };
+#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
+
+    switch (type)
+    {
+    case OFImage:
+	index = number;
+	if (index > NUM_OFI_ERRORS - 1)
+	    index = NUM_OFI_ERRORS - 1;
+	error = form(OFIErrorStrings[index], path, number);
+	break;
+
+    default:
+	error = form("%s(%d): Totally unknown error type %d\n",
+		     path, number, type);
+	break;
+    }
+    safefree(dl_last_error);
+    dl_last_error = savepv(error);
+}
+
+static char *dlopen(char *path, int mode /* mode is ignored */)
+{
+    int dyld_result;
+    NSObjectFileImage ofile;
+    NSModule handle = NULL;
+
+    dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
+    if (dyld_result != NSObjectFileImageSuccess)
+	TranslateError(path, OFImage, dyld_result);
+    else
+    {
+    	// NSLinkModule will cause the run to abort on any link error's
+	// not very friendly but the error recovery functionality is limited.
+	handle = NSLinkModule(ofile, path, TRUE);
+    }
+
+    return handle;
+}
+
+void *
+dlsym(handle, symbol)
+void *handle;
+char *symbol;
+{
+    void *addr;
+
+    if (NSIsSymbolNameDefined(symbol))
+	addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
+    else
+    	addr = NULL;
+
+    return addr;
+}
+
+
+
+/* ----- code from dl_dlopen.xs below here ----- */
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+    dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+}
+
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+
+void *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+    PREINIT:
+    int mode = 1;
+    CODE:
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    if (flags & 0x01)
+	warn("Can't make loaded symbols global on this platform while loading %s",filename);
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    else
+	sv_setiv( ST(0), (IV)RETVAL);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *		libhandle
+    char *		symbolname
+    CODE:
+    symbolname = form("_%s", symbolname);
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
+			     (unsigned long) libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "  symbolref = %lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    else
+	sv_setiv( ST(0), (IV)RETVAL);
+
+
+void
+dl_undef_symbols()
+    PPCODE:
+
+
+
+# These functions should not need changing on any platform:
+
+void
+dl_install_xsub(perl_name, symref, filename="$Package")
+    char *	perl_name
+    void *	symref
+    char *	filename
+    CODE:
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+	    perl_name, symref));
+    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+
+
+char *
+dl_error()
+    CODE:
+    RETVAL = LastError ;
+    OUTPUT:
+    RETVAL
+
++# end.
diff --git a/handy.h b/handy.h
index 90791f980e..33e17f068f 100644
--- a/handy.h
+++ b/handy.h
@@ -54,7 +54,7 @@
 /* The NeXT dynamic loader headers will not build with the bool macro
    So declare them now to clear confusion.
 */
-#ifdef NeXT
+#if defined(NeXT) || defined(__NeXT__)
 # undef FALSE
 # undef TRUE
   typedef enum bool { FALSE = 0, TRUE = 1 } bool;
@@ -62,7 +62,7 @@
 # ifndef HAS_BOOL
 #  define HAS_BOOL 1
 # endif /* !HAS_BOOL */
-#endif /* NeXT */
+#endif /* NeXT || __NeXT__ */
 
 #ifndef HAS_BOOL
 # if defined(UTS) || defined(VMS)
diff --git a/hints/rhapsody.sh b/hints/rhapsody.sh
new file mode 100644
index 0000000000..7f652234c7
--- /dev/null
+++ b/hints/rhapsody.sh
@@ -0,0 +1,54 @@
+##
+# Rhapsody (Mac OS X Server) hints
+# Wilfredo Sanchez <wsanchez@apple.com>
+##
+
+# Since we can build fat, the archname doesn't need the processor type
+archname='rhapsody';
+
+# Perl5.003 precedes this platform
+d_bincompat3='undef';
+
+# Libc is in libsystem.
+libc='/System/Library/Frameworks/System.framework/System';
+
+# nm works.
+usenm='true';
+
+# Optimize.
+optimize='-O3';
+
+# We have a prototype for telldir.
+# We are not NeXTStep.
+ccflags="${ccflags} -pipe -fno-common -DHAS_TELLDIR_PROTOTYPE -UNeXT -U__NeXT__";
+
+# Don't use /usr/local/lib; we may have junk there.
+libpth='/lib /usr/lib';
+
+# Shared library extension in .dylib.
+# Bundle extension in .bundle.
+ld='cc';
+so='dylib';
+dlext='bundle';
+dlsrc='dl_rhapsody.xs';
+cccdlflags='';
+lddlflags="${ldflags} -bundle -undefined suppress";
+useshrplib='true';
+libperl='Perl';
+framework_path='/System/Library/Frameworks/Perl.framework';
+base_address='0x4be00000';
+
+# 4BSD uses /usr/share/man, not /usr/man.
+# Don't put man pages in /usr/lib; that's goofy.
+man1dir='/usr/share/man/man1';
+man3dir='/usr/share/man/man3';
+
+# Where to put modules.
+privlib='/System/Library/Perl';
+sitelib='/Local/Library/Perl';
+
+# vfork works
+usevfork='true';
+
+# malloc works
+usemymalloc='n';
diff --git a/installperl b/installperl
index 006a5506ed..417357b96f 100755
--- a/installperl
+++ b/installperl
@@ -172,6 +172,7 @@ elsif ($^O eq 'mpeix') {
 elsif ($^O ne 'dos') {
     safe_unlink("$installbin/$perl$ver$exe_ext");
     copy("perl$exe_ext", "$installbin/$perl$ver$exe_ext");
+    strip("$installbin/perl$ver$exe_ext") if $^O =~ /^(rhapsody)$;
     chmod(0755, "$installbin/$perl$ver$exe_ext");
 }
 else {
@@ -231,9 +232,14 @@ else {
 foreach my $file (@corefiles) {
     # HP-UX (at least) needs to maintain execute permissions
     # on dynamically-loadable libraries. So we do it for all.
-    copy_if_diff($file,"$installarchlib/CORE/$file")
-	and chmod($file =~ /\.(so|\Q$dlext\E)$/ ? 0555 : 0444,
-		   "$installarchlib/CORE/$file");
+    if (copy_if_diff($file,"$installarchlib/CORE/$file")) {
+	if ($file =~ /\.(so|\Q$dlext\E)$/) {
+	    chmod(0555, "$installarchlib/CORE/$file");
+	    strip("-S", "$installarchlib/CORE/$file") if $^O =~ /^(rhapsody)$;
+	} else {
+	    chmod(0444, "$installarchlib/CORE/$file");
+	}
+    }
 }
 
 # Install main perl executables
@@ -602,3 +608,23 @@ sub copy_if_diff {
 	1;
     }
 }
+
+sub strip
+{
+    my(@args) = @_;
+
+    my @opts;
+    while (@args && $args[0] =~ /^(-\w+)$/) {
+        push @opts, shift @args;
+    }
+
+    foreach my $file (@args) {
+        if (-f $file) {
+            print STDERR "  strip $file\n";
+            system("strip", @opts, $file);
+        } else {
+            print STDERR "# file '$file' skipped\n";
+        }
+    }
+}
+
diff --git a/malloc.c b/malloc.c
index 2716045fae..9d2704b6d4 100644
--- a/malloc.c
+++ b/malloc.c
@@ -1727,7 +1727,7 @@ dump_mstats(char *s)
 
 #ifdef USE_PERL_SBRK
 
-#   if defined(__MACHTEN_PPC__) || defined(__NeXT__)
+#   if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__)
 #      define PERL_SBRK_VIA_MALLOC
 /*
  * MachTen's malloc() returns a buffer aligned on a two-byte boundary.
diff --git a/perl.c b/perl.c
index 2eca5267b0..8e11c43cbf 100644
--- a/perl.c
+++ b/perl.c
@@ -658,7 +658,7 @@ setuid perl scripts securely.\n");
 	return 255;
 #endif
 
-#if defined(NeXT) && defined(__DYNAMIC__)
+#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
     _dyld_lookup_and_bind
 	("__environ", (unsigned long *) &environ_pointer, NULL);
 #endif /* environ */
diff --git a/perl.h b/perl.h
index c01701edc4..3b608f84c3 100644
--- a/perl.h
+++ b/perl.h
@@ -650,7 +650,8 @@ Free_t   Perl_mfree _((Malloc_t where));
 /* Configure already sets Direntry_t */
 #if defined(I_DIRENT)
 #   include <dirent.h>
-#   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
+    /* NeXT needs dirent + sys/dir.h */
+#   if  defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
 #	include <sys/dir.h>
 #   endif
 #else
@@ -1380,7 +1381,7 @@ typedef I32 (*filter_t) _((int, SV *, int));
 #      else
 #        ifdef I_MACH_CTHREADS
 #          include <mach/cthreads.h>
-#          if defined(__NeXT__) && defined(PERL_POLLUTE_MALLOC)
+#          if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
 #            define MUTEX_INIT_CALLS_MALLOC
 #          endif
 typedef cthread_t	perl_os_thread;
@@ -1775,13 +1776,13 @@ END_EXTERN_C
 #endif
 
 #ifndef __cplusplus
-#  ifdef __NeXT__ /* or whatever catches all NeXTs */
+#  if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
 #  else
 #    if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
 char *crypt _((const char*, const char*));
 #    endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
-#  endif /* !__NeXT__ */
+#  endif /* !NeXT && !__NeXT__ */
 #  ifndef DONT_DECLARE_STD
 #    ifndef getenv
 char *getenv _((const char*));
@@ -1870,26 +1871,32 @@ int runops_debug _((void));
 #endif
 #endif
 
-
 /* _ (for $_) must be first in the following list (DEFSV requires it) */
 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
 
-/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
-#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
-#if !defined(DONT_DECLARE_STD) \
-	|| (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
-	|| defined(__sgi) || defined(__DGUX)
-extern char **	environ;	/* environment variables supplied via exec */
-#endif
-#else
-#  if defined(NeXT) && defined(__DYNAMIC__)
-
-#  include <mach-o/dyld.h>
+/* NeXT has problems with crt0.o globals */
+#if defined(__DYNAMIC__) && \
+    (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__))
+#  if defined(NeXT) || defined(__NeXT)
+#    include <mach-o/dyld.h>
+#    define environ (*environ_pointer)
 EXT char *** environ_pointer;
-#  define environ (*environ_pointer)
+#  else
+#    if defined(__APPLE__)
+#      include <crt_externs.h>	/* for the env array */
+#      define environ (*_NSGetEnviron())
+#    endif
 #  endif
-#endif /* environ processing */
-
+#else
+   /* VMS and some other platforms don't use the environ array */
+#  if !defined(VMS) || \
+      !defined(DONT_DECLARE_STD) || \
+      (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+      defined(__sgi) || \
+      defined(__DGUX)
+extern char **	environ;	/* environment variables supplied via exec */
+#  endif
+#endif
 
 /* handy constants */
 EXTCONST char PL_warn_uninit[]
diff --git a/pp_sys.c b/pp_sys.c
index a35a2060b9..85826cca73 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -869,8 +869,8 @@ PP(pp_sselect)
     /* If SELECT_MIN_BITS is greater than one we most probably will want
      * to align the sizes with SELECT_MIN_BITS/8 because for example
      * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
-     * UNIX, Solaris, NeXT) the smallest quantum select() operates on
-     * (sets bit) is 32 bits.  */
+     * UNIX, Solaris, NeXT, Rhapsody) the smallest quantum select() operates
+     * on (sets/tests/clears bits) is 32 bits.  */
     growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
 #  else
     growsize = sizeof(fd_set);
diff --git a/t/op/stat.t b/t/op/stat.t
index e989064f1a..6a5776d69c 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -184,14 +184,20 @@ unless($ENV{PERL_SKIP_TTY_TEST}) {
 	print "ok 37\n";
     }
     else {
-	unless (open(tty,"/dev/tty")) {
-	    print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
+	my $TTY = "/dev/tty";
+
+	$TTY = "/dev/ttyp0" if $^O eq 'rhapsody';
+
+	if (defined $TTY) {
+	    unless (open(TTY, $TTY)) {
+		print STDERR "Can't open $TTY--run t/TEST outside of make.\n";
+	    }
+	    if (-t TTY) {print "ok 36\n";} else {print "not ok 36\n";}
+	    if (-c TTY) {print "ok 37\n";} else {print "not ok 37\n";}
+	    close(TTY);
 	}
-	if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
-	if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
-	close(tty);
     }
-    if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
+    if (! -t TTY) {print "ok 38\n";} else {print "not ok 38\n";}
     if (-t)       {print "ok 39\n";} else {print "not ok 39\n";}
 }
 else {
diff --git a/x2p/util.c b/x2p/util.c
index 364dfe94fa..d43a1eb723 100644
--- a/x2p/util.c
+++ b/x2p/util.c
@@ -203,6 +203,9 @@ fatal(char *pat,...)
     exit(1);
 }
 
+#if defined(__APPLE_CC__)
+__private_extern__	/* warn() conflicts with libc */
+#endif
 void
 warn(char *pat,...)
 {