From: Wilfredo Sánchez Date: Fri, 13 Nov 1998 17:11:30 +0000 (-0800) Subject: First pass of integrating the Rhapsody port, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f1f23e8b15dc90b39e5be39711437f27f72b526;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/Configure b/Configure index 8224931..45c4761 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$$ <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 <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 fa46532..2ef8331 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 0000000..7513bf2 --- /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 + +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 90791f9..33e17f0 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 0000000..7f65223 --- /dev/null +++ b/hints/rhapsody.sh @@ -0,0 +1,54 @@ +## +# Rhapsody (Mac OS X Server) hints +# Wilfredo Sanchez +## + +# 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 006a550..417357b 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 2716045..9d2704b 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 2eca526..8e11c43 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 c01701e..3b608f8 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 -# 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 # endif #else @@ -1380,7 +1381,7 @@ typedef I32 (*filter_t) _((int, SV *, int)); # else # ifdef I_MACH_CTHREADS # include -# 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 +/* NeXT has problems with crt0.o globals */ +#if defined(__DYNAMIC__) && \ + (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__)) +# if defined(NeXT) || defined(__NeXT) +# include +# define environ (*environ_pointer) EXT char *** environ_pointer; -# define environ (*environ_pointer) +# else +# if defined(__APPLE__) +# include /* 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 a35a206..85826cc 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 e989064..6a5776d 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 364dfe9..d43a1eb 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,...) {