Symbian bleadperl@25725 update

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

p4raw-id: //depot/perl@25730

6 files changed, 187 insertions, 41 deletions

diff --git a/ext/Compress/Zlib/Zlib.xs b/ext/Compress/Zlib/Zlib.xs
index 19b5b6b000..cace39b8fb 100644
--- a/ext/Compress/Zlib/Zlib.xs
+++ b/ext/Compress/Zlib/Zlib.xs
@@ -634,6 +634,7 @@ SV * sv ;
 char * string ;
 #endif
 {
+    dTHX;
     bool wipe = 0 ;
     
     SvGETMAGIC(sv);
diff --git a/ext/Compress/Zlib/zlib-src/trees.c b/ext/Compress/Zlib/zlib-src/trees.c
index 395e4e1681..b7be30ecfc 100644
--- a/ext/Compress/Zlib/zlib-src/trees.c
+++ b/ext/Compress/Zlib/zlib-src/trees.c
@@ -126,13 +126,23 @@ struct static_tree_desc_s {
     int     max_length;          /* max bit length for the codes */
 };
 
-local static_tree_desc  static_l_desc =
+#if defined(__SYMBIAN32__)
+# define NO_WRITEABLE_DATA
+#endif
+
+#ifdef NO_WRITEABLE_DATA
+# define DEFINE_LOCAL_STATIC const local
+#else /* #ifdef NO_WRITEABLE_DATA */
+# define DEFINE_LOCAL_STATIC local
+#endif /* #ifdef NO_WRITEABLE_DATA */
+ 
+DEFINE_LOCAL_STATIC static_tree_desc  static_l_desc =
 {static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS};
 
-local static_tree_desc  static_d_desc =
+DEFINE_LOCAL_STATIC static_tree_desc  static_d_desc =
 {static_dtree, extra_dbits, 0,          D_CODES, MAX_BITS};
 
-local static_tree_desc  static_bl_desc =
+DEFINE_LOCAL_STATIC static_tree_desc  static_bl_desc =
 {(const ct_data *)0, extra_blbits, 0,   BL_CODES, MAX_BL_BITS};
 
 /* ===========================================================================
@@ -249,12 +259,14 @@ local void tr_static_init()
 
     if (static_init_done) return;
 
+#ifndef NO_WRITEABLE_DATA
     /* For some embedded targets, global variables are not initialized: */
     static_l_desc.static_tree = static_ltree;
     static_l_desc.extra_bits = extra_lbits;
     static_d_desc.static_tree = static_dtree;
     static_d_desc.extra_bits = extra_dbits;
     static_bl_desc.extra_bits = extra_blbits;
+#endif /* #ifndef NO_WRITEABLE_DATA */
 
     /* Initialize the mapping length (0..255) -> length code (0..28) */
     length = 0;
diff --git a/symbian/PerlApp.cpp b/symbian/PerlApp.cpp
index a97dc47c3a..8be786b2f8 100644
--- a/symbian/PerlApp.cpp
+++ b/symbian/PerlApp.cpp
@@ -1,9 +1,33 @@
 /* Copyright (c) 2004-2005 Nokia. All rights reserved. */
 
-/* The PerlApp application is licensed under the same terms as Perl itself. */
+/* The PerlApp application is licensed under the same terms as Perl itself.
+ * Note that this PerlApp is for Symbian/Series 60 smartphones and has nothing
+ * whatsoever to do with the ActiveState PerlApp. */
+
+/* This source code can be compiled into "PerlApp" which is the simple
+ * launchpad application/demonstrator, or into "PerlMin", which is the
+ * minimal Perl-on-Series-60 application.  Define the cpp symbols
+ * PerlMin (a boolean), PerlMinUid (the Symbian application uid in
+ * the 0x... format), and PerlMinName (a C wide string, with the L prefix)
+ * to compile as "PerlMin". */
 
 #include "PerlApp.h"
 
+#ifdef PerlMinSample
+# define PerlMin
+# define PerlMinUid 0x0beefadd
+# define PerlMinName L"PerlMin"
+#endif
+
+#ifdef PerlMin
+# ifndef PerlMinUid
+#   error PerlMin defined but PerlMinUid undefined
+# endif
+# ifndef PerlMinName
+#  error PerlMin defined but PerlMinName undefined
+# endif
+#endif
+
 #include <avkon.hrh>
 #include <aknnotewrappers.h> 
 #include <apparc.h>
@@ -23,23 +47,41 @@
 
 #include <coemain.h>
 
+#ifndef PerlMin
+
 #include "PerlApp.hrh"
 #include "PerlApp.rsg"
 
+#endif // #ifndef PerlMin
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "PerlBase.h"
 
-const TUid KPerlAppUid = { 0x102015F6 };
+const TUid KPerlAppUid = {
+#ifdef PerlMinUid
+  PerlMinUid
+#else
+  0x102015F6
+#endif
+};
+
+_LIT(KDefaultScript, "default.pl");
 
 // This is like the Symbian _LIT() but without the embedded L prefix,
 // which enables using #defined constants (which need to carry their
 // own L prefix).
 #ifndef _LIT_NO_L
-#define _LIT_NO_L(n, s) static const TLitC<sizeof(s)/2> n={sizeof(s)/2-1,s}
+# define _LIT_NO_L(n, s) static const TLitC<sizeof(s)/2> n={sizeof(s)/2-1,s}
 #endif // #ifndef _LIT_NO_L
 
+#ifdef PerlMinName
+_LIT_NO_L(KAppName, PerlMinName);
+#else
 _LIT(KAppName, "PerlApp");
+#endif
+
+#ifndef PerlMin
 _LIT_NO_L(KFlavor, PERL_SYMBIANSDK_FLAVOR);
 _LIT(KAboutFormat,
      "Perl %d.%d.%d, Symbian port %d.%d.%d, built for %S SDK %d.%d");
@@ -49,6 +91,7 @@ _LIT(KInboxPrefix, "\\System\\Mail\\");
 _LIT(KScriptPrefix, "\\Perl\\");
 
 _LIT8(KModulePrefix, SITELIB); // SITELIB from Perl config.h
+#endif // #ifndef PerlMin
 
 typedef TBuf<256>  TMessageBuffer;
 typedef TBuf8<256> TPeekBuffer;
@@ -98,6 +141,10 @@ CPerlAppUi::~CPerlAppUi()
         iDoorObserver->NotifyExit(MApaEmbeddedDocObserver::EEmpty);
 }
 
+static void DoRunScriptL(TFileName aScriptName);
+
+#ifndef PerlMin
+
 static TBool DlgOk(CAknNoteDialog* dlg)
 {
     return dlg && dlg->RunDlgLD() == EAknSoftkeyOk;
@@ -313,18 +360,6 @@ static TBool InstallStuffL(const TFileName &aSrc, TParse aDrive, TParse aFile, T
     return EFalse;
 }
 
-static void DoRunScriptL(TFileName aScriptName)
-{
-    CPerlBase* perl = CPerlBase::NewInterpreterLC();
-    TRAPD(error, perl->RunScriptL(aScriptName));
-    if (error != KErrNone) {
-        TMessageBuffer message;
-        message.Format(_L("Error %d"), error);
-        YesNoDialogL(message);
-    }
-    CleanupStack::PopAndDestroy(perl);
-}
-
 static TBool RunStuffL(const TFileName& aScriptName, TPeekBuffer aPeekBuffer)
 {
     TBool isModule = EFalse;
@@ -391,14 +426,41 @@ void CPerlAppUi::InstallOrRunL(const TFileName& aFileName)
         Exit();
 }
 
+#endif // #ifndef PerlMin
+
+static void DoRunScriptL(TFileName aScriptName)
+{
+    CPerlBase* perl = CPerlBase::NewInterpreterLC();
+    TRAPD(error, perl->RunScriptL(aScriptName));
+#ifndef PerlMin
+    if (error != KErrNone) {
+        TMessageBuffer message;
+        message.Format(_L("Error %d"), error);
+        YesNoDialogL(message);
+    }
+#endif
+    CleanupStack::PopAndDestroy(perl);
+}
+
 void CPerlAppUi::OpenFileL(const TDesC& aFileName)
 {
+#ifndef PerlMin
     InstallOrRunL(aFileName);
+#else
+    DoRunScriptL(aFileName);
+#endif
     return;
 }
 
 TBool CPerlAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName */, const TDesC8& /* aTail */)
 {
+    if (aCommand == EApaCommandRun) {
+        TFileName appName = Application()->AppFullName();
+	TParse p;
+	p.Set(KDefaultScript, &appName, NULL);
+	DoRunScriptL(p.FullName());
+	return EFalse;
+    }
     return aCommand == EApaCommandOpen ? ETrue : EFalse;
 }
 
@@ -409,7 +471,9 @@ void CPerlAppUi::SetFs(const RFs& aFs)
 
 void CPerlAppUi::HandleCommandL(TInt aCommand)
 {
+#ifndef PerlMin
     TMessageBuffer message;
+#endif // #ifndef PerlMin
 
     switch(aCommand)
     {
@@ -417,6 +481,7 @@ void CPerlAppUi::HandleCommandL(TInt aCommand)
     case EAknSoftkeyExit:
         Exit();
         break;
+#ifndef PerlMin
     case EPerlAppCommandAbout:
         {
             message.Format(KAboutFormat,
@@ -481,7 +546,7 @@ void CPerlAppUi::HandleCommandL(TInt aCommand)
             InformationNoteL(message);
         }
         break;
-
+#endif // #ifndef PerlMin
     default:
         Panic(EPerlAppCommandUnknown);
         break;
diff --git a/symbian/TODO b/symbian/TODO
index 94726415d1..a36aa95e4e 100644
--- a/symbian/TODO
+++ b/symbian/TODO
@@ -43,8 +43,11 @@
 
 - in S60 1.2 (at least in 3650 Nokia 3650 v3.11) setjmp/longjmp is
   fragile (see Symbian FAQ-0929), intensive debugging and fix needed
-- in S60 2.x (at least in Nokia 6630 v4.03.11) launching scripts via
+- in S60 2.6 (at least in Nokia 6630 v4.03.11) launching scripts via
   FExplorer does not open up the console
+- in the SDK the build creates DLLs in the system area
+  (e.g. epoc32\release\thumb\urel\io.dll), this is dangerous.  Prefix them?
+  (needs changes in xsbuild and DynaLoader/XSLoader)
 
 =head2 Unicode
 
diff --git a/symbian/symbian_utils.cpp b/symbian/symbian_utils.cpp
index 16e911c81e..a1a0422079 100644
--- a/symbian/symbian_utils.cpp
+++ b/symbian/symbian_utils.cpp
@@ -42,30 +42,95 @@ extern "C" {
         return ((CPerlBase*)PL_appctx)->ConsoleWrite(fd, b, n);
     }
     static const char NullErr[] = "";
-    EXPORT_C char* symbian_get_error_string(const TInt error)
+    EXPORT_C char* symbian_get_error_string(TInt error)
     {
+	// CTextResolver seems to be unreliable, so we roll our own
+        // at least for the basic Symbian errors (but does not work
+        // for the various subsystems).
         dTHX;
         if (error >= 0)
             return strerror(error);
-        CTextResolver* textResolver = CTextResolver::NewL();
-        CleanupStack::PushL(textResolver);
-        TBuf<KErrorResolverMaxTextLength> buf16;
-        TBuf8<KErrorResolverMaxTextLength> buf8;
-        if (error != KErrNone)
-            buf16 = textResolver->ResolveError(error);
-        if (buf16.Length()) {
-            if (CnvUtfConverter::ConvertFromUnicodeToUtf8(buf8, buf16) !=
-                KErrNone) {
-                CleanupStack::PopAndDestroy(textResolver);
-                return (char*)NullErr;
-            }
-        }
+	error = -error; // flip
+	const TInt KErrStringMax = 256;
+	typedef struct {
+	  const char* kerr;
+	  const char* desc;
+	} kerritem;
+	static const kerritem kerrtable[] = {
+	  { "None",           /*    0 */ "No error"},
+	  { "NotFound",       /*   -1 */ "Unable to find the specified object"},
+	  { "General",        /*   -2 */ "General (unspecified) error"},
+	  { "Cancel",         /*   -3 */ "The operation was cancelled"},
+	  { "NoMemory",       /*   -4 */ "Not enough memory"},
+	  { "NotSupported",   /*   -5 */ "The operation requested is not supported"},
+	  { "Argument",       /*   -6 */ "Bad request"},
+	  { "TotalLossOfPrecision",
+	                      /*   -7 */ "Total loss of precision"},
+	  { "BadHandle",      /*   -8 */ "Bad object"},
+	  { "Overflow",       /*   -9 */ "Overflow"},
+	  { "Underflow",      /*  -10 */ "Underflow"},
+	  { "AlreadyExists",  /*  -11 */ "Already exists"},
+	  { "PathNotFound",   /*  -12 */ "Unable to find the specified folder"},
+	  { "Died",           /*  -13 */ "Closed"},
+	  { "InUse",          /*  -14 */
+	    "The specified object is currently in use by another program"},
+	  { "ServerTerminated",       /*  -15 */ "Server has closed"},
+	  { "ServerBusy",     /*  -16 */ "Server busy"},
+	  { "Completion",     /*  -17 */ "Completion error"},
+	  { "NotReady",       /*  -18 */ "Not ready"},
+	  { "Unknown",        /*  -19 */ "Unknown error"},
+	  { "Corrupt",        /*  -20 */ "Corrupt"},
+	  { "AccessDenied",   /*  -21 */ "Access denied"},
+	  { "Locked",         /*  -22 */ "Locked"},
+	  { "Write",          /*  -23 */ "Failed to write"},
+	  { "DisMounted",     /*  -24 */ "Wrong disk present"},
+	  { "Eof",            /*  -25 */ "Unexpected end of file"},
+	  { "DiskFull",       /*  -26 */ "Disk full"},
+	  { "BadDriver",      /*  -27 */ "Bad device driver"},
+	  { "BadName",        /*  -28 */ "Bad name"},
+	  { "CommsLineFail",  /*  -29 */ "Comms line failed"},
+	  { "CommsFrame",     /*  -30 */ "Comms frame error"},
+	  { "CommsOverrun",   /*  -31 */ "Comms overrun error"},
+	  { "CommsParity",    /*  -32 */ "Comms parity error"},
+	  { "TimedOut",       /*  -33 */ "Timed out"},
+	  { "CouldNotConnect",/*  -34 */ "Failed to connect"},
+	  { "CouldNotDisconnect",
+	                      /* -35 */ "Failed to disconnect"},
+	  { "Disconnected",   /* -36 */ "Disconnected"},
+	  { "BadLibraryEntryPoint",
+	                      /*  -37 */ "Bad library entry point"},
+	  { "BadDescriptor",  /*  -38 */ "Bad descriptor"},
+	  { "Abort",          /*  -39 */ "Interrupted"},
+	  { "TooBig",         /*  -40 */ "Too big"},
+	  { "DivideByZero",   /*  -41 */ "Divide by zero"},
+	  { "BadPower",       /*  -42 */ "Batteries too low"},
+	  { "DirFull",        /*  -43 */ "Folder full"},
+	  { "KErrHardwareNotAvailable",
+	                      /*  -44 */ "Hardware is not available"},
+	  { "SessionClosed",  /*  -45 */ "Session was closed"},
+	  { "PermissionDenied",
+	                      /*  -46 */ "Permission denied"}
+	};
+	const TInt n = sizeof(kerrtable) / sizeof(kerritem *);
+	TBuf8<KErrStringMax> buf8;
+	if (error >= 0 && error < n) {
+	  const char *kerr = kerrtable[error].kerr;
+	  const char *desc = kerrtable[error].desc;
+	  const TPtrC8 kerrp((const unsigned char *)kerr, strlen(kerr));
+	  const TPtrC8 descp((const unsigned char *)desc, strlen(desc));
+	  TBuf8<KErrStringMax> ckerr;
+	  TBuf8<KErrStringMax> cdesc;
+	  ckerr.Copy(kerrp);
+	  cdesc.Copy(descp);
+	  buf8.Format(_L8("K%S (%d) %S"), &ckerr, error, &cdesc);
+		     
+	} else {
+	  buf8.Format(_L8("Symbian error %d"), error);
+	}
         SV* sv = Perl_get_sv(aTHX_ "\005", TRUE); /* $^E or ${^OS_ERROR} */
         if (!sv)
             return (char*)NullErr;
         sv_setpv(sv, (const char *)buf8.PtrZ());
-        SvUTF8_on(sv);
-        CleanupStack::PopAndDestroy(textResolver);
         return SvPV_nolen(sv);
     }
     EXPORT_C void symbian_sleep_usec(const long usec)
diff --git a/symbian/xsbuild.pl b/symbian/xsbuild.pl
index afbc9ef4e5..f4140a96c0 100644
--- a/symbian/xsbuild.pl
+++ b/symbian/xsbuild.pl
@@ -214,6 +214,10 @@ sub write_mmp {
     read_mmp( \%CONF, "_init.mmp" );
     read_mmp( \%CONF, "$base.mmp" );
 
+    if ($base eq 'Zlib') {
+	push @{$CONF{USERINCLUDE}}, "$CWD\\zlib-src";
+    }
+
     for my $ui ( @{$userinclude} ) {
         $ui =~ s!/!\\!g;
         if ( $ui =~ m!^(?:[CD]:)?\\! ) {
@@ -427,7 +431,7 @@ sub xsconfig {
         }
     }
     if ( my @c = glob("*.c *.cpp */*.c */*.cpp") ) {
-        @c = grep { ! m:^zlib-src/: } @c if $ext eq 'ext\Compress\Zlib';
+	@c = grep { ! m:^zlib-src/: } @c if $ext eq 'ext\Compress\Zlib';
         for my $c (@c) {
             $c =~ s:/:\\:g;
             $src{$c}++;
@@ -441,10 +445,6 @@ sub xsconfig {
             $incdir{"$dir\\$h"}++ unless $h eq ".";
         }
     }
-    if ( $ext eq 'ext\Compress\Zlib' ) {
-        system_echo("perl -pi.bak -e s:True:False: config.in") == 0
-          or die "$0: changing BUILD_ZLIB failed: $!\n";
-    }
     if ( exists $EXTCFG{$ext} ) {
         for my $cfg ( @{ $EXTCFG{$ext} } ) {
             if ( $cfg =~ /^([-+])?(.+\.(c|cpp|h))$/ ) {