From: Jarkko Hietaniemi Date: Mon, 10 Oct 2005 14:28:31 +0000 (+0300) Subject: Symbian bleadperl@25725 update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0added8b15cac1ea71069426f604832d35edbd96;p=p5sagit%2Fp5-mst-13.2.git Symbian bleadperl@25725 update Message-ID: p4raw-id: //depot/perl@25730 --- diff --git a/ext/Compress/Zlib/Zlib.xs b/ext/Compress/Zlib/Zlib.xs index 19b5b6b..cace39b 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 395e4e1..b7be30e 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 a97dc47..8be786b 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 #include #include @@ -23,23 +47,41 @@ #include +#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 n={sizeof(s)/2-1,s} +# define _LIT_NO_L(n, s) static const TLitC 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 9472641..a36aa95 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 16e911c..a1a0422 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 buf16; - TBuf8 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 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 ckerr; + TBuf8 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 afbc9ef..f4140a9 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))$/ ) {