Symbian port of Perl

Message-ID: <B356D8F434D20B40A8CEDAEC305A1F2453D653@esebe105.NOE.Nokia.com>

p4raw-id: //depot/perl@24271

3 files changed, 247 insertions, 3 deletions

diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 8476dad187..426d3a5a27 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -26,6 +26,10 @@ sub to_string {
 #   
 #  -- added by VKON, 03-10-2004 to separate $^O-specific between OSes
 #     (so that Win32 never checks for $^O eq 'VMS' for example)
+#
+# The $^O tests test both for $^O and for $Config{osname}.
+# The latter is better for some for cross-compilation setups.
+#
 sub expand_os_specific {
     my $s = shift;
     for ($s) {
@@ -36,7 +40,7 @@ sub expand_os_specific {
 	  if ($expr =~ m[^(.*?)<<\|\$\^O-$op-$os>>(.*?)$]s) {
 	      # #if;#else;#endif
 	      my ($if,$el) = ($1,$2);
-	      if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) {
+	      if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) {
 		  $if
 	      }
 	      else {
@@ -45,7 +49,7 @@ sub expand_os_specific {
 	  }
 	  else {
 	      # #if;#endif
-	      if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) {
+	      if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) {
 		  $expr
 	      }
 	      else {
@@ -496,13 +500,22 @@ sub dl_findfile {
             push(@names,"$_.a")          if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
             push(@names, $_);
         }
+	my $dirsep = '/';
+	<<$^O-eq-symbian>>
+	$dirsep = '\\';
+	if ($0 =~ /^([a-z]):/i) {
+	    my $drive = $1;
+	    @dirs = map { "$drive:$_" } @dirs;
+	    @dl_library_path = map { "$drive:$_" } @dl_library_path;
+	}
+	<</$^O-eq-symbian>>
         foreach $dir (@dirs, @dl_library_path) {
             next unless -d $dir;
 	    <<$^O-eq-VMS>>
             chop($dir = VMS::Filespec::unixpath($dir));
 	    <</$^O-eq-VMS>>
             foreach $name (@names) {
-		my($file) = "$dir/$name";
+		my($file) = "$dir$dirsep$name";
                 print STDERR " checking in $dir for $name\n" if $dl_debug;
 		$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
 		#$file = _check_file($file);
diff --git a/ext/DynaLoader/dl_symbian.xs b/ext/DynaLoader/dl_symbian.xs
new file mode 100644
index 0000000000..6cf1d1f658
--- /dev/null
+++ b/ext/DynaLoader/dl_symbian.xs
@@ -0,0 +1,223 @@
+/* dl_symbian.xs
+ * 
+ * Platform:	Symbian 7.0s
+ * Author:	Jarkko Hietaniemi <jarkko.hietaniemi@nokia.com>
+ * Copyright:	2004, Nokia
+ * License:	Artistic/GPL
+ *
+ */
+
+/*
+ * In Symbian DLLs there is no name information, one can only access
+ * the functions by their ordinals.  Perl, however, very much would like
+ * to load functions by their names.  We fake this by having a special
+ * setup function at the ordinal 1 (this is arranged by building the DLLs
+ * in a special way).  The setup function builds a Perl hash mapping the
+ * names to the ordinals, and the hash is then used by dlsym().
+ *
+ */
+
+#include <e32base.h>
+#include <eikdll.h>
+#include <utf.h>
+
+/* This is a useful pattern: first include the Symbian headers,
+ * only after that the Perl ones.  Otherwise you will get a lot
+ * trouble because of Symbian's New(), Copy(), etc definitions. */
+
+#define DL_SYMBIAN_XS
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+START_EXTERN_C
+
+void *dlopen(const char *filename, int flag);
+void *dlsym(void *handle, const char *symbol);
+int   dlclose(void *handle);
+const char *dlerror(void);
+
+extern void*  memset(void *s, int c, size_t n);
+extern size_t strlen(const char *s);
+
+END_EXTERN_C
+
+#include "dlutils.c"
+
+#define RTLD_LAZY   0x0001
+#define RTLD_NOW    0x0002
+#define RTLD_GLOBAL 0x0004
+
+#ifndef NULL
+#  define NULL 0
+#endif
+
+/* No need to pull in symbian_dll.cpp for this. */
+#define symbian_get_vars() ((void*)Dll::Tls())
+
+const TInt KPerlDllSetupFunction = 1;
+
+typedef struct {
+    RLibrary	handle;
+    TInt	error;
+    HV*		symbols;
+} PerlSymbianLibHandle;
+
+typedef void (*PerlSymbianLibInit)(void *);
+
+void* dlopen(const char *filename, int flags) {
+    TBuf16<KMaxFileName> utf16fn;
+    const TUint8* utf8fn = (const TUint8*)filename;
+    PerlSymbianLibHandle* h = NULL;
+    TInt error;
+
+    error =
+        CnvUtfConverter::ConvertToUnicodeFromUtf8(utf16fn, TPtrC8(utf8fn));
+    if (error == KErrNone) {
+        h = new PerlSymbianLibHandle;
+        if (h) {
+            h->error   = KErrNone;
+            h->symbols = Nullhv;
+        } else
+            error = KErrNoMemory;
+    }
+
+    if (h && error == KErrNone) {
+        error = (h->handle).Load(utf16fn);
+        if (error == KErrNone) {
+            TLibraryFunction init = (h->handle).Lookup(KPerlDllSetupFunction);
+            ((PerlSymbianLibInit)init)(h);
+        } else {
+	    free(h);
+            h = NULL;
+        }
+    }
+
+    if (h)
+        h->error = error;
+
+    return h;
+}
+
+void* dlsym(void *handle, const char *symbol) {
+    if (handle) {
+        dTHX;
+        PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+        HV* symbols = h->symbols;
+        if (symbols) {
+            SV** svp = hv_fetch(symbols, symbol, strlen(symbol), FALSE);
+            if (svp && *svp && SvIOK(*svp)) {
+                IV ord = SvIV(*svp);
+                if (ord > 0)
+                    return (void*)((h->handle).Lookup(ord));
+            }
+        }
+    }
+    return NULL;
+}
+
+int dlclose(void *handle) {
+    PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+    if (h) {
+        (h->handle).Close();
+        if (h->symbols) {
+            dTHX;
+            hv_undef(h->symbols);
+            h->symbols = NULL;
+        }
+        return 0;
+    } else
+        return 1;
+}
+
+const char* dlerror(void) {
+    return 0;	/* Bad interface: assumes static data. */
+}
+
+static void
+dl_private_init(pTHX)
+{
+    (void)dl_generic_private_init(aTHX);
+}
+ 
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+PROTOTYPES:  ENABLE
+
+BOOT:
+    (void)dl_private_init(aTHX);
+
+
+void
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+  PREINIT:
+    PerlSymbianLibHandle* h;
+  CODE:
+{
+    ST(0) = sv_newmortal();
+    h = (PerlSymbianLibHandle*)dlopen(filename, flags);
+    if (h && h->error == KErrNone)
+	sv_setiv(ST(0), PTR2IV(h));
+    else
+	PerlIO_printf(Perl_debug_log, "(dl_load_file %s %d)",
+                      filename, h ? h->error : -1);
+}
+
+
+int
+dl_unload_file(libhandle)
+    void *	libhandle
+  CODE:
+    RETVAL = (dlclose(libhandle) == 0 ? 1 : 0);
+  OUTPUT:
+    RETVAL
+
+
+void
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    PREINIT:
+    void *sym;
+    CODE:
+    PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)libhandle;
+    sym = dlsym(libhandle, symbolname);
+    ST(0) = sv_newmortal();
+    if (sym)
+       sv_setiv(ST(0), PTR2IV(sym));
+    else
+       PerlIO_printf(Perl_debug_log, "(dl_find_symbol %s %d)",
+                     symbolname, h ? h->error : -1);
+
+
+void
+dl_undef_symbols()
+    CODE:
+
+
+
+# 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:
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+					(void(*)(pTHX_ CV *))symref,
+					filename)));
+
+
+char *
+dl_error()
+    CODE:
+    dMY_CXT;
+    RETVAL = dl_last_error;
+    OUTPUT:
+    RETVAL
+
+# end.
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 474c93d367..956848ad94 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -8,6 +8,12 @@
  *                      files when the interpreter exits
  */
 
+#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
+#   include "EXTERN.h"
+#   include "perl.h"
+#   include "XSUB.h"
+#endif
+
 #ifndef XS_VERSION
 #  define XS_VERSION "0"
 #endif
@@ -110,6 +116,7 @@ dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
 }
 
 
+#ifndef SYMBIAN
 /* SaveError() takes printf style args and saves the result in dl_last_error */
 static void
 SaveError(pTHX_ const char* pat, ...)
@@ -133,4 +140,5 @@ SaveError(pTHX_ const char* pat, ...)
     sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
 }
+#endif