diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-10-15 03:09:58 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-10-15 03:09:58 +0000 |
commit | 1cfa4ec74d4933da0d98282eed6171cc7ac307b6 (patch) | |
tree | 16e2d6216053294709570ec219063df3229545f4 /ext | |
parent | 1e2878e610af032604518a9feca8663968d7369a (diff) | |
download | perl-1cfa4ec74d4933da0d98282eed6171cc7ac307b6.tar.gz |
check in all confperl changes as of change#1964 into cfgperl
p4raw-link: @1964 on //depot/confperl: 2d85315bb227e0962a693eaaadc3f40ca2fbf49b
p4raw-id: //depot/cfgperl@1971
Diffstat (limited to 'ext')
-rw-r--r-- | ext/DynaLoader/dl_vmesa.xs | 173 | ||||
-rw-r--r-- | ext/Thread/Thread.xs | 21 |
2 files changed, 190 insertions, 4 deletions
diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs new file mode 100644 index 0000000000..34d4dddad7 --- /dev/null +++ b/ext/DynaLoader/dl_vmesa.xs @@ -0,0 +1,173 @@ +/* dl_vmesa.xs + * + * Platform: VM/ESA, possibly others which use dllload etc. + * Author: Neale Ferguson (neale@mailbox.tabnsw.com.au) + * Created: 23rd Septemer, 1998 + * + * + */ + +/* Porting notes: + + + Definition of VM/ESA dynamic Linking functions + ============================================== + In order to make this implementation easier to understand here is a + quick definition of the VM/ESA Dynamic Linking functions which are + used here. + + dlopen + ------ + void * + dlopen(const char *path) + + This function takes the name of a dynamic object file and returns + a descriptor which can be used by dlsym later. It returns NULL on + error. + + + dllsym + ------ + void * + dlsym(void *handle, char *symbol) + + Takes the handle returned from dlopen and the name of a symbol to + get the address of. If the symbol was found a pointer is + returned. It returns NULL on error. + + dlerror + ------- + char * dlerror() + + Returns a null-terminated string which describes the last error + that occurred with the other dll functions. After each call to + dlerror the error message will be reset to a null pointer. The + SaveError function is used to save the error as soo as it happens. + + + Return Types + ============ + In this implementation the two functions, dl_load_file & + dl_find_symbol, return void *. This is because the underlying SunOS + dynamic linker calls also return void *. This is not necessarily + the case for all architectures. For example, some implementation + will want to return a char * for dl_load_file. + + If void * is not appropriate for your architecture, you will have to + change the void * to whatever you require. If you are not certain of + how Perl handles C data types, I suggest you start by consulting + Dean Roerich's Perl 5 API document. Also, have a look in the typemap + file (in the ext directory) for a fairly comprehensive list of types + that are already supported. If you are completely stuck, I suggest you + post a message to perl5-porters, comp.lang.perl.misc or if you are really + desperate to me. + + Remember when you are making any changes that the return value from + dl_load_file is used as a parameter in the dl_find_symbol + function. Also the return value from find_symbol is used as a parameter + to install_xsub. + + + Dealing with Error Messages + ============================ + In order to make the handling of dynamic linking errors as generic as + possible you should store any error messages associated with your + implementation with the StoreError function. + + In the case of VM/ESA the function dlerror returns the error message + associated with the last dynamic link error. As the VM/ESA dynamic + linker functions return NULL on error every call to a VM/ESA dynamic + dynamic link routine is coded like this + + RETVAL = dlopen(filename) ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + + Note that SaveError() takes a printf format string. Use a "%s" as + the first parameter if the error may contain and % characters. + +*/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <dll.h> + + +#include "dlutils.c" /* SaveError() etc */ + + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename, flags=0) + char * filename + int flags + CODE: + if (flags & 0x01) + warn("Can't make loaded symbols global on this platform while loading %s",filename); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + RETVAL = dlopen(filename) ; + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) 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: + 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=%lx)\n", + perl_name, (unsigned long) symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index a4bff69a9b..84f9f57fc5 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -230,7 +230,10 @@ newthread (SV *startsv, AV *initargs, char *classname) static int attr_inited = 0; sigset_t fullmask, oldmask; #endif - +#ifdef PTHREAD_SETDETACHSTATE_ARG2_POINTER + static int attr_joinable = ATTR_JOINABLE; +#endif + savethread = thr; thr = new_struct_thread(thr); SPAGAIN; @@ -264,14 +267,24 @@ newthread (SV *startsv, AV *initargs, char *classname) #ifdef OLD_PTHREADS_API #ifdef VMS /* This is available with the old pthreads API, but only with */ -/* DecThreads (VMS and Digital Unix) */ +/* DecThreads (VMS and Digital Unix (which has and uses the new one)) */ if (err == 0) err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE); #endif -#else +#else /* !defined(VMS) */ +#ifdef ATTR_JOINABLE if (err == 0) err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE); -#endif +#else /* !defined(ATTR_JOINABLE) */ +#ifdef __UNDETACHED + if (err == 0) + err = pthread_attr_setdetachstate(&attr, &__undetached); +#else /* !defined(__UNDETACHED) */ + croak("panic: can't pthread_attr_setdetachstate"); +#endif /* __UNDETACHED */ +#endif /* ATTR_JOINABLE */ +#endif /* VMS */ +#endif /* OLD_PTHREADS_API */ } if (err == 0) #ifdef OLD_PTHREADS_API |