diff options
author | Larry Wall <lwall@scalpel.netlabs.com> | 1995-11-21 10:01:00 +1200 |
---|---|---|
committer | Larry <lwall@scalpel.netlabs.com> | 1995-11-21 10:01:00 +1200 |
commit | 4633a7c4bad06b471d9310620b7fe8ddd158cccd (patch) | |
tree | 37ebeb26a64f123784fd8fac6243b124767243b0 /ext/DynaLoader | |
parent | 8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f (diff) | |
download | perl-4633a7c4bad06b471d9310620b7fe8ddd158cccd.tar.gz |
5.002 beta 1
If you're adventurous, have a look at
ftp://ftp.sems.com/pub/outgoing/perl5.0/perl5.002beta1.tar.gz
Many thanks to Andy for doing the integration.
Obviously, if you consult the bugs database, you'll note there are
still plenty of buglets that need fixing, and several enhancements that
I've intended to put in still haven't made it in (Hi, Tim and Ilya).
But I think it'll be pretty stable. And you can start to fiddle around
with prototypes (which are, of course, still totally undocumented).
Packrats, don't worry too much about readvertising this widely.
Nowadays we're on a T1 here, so our bandwidth is okay.
Have the appropriate amount of jollity.
Larry
Diffstat (limited to 'ext/DynaLoader')
-rw-r--r-- | ext/DynaLoader/DynaLoader.pm | 12 | ||||
-rw-r--r-- | ext/DynaLoader/dl_os2.xs | 187 |
2 files changed, 193 insertions, 6 deletions
diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index 05053b849e..11051c090a 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -73,7 +73,7 @@ sub bootstrap { local($module) = $args[0]; local(@dirs, $file); - Carp::confess "Usage: DynaLoader::bootstrap(module)" unless $module; + Carp::confess("Usage: DynaLoader::bootstrap(module)") unless $module; # A common error on platforms which don't support dynamic loading. # Since it's fatal and potentially confusing we give a detailed message. @@ -108,7 +108,7 @@ sub bootstrap { # last resort, let dl_findfile have a go in all known locations $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file; - Carp::croak "Can't find loadable object for module $module in \@INC (@INC)" + Carp::croak("Can't find loadable object for module $module in \@INC (@INC)") unless $file; my $bootname = "boot_$module"; @@ -134,14 +134,14 @@ sub bootstrap { # it executed. my $libref = dl_load_file($file) or - Carp::croak "Can't load '$file' for module $module: ".dl_error()."\n"; + Carp::croak("Can't load '$file' for module $module: ".dl_error()."\n"); my @unresolved = dl_undef_symbols(); - Carp::carp "Undefined symbols present after loading $file: @unresolved\n" + Carp::carp("Undefined symbols present after loading $file: @unresolved\n") if @unresolved; my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or - Carp::croak "Can't find '$bootname' symbol in $file\n"; + Carp::croak("Can't find '$bootname' symbol in $file\n"); my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); @@ -250,7 +250,7 @@ sub dl_expandspec { my $file = $spec; # default output to input if ($osname eq 'VMS') { # dl_expandspec should be defined in dl_vms.xs - Carp::croak "dl_expandspec: should be defined in XS file!\n"; + Carp::croak("dl_expandspec: should be defined in XS file!\n"); } else { return undef unless -f $file; } diff --git a/ext/DynaLoader/dl_os2.xs b/ext/DynaLoader/dl_os2.xs new file mode 100644 index 0000000000..5ca213b985 --- /dev/null +++ b/ext/DynaLoader/dl_os2.xs @@ -0,0 +1,187 @@ +/* dl_os2.xs + * + * Platform: OS/2. + * Author: Andreas Kaiser (ak@ananke.s.bawue.de) + * Created: 08th December 1994 + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define INCL_BASE +#include <os2.h> + +#include "dlutils.c" /* SaveError() etc */ + +static ULONG retcode; + +static void * +dlopen(char *path, int mode) +{ + HMODULE handle; + char tmp[260], *beg, *dot; + char fail[300]; + ULONG rc; + + if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0) + return (void *)handle; + + /* Not found. Check for non-FAT name and try truncated name. */ + /* Don't know if this helps though... */ + for (beg = dot = path + strlen(path); + beg > path && !strchr(":/\\", *(beg-1)); + beg--) + if (*beg == '.') + dot = beg; + if (dot - beg > 8) { + int n = beg+8-path; + memmove(tmp, path, n); + memmove(tmp+n, dot, strlen(dot)+1); + if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0) + return (void *)handle; + } + + retcode = rc; + return NULL; +} + +static void * +dlsym(void *handle, char *symbol) +{ + ULONG rc, type; + PFN addr; + + rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); + if (rc == 0) { + rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); + if (rc == 0 && type == PT_32BIT) + return (void *)addr; + rc = ERROR_CALL_NOT_IMPLEMENTED; + } + retcode = rc; + return NULL; +} + +static char * +dlerror(void) +{ + static char buf[300]; + ULONG len; + + if (retcode == 0) + return NULL; + if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len)) + sprintf(buf, "OS/2 system error code %d", retcode); + else + buf[len] = '\0'; + retcode = 0; + return buf; +} + + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +static char * +mod2fname(sv) + SV *sv; +{ + static char fname[9]; + int pos = 7; + int len; + AV *av; + SV *svp; + char *s; + + if (!SvROK(sv)) croak("Not a reference given to mod2fname"); + sv = SvRV(sv); + if (SvTYPE(sv) != SVt_PVAV) + croak("Not array reference given to mod2fname"); + if (av_len((AV*)sv) < 0) + croak("Empty array reference given to mod2fname"); + s = SvPV(*av_fetch((AV*)sv, av_len((AV*)sv), FALSE), na); + strncpy(fname, s, 8); + if ((len=strlen(s)) < 7) pos = len; + fname[pos] = '_'; + fname[pos + 1] = '\0'; + return (char *)fname; +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename) + char * filename + CODE: + int mode = 1; /* Solaris 1 */ +#ifdef RTLD_LAZY + mode = RTLD_LAZY; /* Solaris 2 */ +#endif + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + RETVAL = dlopen(filename, mode) ; + DLDEBUG(2,fprintf(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: +#ifdef DLSYM_NEEDS_UNDERSCORE + char symbolname_buf[1024]; + symbolname = dl_add_underscore(symbolname, symbolname_buf); +#endif + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + RETVAL = dlsym(libhandle, symbolname); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + +char * +mod2fname(sv) + SV *sv; + + +# 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,fprintf(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. |