summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--EXTERN.h4
-rw-r--r--INTERN.h36
-rw-r--r--MANIFEST33
-rw-r--r--Porting/curliff.pl7
-rw-r--r--Porting/makerel6
-rw-r--r--README.symbian352
-rw-r--r--XSUB.h7
-rw-r--r--av.c5
-rw-r--r--bytecode.pl1
-rwxr-xr-xconfigpm9
-rw-r--r--doio.c20
-rw-r--r--dump.c26
-rw-r--r--embed.fnc11
-rw-r--r--embed.h12
-rwxr-xr-xembed.pl61
-rw-r--r--embedvar.h93
-rw-r--r--ext/B/B.xs14
-rw-r--r--ext/ByteLoader/byterun.c13
-rw-r--r--ext/Data/Dumper/Dumper.xs4
-rw-r--r--ext/Digest/MD5/MD5.xs18
-rw-r--r--ext/Digest/MD5/t/files.t6
-rw-r--r--ext/DynaLoader/DynaLoader_pm.PL19
-rw-r--r--ext/DynaLoader/dl_symbian.xs223
-rw-r--r--ext/DynaLoader/dlutils.c8
-rw-r--r--ext/Errno/Errno_pm.PL34
-rw-r--r--ext/IO/lib/IO/Socket.pm2
-rw-r--r--ext/List/Util/Util.xs21
-rw-r--r--ext/MIME/Base64/Base64.xs4
-rw-r--r--ext/POSIX/POSIX.xs24
-rw-r--r--ext/PerlIO/scalar/scalar.xs4
-rw-r--r--ext/PerlIO/via/via.xs4
-rw-r--r--ext/SDBM_File/sdbm/sdbm.c2
-rw-r--r--ext/Storable/Storable.xs172
-rw-r--r--ext/Time/HiRes/HiRes.xs1
-rw-r--r--global.sym2
-rw-r--r--globvar.sym74
-rw-r--r--gv.c4
-rw-r--r--hv.c6
-rw-r--r--intrpvar.h2
-rw-r--r--lib/ExtUtils/t/Embed.t18
-rwxr-xr-xlib/ExtUtils/xsubpp21
-rw-r--r--lib/File/Spec.pm1
-rw-r--r--lib/File/Spec/Win32.pm6
-rw-r--r--locale.c4
-rw-r--r--mg.c76
-rw-r--r--miniperlmain.c32
-rw-r--r--numeric.c1
-rw-r--r--op.c57
-rw-r--r--opcode.h50
-rwxr-xr-xopcode.pl50
-rw-r--r--pad.c2
-rw-r--r--patchlevel.h2
-rw-r--r--perl.c92
-rw-r--r--perl.h170
-rw-r--r--perlapi.c37
-rw-r--r--perlapi.h51
-rw-r--r--perlio.c160
-rw-r--r--perlio.h142
-rw-r--r--perliol.h115
-rw-r--r--perlvars.h63
-rw-r--r--pod.lst1
-rw-r--r--pod/perl.pod1
-rw-r--r--pod/perlguts.pod27
-rw-r--r--pod/perlintern.pod10
-rw-r--r--pp.c16
-rw-r--r--pp_ctl.c57
-rw-r--r--pp_hot.c18
-rw-r--r--pp_pack.c2
-rw-r--r--pp_sort.c6
-rw-r--r--pp_sys.c65
-rw-r--r--proto.h11
-rw-r--r--reentr.pl2
-rw-r--r--regcomp.c7
-rw-r--r--regexec.c4
-rw-r--r--scope.h1
-rw-r--r--sv.c40
-rw-r--r--symbian/PerlApp.cpp549
-rw-r--r--symbian/PerlApp.h60
-rw-r--r--symbian/PerlApp.hrh17
-rw-r--r--symbian/PerlApp.rss141
-rw-r--r--symbian/PerlAppAif.rss21
-rw-r--r--symbian/PerlBase.cpp409
-rw-r--r--symbian/PerlBase.h118
-rw-r--r--symbian/PerlBase.pod202
-rw-r--r--symbian/PerlRecog.cpp57
-rw-r--r--symbian/PerlRecog.mmp9
-rw-r--r--symbian/README20
-rw-r--r--symbian/TODO150
-rw-r--r--symbian/bld.inf4
-rw-r--r--symbian/config.pl768
-rw-r--r--symbian/config.sh768
-rw-r--r--symbian/cwd.pl6
-rw-r--r--symbian/demo_pl128
-rw-r--r--symbian/install.cfg108
-rw-r--r--symbian/makesis.pl185
-rw-r--r--symbian/port.pl6
-rw-r--r--symbian/sanity.pl28
-rw-r--r--symbian/sdk.pl48
-rw-r--r--symbian/symbian_dll.cpp20
-rw-r--r--symbian/symbian_proto.h72
-rw-r--r--symbian/symbian_stubs.c112
-rw-r--r--symbian/symbian_stubs.h22
-rw-r--r--symbian/symbian_utils.cpp299
-rw-r--r--symbian/symbianish.h209
-rw-r--r--symbian/uid.pl1
-rw-r--r--symbian/version.pl22
-rw-r--r--symbian/xsbuild.pl861
-rw-r--r--taint.c4
-rw-r--r--toke.c43
-rw-r--r--universal.c6
-rw-r--r--utf8.c7
-rw-r--r--utf8.h2
-rw-r--r--util.c147
-rw-r--r--util.h4
-rw-r--r--vms/descrip_mms.template15
-rw-r--r--win32/Makefile7
-rw-r--r--win32/makefile.mk7
-rw-r--r--win32/win32io.c2
-rw-r--r--xsutils.c12
119 files changed, 7688 insertions, 750 deletions
diff --git a/EXTERN.h b/EXTERN.h
index fe8a0eed3f..58ca37a47f 100644
--- a/EXTERN.h
+++ b/EXTERN.h
@@ -28,8 +28,8 @@
# define EXTCONST globalref
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
-# if defined(WIN32) && !defined(PERL_STATIC_SYMS)
-# ifdef PERLDLL
+# if (defined(WIN32) || defined(__SYMBIAN32__)) && !defined(PERL_STATIC_SYMS)
+# if defined(PERLDLL) || defined(__SYMBIAN32__)
# define EXT extern __declspec(dllexport)
# define dEXT
# define EXTCONST extern __declspec(dllexport) const
diff --git a/INTERN.h b/INTERN.h
index d2fb950e6d..da3057a83c 100644
--- a/INTERN.h
+++ b/INTERN.h
@@ -28,24 +28,24 @@
# define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
#else
-#if defined(WIN32) && defined(__MINGW32__)
-# define EXT __declspec(dllexport)
-# define dEXT
-# define EXTCONST __declspec(dllexport) const
-# define dEXTCONST const
-#else
-#ifdef __cplusplus
-# define EXT
-# define dEXT
-# define EXTCONST extern const
-# define dEXTCONST const
-#else
-# define EXT
-# define dEXT
-# define EXTCONST const
-# define dEXTCONST const
-#endif
-#endif
+# if (defined(WIN32) && defined(__MINGW32__)) || defined(__SYMBIAN32__)
+# define EXT __declspec(dllexport)
+# define dEXT
+# define EXTCONST __declspec(dllexport) const
+# define dEXTCONST const
+# else
+# ifdef __cplusplus
+# define EXT
+# define dEXT
+# define EXTCONST extern const
+# define dEXTCONST const
+# else
+# define EXT
+# define dEXT
+# define EXTCONST const
+# define dEXTCONST const
+# endif
+# endif
#endif
#undef INIT
diff --git a/MANIFEST b/MANIFEST
index c791a84b74..b0361c8490 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -329,6 +329,7 @@ ext/DynaLoader/dl_mac.xs MacOS implementation
ext/DynaLoader/dl_mpeix.xs MPE/iX implementation
ext/DynaLoader/dl_next.xs NeXT implementation
ext/DynaLoader/dl_none.xs Stub implementation
+ext/DynaLoader/dl_symbian.xs Symbian implementation
ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files
ext/DynaLoader/dl_vmesa.xs VM/ESA implementation
ext/DynaLoader/dl_vms.xs VMS implementation
@@ -2445,6 +2446,7 @@ README.os400 Perl notes for OS/400
README.plan9 Perl notes for Plan 9
README.qnx Perl notes for QNX
README.solaris Perl notes for Solaris
+README.symbian Perl notes for Symbian
README.tru64 Perl notes for Tru64
README.tw Perl for Traditional Chinese (in Big5)
README.uts Perl notes for UTS
@@ -2470,6 +2472,37 @@ scope.c Scope entry and exit code
scope.h Scope entry and exit header
sv.c Scalar value code
sv.h Scalar value header
+symbian/bld.inf Symbian sample app build config
+symbian/config.pl Configuration script for Symbian
+symbian/config.sh Configuration data for Symbian
+symbian/cwd.pl Helper code for config.pl
+symbian/demo_pl "Archive" of demo code
+symbian/install.cfg Installation instructions
+symbian/makesis.pl Installation file creator
+symbian/PerlApp.cpp Symbian sample app code
+symbian/PerlApp.h Symbian sample app header
+symbian/PerlApp.hrh Symbian sample app resource header
+symbian/PerlApp.rss Symbian sample app resource definition
+symbian/PerlAppAif.rss Symbian sample app code
+symbian/PerlBase.cpp Symbian Perl base class
+symbian/PerlBase.h Symbian Perl base class header
+symbian/PerlBase.pod Symbian Perl base class documentation
+symbian/PerlRecog.cpp Symbian recognizer code
+symbian/PerlRecog.mmp Symbian recognizer build
+symbian/port.pl Helper code for config.pl
+symbian/README ReadMe for the Symbian files
+symbian/sanity.pl Helper code for config.pl
+symbian/sdk.pl Helper code for config.pl
+symbian/symbian_dll.cpp The DLL stub for Symbian
+symbian/symbianish.h Header for Symbian
+symbian/symbian_proto.h Prototypes for Symbian
+symbian/symbian_stubs.c Stub routines for Symbian
+symbian/symbian_stubs.h Stub headers for Symbian
+symbian/symbian_utils.cpp Helper routines for Symbian
+symbian/TODO Symbian things to do
+symbian/uid.pl Helper code for config.pl
+symbian/version.pl Helper code for config.pl
+symbian/xsbuild.pl Building extensions
taint.c Tainting code
t/base/cond.t See if conditionals work
t/base/if.t See if if works
diff --git a/Porting/curliff.pl b/Porting/curliff.pl
index 636dccdf71..f3937b9c9c 100644
--- a/Porting/curliff.pl
+++ b/Porting/curliff.pl
@@ -10,13 +10,20 @@ use strict;
use vars qw($r);
+# This list is also in makerel.
my @FILES = qw(
djgpp/configure.bat
README.ce
README.dos
+ README.symbian
README.win32
+ symbian/config.pl
+ symbian/makesis.pl
+ symbian/README
+ symbian/xsbuild.pl
win32/Makefile
win32/makefile.mk
+ wince/Makefile.ce
wince/compile-all.bat
wince/README.perlce
wince/registry.bat
diff --git a/Porting/makerel b/Porting/makerel
index 42b24d6c8e..d4022bbccb 100644
--- a/Porting/makerel
+++ b/Porting/makerel
@@ -151,11 +151,17 @@ system("chmod +w @writables") == 0
or die "system: $!";
print "Adding CRs to DOSish files...\n";
+# This list is also in curliff.pl.
my @crlf = qw(
djgpp/configure.bat
README.ce
README.dos
+ README.symbian
README.win32
+ symbian/config.pl
+ symbian/makesis.pl
+ symbian/README
+ symbian/xsbuild.pl
win32/Makefile
win32/makefile.mk
wince/Makefile.ce
diff --git a/README.symbian b/README.symbian
new file mode 100644
index 0000000000..e6cb4dc643
--- /dev/null
+++ b/README.symbian
@@ -0,0 +1,352 @@
+If you read this file _as_is_, just ignore the funny characters you see.
+It is written in the POD format (see pod/perlpod.pod) which is specially
+designed to be readable as is.
+
+=head1 NAME
+
+README.symbian - Perl version 5 on Symbian OS
+
+=head1 DESCRIPTION
+
+This document describes various features of the Symbian operating
+system that will affect how Perl version 5 (hereafter just Perl)
+is compiled and/or runs.
+
+B<NOTE: this port (as of 0.1.0) does not compile into a Symbian
+OS GUI application, but instead it results in a Symbian DLL.>
+The DLL includes a C++ class called CPerlBase, which one can then
+(derive from and) use to embed Perl into applications, see F<symbian/README>.
+
+The base port of Perl to Symbian only implements the basic POSIX-like
+functionality; it does not implement any further Symbian or Series 60
+bindings for Perl.
+
+It is also possible to generate Symbian executables for "miniperl"
+and "perl", but since there is no standard command line interface
+for Symbian (nor full keyboards in the devices), these are useful
+mainly as demonstrations.
+
+=head2 Compiling Perl on Symbian
+
+(0) You need to have the Symbian SDK installed.
+
+ These instructions have been tested under various Nokia Series 60
+ Symbian SDKs (1.2 to 2.6). You can get the SDKs from
+ Forum Nokia (http://www.forum.nokia.com/).
+
+ A prerequisite for any of the SDKs is to install ActivePerl
+ from ActiveState, http://www.activestate.com/Products/ActivePerl/
+
+ Having the SDK installed also means that you need to have either
+ the Metrowerks CodeWarrior installed (2.8 and 3.0 were used in testing)
+ or the Microsoft Visual C++ 6.0 installed (SP3 minimum, SP5 recommended).
+
+ Note that for example the Serie s60 2.0 VC SDK installation talks
+ about ActivePerl build 518, which does no more (as of mid-2004) exist
+ at the ActiveState website. The ActivePerl 5.8.4 build 810 was
+ used successfully for compiling Perl on Symbian. The 5.6.x ActivePerls
+ do not work.
+
+ Other SDKs or compilers like Visual.NET, command-line-only
+ Visual.NET, Borland, GnuPoc, or sdk2unix have not been tried.
+
+ These instructions almost certainly won't work with older Symbian
+ releases or other SDKs. Patches to get this port running in other
+ releases, SDKs, compilers, platforms, or devices are naturally welcome.
+
+(1) Get a Perl source code distribution (for example the file
+ perl-5.9.2.tar.gz is fine) from http://www.cpan.org/src/
+ and unpack it in your the C:/Symbian directory of your Windows
+ system.
+
+(2) Change to the perl source directory.
+
+ cd c:\Symbian\perl-5.x.x
+
+(3) Run the following script using the perl coming with the SDK
+
+ perl symbian\config.pl
+
+ You must use the cmd.exe, the Cygwin shell will not work
+ (the PATH must include the SDK tools, including a Perl,
+ which should be the case under cmd.exe)
+
+(4) Build the project, either by
+
+ make all
+
+ in cmd.exe or by using either the Metrowerks CodeWarrior
+ or the Visual C++ 6.0.
+
+ If you use the VC IDE, you will have to run F<symbian\config.pl>
+ first using the cmd.exe, and then run 'make win.mf vc6.mf' to generate
+ the VC6 makefiles and workspaces.
+
+ The following Series 60 SDK and compiler configurations and Nokia
+ phones that were tested (+ = compiled and PerlApp run, - = not),
+ both for Perl 5.8.x and 5.9.x:
+
+ SDK | VC | CW |
+ ----+----+----+---
+ 1.2 | + | + | 3650 (*)
+ 2.0 | + | + | 6600
+ 2.1 | - | + | 6670
+ 2.6 | + | + | 6630
+
+ If you are using the 'make' directly, it is the GNU make from the SDKs,
+ and it will invoke the right make commands for the Windows emulator
+ build and the Arm target builds ('thumb' by default) as necessary.
+ (*) Compiles but does not work, unfortunately.
+
+ The build scripts assume the 'absolute style' SDK installs under C:,
+ the 'subst style' will not work.
+
+ If using the VC IDE, to build use for example the File->Open Workspace->
+ C:\Symbian\8.as\S60_2nd_FP2\epoc32\build\symbian\perl\perl\wins\perl.dsw
+ The emulator binaries will appear in the same directory.
+
+ If using the VC IDE, you will a lot of warnings in the beginning of
+ the build because a lot of headers mentioned by the source cannot
+ be found, but this is not serious since those headers are not used.
+
+ The Metrowerks will give a lot of warnings about unused variables and
+ empty declarations, you can ignore those.
+
+ When the Windows and Arm DLLs are built do not be scared by a very long
+ messages whizzing by: it is the "export freeze" phase where the whole
+ (rather large) API of Perl is listed.
+
+ Once the build is completed you need to create the DLL SIS file by
+
+ make perldll.sis
+
+ which will create the file perlXYZ.sis (the XYZ being the Perl version)
+ which you can then install into your Symbian device: an easy way
+ to do this is to send them via Bluetooth or infrared and just open
+ the messages.
+
+ Since the total size of all Perl SIS files once installed is
+ over 1.9 MB, it is recommended to do the installation into a
+ memory card (drive E:) instead of the C: drive.
+
+ The size of the perlXYZ.SIS is about 370 kB but once it is in the
+ device it is about one 750 kB (according to the application manager).
+
+ The perlXYZ.sis includes only the Perl DLL: to create an additional
+ SIS file which includes some of the standard (pure) Perl libraries,
+ issue the command
+
+ make perllib.sis
+
+ Some of the standard Perl libraries are included, but not all:
+ see L</HISTORY> or F<symbian\install.cfg> for more details
+ (250 kB -> 700 kB).
+
+ Some of the standard Perl XS extensions (see L</HISTORY> are
+ also available:
+
+ make perlext.sis
+
+ which will create perlXYZext.sis (210 kB -> 470 kB).
+
+ To compile the demonstration application PerlApp you need first to
+ install the Perl headers under the SDK.
+
+ To install the Perl headers and the class CPerlBase documentation
+ so that you no more need the Perl sources around to compile Perl
+ applications using the SDK:
+
+ make sdkinstall
+
+ The destination directory is C:\Symbian\perl\X.Y.Z. For more
+ details, see F<symbian\PerlBase.pod>.
+
+ Once the headers have been installed, you can create a SIS for
+ the PerlApp:
+
+ make perlapp.sis
+
+ The perlapp.sis (11 kB -> 16 kB) will be built in the symbian
+ subdirectory, but a copy will also be made to the main directory.
+
+ If you want to package the Perl DLLs (one for WINS, one for ARMI),
+ the headers, and the documentation:
+
+ make perlsdk.zip
+
+ which will create perlXYZsdk.zip that can be used in another
+ Windows system with the SDK, without having to compile Perl in
+ that system.
+
+ If you want to package the PerlApp sources:
+
+ make perlapp.zip
+
+ If you want to package the perl.exe and miniperl.exe, you
+ can use the perlexe.sis and miniperlexe.sis make targets.
+ You also probably want the perllib.sis for the libraries
+ and maybe even the perlapp.sis for the recognizer.
+
+ The make target 'allsis' combines all the above SIS targets.
+
+ To clean up after compilation you can use either of
+
+ make clean
+ make distclean
+
+ depending on how clean you want to be.
+
+=head2 Compilation problems
+
+If you see right after "make" this
+
+ cat makefile.sh >makefile
+ 'cat' is not recognized as an internal or external command,
+ operable program or batch file.
+
+it means you need to (re)run the symbian\config.pl.
+
+If you get the error
+
+ 'perl' is not recognized as an internal or external command,
+ operable program or batch file.
+
+you may need to reinstall the ActivePerl.
+
+If you see this
+
+ ren makedef.pl nomakedef.pl
+ The system cannot find the file specified.
+ C:\Symbian\...\make.exe: [rename_makedef] Error 1 (ignored)
+
+please ignore it since it is nothing serious (the build process of
+renames the Perl makedef.pl as nomakedef.pl to avoid confusing it
+with a makedef.pl of the SDK).
+
+=head2 PerlApp
+
+The PerlApp application demonstrates how to embed Perl interpreters
+to a Symbian application. The "Time" menu item runs the following
+Perl code: C<print "Running in ", $^O, "\n", scalar localtime>,
+the "Oneliner" allows one to type in Perl code, and the "Run"
+opens a file chooser for selecting a Perl file to run.
+
+The PerlApp also is started when the "Perl recognizer" (also included
+and installed) detects a Perl file being activated througg the GUI,
+and offers either to install it under \Perl (if the Perl file is in
+the inbox of the messaging application) or to run it (if the Perl file
+is under \Perl).
+
+=head2 Using Perl in Symbian
+
+First of all note that you have full access to the Symbian device
+when using Perl: you can do a lot of damage to your device (like
+removing system files) unless you are careful. Please do take
+backups before doing anything.
+
+The Perl port has been done for the most part using the Symbian
+standard POSIX-ish STDLIB library. It is a reasonably complete
+library, but certain corners of such emulation libraries that tend
+to be left unimplemented on non-UNIX platforms have been left
+unimplemented also this time: fork(), signals(), user/group ids,
+select() working for sockets, non-blocking sockets, and so forth.
+See the file symbian/config.sh and look for 'undef' to find the
+unsupported APIs (or from Perl use Config).
+
+The filesystem of Symbian devices uses DOSish syntax, "drives"
+separated from paths by a colon, and backslashes for the path.
+The exact assignment of the drives probably varies between platforms,
+but you might for example see C: as the flash main memory, D: as the
+RAM drive, E: as the memory card (MMC), Z: as the ROM. As far the
+devices go the NUL: is the bit bucket, the COMx: are the serial lines,
+IRCOMx: are the IR ports, TMP: might be C:\System\Temp. Remember to
+double those backslashes in doublequoted strings.
+
+The Perl DLL is installed in \System\Libs\. The Perl libraries and
+extension DLLs are installed in \System\Libs\Perl\X.Y.Z\. The PerlApp
+is installed in \System\Apps\, and the SIS also installs a couple of
+demo scripts in \Perl\.
+
+Note that the Symbian filesystem is very picky: it strongly prefers
+the \ instead of the /.
+
+When doing XS / Symbian C++ programming include first the Symbian
+headers, then any standard C/POSIX headers, then Perl headers, and finally
+any application headers.
+
+New() and Copy() are unfortunately used by both Symbian and Perl code
+so you'll have to play cpp games if you need them. PerlBase.h undefines
+the Perl definitions and redefines them as PerlNew() and PerlCopy().
+
+=head1 TO DO
+
+Lots. See F<symbian\TODO>.
+
+=head1 WARNING
+
+As of Perl Symbian port version 0.1.0 any part of Perl's standard
+regression test suite has not been run on a real Symbian device using
+the ported Perl, so innumerable bugs may lie in wait. Therefore there
+is absolutely no warranty.
+
+=head1 NOTE
+
+When creating and extending application programming interfaces (APIs)
+for Symbian or Series 60 it is suggested that trademarks, registered
+trademarks, or trade names are not used in the API names. Instead,
+developers should consider basing the API naming in the existing (C++)
+public component and API naming, modified as appropriate by the rules
+of the programming language the new APIs are for.
+
+Nokia is a registered trademark of Nokia Corporation. Nokia's product
+names are trademarks or registered trademarks of Nokia. Other product
+and company names mentioned herein may be trademarks or trade names of
+their respective owners.
+
+=head1 AUTHOR
+
+Jarkko Hietaniemi
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+=head1 LICENSE
+
+The Symbian port is licensed under the same terms as Perl itself.
+
+=head1 HISTORY
+
+Perl Symbian Port version 0.1.0: April 2005
+(This will show as "0.01" in the Symbian Installer.)
+
+ - The console window is a very simple console indeed: one can
+ get the newline with "000" and the "C" button is a backspace.
+ Do not expect a terminal capable of vt100 or ANSI sequences.
+ The console is also "ASCII", you cannot input e.g. any accented
+ letters. Because of obvious physical constraints the console is
+ also very small: (in Nokia 6600) 22 columns, 17 rows.
+ - The following libraries are available:
+ AnyDBM_File AutoLoader base Carp Config Cwd constant
+ DynaLoader Exporter File::Spec integer lib strict Symbol
+ vars warnings XSLoader
+ - The following extensions are available:
+ attrs Cwd Data::Dumper Devel::Peek Digest::MD5 DynaLoader
+ Fcntl File::Glob Filter::Util::Call IO List::Util MIME::Base64
+ PerlIO::scalar PerlIO::via SDBM_File Socket Storable Time::HiRes
+ - The following extensions are missing for various technical reasons:
+ B ByteLoader Devel::DProf Devel::PPPort Encode GDBM_File
+ I18N::Langinfo IPC::SysV NDBM_File Opcode PerlIO::encoding POSIX
+ re Safe Sys::Hostname Sys::Syslog
+ threads threads::shared Unicode::Normalize
+ - Using MakeMaker or the Module::* to build and install modules
+ is not supported. A future solution might use the native
+ SIS packaging format (see symbian\TODO).
+ - Building XS other than the ones in the core is not supported.
+
+Since this is 0.1.0, any future releases are almost guaranteed to be
+binary incompatible. As a sign of this the Symbian symbol exports are
+kept unfrozen and the .def files rebuilt every time.
+
+=cut
+
diff --git a/XSUB.h b/XSUB.h
index 7c059c1d28..b611581d59 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -80,9 +80,14 @@ is a lexical $_ in scope.
#define ST(off) PL_stack_base[ax + (off)]
+#undef XS
#if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
# define XS(name) __declspec(dllexport) void name(pTHX_ CV* cv)
-#else
+#endif
+#if defined(SYMBIAN)
+# define XS(name) EXPORT_C void name(pTHX_ CV* cv)
+#endif
+#ifndef XS
# define XS(name) void name(pTHX_ CV* cv)
#endif
diff --git a/av.c b/av.c
index 549f2df840..bc35333a9c 100644
--- a/av.c
+++ b/av.c
@@ -525,6 +525,7 @@ to accommodate the addition.
void
Perl_av_push(pTHX_ register AV *av, SV *val)
{
+ dVAR;
MAGIC *mg;
if (!av)
return;
@@ -560,6 +561,7 @@ is empty.
SV *
Perl_av_pop(pTHX_ register AV *av)
{
+ dVAR;
SV *retval;
MAGIC* mg;
@@ -605,6 +607,7 @@ must then use C<av_store> to assign values to these new elements.
void
Perl_av_unshift(pTHX_ register AV *av, register I32 num)
{
+ dVAR;
register I32 i;
register SV **ary;
MAGIC* mg;
@@ -676,6 +679,7 @@ Shifts an SV off the beginning of the array.
SV *
Perl_av_shift(pTHX_ register AV *av)
{
+ dVAR;
SV *retval;
MAGIC* mg;
@@ -738,6 +742,7 @@ Perl's C<$#array = $fill;>.
void
Perl_av_fill(pTHX_ register AV *av, I32 fill)
{
+ dVAR;
MAGIC *mg;
if (!av)
Perl_croak(aTHX_ "panic: null array");
diff --git a/bytecode.pl b/bytecode.pl
index adf1d1fa46..59069b3a58 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -105,6 +105,7 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
+ dVAR;
register int insn;
U32 ix;
SV *specialsv_list[6];
diff --git a/configpm b/configpm
index c9f5e3423a..e98666457c 100755
--- a/configpm
+++ b/configpm
@@ -424,12 +424,16 @@ EOT
foreach my $prefix (qw(ccflags ldflags)) {
my $value = fetch_string ({}, $prefix);
my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
- $value =~ s/\Q$withlargefiles\E\b//;
- print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
+ if (defined $withlargefiles) {
+ $value =~ s/\Q$withlargefiles\E\b//;
+ print CONFIG_HEAVY "${prefix}_nolargefiles='$value'\n";
+ }
}
foreach my $prefix (qw(libs libswanted)) {
my $value = fetch_string ({}, $prefix);
+ my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
+ next unless defined $withlf;
my @lflibswanted
= split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
if (@lflibswanted) {
@@ -861,6 +865,7 @@ EOS
# Now do some simple tests on the Config.pm file we have created
unshift(@INC,'lib');
+unshift(@INC,'xlib/symbian') if $Opts{cross};
require $Config_PM;
import Config;
diff --git a/doio.c b/doio.c
index 3847da6db4..1d7e56fc40 100644
--- a/doio.c
+++ b/doio.c
@@ -81,6 +81,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
I32 num_svs)
{
+ dVAR;
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
PerlIO *saveofp = Nullfp;
@@ -1241,9 +1242,8 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
}
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE)
-I32 my_chsize(fd, length)
-I32 fd; /* file descriptor */
-Off_t length; /* length to set file to */
+I32
+my_chsize(int fd, Off_t length)
{
#ifdef F_FREESP
/* code courtesy of William Kucharski */
@@ -1287,12 +1287,11 @@ Off_t length; /* length to set file to */
return -1;
}
-
return 0;
#else
- dTHX;
- DIE(aTHX_ "truncate not implemented");
+ Perl_croak_nocontext("truncate not implemented");
#endif /* F_FREESP */
+ return -1;
}
#endif /* !HAS_TRUNCATE && !HAS_CHSIZE */
@@ -1418,7 +1417,7 @@ Perl_my_stat(pTHX)
}
}
-static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
+static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
I32
Perl_my_lstat(pTHX)
@@ -1471,7 +1470,8 @@ bool
Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
int fd, int do_report)
{
-#ifdef MACOS_TRADITIONAL
+ dVAR;
+#if defined(MACOS_TRADITIONAL) || defined(SYMBIAN)
Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
#else
register char **a;
@@ -1527,7 +1527,7 @@ Perl_do_execfree(pTHX)
}
}
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL)
bool
Perl_do_exec(pTHX_ char *cmd)
@@ -1538,6 +1538,7 @@ Perl_do_exec(pTHX_ char *cmd)
bool
Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
{
+ dVAR;
register char **a;
register char *s;
@@ -2306,6 +2307,7 @@ Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
PerlIO *
Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
{
+ dVAR;
SV *tmpcmd = NEWSV(55, 0);
PerlIO *fp;
ENTER;
diff --git a/dump.c b/dump.c
index cc500e09f0..2ee5483ebd 100644
--- a/dump.c
+++ b/dump.c
@@ -25,7 +25,7 @@
#include "perl.h"
#include "regcomp.h"
-static HV *Sequence;
+#define Sequence PL_op_sequence
void
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
@@ -153,6 +153,7 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
char *
Perl_sv_peek(pTHX_ SV *sv)
{
+ dVAR;
SV *t = sv_newmortal();
STRLEN n_a;
int unref = 0;
@@ -404,16 +405,13 @@ Perl_pmop_dump(pTHX_ PMOP *pm)
STATIC void
sequence(pTHX_ register const OP *o)
{
+ dVAR;
SV *op;
char *key;
STRLEN len;
- static UV seq;
const OP *oldop = 0;
OP *l;
- if (!Sequence)
- Sequence = newHV();
-
if (!o)
return;
@@ -431,7 +429,7 @@ sequence(pTHX_ register const OP *o)
switch (o->op_type) {
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
}
goto nothin;
@@ -445,7 +443,7 @@ sequence(pTHX_ register const OP *o)
nothin:
if (oldop && o->op_next)
continue;
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
case OP_MAPWHILE:
@@ -458,7 +456,7 @@ sequence(pTHX_ register const OP *o)
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
;
sequence(aTHX_ l);
@@ -466,7 +464,7 @@ sequence(pTHX_ register const OP *o)
case OP_ENTERLOOP:
case OP_ENTERITER:
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
;
sequence(aTHX_ l);
@@ -481,7 +479,7 @@ sequence(pTHX_ register const OP *o)
case OP_QR:
case OP_MATCH:
case OP_SUBST:
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
;
sequence(aTHX_ l);
@@ -491,7 +489,7 @@ sequence(pTHX_ register const OP *o)
break;
default:
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
}
oldop = o;
@@ -501,6 +499,7 @@ sequence(pTHX_ register const OP *o)
STATIC UV
sequence_num(pTHX_ const OP *o)
{
+ dVAR;
SV *op,
**seq;
char *key;
@@ -515,6 +514,7 @@ sequence_num(pTHX_ const OP *o)
void
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
{
+ dVAR;
UV seq;
sequence(aTHX_ o);
Perl_dump_indent(aTHX_ level, file, "{\n");
@@ -887,7 +887,7 @@ Perl_gv_dump(pTHX_ GV *gv)
* (with the PERL_MAGIC_ prefixed stripped)
*/
-static struct { const char type; const char *name; } magic_names[] = {
+static const struct { const char type; const char *name; } magic_names[] = {
{ PERL_MAGIC_sv, "sv(\\0)" },
{ PERL_MAGIC_arylen, "arylen(#)" },
{ PERL_MAGIC_glob, "glob(*)" },
@@ -982,7 +982,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
{
int n;
const char *name = 0;
- for (n=0; magic_names[n].name; n++) {
+ for (n = 0; magic_names[n].name; n++) {
if (mg->mg_type == magic_names[n].type) {
name = magic_names[n].name;
break;
diff --git a/embed.fnc b/embed.fnc
index 66fb8bf6eb..737392951b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -170,7 +170,7 @@ p |void |do_chop |SV* asv|SV* sv
Ap |bool |do_close |GV* gv|bool not_implicit
p |bool |do_eof |GV* gv
p |bool |do_exec |char* cmd
-#if defined(WIN32)
+#if defined(WIN32) || defined(SYMBIAN)
Ap |int |do_aspawn |SV* really|SV** mark|SV** sp
Ap |int |do_spawn |char* cmd
Ap |int |do_spawn_nowait|char* cmd
@@ -245,7 +245,7 @@ Ap |GV* |gv_autoload4 |HV* stash|const char* name|STRLEN len \
|I32 method
Ap |void |gv_check |HV* stash
Ap |void |gv_efullname |SV* sv|const GV* gv
-Amb |void |gv_efullname3 |SV* sv|const GV* gv|const char* prefix
+Apmb |void |gv_efullname3 |SV* sv|const GV* gv|const char* prefix
Ap |void |gv_efullname4 |SV* sv|const GV* gv|const char* prefix|bool keepmain
Ap |GV* |gv_fetchfile |const char* name
Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \
@@ -257,7 +257,7 @@ Apd |GV* |gv_fetchmethod_autoload|HV* stash|const char* name \
|I32 autoload
Ap |GV* |gv_fetchpv |const char* name|I32 add|I32 sv_type
Ap |void |gv_fullname |SV* sv|const GV* gv
-Amb |void |gv_fullname3 |SV* sv|const GV* gv|const char* prefix
+Apmb |void |gv_fullname3 |SV* sv|const GV* gv|const char* prefix
Ap |void |gv_fullname4 |SV* sv|const GV* gv|const char* prefix|bool keepmain
Ap |void |gv_init |GV* gv|HV* stash|const char* name \
|STRLEN len|int multi
@@ -1290,8 +1290,10 @@ s |SV*|isa_lookup |HV *stash|const char *name|HV *name_stash|int len|int level
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
s |char* |stdize_locale |char* locs
#endif
+#endif
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
s |COP* |closest_cop |COP *cop|OP *o
@@ -1480,4 +1482,7 @@ dp |bool |is_gv_magical_sv|SV *name|U32 flags
Apd |char* |savesvpv |SV* sv
+Ap |struct perl_vars*|init_global_struct
+Ap |void |free_global_struct|struct perl_vars*
+
END_EXTERN_C
diff --git a/embed.h b/embed.h
index 307278149f..54c887f835 100644
--- a/embed.h
+++ b/embed.h
@@ -188,7 +188,7 @@
#ifdef PERL_CORE
#define do_exec Perl_do_exec
#endif
-#if defined(WIN32)
+#if defined(WIN32) || defined(SYMBIAN)
#define do_aspawn Perl_do_aspawn
#define do_spawn Perl_do_spawn
#define do_spawn_nowait Perl_do_spawn_nowait
@@ -1995,10 +1995,12 @@
#endif
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
#ifdef PERL_CORE
#define stdize_locale S_stdize_locale
#endif
#endif
+#endif
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define closest_cop S_closest_cop
@@ -2265,6 +2267,8 @@
#define is_gv_magical_sv Perl_is_gv_magical_sv
#endif
#define savesvpv Perl_savesvpv
+#define init_global_struct Perl_init_global_struct
+#define free_global_struct Perl_free_global_struct
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_concat Perl_ck_concat
@@ -2800,7 +2804,7 @@
#ifdef PERL_CORE
#define do_exec(a) Perl_do_exec(aTHX_ a)
#endif
-#if defined(WIN32)
+#if defined(WIN32) || defined(SYMBIAN)
#define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c)
#define do_spawn(a) Perl_do_spawn(aTHX_ a)
#define do_spawn_nowait(a) Perl_do_spawn_nowait(aTHX_ a)
@@ -4598,10 +4602,12 @@
#endif
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
#ifdef PERL_CORE
#define stdize_locale(a) S_stdize_locale(aTHX_ a)
#endif
#endif
+#endif
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define closest_cop(a,b) S_closest_cop(aTHX_ a,b)
@@ -4868,6 +4874,8 @@
#define is_gv_magical_sv(a,b) Perl_is_gv_magical_sv(aTHX_ a,b)
#endif
#define savesvpv(a) Perl_savesvpv(aTHX_ a)
+#define init_global_struct() Perl_init_global_struct(aTHX)
+#define free_global_struct(a) Perl_free_global_struct(aTHX_ a)
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
diff --git a/embed.pl b/embed.pl
index ac0822f0e8..1d816b1b4e 100755
--- a/embed.pl
+++ b/embed.pl
@@ -274,7 +274,7 @@ sub readvars(\%$$@) {
or die "embed.pl: Can't open $file: $!\n";
while (<FILE>) {
s/[ \t]*#.*//; # Delete comments.
- if (/PERLVARA?I?C?\($pre(\w+)/) {
+ if (/PERLVARA?I?S?C?\($pre(\w+)/) {
my $sym = $1;
$sym = $pre . $sym if $keep_pre;
warn "duplicate symbol $sym while processing $file\n"
@@ -609,7 +609,8 @@ print EM <<'END';
END
for $sym (sort keys %globvar) {
- print EM multon($sym,'G','PL_Vars.');
+ print EM multon($sym, 'G','my_vars->');
+ print EM multon("G$sym",'', 'my_vars->');
}
print EM <<'END';
@@ -662,11 +663,14 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i) typedef const char PL_##v##_t[sizeof(i)]; \
+ EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
#include "thrdvar.h"
#include "intrpvar.h"
@@ -676,6 +680,16 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+EXTERN_C Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX);
+EXTERN_C Perl_check_t** Perl_Gcheck_ptr(pTHX);
+EXTERN_C unsigned char** Perl_Gfold_locale_ptr(pTHX);
+#define Perl_ppaddr_ptr Perl_Gppaddr_ptr
+#define Perl_check_ptr Perl_Gcheck_ptr
+#define Perl_fold_locale_ptr Perl_Gfold_locale_ptr
+#endif
END_EXTERN_C
@@ -691,9 +705,9 @@ END_EXTERN_C
START_EXTERN_C
#ifndef DOINIT
-EXT void *PL_force_link_funcs[];
+EXTCONST void * const PL_force_link_funcs[];
#else
-EXT void *PL_force_link_funcs[] = {
+EXTCONST void * const PL_force_link_funcs[] = {
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
@@ -702,6 +716,7 @@ EXT void *PL_force_link_funcs[] = {
#define PERLVARA(v,n,t) PERLVAR(v,t)
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v,t)
+#define PERLVARISC(v,i) PERLVAR(v,char)
#include "thrdvar.h"
#include "intrpvar.h"
@@ -711,6 +726,7 @@ EXT void *PL_force_link_funcs[] = {
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
};
#endif /* DOINIT */
@@ -759,14 +775,17 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
- { return &(aTHX->v); }
+ { dVAR; return &(aTHX->v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
- { return &(aTHX->v); }
+ { dVAR; return &(aTHX->v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \
+ { dVAR; return &(aTHX->v); }
#include "thrdvar.h"
#include "intrpvar.h"
@@ -774,18 +793,42 @@ START_EXTERN_C
#undef PERLVAR
#undef PERLVARA
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
- { return &(PL_##v); }
+ { dVAR; return &(PL_##v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
- { return &(PL_##v); }
+ { dVAR; return &(PL_##v); }
#undef PERLVARIC
-#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
+#undef PERLVARISC
+#define PERLVARIC(v,t,i) \
+ const t* Perl_##v##_ptr(pTHX) \
{ return (const t *)&(PL_##v); }
+#define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \
+ { dVAR; return &(PL_##v); }
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+/* A few evil special cases. Could probably macrofy this. */
+#undef PL_ppaddr
+#undef PL_check
+#undef PL_fold_locale
+Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX) {
+ static const Perl_ppaddr_t* ppaddr_ptr = PL_ppaddr;
+ return (Perl_ppaddr_t**)&ppaddr_ptr;
+}
+Perl_check_t** Perl_Gcheck_ptr(pTHX) {
+ static const Perl_check_t* check_ptr = PL_check;
+ return (Perl_check_t**)&check_ptr;
+}
+unsigned char** Perl_Gfold_locale_ptr(pTHX) {
+ static const unsigned char* fold_locale_ptr = PL_fold_locale;
+ return (unsigned char**)&fold_locale_ptr;
+}
+#endif
END_EXTERN_C
diff --git a/embedvar.h b/embedvar.h
index 449658264a..b7ce358354 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -885,39 +885,102 @@
#if defined(PERL_GLOBAL_STRUCT)
-#define PL_No (PL_Vars.GNo)
-#define PL_Yes (PL_Vars.GYes)
-#define PL_csighandlerp (PL_Vars.Gcsighandlerp)
-#define PL_curinterp (PL_Vars.Gcurinterp)
-#define PL_do_undump (PL_Vars.Gdo_undump)
-#define PL_dollarzero_mutex (PL_Vars.Gdollarzero_mutex)
-#define PL_hexdigit (PL_Vars.Ghexdigit)
-#define PL_malloc_mutex (PL_Vars.Gmalloc_mutex)
-#define PL_op_mutex (PL_Vars.Gop_mutex)
-#define PL_patleave (PL_Vars.Gpatleave)
-#define PL_sh_path (PL_Vars.Gsh_path)
-#define PL_sigfpe_saved (PL_Vars.Gsigfpe_saved)
-#define PL_sv_placeholder (PL_Vars.Gsv_placeholder)
-#define PL_thr_key (PL_Vars.Gthr_key)
-#define PL_use_safe_putenv (PL_Vars.Guse_safe_putenv)
+#define PL_No (my_vars->GNo)
+#define PL_GNo (my_vars->GNo)
+#define PL_Yes (my_vars->GYes)
+#define PL_GYes (my_vars->GYes)
+#define PL_appctx (my_vars->Gappctx)
+#define PL_Gappctx (my_vars->Gappctx)
+#define PL_check (my_vars->Gcheck)
+#define PL_Gcheck (my_vars->Gcheck)
+#define PL_csighandlerp (my_vars->Gcsighandlerp)
+#define PL_Gcsighandlerp (my_vars->Gcsighandlerp)
+#define PL_curinterp (my_vars->Gcurinterp)
+#define PL_Gcurinterp (my_vars->Gcurinterp)
+#define PL_do_undump (my_vars->Gdo_undump)
+#define PL_Gdo_undump (my_vars->Gdo_undump)
+#define PL_dollarzero_mutex (my_vars->Gdollarzero_mutex)
+#define PL_Gdollarzero_mutex (my_vars->Gdollarzero_mutex)
+#define PL_fold_locale (my_vars->Gfold_locale)
+#define PL_Gfold_locale (my_vars->Gfold_locale)
+#define PL_hexdigit (my_vars->Ghexdigit)
+#define PL_Ghexdigit (my_vars->Ghexdigit)
+#define PL_malloc_mutex (my_vars->Gmalloc_mutex)
+#define PL_Gmalloc_mutex (my_vars->Gmalloc_mutex)
+#define PL_mmap_page_size (my_vars->Gmmap_page_size)
+#define PL_Gmmap_page_size (my_vars->Gmmap_page_size)
+#define PL_op_mutex (my_vars->Gop_mutex)
+#define PL_Gop_mutex (my_vars->Gop_mutex)
+#define PL_op_seq (my_vars->Gop_seq)
+#define PL_Gop_seq (my_vars->Gop_seq)
+#define PL_op_sequence (my_vars->Gop_sequence)
+#define PL_Gop_sequence (my_vars->Gop_sequence)
+#define PL_patleave (my_vars->Gpatleave)
+#define PL_Gpatleave (my_vars->Gpatleave)
+#define PL_perlio_debug_fd (my_vars->Gperlio_debug_fd)
+#define PL_Gperlio_debug_fd (my_vars->Gperlio_debug_fd)
+#define PL_perlio_fd_refcnt (my_vars->Gperlio_fd_refcnt)
+#define PL_Gperlio_fd_refcnt (my_vars->Gperlio_fd_refcnt)
+#define PL_ppaddr (my_vars->Gppaddr)
+#define PL_Gppaddr (my_vars->Gppaddr)
+#define PL_sh_path (my_vars->Gsh_path)
+#define PL_Gsh_path (my_vars->Gsh_path)
+#define PL_sig_defaulting (my_vars->Gsig_defaulting)
+#define PL_Gsig_defaulting (my_vars->Gsig_defaulting)
+#define PL_sig_handlers_initted (my_vars->Gsig_handlers_initted)
+#define PL_Gsig_handlers_initted (my_vars->Gsig_handlers_initted)
+#define PL_sig_ignoring (my_vars->Gsig_ignoring)
+#define PL_Gsig_ignoring (my_vars->Gsig_ignoring)
+#define PL_sig_sv (my_vars->Gsig_sv)
+#define PL_Gsig_sv (my_vars->Gsig_sv)
+#define PL_sig_trapped (my_vars->Gsig_trapped)
+#define PL_Gsig_trapped (my_vars->Gsig_trapped)
+#define PL_sigfpe_saved (my_vars->Gsigfpe_saved)
+#define PL_Gsigfpe_saved (my_vars->Gsigfpe_saved)
+#define PL_sv_placeholder (my_vars->Gsv_placeholder)
+#define PL_Gsv_placeholder (my_vars->Gsv_placeholder)
+#define PL_thr_key (my_vars->Gthr_key)
+#define PL_Gthr_key (my_vars->Gthr_key)
+#define PL_timesbase (my_vars->Gtimesbase)
+#define PL_Gtimesbase (my_vars->Gtimesbase)
+#define PL_use_safe_putenv (my_vars->Guse_safe_putenv)
+#define PL_Guse_safe_putenv (my_vars->Guse_safe_putenv)
+#define PL_watch_pvx (my_vars->Gwatch_pvx)
+#define PL_Gwatch_pvx (my_vars->Gwatch_pvx)
#else /* !PERL_GLOBAL_STRUCT */
#define PL_GNo PL_No
#define PL_GYes PL_Yes
+#define PL_Gappctx PL_appctx
+#define PL_Gcheck PL_check
#define PL_Gcsighandlerp PL_csighandlerp
#define PL_Gcurinterp PL_curinterp
#define PL_Gdo_undump PL_do_undump
#define PL_Gdollarzero_mutex PL_dollarzero_mutex
+#define PL_Gfold_locale PL_fold_locale
#define PL_Ghexdigit PL_hexdigit
#define PL_Gmalloc_mutex PL_malloc_mutex
+#define PL_Gmmap_page_size PL_mmap_page_size
#define PL_Gop_mutex PL_op_mutex
+#define PL_Gop_seq PL_op_seq
+#define PL_Gop_sequence PL_op_sequence
#define PL_Gpatleave PL_patleave
+#define PL_Gperlio_debug_fd PL_perlio_debug_fd
+#define PL_Gperlio_fd_refcnt PL_perlio_fd_refcnt
+#define PL_Gppaddr PL_ppaddr
#define PL_Gsh_path PL_sh_path
+#define PL_Gsig_defaulting PL_sig_defaulting
+#define PL_Gsig_handlers_initted PL_sig_handlers_initted
+#define PL_Gsig_ignoring PL_sig_ignoring
+#define PL_Gsig_sv PL_sig_sv
+#define PL_Gsig_trapped PL_sig_trapped
#define PL_Gsigfpe_saved PL_sigfpe_saved
#define PL_Gsv_placeholder PL_sv_placeholder
#define PL_Gthr_key PL_thr_key
+#define PL_Gtimesbase PL_timesbase
#define PL_Guse_safe_putenv PL_use_safe_putenv
+#define PL_Gwatch_pvx PL_watch_pvx
#endif /* PERL_GLOBAL_STRUCT */
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 32556ec626..a5aecbb0f9 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -19,7 +19,7 @@ typedef FILE * InputStream;
#endif
-static char *svclassnames[] = {
+static const char* const svclassnames[] = {
"B::NULL",
"B::IV",
"B::NV",
@@ -58,7 +58,7 @@ typedef enum {
OPc_COP /* 11 */
} opclass;
-static char *opclassnames[] = {
+static const char* const opclassnames[] = {
"B::NULL",
"B::OP",
"B::UNOP",
@@ -73,7 +73,7 @@ static char *opclassnames[] = {
"B::COP"
};
-static size_t opsizes[] = {
+static const size_t opsizes[] = {
0,
sizeof(OP),
sizeof(UNOP),
@@ -211,13 +211,13 @@ cc_opclass(pTHX_ OP *o)
static char *
cc_opclassname(pTHX_ OP *o)
{
- return opclassnames[cc_opclass(aTHX_ o)];
+ return (char *)opclassnames[cc_opclass(aTHX_ o)];
}
static SV *
make_sv_object(pTHX_ SV *arg, SV *sv)
{
- char *type = 0;
+ const char *type = 0;
IV iv;
dMY_CXT;
@@ -734,7 +734,7 @@ threadsv_names()
#define OP_next(o) o->op_next
#define OP_sibling(o) o->op_sibling
-#define OP_desc(o) PL_op_desc[o->op_type]
+#define OP_desc(o) (char *)PL_op_desc[o->op_type]
#define OP_targ(o) o->op_targ
#define OP_type(o) o->op_type
#if PERL_VERSION >= 9
@@ -769,7 +769,7 @@ char *
OP_name(o)
B::OP o
CODE:
- RETVAL = PL_op_name[o->op_type];
+ RETVAL = (char *)PL_op_name[o->op_type];
OUTPUT:
RETVAL
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 3432eb326f..bdc9555335 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -47,6 +47,7 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
+ dVAR;
register int insn;
U32 ix;
SV *specialsv_list[6];
@@ -216,7 +217,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
svindex arg;
BGET_svindex(arg);
- SvRV(bstate->bs_sv) = arg;
+ BSET_xrv(bstate->bs_sv, arg);
break;
}
case INSN_XPV: /* 22 */
@@ -228,28 +229,28 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
STRLEN arg;
BGET_PADOFFSET(arg);
- SvCUR(bstate->bs_sv) = arg;
+ BSET_xpv_cur(bstate->bs_sv, arg);
break;
}
case INSN_XPV_LEN: /* 24 */
{
STRLEN arg;
BGET_PADOFFSET(arg);
- SvLEN(bstate->bs_sv) = arg;
+ BSET_xpv_len(bstate->bs_sv, arg);
break;
}
case INSN_XIV: /* 25 */
{
IV arg;
BGET_IV(arg);
- SvIVX(bstate->bs_sv) = arg;
+ BSET_xiv(bstate->bs_sv, arg);
break;
}
case INSN_XNV: /* 26 */
{
NV arg;
BGET_NV(arg);
- SvNVX(bstate->bs_sv) = arg;
+ BSET_xnv(bstate->bs_sv, arg);
break;
}
case INSN_XLV_TARGOFF: /* 27 */
@@ -592,7 +593,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&SvSTASH(bstate->bs_sv) = arg;
+ bstate->bs_sv = arg;
break;
}
case INSN_GV_FETCHPV: /* 77 */
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 0626977e00..ee1bc14a65 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -830,8 +830,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
SvCUR_set(retval, SvCUR(retval)+i);
if (purity) {
- static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
- static STRLEN sizes[] = { 8, 7, 6 };
+ static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
+ static const STRLEN sizes[] = { 8, 7, 6 };
SV *e;
SV *nname = newSVpvn("", 0);
SV *newapad = newSVpvn("", 0);
diff --git a/ext/Digest/MD5/MD5.xs b/ext/Digest/MD5/MD5.xs
index 1abe4c429c..a89bbd7b8e 100644
--- a/ext/Digest/MD5/MD5.xs
+++ b/ext/Digest/MD5/MD5.xs
@@ -153,7 +153,7 @@ typedef struct {
* padding is also the reason the buffer in MD5_CTX have to be
* 128 bytes.
*/
-static unsigned char PADDING[64] = {
+static const unsigned char PADDING[64] = {
0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
@@ -484,7 +484,7 @@ static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
static char* hex_16(const unsigned char* from, char* to)
{
- static char *hexdigits = "0123456789abcdef";
+ static const char hexdigits[] = "0123456789abcdef";
const unsigned char *end = from + 16;
char *d = to;
@@ -499,7 +499,7 @@ static char* hex_16(const unsigned char* from, char* to)
static char* base64_16(const unsigned char* from, char* to)
{
- static char* base64 =
+ static const char base64[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
const unsigned char *end = from + 16;
unsigned char c1, c2, c3;
@@ -626,10 +626,18 @@ addfile(self, fh)
PREINIT:
MD5_CTX* context = get_md5_ctx(aTHX_ self);
STRLEN fill = context->bytes_low & 0x3F;
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ unsigned char* buffer;
+#else
unsigned char buffer[4096];
+#endif
int n;
CODE:
if (fh) {
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ New(0, buffer, 4096, unsigned char);
+ assert(buffer);
+#endif
if (fill) {
/* The MD5Update() function is faster if it can work with
* complete blocks. This will fill up any buffered block
@@ -646,7 +654,9 @@ addfile(self, fh)
while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
MD5Update(context, buffer, n);
}
-
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ Safefree(buffer);
+#endif
if (PerlIO_error(fh)) {
croak("Reading from filehandle failed");
}
diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t
index 3f183206dd..615590e704 100644
--- a/ext/Digest/MD5/t/files.t
+++ b/ext/Digest/MD5/t/files.t
@@ -23,7 +23,7 @@ if (ord "A" == 193) { # EBCDIC
15e4c91ad67f5ff238033305376c9140 Changes
0565ec21b15c0f23f4c51fb327c8926d README
f0f77710cd8d5ba7d9faedec8d02dc2f MD5.pm
-f9848c0ee3b20a9177465eec19361e6c MD5.xs
+f6314d62d3aa97dcf4cba66b4c39b105 MD5.xs
276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
EOT
} elsif ("\n" eq "\015") { # MacOS
@@ -31,7 +31,7 @@ EOT
dea016b088ab4d88a5e7cbd9c15a9c88 Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
} else {
@@ -40,7 +40,7 @@ EOT
0f09886e2c129bdabf57674c6822bd4f Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
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
diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
index 39e2c19230..5c76d89057 100644
--- a/ext/Errno/Errno_pm.PL
+++ b/ext/Errno/Errno_pm.PL
@@ -7,6 +7,11 @@ our $VERSION = "1.09_01";
my %err = ();
my %wsa = ();
+# Symbian cross-compiling environment.
+my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32";
+
+my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian;
+
unlink "Errno.pm" if -f "Errno.pm";
open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
select OUT;
@@ -27,7 +32,7 @@ sub process_file {
}
return unless defined $file and -f $file;
-# warn "Processing $file\n";
+# warn "Processing $file\n";
local *FH;
if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
@@ -53,7 +58,7 @@ sub process_file {
return;
}
}
-
+
if ($^O eq 'MacOS') {
while(<FH>) {
$err{$1} = $2
@@ -63,12 +68,13 @@ sub process_file {
while(<FH>) {
$err{$1} = 1
if /^\s*#\s*define\s+(E\w+)\s+/;
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
$wsa{$1} = 1
if /^\s*#\s*define\s+WSA(E\w+)\s+/;
}
}
}
+
close(FH);
}
@@ -130,6 +136,10 @@ sub get_files {
} elsif ($^O eq 'vos') {
# avoid problem where cpp returns non-POSIX pathnames
$file{'/system/include_library/errno.h'} = 1;
+ } elsif ($IsSymbian) {
+ my $SDK = $ENV{SDK};
+ $SDK =~ s!\\!/!g;
+ $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
} else {
open(CPPI,"> errno.c") or
die "Cannot open errno.c";
@@ -138,7 +148,7 @@ sub get_files {
print CPPI "#include <nwerrno.h>\n";
} else {
print CPPI "#include <errno.h>\n";
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
print CPPI "#include <winsock.h>\n";
}
@@ -147,7 +157,7 @@ sub get_files {
close(CPPI);
# invoke CPP and read the output
- if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+ if ($IsMSWin32 || $^O eq 'NetWare') {
open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
} else {
@@ -157,14 +167,14 @@ sub get_files {
}
my $pat;
- if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
+ if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
$pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
}
else {
$pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
}
while(<CPPO>) {
- if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
+ if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
if (/$pat/o) {
my $f = $1;
$f =~ s,\\\\,/,g;
@@ -198,7 +208,7 @@ sub write_errno_pm {
else {
print CPPI "#include <errno.h>\n";
}
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
print CPPI "#include <winsock.h>\n";
foreach $err (keys %wsa) {
print CPPI "#ifndef $err\n";
@@ -222,10 +232,14 @@ sub write_errno_pm {
$cpp =~ s/sys\$input//i;
open(CPPO,"$cpp errno.c |") or
die "Cannot exec $Config{cppstdin}";
- } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+ } elsif ($IsMSWin32 || $^O eq 'NetWare') {
open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
- } else {
+ } elsif ($IsSymbian) {
+ my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -";
+ open(CPPO,"$cpp < errno.c |")
+ or die "Cannot exec $cpp";
+ } else {
my $cpp = default_cpp();
open(CPPO,"$cpp < errno.c |")
or die "Cannot exec $cpp";
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index e706894a75..353785a3ea 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -19,7 +19,7 @@ use Errno;
# legacy
require IO::Socket::INET;
-require IO::Socket::UNIX if ($^O ne 'epoc');
+require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
@ISA = qw(IO::Handle);
diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index 3a03488197..790a2b9af4 100644
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -103,6 +103,24 @@ sv_tainted(SV *sv)
# define PTR2UV(ptr) (UV)(ptr)
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
MODULE=List::Util PACKAGE=List::Util
void
@@ -206,6 +224,7 @@ reduce(block,...)
PROTOTYPE: &@
CODE:
{
+ dVAR;
SV *ret = sv_newmortal();
int index;
GV *agv,*bgv,*gv;
@@ -261,6 +280,7 @@ first(block,...)
PROTOTYPE: &@
CODE:
{
+ dVAR;
int index;
GV *gv;
HV *stash;
@@ -315,6 +335,7 @@ shuffle(...)
PROTOTYPE: @
CODE:
{
+ dVAR;
int index;
struct op dmy_op;
struct op *old_op = PL_op;
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index 8fd14cf355..99ff0e49a1 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -56,14 +56,14 @@ extern "C" {
#define MAX_LINE 76 /* size of encoded lines */
-static char basis_64[] =
+static const char basis_64[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
#define XX 255 /* illegal base64 char */
#define EQ 254 /* padding */
#define INVALID XX
-static unsigned char index_64[256] = {
+static const unsigned char index_64[256] = {
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 561dc3053c..9f76b47c86 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -85,6 +85,24 @@ char *tzname[] = { "" , "" };
#endif
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
#if defined(__VMS) && !defined(__POSIX_SOURCE)
# include <libdef.h> /* LIB$_INVARG constant */
# include <lib$routines.h> /* prototype for lib$ediv() */
@@ -189,7 +207,9 @@ char *tzname[] = { "" , "" };
# define ttyname(a) (char*)not_here("ttyname")
# define tzset() not_here("tzset")
# else
-# include <grp.h>
+# ifdef I_GRP
+# include <grp.h>
+# endif
# include <sys/times.h>
# ifdef HAS_UNAME
# include <sys/utsname.h>
@@ -602,7 +622,6 @@ sigismember(sigset, sig)
POSIX::SigSet sigset
int sig
-
MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
POSIX::Termios
@@ -1228,6 +1247,7 @@ sigaction(sig, optaction, oldaction = 0)
# interface look beautiful, which is hard.
{
+ dVAR;
POSIX__SigAction action;
GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 074da92631..55a5fd8057 100644
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -254,7 +254,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
return f;
}
-PerlIO_funcs PerlIO_scalar = {
+PERLIO_FUNCS_DECL(PerlIO_scalar) = {
sizeof(PerlIO_funcs),
"scalar",
sizeof(PerlIOScalar),
@@ -295,7 +295,7 @@ PROTOTYPES: ENABLE
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_scalar);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
#endif
}
diff --git a/ext/PerlIO/via/via.xs b/ext/PerlIO/via/via.xs
index d95d631190..ad27416b0f 100644
--- a/ext/PerlIO/via/via.xs
+++ b/ext/PerlIO/via/via.xs
@@ -590,7 +590,7 @@ PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
-PerlIO_funcs PerlIO_object = {
+PERLIO_FUNCS_DECL(PerlIO_object) = {
sizeof(PerlIO_funcs),
"via",
sizeof(PerlIOVia),
@@ -630,7 +630,7 @@ PROTOTYPES: ENABLE;
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_object);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
#endif
}
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index a3c4acfb3d..f705db58af 100644
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -62,7 +62,7 @@ static int makroom proto((DBM *, long, int));
#define OFF_PAG(off) (long) (off) * PBLKSIZ
#define OFF_DIR(off) (long) (off) * DBLKSIZ
-static long masks[] = {
+static const long masks[] = {
000000000000, 000000000001, 000000000003, 000000000007,
000000000017, 000000000037, 000000000077, 000000000177,
000000000377, 000000000777, 000000001777, 000000003777,
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 702644e5f6..7c6a755ec5 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -93,6 +93,24 @@ typedef double NV; /* Older perls lack the NV type */
#endif
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
@@ -1024,15 +1042,17 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv);
static int store_other(pTHX_ stcxt_t *cxt, SV *sv);
static int store_blessed(pTHX_ stcxt_t *cxt, SV *sv, int type, HV *pkg);
-static int (*sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
- store_ref, /* svis_REF */
- store_scalar, /* svis_SCALAR */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_array, /* svis_ARRAY */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_hash, /* svis_HASH */
- store_tied, /* svis_TIED */
- store_tied_item, /* svis_TIED_ITEM */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_code, /* svis_CODE */
- store_other, /* svis_OTHER */
+#define SV_STORE_TYPE (const int (* const)(pTHX_ stcxt_t *cxt, SV *sv))
+
+static const int (* const sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
+ SV_STORE_TYPE store_ref, /* svis_REF */
+ SV_STORE_TYPE store_scalar, /* svis_SCALAR */
+ SV_STORE_TYPE store_array, /* svis_ARRAY */
+ SV_STORE_TYPE store_hash, /* svis_HASH */
+ SV_STORE_TYPE store_tied, /* svis_TIED */
+ SV_STORE_TYPE store_tied_item, /* svis_TIED_ITEM */
+ SV_STORE_TYPE store_code, /* svis_CODE */
+ SV_STORE_TYPE store_other, /* svis_OTHER */
};
#define SV_STORE(x) (*sv_store[x])
@@ -1058,37 +1078,39 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname);
-static SV *(*sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
- 0, /* SX_OBJECT -- entry unused dynamically */
- retrieve_lscalar, /* SX_LSCALAR */
- old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
- old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
- retrieve_ref, /* SX_REF */
- retrieve_undef, /* SX_UNDEF */
- retrieve_integer, /* SX_INTEGER */
- retrieve_double, /* SX_DOUBLE */
- retrieve_byte, /* SX_BYTE */
- retrieve_netint, /* SX_NETINT */
- retrieve_scalar, /* SX_SCALAR */
- retrieve_tied_array, /* SX_ARRAY */
- retrieve_tied_hash, /* SX_HASH */
- retrieve_tied_scalar, /* SX_SCALAR */
- retrieve_other, /* SX_SV_UNDEF not supported */
- retrieve_other, /* SX_SV_YES not supported */
- retrieve_other, /* SX_SV_NO not supported */
- retrieve_other, /* SX_BLESS not supported */
- retrieve_other, /* SX_IX_BLESS not supported */
- retrieve_other, /* SX_HOOK not supported */
- retrieve_other, /* SX_OVERLOADED not supported */
- retrieve_other, /* SX_TIED_KEY not supported */
- retrieve_other, /* SX_TIED_IDX not supported */
- retrieve_other, /* SX_UTF8STR not supported */
- retrieve_other, /* SX_LUTF8STR not supported */
- retrieve_other, /* SX_FLAG_HASH not supported */
- retrieve_other, /* SX_CODE not supported */
- retrieve_other, /* SX_WEAKREF not supported */
- retrieve_other, /* SX_WEAKOVERLOAD not supported */
- retrieve_other, /* SX_ERROR */
+#define SV_RETRIEVE_TYPE (const SV* (* const)(pTHX_ stcxt_t *cxt, char *cname))
+
+static const SV *(* const sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+ 0, /* SX_OBJECT -- entry unused dynamically */
+ SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
+ SV_RETRIEVE_TYPE old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
+ SV_RETRIEVE_TYPE old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
+ SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
+ SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
+ SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
+ SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
+ SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
+ SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_UNDEF not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_YES not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_NO not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_BLESS not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_IX_BLESS not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_HOOK not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_OVERLOADED not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_KEY not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_IDX not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_UTF8STR not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_LUTF8STR not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_FLAG_HASH not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_CODE not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKREF not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKOVERLOAD not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
};
static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
@@ -1107,37 +1129,37 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname);
-static SV *(*sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+static const SV *(* const sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
0, /* SX_OBJECT -- entry unused dynamically */
- retrieve_lscalar, /* SX_LSCALAR */
- retrieve_array, /* SX_ARRAY */
- retrieve_hash, /* SX_HASH */
- retrieve_ref, /* SX_REF */
- retrieve_undef, /* SX_UNDEF */
- retrieve_integer, /* SX_INTEGER */
- retrieve_double, /* SX_DOUBLE */
- retrieve_byte, /* SX_BYTE */
- retrieve_netint, /* SX_NETINT */
- retrieve_scalar, /* SX_SCALAR */
- retrieve_tied_array, /* SX_ARRAY */
- retrieve_tied_hash, /* SX_HASH */
- retrieve_tied_scalar, /* SX_SCALAR */
- retrieve_sv_undef, /* SX_SV_UNDEF */
- retrieve_sv_yes, /* SX_SV_YES */
- retrieve_sv_no, /* SX_SV_NO */
- retrieve_blessed, /* SX_BLESS */
- retrieve_idx_blessed, /* SX_IX_BLESS */
- retrieve_hook, /* SX_HOOK */
- retrieve_overloaded, /* SX_OVERLOAD */
- retrieve_tied_key, /* SX_TIED_KEY */
- retrieve_tied_idx, /* SX_TIED_IDX */
- retrieve_utf8str, /* SX_UTF8STR */
- retrieve_lutf8str, /* SX_LUTF8STR */
- retrieve_flag_hash, /* SX_HASH */
- retrieve_code, /* SX_CODE */
- retrieve_weakref, /* SX_WEAKREF */
- retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
- retrieve_other, /* SX_ERROR */
+ SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
+ SV_RETRIEVE_TYPE retrieve_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
+ SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
+ SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
+ SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
+ SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
+ SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_sv_undef, /* SX_SV_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_sv_yes, /* SX_SV_YES */
+ SV_RETRIEVE_TYPE retrieve_sv_no, /* SX_SV_NO */
+ SV_RETRIEVE_TYPE retrieve_blessed, /* SX_BLESS */
+ SV_RETRIEVE_TYPE retrieve_idx_blessed, /* SX_IX_BLESS */
+ SV_RETRIEVE_TYPE retrieve_hook, /* SX_HOOK */
+ SV_RETRIEVE_TYPE retrieve_overloaded, /* SX_OVERLOAD */
+ SV_RETRIEVE_TYPE retrieve_tied_key, /* SX_TIED_KEY */
+ SV_RETRIEVE_TYPE retrieve_tied_idx, /* SX_TIED_IDX */
+ SV_RETRIEVE_TYPE retrieve_utf8str, /* SX_UTF8STR */
+ SV_RETRIEVE_TYPE retrieve_lutf8str, /* SX_LUTF8STR */
+ SV_RETRIEVE_TYPE retrieve_flag_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_code, /* SX_CODE */
+ SV_RETRIEVE_TYPE retrieve_weakref, /* SX_WEAKREF */
+ SV_RETRIEVE_TYPE retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
};
#define RETRIEVE(c,x) (*(c)->retrieve_vtbl[(x) >= SX_ERROR ? SX_ERROR : (x)])
@@ -2161,6 +2183,7 @@ sortcmp(const void *a, const void *b)
*/
static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
{
+ dVAR;
I32 len =
#ifdef HAS_RESTRICTED_HASHES
HvTOTALKEYS(hv);
@@ -2250,7 +2273,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
for (i = 0; i < len; i++) {
#ifdef HAS_RESTRICTED_HASHES
- int placeholders = HvPLACEHOLDERS(hv);
+ int placeholders = (int)HvPLACEHOLDERS(hv);
#endif
unsigned char flags = 0;
char *keyval;
@@ -3235,7 +3258,7 @@ static int store_blessed(
static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
{
I32 len;
- static char buf[80];
+ char buf[80];
TRACEME(("store_other"));
@@ -5050,6 +5073,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
*/
static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
{
+ dVAR;
I32 len;
I32 size;
I32 i;
@@ -5373,7 +5397,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
HV *hv;
SV *sv = (SV *) 0;
int c;
- static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
+ SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
TRACEME(("old_retrieve_hash (#%d)", cxt->tagnum));
@@ -5524,7 +5548,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
*/
version_major = use_network_order >> 1;
- cxt->retrieve_vtbl = version_major ? sv_retrieve : sv_old_retrieve;
+ cxt->retrieve_vtbl = (SV*(**)()) (version_major ? sv_retrieve : sv_old_retrieve);
TRACEME(("magic_check: netorder = 0x%x", use_network_order));
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 3272748fa8..b9040eb0e2 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -31,6 +31,7 @@ extern "C" {
#ifdef HAS_PAUSE
# define Pause pause
#else
+# undef Pause /* In case perl.h did it already. */
# define Pause() sleep(~0) /* Zzz for a long time. */
#endif
diff --git a/global.sym b/global.sym
index 3624874ff8..3887879fd0 100644
--- a/global.sym
+++ b/global.sym
@@ -675,3 +675,5 @@ Perl_hv_scalar
Perl_gv_fetchpvn_flags
Perl_gv_fetchsv
Perl_savesvpv
+Perl_init_global_struct
+Perl_free_global_struct
diff --git a/globvar.sym b/globvar.sym
index 0d768889a8..2e528e32b8 100644
--- a/globvar.sym
+++ b/globvar.sym
@@ -1,68 +1,72 @@
# Global variables that must be exported for embedded applications.
-
+# *** Do NOT add functions here, those go in global.sym.
# *** Only structures/arrays with constant initializers should go here.
# *** Usual globals initialized at runtime should be added in *var*.h.
-# *** Do NOT add functions here, those go in global.sym.
AMG_names
block_type
+check
fold
fold_locale
freq
-warn_uninit
-warn_nosemi
-warn_reserved
-warn_nl
-no_wrongref
-no_symref
-no_usym
+memory_wrap
no_aelem
+no_dir_func
+no_func
no_helem
-no_modify
+no_localize_ref
no_mem
+no_modify
+no_myglob
no_security
no_sock_func
-no_dir_func
-no_func
-no_myglob
-check
+no_symref
+no_usym
+no_wrongref
op_desc
op_name
opargs
ppaddr
+regkind
sig_name
sig_num
-regkind
simple
utf8skip
uuemap
varies
-vtbl_sv
+vtbl_amagic
+vtbl_amagicelem
+vtbl_arylen
+vtbl_backref
+vtbl_bm
+vtbl_collxfrm
+vtbl_dbline
+vtbl_defelem
vtbl_env
vtbl_envelem
-vtbl_sig
-vtbl_sigelem
-vtbl_pack
-vtbl_packelem
-vtbl_dbline
+vtbl_fm
+vtbl_glob
vtbl_isa
vtbl_isaelem
-vtbl_arylen
-vtbl_glob
vtbl_mglob
+vtbl_mutex
vtbl_nkeys
-vtbl_taint
-vtbl_substr
-vtbl_vec
+vtbl_pack
+vtbl_packelem
vtbl_pos
-vtbl_bm
-vtbl_fm
-vtbl_uvar
-vtbl_mutex
-vtbl_defelem
-vtbl_regexp
vtbl_regdata
vtbl_regdatum
-vtbl_collxfrm
-vtbl_amagic
-vtbl_amagicelem
+vtbl_regexp
+vtbl_sig
+vtbl_sigelem
+vtbl_substr
+vtbl_sv
+vtbl_taint
+vtbl_utf8
+vtbl_uvar
+vtbl_vec
+warn_nl
+warn_nosemi
+warn_reserved
+warn_uninit
+watch_pvx
diff --git a/gv.c b/gv.c
index 8ad546dacc..8ea4171d2a 100644
--- a/gv.c
+++ b/gv.c
@@ -105,6 +105,7 @@ Perl_gv_fetchfile(pTHX_ const char *name)
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
+ dVAR;
register GP *gp;
const bool doproto = SvTYPE(gv) > SVt_NULL;
char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
@@ -482,6 +483,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
+ dVAR;
char autoload[] = "AUTOLOAD";
STRLEN autolen = sizeof(autoload)-1;
GV* gv;
@@ -557,6 +559,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
STATIC void
S_require_errno(pTHX_ GV *gv)
{
+ dVAR;
HV* stash = gv_stashpvn("Errno",5,FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
@@ -1497,6 +1500,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
+ dVAR;
MAGIC *mg;
CV *cv=NULL;
CV **cvp=NULL, **ocvp=NULL;
diff --git a/hv.c b/hv.c
index 8c6ec39c3a..8345ee5460 100644
--- a/hv.c
+++ b/hv.c
@@ -383,6 +383,7 @@ STATIC HE *
S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int flags, int action, SV *val, register U32 hash)
{
+ dVAR;
XPVHV* xhv;
U32 n_links;
HE *entry;
@@ -882,6 +883,7 @@ STATIC SV *
S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int k_flags, I32 d_flags, U32 hash)
{
+ dVAR;
register XPVHV* xhv;
register I32 i;
register HE *entry;
@@ -1442,6 +1444,7 @@ Clears a hash, making it empty.
void
Perl_hv_clear(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv;
if (!hv)
return;
@@ -1506,6 +1509,7 @@ See Hash::Util::lock_keys() for an example of its use.
void
Perl_hv_clear_placeholders(pTHX_ HV *hv)
{
+ dVAR;
I32 items = (I32)HvPLACEHOLDERS(hv);
I32 i = HvMAX(hv);
@@ -1696,6 +1700,7 @@ insufficiently abstracted for any change to be tidy.
HE *
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
+ dVAR;
register XPVHV* xhv;
register HE *entry;
HE *oldentry;
@@ -2137,6 +2142,7 @@ Check that a hash is in an internally consistent state.
void
Perl_hv_assert(pTHX_ HV *hv)
{
+ dVAR;
HE* entry;
int withflags = 0;
int placeholders = 0;
diff --git a/intrpvar.h b/intrpvar.h
index 3159b28aa6..3fe5adb736 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -29,7 +29,7 @@ PERLVAR(Iwarnhook, SV *)
/* switches */
PERLVAR(Iminus_c, bool)
PERLVAR(Ipatchlevel, SV *)
-PERLVAR(Ilocalpatches, const char **)
+PERLVAR(Ilocalpatches, const char * const *)
PERLVARI(Isplitstr, const char *, " ")
PERLVAR(Ipreprocess, bool)
PERLVAR(Iminus_n, bool)
diff --git a/lib/ExtUtils/t/Embed.t b/lib/ExtUtils/t/Embed.t
index fc0ed3cbc1..1c82cd9ae0 100644
--- a/lib/ExtUtils/t/Embed.t
+++ b/lib/ExtUtils/t/Embed.t
@@ -153,10 +153,22 @@ __END__
static char *cmds[] = { "perl","-e", "$|=1; print qq[ok 5\\n]", NULL };
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+static struct perl_vars *my_plvarsp;
+struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
+#endif
+
int main(int argc, char **argv, char **env)
{
PerlInterpreter *my_perl;
-
+#ifdef PERL_GLOBAL_STRUCT
+ dVAR;
+ struct perl_vars *plvarsp = init_global_struct();
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ my_vars = my_plvarsp = plvarsp;
+# endif
+#endif /* PERL_GLOBAL_STRUCT */
+
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
@@ -183,6 +195,10 @@ int main(int argc, char **argv, char **env)
perl_free(my_perl);
+#ifdef PERL_GLOBAL_STRUCT
+ free_global_struct(plvarsp);
+#endif /* PERL_GLOBAL_STRUCT */
+
my_puts("ok 8");
PERL_SYS_TERM();
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 7ae8020e25..9be40e64ec 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
=head1 SYNOPSIS
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-csuffix csuffix>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs
=head1 DESCRIPTION
@@ -34,6 +34,12 @@ any makefiles generated by MakeMaker.
Adds ``extern "C"'' to the C code.
+=item B<-csuffix csuffix>
+
+Set the suffix used for the generated C or C++ code. Defaults to '.c'
+(even with B<-C++>), but some platforms might want to have e.g. '.cpp'.
+Don't forget the '.' from the front.
+
=item B<-hiertype>
Retains '::' in type names so that C++ hierachical types can be mapped.
@@ -126,7 +132,7 @@ if ($^O eq 'VMS') {
$FH = 'File0000' ;
-$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
+$usage = "Usage: xsubpp [-v] [-C++] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
$proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
@@ -141,12 +147,14 @@ $Fallback = 'PL_sv_undef';
my $process_inout = 1;
my $process_argtypes = 1;
+my $csuffix = '.c';
SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
$flag = shift @ARGV;
$flag =~ s/^-// ;
$spat = quotemeta shift, next SWITCH if $flag eq 's';
$cplusplus = 1, next SWITCH if $flag eq 'C++';
+ $csuffix = shift, next SWITCH if $flag eq 'csuffix';
$hiertype = 1, next SWITCH if $flag eq 'hiertype';
$WantPrototypes = 0, next SWITCH if $flag eq 'noprototypes';
$WantPrototypes = 1, next SWITCH if $flag eq 'prototypes';
@@ -357,7 +365,7 @@ if ($WantLineNumbers) {
}
my $cfile = $filename;
- $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+ $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile);
select PSEUDO_STDOUT;
}
@@ -1059,6 +1067,7 @@ while (fetch_para()) {
undef(%var_types);
undef(%defaults);
undef($class);
+ undef($externC);
undef($static);
undef($elipsis);
undef($wantRETVAL) ;
@@ -1112,7 +1121,8 @@ while (fetch_para()) {
blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
unless @line ;
- $static = 1 if $ret_type =~ s/^static\s+//;
+ $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
+ $static = 1 if $ret_type =~ s/^static\s+//;
$func_header = shift(@line);
blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
@@ -1251,8 +1261,11 @@ while (fetch_para()) {
$xsreturn = 1 if $EXPLICIT_RETURN;
+ $externC = $externC ? qq[extern "C"] : "";
+
# print function header
print Q<<"EOF";
+#$externC
#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
#XS(XS_${Full_func_name})
#[[
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index e1986a96d6..7cb7192188 100644
--- a/lib/File/Spec.pm
+++ b/lib/File/Spec.pm
@@ -12,6 +12,7 @@ my %module = (MacOS => 'Mac',
VMS => 'VMS',
epoc => 'Epoc',
NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
+ symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
cygwin => 'Cygwin');
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index de560ce2ec..e5d38102d7 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -44,12 +44,13 @@ from the following list:
$ENV{TEMP}
$ENV{TMP}
SYS:/temp
+ C:\system\temp
C:/temp
/tmp
/
-The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
-is used also for NetWare).
+The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
+for Symbian (the File::Spec::Win32 is used also for those platforms).
Since Perl 5.8.0, if running under taint mode, and if the environment
variables are tainted, they are not used.
@@ -62,6 +63,7 @@ sub tmpdir {
my $self = shift;
$tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
'SYS:/temp',
+ 'C:\system\temp',
'C:/temp',
'/tmp',
'/' );
diff --git a/locale.c b/locale.c
index 7f336a6e91..94609a485f 100644
--- a/locale.c
+++ b/locale.c
@@ -36,6 +36,7 @@
#include "reentr.h"
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
@@ -79,6 +80,7 @@ S_stdize_locale(pTHX_ char *locs)
return locs;
}
+#endif
void
Perl_set_numeric_radix(pTHX)
@@ -173,7 +175,7 @@ void
Perl_new_ctype(pTHX_ char *newctype)
{
#ifdef USE_LOCALE_CTYPE
-
+ dVAR;
int i;
for (i = 0; i < 256; i++) {
diff --git a/mg.c b/mg.c
index af52790175..39b8fd823a 100644
--- a/mg.c
+++ b/mg.c
@@ -580,6 +580,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register I32 paren;
register char *s = NULL;
register I32 i;
@@ -962,6 +963,7 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register char *s;
char *ptr;
STRLEN len, klen;
@@ -1047,7 +1049,7 @@ Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
{
-#if defined(VMS)
+#if defined(VMS) || defined(EPOC) || defined(SYMBIAN)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
if (PL_localizing) {
@@ -1068,8 +1070,9 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
#ifndef PERL_MICRO
-#if defined(VMS) || defined(EPOC)
+#if defined(VMS) || defined(EPOC) || defined(SYMBIAN)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
@@ -1104,16 +1107,6 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
return 0;
}
-#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
-static int sig_handlers_initted = 0;
-#endif
-#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-static int sig_ignoring[SIG_SIZE]; /* which signals we are ignoring */
-#endif
-#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-static int sig_defaulting[SIG_SIZE];
-#endif
-
#ifndef PERL_MICRO
#ifdef HAS_SIGPROCMASK
static void
@@ -1137,10 +1130,10 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
Sighandler_t sigstate;
sigstate = rsignal_state(i);
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- if (sig_handlers_initted && sig_ignoring[i]) sigstate = SIG_IGN;
+ if (PL_sig_handlers_initted && PL_sig_ignoring[i]) sigstate = SIG_IGN;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
- if (sig_handlers_initted && sig_defaulting[i]) sigstate = SIG_DFL;
+ if (PL_sig_handlers_initted && PL_sig_defaulting[i]) sigstate = SIG_DFL;
#endif
/* cache state so we don't fetch it again */
if(sigstate == SIG_IGN)
@@ -1159,18 +1152,19 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
/* XXX Some of this code was copied from Perl_magic_setsig. A little
* refactoring might be in order.
*/
+ dVAR;
STRLEN n_a;
register const char *s = MgPV(mg,n_a);
(void)sv;
if (*s == '_') {
- SV** svp;
+ SV** svp = 0;
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
else if (strEQ(s,"__WARN__"))
svp = &PL_warnhook;
else
Perl_croak(aTHX_ "No such hook: %s", s);
- if (*svp) {
+ if (svp && *svp) {
SV *to_dec = *svp;
*svp = 0;
SvREFCNT_dec(to_dec);
@@ -1195,10 +1189,10 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
#endif
PERL_ASYNC_CHECK();
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
- if (!sig_handlers_initted) Perl_csighandler_init();
+ if (!PL_sig_handlers_initted) Perl_csighandler_init();
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
- sig_defaulting[i] = 1;
+ PL_sig_defaulting[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, SIG_DFL);
@@ -1239,10 +1233,10 @@ Perl_csighandler(int sig)
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
(void) rsignal(sig, PL_csighandlerp);
- if (sig_ignoring[sig]) return;
+ if (PL_sig_ignoring[sig]) return;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
- if (sig_defaulting[sig])
+ if (PL_sig_defaulting[sig])
#ifdef KILL_BY_SIGPRC
exit((Perl_sig_to_vmscondition(sig)&STS$M_COND_ID)|STS$K_SEVERE|STS$M_INHIB_MSG);
#else
@@ -1262,19 +1256,19 @@ void
Perl_csighandler_init(void)
{
int sig;
- if (sig_handlers_initted) return;
+ if (PL_sig_handlers_initted) return;
for (sig = 1; sig < SIG_SIZE; sig++) {
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
dTHX;
- sig_defaulting[sig] = 1;
+ PL_sig_defaulting[sig] = 1;
(void) rsignal(sig, PL_csighandlerp);
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- sig_ignoring[sig] = 0;
+ PL_sig_ignoring[sig] = 0;
#endif
}
- sig_handlers_initted = 1;
+ PL_sig_handlers_initted = 1;
}
#endif
@@ -1297,6 +1291,7 @@ Perl_despatch_signals(pTHX)
int
Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
I32 i;
SV** svp = 0;
/* Need to be careful with SvREFCNT_dec(), because that can have side
@@ -1343,13 +1338,13 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
#endif
PERL_ASYNC_CHECK();
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
- if (!sig_handlers_initted) Perl_csighandler_init();
+ if (!PL_sig_handlers_initted) Perl_csighandler_init();
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- sig_ignoring[i] = 0;
+ PL_sig_ignoring[i] = 0;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
- sig_defaulting[i] = 0;
+ PL_sig_defaulting[i] = 0;
#endif
SvREFCNT_dec(PL_psig_name[i]);
to_dec = PL_psig_ptr[i];
@@ -1375,7 +1370,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
if (strEQ(s,"IGNORE")) {
if (i) {
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- sig_ignoring[i] = 1;
+ PL_sig_ignoring[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, SIG_IGN);
@@ -1386,7 +1381,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
if (i)
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
{
- sig_defaulting[i] = 1;
+ PL_sig_defaulting[i] = 1;
(void)rsignal(i, PL_csighandlerp);
}
#else
@@ -1498,7 +1493,7 @@ S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int
STATIC int
S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
{
- dSP;
+ dVAR; dSP;
ENTER;
SAVETMPS;
@@ -1526,7 +1521,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
@@ -1545,7 +1540,7 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
U32
Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
U32 retval = 0;
ENTER;
@@ -1564,7 +1559,7 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
@@ -1581,7 +1576,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
int
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
- dSP;
+ dVAR; dSP;
const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
ENTER;
@@ -1612,7 +1607,7 @@ Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
SV *
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
SV *retval = &PL_sv_undef;
SV *tied = SvTIED_obj((SV*)hv, mg);
HV *pkg = SvSTASH((SV*)SvRV(tied));
@@ -2524,7 +2519,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
I32
Perl_whichsig(pTHX_ const char *sig)
{
- register const char **sigv;
+ register const char * const *sigv;
for (sigv = PL_sig_name; *sigv; sigv++)
if (strEQ(sig,*sigv))
@@ -2540,10 +2535,6 @@ Perl_whichsig(pTHX_ const char *sig)
return -1;
}
-#if !defined(PERL_IMPLICIT_CONTEXT)
-static SV* sig_sv;
-#endif
-
Signal_t
Perl_sighandler(int sig)
{
@@ -2603,7 +2594,7 @@ Perl_sighandler(int sig)
sv = SvREFCNT_inc(PL_psig_name[sig]);
flags |= 64;
#if !defined(PERL_IMPLICIT_CONTEXT)
- sig_sv = sv;
+ PL_sig_sv = sv;
#endif
} else {
sv = sv_newmortal();
@@ -2705,6 +2696,7 @@ restore_magic(pTHX_ const void *p)
static void
unwind_handler_stack(pTHX_ const void *p)
{
+ dVAR;
const U32 flags = *(const U32*)p;
if (flags & 1)
@@ -2712,7 +2704,7 @@ unwind_handler_stack(pTHX_ const void *p)
/* cxstack_ix-- Not needed, die already unwound it. */
#if !defined(PERL_IMPLICIT_CONTEXT)
if (flags & 64)
- SvREFCNT_dec(sig_sv);
+ SvREFCNT_dec(PL_sig_sv);
#endif
}
diff --git a/miniperlmain.c b/miniperlmain.c
index 252a48d8e9..53ab947537 100644
--- a/miniperlmain.c
+++ b/miniperlmain.c
@@ -44,27 +44,31 @@ static PerlInterpreter *my_perl;
long _stksize = 64 * 1024;
#endif
+#if defined(PERL_GLOBAL_STRUCT_PRIVATE)
+/* The static struct perl_vars* may seem counterproductive since the
+ * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note
+ * that this static is not in the shared perl library, the globals PL_Vars
+ * and PL_VarsPtr will stay away. */
+static struct perl_vars* my_plvarsp;
+struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
+#endif
+
int
main(int argc, char **argv, char **env)
{
+ dVAR;
int exitstatus;
+#ifdef PERL_GLOBAL_STRUCT
+ struct perl_vars *plvarsp = init_global_struct();
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ my_vars = my_plvarsp = plvarsp;
+# endif
+#endif /* PERL_GLOBAL_STRUCT */
(void)env;
#ifndef PERL_USE_SAFE_PUTENV
PL_use_safe_putenv = 0;
#endif /* PERL_USE_SAFE_PUTENV */
-#ifdef PERL_GLOBAL_STRUCT
-#define PERLVAR(var,type) /**/
-#define PERLVARA(var,type) /**/
-#define PERLVARI(var,type,init) PL_Vars.var = init;
-#define PERLVARIC(var,type,init) PL_Vars.var = init;
-#include "perlvars.h"
-#undef PERLVAR
-#undef PERLVARA
-#undef PERLVARI
-#undef PERLVARIC
-#endif
-
/* if user wants control of gprof profiling off by default */
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
@@ -102,6 +106,10 @@ main(int argc, char **argv, char **env)
perl_free(my_perl);
+#ifdef PERL_GLOBAL_STRUCT
+ free_global_struct(plvarsp);
+#endif /* PERL_GLOBAL_STRUCT */
+
PERL_SYS_TERM();
exit(exitstatus);
diff --git a/numeric.c b/numeric.c
index 38f00fc6ed..297dbdd756 100644
--- a/numeric.c
+++ b/numeric.c
@@ -261,6 +261,7 @@ number may use '_' characters to separate digits.
UV
Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) {
+ dVAR;
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
diff --git a/op.c b/op.c
index 82642326b2..ef8dfcae2a 100644
--- a/op.c
+++ b/op.c
@@ -270,6 +270,7 @@ Perl_allocmy(pTHX_ char *name)
void
Perl_op_free(pTHX_ OP *o)
{
+ dVAR;
OPCODE type;
PADOFFSET refcnt;
@@ -323,6 +324,7 @@ void
Perl_op_clear(pTHX_ OP *o)
{
+ dVAR;
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
case OP_ENTEREVAL: /* Was holding hints. */
@@ -471,6 +473,7 @@ S_cop_free(pTHX_ COP* cop)
void
Perl_op_null(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_NULL)
return;
op_clear(o);
@@ -482,12 +485,14 @@ Perl_op_null(pTHX_ OP *o)
void
Perl_op_refcnt_lock(pTHX)
{
+ dVAR;
OP_REFCNT_LOCK;
}
void
Perl_op_refcnt_unlock(pTHX)
{
+ dVAR;
OP_REFCNT_UNLOCK;
}
@@ -549,6 +554,7 @@ S_scalarboolean(pTHX_ OP *o)
OP *
Perl_scalar(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
/* assumes no premature commitment */
@@ -619,6 +625,7 @@ Perl_scalar(pTHX_ OP *o)
OP *
Perl_scalarvoid(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
const char* useless = 0;
SV* sv;
@@ -858,6 +865,7 @@ Perl_listkids(pTHX_ OP *o)
OP *
Perl_list(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
/* assumes no premature commitment */
@@ -981,6 +989,7 @@ S_modkids(pTHX_ OP *o, I32 type)
OP *
Perl_mod(pTHX_ OP *o, I32 type)
{
+ dVAR;
OP *kid;
/* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
int localize = -1;
@@ -1403,6 +1412,7 @@ Perl_refkids(pTHX_ OP *o, I32 type)
OP *
Perl_ref(pTHX_ OP *o, I32 type)
{
+ dVAR;
OP *kid;
if (!o || PL_error_count)
@@ -1515,6 +1525,7 @@ S_dup_attrlist(pTHX_ OP *o)
STATIC void
S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
{
+ dVAR;
SV *stashsv;
/* fake up C<use attributes $pkg,$rv,@attrs> */
@@ -1828,6 +1839,7 @@ Perl_invert(pTHX_ OP *o)
OP *
Perl_scope(pTHX_ OP *o)
{
+ dVAR;
if (o) {
if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
@@ -2013,6 +2025,7 @@ Perl_jmaybe(pTHX_ OP *o)
OP *
Perl_fold_constants(pTHX_ register OP *o)
{
+ dVAR;
register OP *curop;
I32 type = o->op_type;
SV *sv;
@@ -2092,6 +2105,7 @@ Perl_fold_constants(pTHX_ register OP *o)
OP *
Perl_gen_constant_list(pTHX_ register OP *o)
{
+ dVAR;
register OP *curop;
const I32 oldtmps_floor = PL_tmps_floor;
@@ -2123,6 +2137,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
OP *
Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
{
+ dVAR;
if (!o || o->op_type != OP_LIST)
o = newLISTOP(OP_LIST, 0, o, Nullop);
else
@@ -2244,6 +2259,7 @@ Perl_force_list(pTHX_ OP *o)
OP *
Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
+ dVAR;
LISTOP *listop;
NewOp(1101, listop, 1, LISTOP);
@@ -2278,6 +2294,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
OP *
Perl_newOP(pTHX_ I32 type, I32 flags)
{
+ dVAR;
OP *o;
NewOp(1101, o, 1, OP);
o->op_type = (OPCODE)type;
@@ -2296,6 +2313,7 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
OP *
Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
{
+ dVAR;
UNOP *unop;
if (!first)
@@ -2319,6 +2337,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
OP *
Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
+ dVAR;
BINOP *binop;
NewOp(1101, binop, 1, BINOP);
@@ -2671,6 +2690,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
OP *
Perl_newPMOP(pTHX_ I32 type, I32 flags)
{
+ dVAR;
PMOP *pmop;
NewOp(1101, pmop, 1, PMOP);
@@ -2727,6 +2747,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
OP *
Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
{
+ dVAR;
PMOP *pm;
LOGOP *rcop;
I32 repl_has_vars = 0;
@@ -2896,6 +2917,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
OP *
Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
{
+ dVAR;
SVOP *svop;
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
@@ -2913,6 +2935,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
OP *
Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
{
+ dVAR;
PADOP *padop;
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
@@ -2934,6 +2957,7 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
+ dVAR;
#ifdef USE_ITHREADS
if (gv)
GvIN_PAD_on(gv);
@@ -2946,6 +2970,7 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
OP *
Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
{
+ dVAR;
PVOP *pvop;
NewOp(1101, pvop, 1, PVOP);
pvop->op_type = (OPCODE)type;
@@ -3406,6 +3431,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
OP *
Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
{
+ dVAR;
const U32 seq = intro_my();
register COP *cop;
@@ -3470,12 +3496,14 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
OP *
Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
{
+ dVAR;
return new_logop(type, flags, &first, &other);
}
STATIC OP *
S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
{
+ dVAR;
LOGOP *logop;
OP *o;
OP *first = *firstp;
@@ -3610,6 +3638,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
OP *
Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
{
+ dVAR;
LOGOP *logop;
OP *start;
OP *o;
@@ -3665,6 +3694,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
OP *
Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
{
+ dVAR;
LOGOP *range;
OP *flip;
OP *flop;
@@ -3771,6 +3801,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
OP *
Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
{
+ dVAR;
OP *redo;
OP *next = 0;
OP *listop;
@@ -3865,6 +3896,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
OP *
Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
{
+ dVAR;
LOOP *loop;
OP *wop;
PADOFFSET padoff = 0;
@@ -4004,6 +4036,7 @@ children can still follow the full lexical scope chain.
void
Perl_cv_undef(pTHX_ CV *cv)
{
+ dVAR;
#ifdef USE_ITHREADS
if (CvFILE(cv) && !CvXSUB(cv)) {
/* for XSUBs CvFILE point directly to static memory; __FILE__ */
@@ -4194,6 +4227,7 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
CV *
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
+ dVAR;
STRLEN n_a;
const char *name;
const char *aname;
@@ -4552,6 +4586,7 @@ eligible for inlining at compile-time.
CV *
Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
{
+ dVAR;
CV* cv;
ENTER;
@@ -4768,6 +4803,7 @@ Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block)
OP *
Perl_oopsAV(pTHX_ OP *o)
{
+ dVAR;
switch (o->op_type) {
case OP_PADSV:
o->op_type = OP_PADAV;
@@ -4791,6 +4827,7 @@ Perl_oopsAV(pTHX_ OP *o)
OP *
Perl_oopsHV(pTHX_ OP *o)
{
+ dVAR;
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
@@ -4816,6 +4853,7 @@ Perl_oopsHV(pTHX_ OP *o)
OP *
Perl_newAVREF(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADAV;
o->op_ppaddr = PL_ppaddr[OP_PADAV];
@@ -4840,6 +4878,7 @@ Perl_newGVREF(pTHX_ I32 type, OP *o)
OP *
Perl_newHVREF(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADHV;
o->op_ppaddr = PL_ppaddr[OP_PADHV];
@@ -4875,6 +4914,7 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
OP *
Perl_newSVREF(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADSV;
o->op_ppaddr = PL_ppaddr[OP_PADSV];
@@ -4944,6 +4984,7 @@ Perl_ck_concat(pTHX_ OP *o)
OP *
Perl_ck_spair(pTHX_ OP *o)
{
+ dVAR;
if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
@@ -5021,6 +5062,7 @@ Perl_ck_eof(pTHX_ OP *o)
OP *
Perl_ck_eval(pTHX_ OP *o)
{
+ dVAR;
PL_hints |= HINT_BLOCK_SCOPE;
if (o->op_flags & OPf_KIDS) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
@@ -5129,6 +5171,7 @@ Perl_ck_gvconst(pTHX_ register OP *o)
OP *
Perl_ck_rvconst(pTHX_ register OP *o)
{
+ dVAR;
SVOP *kid = (SVOP*)cUNOPo->op_first;
o->op_private |= (PL_hints & HINT_STRICT_REFS);
@@ -5227,6 +5270,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
OP *
Perl_ck_ftst(pTHX_ OP *o)
{
+ dVAR;
const I32 type = o->op_type;
if (o->op_flags & OPf_REF) {
@@ -5512,6 +5556,7 @@ Perl_ck_fun(pTHX_ OP *o)
OP *
Perl_ck_glob(pTHX_ OP *o)
{
+ dVAR;
GV *gv;
o = ck_fun(o);
@@ -5566,6 +5611,7 @@ Perl_ck_glob(pTHX_ OP *o)
OP *
Perl_ck_grep(pTHX_ OP *o)
{
+ dVAR;
LOGOP *gwop;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
@@ -5943,6 +5989,7 @@ Perl_ck_retarget(pTHX_ OP *o)
OP *
Perl_ck_select(pTHX_ OP *o)
{
+ dVAR;
OP* kid;
if (o->op_flags & OPf_KIDS) {
kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
@@ -6111,6 +6158,7 @@ S_simplify_sort(pTHX_ OP *o)
OP *
Perl_ck_split(pTHX_ OP *o)
{
+ dVAR;
register OP *kid;
if (o->op_flags & OPf_STACKED)
@@ -6474,6 +6522,7 @@ Perl_ck_substr(pTHX_ OP *o)
void
Perl_peep(pTHX_ register OP *o)
{
+ dVAR;
register OP* oldop = 0;
if (!o || o->op_opt)
@@ -7040,13 +7089,13 @@ Perl_custom_op_name(pTHX_ const OP* o)
HE* he;
if (!PL_custom_op_names) /* This probably shouldn't happen */
- return PL_op_name[OP_CUSTOM];
+ return (char *)PL_op_name[OP_CUSTOM];
keysv = sv_2mortal(newSViv(index));
he = hv_fetch_ent(PL_custom_op_names, keysv, 0, 0);
if (!he)
- return PL_op_name[OP_CUSTOM]; /* Don't know who you are */
+ return (char *)PL_op_name[OP_CUSTOM]; /* Don't know who you are */
return SvPV_nolen(HeVAL(he));
}
@@ -7059,13 +7108,13 @@ Perl_custom_op_desc(pTHX_ const OP* o)
HE* he;
if (!PL_custom_op_descs)
- return PL_op_desc[OP_CUSTOM];
+ return (char *)PL_op_desc[OP_CUSTOM];
keysv = sv_2mortal(newSViv(index));
he = hv_fetch_ent(PL_custom_op_descs, keysv, 0, 0);
if (!he)
- return PL_op_desc[OP_CUSTOM];
+ return (char *)PL_op_desc[OP_CUSTOM];
return SvPV_nolen(HeVAL(he));
}
diff --git a/opcode.h b/opcode.h
index 356145f540..8e52cf6f6c 100644
--- a/opcode.h
+++ b/opcode.h
@@ -12,24 +12,24 @@
* will be lost!
*/
+#ifndef PERL_GLOBAL_STRUCT_INIT
+
#define Perl_pp_i_preinc Perl_pp_preinc
#define Perl_pp_i_predec Perl_pp_predec
#define Perl_pp_i_postinc Perl_pp_postinc
#define Perl_pp_i_postdec Perl_pp_postdec
-
START_EXTERN_C
-
#define OP_NAME(o) ((o)->op_type == OP_CUSTOM ? custom_op_name(o) : \
PL_op_name[(o)->op_type])
#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \
PL_op_desc[(o)->op_type])
#ifndef DOINIT
-EXT char *PL_op_name[];
+EXTCONST char* const PL_op_name[];
#else
-EXT char *PL_op_name[] = {
+EXTCONST char* const PL_op_name[] = {
"null",
"stub",
"scalar",
@@ -388,9 +388,9 @@ EXT char *PL_op_name[] = {
#endif
#ifndef DOINIT
-EXT char *PL_op_desc[];
+EXTCONST char* const PL_op_desc[];
#else
-EXT char *PL_op_desc[] = {
+EXTCONST char* const PL_op_desc[] = {
"null operation",
"stub",
"scalar",
@@ -750,13 +750,20 @@ EXT char *PL_op_desc[] = {
END_EXTERN_C
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
+
START_EXTERN_C
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_ppaddr_t Gppaddr[]
#else
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
+# ifndef PERL_GLOBAL_STRUCT
+EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
+# endif
+#endif /* PERL_GLOBAL_STRUCT */
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
MEMBER_TO_FPTR(Perl_pp_null),
MEMBER_TO_FPTR(Perl_pp_stub),
MEMBER_TO_FPTR(Perl_pp_scalar),
@@ -1110,13 +1117,19 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
MEMBER_TO_FPTR(Perl_pp_method_named),
MEMBER_TO_FPTR(Perl_pp_dor),
MEMBER_TO_FPTR(Perl_pp_dorassign),
-};
+}
#endif
+;
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_check_t Gcheck[]
#else
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
+# ifndef PERL_GLOBAL_STRUCT
+EXT Perl_check_t PL_check[] /* or perlvars.h */
+# endif
+#endif
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
MEMBER_TO_FPTR(Perl_ck_null), /* null */
MEMBER_TO_FPTR(Perl_ck_null), /* stub */
MEMBER_TO_FPTR(Perl_ck_fun), /* scalar */
@@ -1471,13 +1484,16 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
MEMBER_TO_FPTR(Perl_ck_null), /* dor */
MEMBER_TO_FPTR(Perl_ck_null), /* dorassign */
MEMBER_TO_FPTR(Perl_ck_null), /* custom */
-};
+}
#endif
+;
+
+#ifndef PERL_GLOBAL_STRUCT_INIT
#ifndef DOINIT
-EXT U32 PL_opargs[];
+EXT const U32 PL_opargs[];
#else
-EXT U32 PL_opargs[] = {
+EXT const U32 PL_opargs[] = {
0x00000000, /* null */
0x00000000, /* stub */
0x00003604, /* scalar */
@@ -1836,3 +1852,5 @@ EXT U32 PL_opargs[] = {
#endif
END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
diff --git a/opcode.pl b/opcode.pl
index d9c81b3c81..ac9499d5d7 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -51,6 +51,8 @@ print <<"END";
* will be lost!
*/
+#ifndef PERL_GLOBAL_STRUCT_INIT
+
#define Perl_pp_i_preinc Perl_pp_preinc
#define Perl_pp_i_predec Perl_pp_predec
#define Perl_pp_i_postinc Perl_pp_postinc
@@ -88,19 +90,17 @@ print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n";
# Emit op names and descriptions.
print <<END;
-
START_EXTERN_C
-
#define OP_NAME(o) ((o)->op_type == OP_CUSTOM ? custom_op_name(o) : \\
PL_op_name[(o)->op_type])
#define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \\
PL_op_desc[(o)->op_type])
#ifndef DOINIT
-EXT char *PL_op_name[];
+EXTCONST char* const PL_op_name[];
#else
-EXT char *PL_op_name[] = {
+EXTCONST char* const PL_op_name[] = {
END
for (@ops) {
@@ -115,9 +115,9 @@ END
print <<END;
#ifndef DOINIT
-EXT char *PL_op_desc[];
+EXTCONST char* const PL_op_desc[];
#else
-EXT char *PL_op_desc[] = {
+EXTCONST char* const PL_op_desc[] = {
END
for (@ops) {
@@ -135,6 +135,8 @@ print <<END;
END_EXTERN_C
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
+
END
# Emit function declarations.
@@ -155,10 +157,15 @@ print <<END;
START_EXTERN_C
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_ppaddr_t Gppaddr[]
#else
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
+# ifndef PERL_GLOBAL_STRUCT
+EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
+# endif
+#endif /* PERL_GLOBAL_STRUCT */
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
END
for (@ops) {
@@ -166,18 +173,24 @@ for (@ops) {
}
print <<END;
-};
+}
#endif
+;
END
# Emit check routines.
print <<END;
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_check_t Gcheck[]
#else
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
+# ifndef PERL_GLOBAL_STRUCT
+EXT Perl_check_t PL_check[] /* or perlvars.h */
+# endif
+#endif
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
END
for (@ops) {
@@ -185,18 +198,21 @@ for (@ops) {
}
print <<END;
-};
+}
#endif
+;
END
# Emit allowed argument types.
print <<END;
+#ifndef PERL_GLOBAL_STRUCT_INIT
+
#ifndef DOINIT
-EXT U32 PL_opargs[];
+EXT const U32 PL_opargs[];
#else
-EXT U32 PL_opargs[] = {
+EXT const U32 PL_opargs[] = {
END
%argnum = (
@@ -266,6 +282,8 @@ print <<END;
#endif
END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
END
if (keys %OP_IS_SOCKET) {
diff --git a/pad.c b/pad.c
index 14649fcaa4..ce6ef3f2b0 100644
--- a/pad.c
+++ b/pad.c
@@ -1119,6 +1119,7 @@ Tidy up a pad after we've finished compiling it:
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
+ dVAR;
PADOFFSET ix;
ASSERT_CURPAD_ACTIVE("pad_tidy");
@@ -1368,6 +1369,7 @@ any outer lexicals.
CV *
Perl_cv_clone(pTHX_ CV *proto)
{
+ dVAR;
I32 ix;
AV* protopadlist = CvPADLIST(proto);
const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
diff --git a/patchlevel.h b/patchlevel.h
index 302e4f945d..86b87be4f4 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -118,7 +118,7 @@ hunk.
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
-static const char *local_patches[] = {
+static const char * const local_patches[] = {
NULL
,"DEVEL24148"
,NULL
diff --git a/perl.c b/perl.c
index 1e39037434..cf8a76e5ba 100644
--- a/perl.c
+++ b/perl.c
@@ -125,6 +125,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
static void
S_init_tls_and_interp(PerlInterpreter *my_perl)
{
+ dVAR;
if (!PL_curinterp) {
PERL_SET_INTERP(my_perl);
#if defined(USE_ITHREADS)
@@ -201,6 +202,7 @@ Initializes a new Perl interpreter. See L<perlembed>.
void
perl_construct(pTHXx)
{
+ dVAR;
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
@@ -303,7 +305,9 @@ perl_construct(pTHXx)
/* Use sysconf(_SC_CLK_TCK) if available, if not
* available or if the sysconf() fails, use the HZ.
- * BeOS has those, but returns the wrong value. */
+ * BeOS has those, but returns the wrong value.
+ * The HZ if not originally defined has been by now
+ * been defined as CLK_TCK, if available. */
#if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) && !defined(__BEOS__)
PL_clocktick = sysconf(_SC_CLK_TCK);
if (PL_clocktick <= 0)
@@ -319,6 +323,51 @@ perl_construct(pTHXx)
(int)PERL_SUBVERSION ), 0
);
+#ifdef HAS_MMAP
+ if (!PL_mmap_page_size) {
+#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE))
+ {
+ SETERRNO(0, SS_NORMAL);
+# ifdef _SC_PAGESIZE
+ PL_mmap_page_size = sysconf(_SC_PAGESIZE);
+# else
+ PL_mmap_page_size = sysconf(_SC_MMAP_PAGE_SIZE);
+# endif
+ if ((long) PL_mmap_page_size < 0) {
+ if (errno) {
+ SV *error = ERRSV;
+ char *msg;
+ STRLEN n_a;
+ (void) SvUPGRADE(error, SVt_PV);
+ msg = SvPVx(error, n_a);
+ Perl_croak(aTHX_ "panic: sysconf: %s", msg);
+ }
+ else
+ Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
+ }
+ }
+#else
+# ifdef HAS_GETPAGESIZE
+ PL_mmap_page_size = getpagesize();
+# else
+# if defined(I_SYS_PARAM) && defined(PAGESIZE)
+ PL_mmap_page_size = PAGESIZE; /* compiletime, bad */
+# endif
+# endif
+#endif
+ if (PL_mmap_page_size <= 0)
+ Perl_croak(aTHX_ "panic: bad pagesize %" IVdf,
+ (IV) PL_mmap_page_size);
+ }
+#endif /* HAS_MMAP */
+
+#if defined(HAS_TIMES) && defined(PERL_NEED_TIMESBASE)
+ PL_timesbase.tms_utime = 0;
+ PL_timesbase.tms_stime = 0;
+ PL_timesbase.tms_cutime = 0;
+ PL_timesbase.tms_cstime = 0;
+#endif
+
ENTER;
}
@@ -348,6 +397,7 @@ Shuts down a Perl interpreter. See L<perlembed>.
int
perl_destruct(pTHXx)
{
+ dVAR;
volatile int destruct_level; /* 0=none, 1=full, 2=full with checks */
HV *hv;
@@ -366,8 +416,7 @@ perl_destruct(pTHXx)
}
#endif
-
- if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
dJMPENV;
int x = 0;
@@ -967,6 +1016,7 @@ perl_free(pTHXx)
static void __attribute__((destructor))
perl_fini()
{
+ dVAR;
if (PL_curinterp)
FREE_THREAD_KEY;
}
@@ -1045,6 +1095,7 @@ Tells a Perl interpreter to parse a Perl script. See L<perlembed>.
int
perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
+ dVAR;
I32 oldscope;
int ret;
dJMPENV;
@@ -1229,6 +1280,7 @@ setuid perl scripts securely.\n");
STATIC void *
S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
{
+ dVAR;
int argc = PL_origargc;
char **argv = PL_origargv;
const char *scriptname = NULL;
@@ -1663,10 +1715,13 @@ print \" \\@INC:\\n @INC\\n\";");
if (!PL_do_undump)
init_postdump_symbols(argc,argv,env);
- /* PL_unicode is turned on by -C or by $ENV{PERL_UNICODE}.
- * PL_utf8locale is conditionally turned on by
+ /* PL_unicode is turned on by -C, or by $ENV{PERL_UNICODE},
+ * or explicitly in some platforms.
* locale.c:Perl_init_i18nl10n() if the environment
* look like the user wants to use UTF-8. */
+#if defined(SYMBIAN)
+ PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
+#endif
if (PL_unicode) {
/* Requires init_predump_symbols(). */
if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
@@ -1869,7 +1924,6 @@ S_run_body(pTHX_ I32 oldscope)
PL_op = PL_main_start;
CALLRUNOPS(aTHX);
}
-
my_exit(0);
/* NOTREACHED */
}
@@ -2059,7 +2113,7 @@ I32
Perl_call_sv(pTHX_ SV *sv, I32 flags)
/* See G_* flags in cop.h */
{
- dSP;
+ dVAR; dSP;
LOGOP myop; /* fake syntax tree node */
UNOP method_op;
I32 oldmark;
@@ -2382,7 +2436,7 @@ S_usage(pTHX_ const char *name) /* XXX move this out into a module ? */
/* This message really ought to be max 23 lines.
* Removed -h because the user already knows that option. Others? */
- static const char *usage_msg[] = {
+ static const char * const usage_msg[] = {
"-0[octal] specify record separator (\\0, if no argument)",
"-a autosplit mode with -n or -p (splits $_ into @F)",
"-C[number/list] enables the listed Unicode features",
@@ -2414,7 +2468,7 @@ S_usage(pTHX_ const char *name) /* XXX move this out into a module ? */
"\n",
NULL
};
- const char **p = usage_msg;
+ const char * const *p = usage_msg;
PerlIO_printf(PerlIO_stdout(),
"\nUsage: %s [switches] [--] [programfile] [arguments]",
@@ -2430,7 +2484,7 @@ NULL
int
Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
{
- static const char *usage_msgd[] = {
+ static const char * const usage_msgd[] = {
" Debugging flag values: (see also -d)",
" p Tokenizing and parsing (with v, displays parse stack)",
" s Stack snapshots (with v, displays all stacks)",
@@ -2493,6 +2547,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
char *
Perl_moreswitches(pTHX_ char *s)
{
+ dVAR;
STRLEN numlen;
UV rschar;
@@ -2856,6 +2911,10 @@ Perl_moreswitches(pTHX_ char *s)
PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
wce_hitreturn();
#endif
+#ifdef SYMBIAN
+ PerlIO_printf(PerlIO_stdout(),
+ "Symbian port by Nokia, 2004-2005\n");
+#endif
#ifdef BINARY_BUILD_NOTICE
BINARY_BUILD_NOTICE;
#endif
@@ -2956,7 +3015,7 @@ S_init_interp(pTHX)
# if defined(PERL_IMPLICIT_CONTEXT)
# if defined(USE_5005THREADS)
# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
-# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
# else /* !USE_5005THREADS */
# define PERLVARI(var,type,init) aTHX->var = init;
# define PERLVARIC(var,type,init) aTHX->var = init;
@@ -3032,6 +3091,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
const char *cpp_discard_flag;
const char *perl;
#endif
+ dVAR;
PL_fdscript = -1;
PL_suidscript = -1;
@@ -3328,6 +3388,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
STATIC void
S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
{
+ dVAR;
#ifdef IAMSUID
/* int which; */
#endif /* IAMSUID */
@@ -4071,8 +4132,7 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
STATIC void
S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
{
- char *s;
- SV *sv;
+ dVAR;
GV* tmpgv;
PL_toptarget = NEWSV(0,0);
@@ -4120,6 +4180,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
}
if (env) {
char** origenv = environ;
+ char *s;
+ SV *sv;
for (; *env; env++) {
if (!(s = strchr(*env,'=')) || s == *env)
continue;
@@ -4276,7 +4338,7 @@ S_init_perllib(pTHX)
#endif /* MACOS_TRADITIONAL */
}
-#if defined(DOSISH) || defined(EPOC)
+#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
# define PERLLIB_SEP ';'
#else
# if defined(VMS)
@@ -4609,6 +4671,7 @@ S_init_main_thread(pTHX)
void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
+ dVAR;
SV *atsv;
const line_t oldline = CopLINE(PL_curcop);
CV *cv;
@@ -4753,6 +4816,7 @@ Perl_my_failure_exit(pTHX)
STATIC void
S_my_exit_jump(pTHX)
{
+ dVAR;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
diff --git a/perl.h b/perl.h
index c867ab264c..e0b1a94016 100644
--- a/perl.h
+++ b/perl.h
@@ -65,13 +65,45 @@
# endif
#endif
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# ifndef PERL_GLOBAL_STRUCT
+# define PERL_GLOBAL_STRUCT
+# endif
+#endif
+#ifdef PERL_GLOBAL_STRUCT
+# ifndef MULTIPLICITY
+# define MULTIPLICITY
+# endif
+#endif
+
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
# undef WIN32
# undef _WIN32
#endif
-/* Use the reentrant APIs like localtime_r and getpwent_r */
+#if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS))
+# ifndef SYMBIAN
+# define SYMBIAN
+# endif
+#endif
+
+#ifdef SYMBIAN
+# include "symbian/symbian_proto.h"
+#endif
+
+/* Any stack-challenged places. The limit varies (and often
+ * is configurable), but using more than a kilobyte of stack
+ * is usually dubious in these systems. */
+#if defined(EPOC) || defined(SYMBIAN)
+/* EPOC/Symbian: need to work around the SDK features. *
+ * On WINS: MS VC5 generates calls to _chkstk, *
+ * if a "large" stack frame is allocated. *
+ * gcc on MARM does not generate calls like these. */
+# define USE_HEAP_INSTEAD_OF_STACK
+#endif
+
+#/* Use the reentrant APIs like localtime_r and getpwent_r */
/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
# define USE_REENTRANT_API
@@ -90,14 +122,44 @@
# endif
#endif
+#ifdef PERL_GLOBAL_STRUCT
+# ifndef PERL_GET_VARS
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ extern struct perl_vars* Perl_GetVarsPrivate();
+# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
+# ifndef PERLIO_FUNCS_CONST
+# define PERLIO_FUNCS_CONST /* Can't have these lying around. */
+# endif
+# else
+# define PERL_GET_VARS() PL_VarsPtr
+# endif
+# endif
+#endif
+
+#define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL
+
+#ifdef PERL_GLOBAL_STRUCT
+# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS()
+#else
+# define dVAR dNOOP
+#endif
+
#ifdef PERL_IMPLICIT_CONTEXT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# endif
# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL
# define aTHX my_perl
-# define dTHXa(a) pTHX = (PerlInterpreter*)a
-# define dTHX pTHX = PERL_GET_THX
+# ifdef PERL_GLOBAL_STRUCT
+# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a
+# else
+# define dTHXa(a) pTHX = (PerlInterpreter*)a
+# endif
+# ifdef PERL_GLOBAL_STRUCT
+# define dTHX dVAR; pTHX = PERL_GET_THX
+# else
+# define dTHX pTHX = PERL_GET_THX
+# endif
# define pTHX_ pTHX,
# define aTHX_ aTHX,
# define pTHX_1 2
@@ -123,6 +185,12 @@
#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
#define CALLREGFREE CALL_FPTR(PL_regfree)
+#if defined(SYMBIAN) && defined(__GNUC__)
+# undef __attribute__
+# undef __attribute__(_arg_)
+# define HASATTRIBUTE
+#endif
+
#ifdef HASATTRIBUTE
# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
# define PERL_UNUSED_DECL
@@ -132,6 +200,12 @@
#else
# define PERL_UNUSED_DECL
#endif
+
+#if defined(SYMBIAN) && defined(__GNUC__)
+# undef __attribute__
+# undef __attribute__(_arg_)
+# define HASATTRIBUTE
+#endif
/* gcc -Wall:
* for silencing unused variables that are actually used most of the time,
@@ -155,6 +229,10 @@
# define pTHX_4 4
#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+
/* these are only defined for compatibility; should not be used internally */
#if !defined(pTHXo) && !defined(PERL_CORE)
# define pTHXo pTHX
@@ -177,9 +255,17 @@
* PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
* dTHXs is therefore needed for all functions using PerlIO_foo(). */
#ifdef PERL_IMPLICIT_SYS
-# define dTHXs dTHX
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define dTHXs dVAR; dTHX
+# else
+# define dTHXs dTHX
+# endif
#else
-# define dTHXs dNOOP
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define dTHXs dVAR
+# else
+# define dTHXs dNOOP
+# endif
#endif
#undef START_EXTERN_C
@@ -195,6 +281,18 @@
# define EXTERN_C extern
#endif
+/* Some platforms require marking function declarations
+ * for them to be exportable. Used in perlio.h, proto.h
+ * is handled either by the makedef.pl or by defining the
+ * PERL_CALLCONV to be something special. See also the
+ * definition of XS() in XSUB.h. */
+#ifndef PERL_EXPORT_C
+# define PERL_EXPORT_C extern
+#endif
+#ifndef PERL_XS_EXPORT_C
+# define PERL_XS_EXPORT_C
+#endif
+
#ifdef OP_IN_REGISTER
# ifdef __GNUC__
# define stringify_immed(s) #s
@@ -273,7 +371,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) || defined(SYMBIAN)
# define STANDARD_C 1
#endif
@@ -435,6 +533,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
# include <unistd.h>
#endif
+#ifdef SYMBIAN
+# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
+#endif
+
#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
int syscall(int, ...);
#endif
@@ -698,10 +800,12 @@ int usleep(unsigned int);
# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
#endif
-#if defined(I_STRING) || defined(__cplusplus)
-# include <string.h>
-#else
-# include <strings.h>
+#ifndef SYMBIAN
+# if defined(I_STRING) || defined(__cplusplus)
+# include <string.h>
+# else
+# include <strings.h>
+# endif
#endif
/* This comes after <stdlib.h> so we don't try to change the standard
@@ -749,7 +853,7 @@ int usleep(unsigned int);
# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
-#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), s)
+#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what)
#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "")
#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL)
@@ -2157,6 +2261,12 @@ typedef struct clone_params CLONE_PARAMS;
# define ISHISH "epoc"
#endif
+#ifdef SYMBIAN
+# include "symbian/symbianish.h"
+# include "embed.h"
+# define ISHISH "symbian"
+#endif
+
#if defined(MACOS_TRADITIONAL)
# include "macos/macish.h"
# ifndef NO_ENVIRON_ARRAY
@@ -2703,7 +2813,7 @@ long vtohl(long n);
#endif
#ifndef __cplusplus
-#ifndef UNDER_CE
+#if !(defined(UNDER_CE) || defined(SYMBIAN))
Uid_t getuid (void);
Uid_t geteuid (void);
Gid_t getgid (void);
@@ -3268,18 +3378,18 @@ EXTCONST char PL_uuemap[65]
#ifdef DOINIT
-EXT const char *PL_sig_name[] = { SIG_NAME };
-EXT int PL_sig_num[] = { SIG_NUM };
+EXTCONST char* const PL_sig_name[] = { SIG_NAME };
+EXTCONST int PL_sig_num[] = { SIG_NUM };
#else
-EXT const char *PL_sig_name[];
-EXT int PL_sig_num[];
+EXTCONST char* const PL_sig_name[];
+EXTCONST int PL_sig_num[];
#endif
/* fast conversion and case folding tables */
#ifdef DOINIT
#ifdef EBCDIC
-EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
+EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
@@ -3353,8 +3463,9 @@ EXTCONST unsigned char PL_fold[] = {
EXTCONST unsigned char PL_fold[];
#endif
+#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
#ifdef DOINIT
-EXT unsigned char PL_fold_locale[] = {
+EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
@@ -3389,12 +3500,13 @@ EXT unsigned char PL_fold_locale[] = {
248, 249, 250, 251, 252, 253, 254, 255
};
#else
-EXT unsigned char PL_fold_locale[];
+EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */
#endif
+#endif /* !PERL_GLOBAL_STRUCT */
#ifdef DOINIT
#ifdef EBCDIC
-EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
+EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
1, 2, 84, 151, 154, 155, 156, 157,
165, 246, 250, 3, 158, 7, 18, 29,
40, 51, 62, 73, 85, 96, 107, 118,
@@ -3470,7 +3582,7 @@ EXTCONST unsigned char PL_freq[];
#ifdef DEBUGGING
#ifdef DOINIT
-EXTCONST char* PL_block_type[] = {
+EXTCONST char* const PL_block_type[] = {
"NULL",
"SUB",
"EVAL",
@@ -3641,6 +3753,10 @@ typedef void (*XSUBADDR_t) (pTHX_ CV *);
#define PERLVARA(var,n,type) type var[n];
#define PERLVARI(var,type,init) type var;
#define PERLVARIC(var,type,init) type var;
+#define PERLVARISC(var,init) const char var[sizeof(init)];
+
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
/* Interpreter exitlist entry */
typedef struct exitlistentry {
@@ -3654,8 +3770,12 @@ struct perl_vars {
};
# ifdef PERL_CORE
+# ifndef PERL_GLOBAL_STRUCT_PRIVATE
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
+# undef PERL_GET_VARS
+# define PERL_GET_VARS() PL_VarsPtr
+# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */
# else /* PERL_CORE */
# if !defined(__GNUC__) || !defined(WIN32)
EXT
@@ -3696,6 +3816,7 @@ typedef void *Thread;
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
/* Types used by pack/unpack */
typedef enum {
@@ -3760,6 +3881,7 @@ typedef struct tempsym {
#define PERLVARA(var,n,type) EXT type PL_##var[n];
#define PERLVARI(var,type,init) EXT type PL_##var INIT(init);
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
+#define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init);
#if !defined(MULTIPLICITY)
START_EXTERN_C
@@ -3789,9 +3911,9 @@ END_EXTERN_C
START_EXTERN_C
#ifdef DOINIT
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var = {a,b,c,d,e,f,g}
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
#else
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
#endif
MGVTBL_SET(
@@ -4187,7 +4309,7 @@ enum {
#define AMG_id2name(id) (PL_AMG_names[id]+1)
#ifdef DOINIT
-EXTCONST char * PL_AMG_names[NofAMmeth] = {
+EXTCONST char * const PL_AMG_names[NofAMmeth] = {
/* Names kept in the symbol table. fallback => "()", the rest has
"(" prepended. The only other place in perl which knows about
this convention is AMG_id2name (used for debugging output and
diff --git a/perlapi.c b/perlapi.c
index e0bf9fbfdb..b1ed782f38 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -34,14 +34,17 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
- { return &(aTHX->v); }
+ { dVAR; return &(aTHX->v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
- { return &(aTHX->v); }
+ { dVAR; return &(aTHX->v); }
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \
+ { dVAR; return &(aTHX->v); }
#include "thrdvar.h"
#include "intrpvar.h"
@@ -49,18 +52,42 @@ START_EXTERN_C
#undef PERLVAR
#undef PERLVARA
#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \
- { return &(PL_##v); }
+ { dVAR; return &(PL_##v); }
#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \
- { return &(PL_##v); }
+ { dVAR; return &(PL_##v); }
#undef PERLVARIC
-#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHX) \
+#undef PERLVARISC
+#define PERLVARIC(v,t,i) \
+ const t* Perl_##v##_ptr(pTHX) \
{ return (const t *)&(PL_##v); }
+#define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \
+ { dVAR; return &(PL_##v); }
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+/* A few evil special cases. Could probably macrofy this. */
+#undef PL_ppaddr
+#undef PL_check
+#undef PL_fold_locale
+Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX) {
+ static const Perl_ppaddr_t* ppaddr_ptr = PL_ppaddr;
+ return (Perl_ppaddr_t**)&ppaddr_ptr;
+}
+Perl_check_t** Perl_Gcheck_ptr(pTHX) {
+ static const Perl_check_t* check_ptr = PL_check;
+ return (Perl_check_t**)&check_ptr;
+}
+unsigned char** Perl_Gfold_locale_ptr(pTHX) {
+ static const unsigned char* fold_locale_ptr = PL_fold_locale;
+ return (unsigned char**)&fold_locale_ptr;
+}
+#endif
END_EXTERN_C
diff --git a/perlapi.h b/perlapi.h
index 28edb59cd8..c9ccd690b9 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -27,11 +27,14 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHX);
#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+#define PERLVARISC(v,i) typedef const char PL_##v##_t[sizeof(i)]; \
+ EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHX);
#include "thrdvar.h"
#include "intrpvar.h"
@@ -41,6 +44,16 @@ START_EXTERN_C
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
+
+#ifndef PERL_GLOBAL_STRUCT
+EXTERN_C Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX);
+EXTERN_C Perl_check_t** Perl_Gcheck_ptr(pTHX);
+EXTERN_C unsigned char** Perl_Gfold_locale_ptr(pTHX);
+#define Perl_ppaddr_ptr Perl_Gppaddr_ptr
+#define Perl_check_ptr Perl_Gcheck_ptr
+#define Perl_fold_locale_ptr Perl_Gfold_locale_ptr
+#endif
END_EXTERN_C
@@ -56,9 +69,9 @@ END_EXTERN_C
START_EXTERN_C
#ifndef DOINIT
-EXT void *PL_force_link_funcs[];
+EXTCONST void * const PL_force_link_funcs[];
#else
-EXT void *PL_force_link_funcs[] = {
+EXTCONST void * const PL_force_link_funcs[] = {
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
@@ -67,6 +80,7 @@ EXT void *PL_force_link_funcs[] = {
#define PERLVARA(v,n,t) PERLVAR(v,t)
#define PERLVARI(v,t,i) PERLVAR(v,t)
#define PERLVARIC(v,t,i) PERLVAR(v,t)
+#define PERLVARISC(v,i) PERLVAR(v,char)
#include "thrdvar.h"
#include "intrpvar.h"
@@ -76,6 +90,7 @@ EXT void *PL_force_link_funcs[] = {
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
};
#endif /* DOINIT */
@@ -921,6 +936,10 @@ END_EXTERN_C
#define PL_No (*Perl_GNo_ptr(NULL))
#undef PL_Yes
#define PL_Yes (*Perl_GYes_ptr(NULL))
+#undef PL_appctx
+#define PL_appctx (*Perl_Gappctx_ptr(NULL))
+#undef PL_check
+#define PL_check (*Perl_Gcheck_ptr(NULL))
#undef PL_csighandlerp
#define PL_csighandlerp (*Perl_Gcsighandlerp_ptr(NULL))
#undef PL_curinterp
@@ -929,24 +948,52 @@ END_EXTERN_C
#define PL_do_undump (*Perl_Gdo_undump_ptr(NULL))
#undef PL_dollarzero_mutex
#define PL_dollarzero_mutex (*Perl_Gdollarzero_mutex_ptr(NULL))
+#undef PL_fold_locale
+#define PL_fold_locale (*Perl_Gfold_locale_ptr(NULL))
#undef PL_hexdigit
#define PL_hexdigit (*Perl_Ghexdigit_ptr(NULL))
#undef PL_malloc_mutex
#define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL))
+#undef PL_mmap_page_size
+#define PL_mmap_page_size (*Perl_Gmmap_page_size_ptr(NULL))
#undef PL_op_mutex
#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL))
+#undef PL_op_seq
+#define PL_op_seq (*Perl_Gop_seq_ptr(NULL))
+#undef PL_op_sequence
+#define PL_op_sequence (*Perl_Gop_sequence_ptr(NULL))
#undef PL_patleave
#define PL_patleave (*Perl_Gpatleave_ptr(NULL))
+#undef PL_perlio_debug_fd
+#define PL_perlio_debug_fd (*Perl_Gperlio_debug_fd_ptr(NULL))
+#undef PL_perlio_fd_refcnt
+#define PL_perlio_fd_refcnt (*Perl_Gperlio_fd_refcnt_ptr(NULL))
+#undef PL_ppaddr
+#define PL_ppaddr (*Perl_Gppaddr_ptr(NULL))
#undef PL_sh_path
#define PL_sh_path (*Perl_Gsh_path_ptr(NULL))
+#undef PL_sig_defaulting
+#define PL_sig_defaulting (*Perl_Gsig_defaulting_ptr(NULL))
+#undef PL_sig_handlers_initted
+#define PL_sig_handlers_initted (*Perl_Gsig_handlers_initted_ptr(NULL))
+#undef PL_sig_ignoring
+#define PL_sig_ignoring (*Perl_Gsig_ignoring_ptr(NULL))
+#undef PL_sig_sv
+#define PL_sig_sv (*Perl_Gsig_sv_ptr(NULL))
+#undef PL_sig_trapped
+#define PL_sig_trapped (*Perl_Gsig_trapped_ptr(NULL))
#undef PL_sigfpe_saved
#define PL_sigfpe_saved (*Perl_Gsigfpe_saved_ptr(NULL))
#undef PL_sv_placeholder
#define PL_sv_placeholder (*Perl_Gsv_placeholder_ptr(NULL))
#undef PL_thr_key
#define PL_thr_key (*Perl_Gthr_key_ptr(NULL))
+#undef PL_timesbase
+#define PL_timesbase (*Perl_Gtimesbase_ptr(NULL))
#undef PL_use_safe_putenv
#define PL_use_safe_putenv (*Perl_Guse_safe_putenv_ptr(NULL))
+#undef PL_watch_pvx
+#define PL_watch_pvx (*Perl_Gwatch_pvx_ptr(NULL))
#endif /* !PERL_CORE */
#endif /* MULTIPLICITY */
diff --git a/perlio.c b/perlio.c
index 04677b87ad..9085480494 100644
--- a/perlio.c
+++ b/perlio.c
@@ -56,6 +56,8 @@
#include "XSUB.h"
+#define PERLIO_MAX_REFCOUNTABLE_FD 2048
+
#ifdef __Lynx__
/* Missing proto on LynxOS */
int mkstemp(char*);
@@ -250,7 +252,7 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
PerlIO *
PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
{
-#ifdef PERL_MICRO
+#if defined(PERL_MICRO) || defined(SYMBIAN)
return NULL;
#else
#ifdef PERL_IMPLICIT_SYS
@@ -450,18 +452,17 @@ void PerlIO_debug(const char *fmt, ...)
void
PerlIO_debug(const char *fmt, ...)
{
- static int dbg = 0;
va_list ap;
dSYS;
va_start(ap, fmt);
- if (!dbg && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
+ if (!PL_perlio_debug_fd && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
char *s = PerlEnv_getenv("PERLIO_DEBUG");
if (s && *s)
- dbg = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
+ PL_perlio_debug_fd = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
else
- dbg = -1;
+ PL_perlio_debug_fd = -1;
}
- if (dbg > 0) {
+ if (PL_perlio_debug_fd > 0) {
dTHX;
const char *s;
#ifdef USE_ITHREADS
@@ -474,7 +475,7 @@ PerlIO_debug(const char *fmt, ...)
sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
len = strlen(buffer);
vsprintf(buffer+len, fmt, ap);
- PerlLIO_write(dbg, buffer, strlen(buffer));
+ PerlLIO_write(PL_perlio_debug_fd, buffer, strlen(buffer));
#else
SV *sv = newSVpvn("", 0);
STRLEN len;
@@ -486,7 +487,7 @@ PerlIO_debug(const char *fmt, ...)
Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
s = SvPV(sv, len);
- PerlLIO_write(dbg, s, len);
+ PerlLIO_write(PL_perlio_debug_fd, s, len);
SvREFCNT_dec(sv);
#endif
}
@@ -740,6 +741,7 @@ PerlIO_get_layers(pTHX_ PerlIO *f)
PerlIO_funcs *
PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
{
+ dVAR;
IV i;
if ((SSize_t) len <= 0)
len = strlen(name);
@@ -1001,7 +1003,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
void
PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
{
- PerlIO_funcs *tab = &PerlIO_perlio;
+ PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio;
#ifdef PERLIO_USING_CRLF
tab = &PerlIO_crlf;
#else
@@ -1043,7 +1045,7 @@ PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
return -1;
}
-PerlIO_funcs PerlIO_remove = {
+PERLIO_FUNCS_DECL(PerlIO_remove) = {
sizeof(PerlIO_funcs),
"pop",
0,
@@ -1077,25 +1079,25 @@ PerlIO_default_layers(pTHX)
{
if (!PL_def_layerlist) {
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
- PerlIO_funcs *osLayer = &PerlIO_unix;
+ PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
PL_def_layerlist = PerlIO_list_alloc(aTHX);
- PerlIO_define_layer(aTHX_ & PerlIO_unix);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix));
#if defined(WIN32)
- PerlIO_define_layer(aTHX_ & PerlIO_win32);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_win32));
#if 0
osLayer = &PerlIO_win32;
#endif
#endif
- PerlIO_define_layer(aTHX_ & PerlIO_raw);
- PerlIO_define_layer(aTHX_ & PerlIO_perlio);
- PerlIO_define_layer(aTHX_ & PerlIO_stdio);
- PerlIO_define_layer(aTHX_ & PerlIO_crlf);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_raw));
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_perlio));
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_stdio));
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_crlf));
#ifdef HAS_MMAP
- PerlIO_define_layer(aTHX_ & PerlIO_mmap);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_mmap));
#endif
- PerlIO_define_layer(aTHX_ & PerlIO_utf8);
- PerlIO_define_layer(aTHX_ & PerlIO_remove);
- PerlIO_define_layer(aTHX_ & PerlIO_byte);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_utf8));
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_remove));
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_byte));
PerlIO_list_push(aTHX_ PL_def_layerlist,
PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
&PL_sv_undef);
@@ -1129,7 +1131,7 @@ PerlIO_default_layer(pTHX_ I32 n)
PerlIO_list_t *av = PerlIO_default_layers(aTHX);
if (n < 0)
n += av->cur;
- return PerlIO_layer_fetch(aTHX_ av, n, &PerlIO_stdio);
+ return PerlIO_layer_fetch(aTHX_ av, n, PERLIO_FUNCS_CAST(&PerlIO_stdio));
}
#define PerlIO_default_top() PerlIO_default_layer(aTHX_ -1)
@@ -1147,7 +1149,7 @@ PerlIO_stdstreams(pTHX)
}
PerlIO *
-PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
+PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
{
if (tab->fsize != sizeof(PerlIO_funcs)) {
mismatch:
@@ -1163,12 +1165,12 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
if (l && f) {
Zero(l, tab->size, char);
l->next = *f;
- l->tab = tab;
+ l->tab = (PerlIO_funcs*) tab;
*f = l;
PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
(mode) ? mode : "(Null)", (void*)arg);
if (*l->tab->Pushed &&
- (*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+ (*l->tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
PerlIO_pop(aTHX_ f);
return NULL;
}
@@ -1179,7 +1181,7 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
(mode) ? mode : "(Null)", (void*)arg);
if (tab->Pushed &&
- (*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+ (*tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
return NULL;
}
}
@@ -1332,7 +1334,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
/* Legacy binmode is now _defined_ as being equivalent to pushing :raw
So code that used to be here is now in PerlIORaw_pushed().
*/
- return PerlIO_push(aTHX_ f, &PerlIO_raw, Nullch, Nullsv) ? TRUE : FALSE;
+ return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), Nullch, Nullsv) ? TRUE : FALSE;
}
}
@@ -1813,7 +1815,7 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
return -1;
}
-PerlIO_funcs PerlIO_utf8 = {
+PERLIO_FUNCS_DECL(PerlIO_utf8) = {
sizeof(PerlIO_funcs),
"utf8",
0,
@@ -1842,7 +1844,7 @@ PerlIO_funcs PerlIO_utf8 = {
NULL, /* set_ptrcnt */
};
-PerlIO_funcs PerlIO_byte = {
+PERLIO_FUNCS_DECL(PerlIO_byte) = {
sizeof(PerlIO_funcs),
"bytes",
0,
@@ -1884,7 +1886,7 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
return NULL;
}
-PerlIO_funcs PerlIO_raw = {
+PERLIO_FUNCS_DECL(PerlIO_raw) = {
sizeof(PerlIO_funcs),
"raw",
0,
@@ -2032,7 +2034,7 @@ PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
*/
Off_t old = PerlIO_tell(f);
SSize_t done;
- PerlIO_push(aTHX_ f, &PerlIO_pending, "r", Nullsv);
+ PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", Nullsv);
PerlIOSelf(f, PerlIOBuf)->posn = old;
done = PerlIOBuf_unread(aTHX_ f, vbuf, count);
return done;
@@ -2195,30 +2197,31 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
return f;
}
-#define PERLIO_MAX_REFCOUNTABLE_FD 2048
#ifdef USE_THREADS
perl_mutex PerlIO_mutex;
#endif
-int PerlIO_fd_refcnt[PERLIO_MAX_REFCOUNTABLE_FD];
+
+/* PL_perlio_fd_refcnt[] is in intrpvar.h */
void
PerlIO_init(pTHX)
{
/* Place holder for stdstreams call ??? */
#ifdef USE_THREADS
- MUTEX_INIT(&PerlIO_mutex);
+ MUTEX_INIT(&PerlIO_mutex);
#endif
}
void
PerlIOUnix_refcnt_inc(int fd)
{
+ dTHX;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
- PerlIO_fd_refcnt[fd]++;
- PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
+ PL_perlio_fd_refcnt[fd]++;
+ PerlIO_debug("fd %d refcnt=%d\n",fd,PL_perlio_fd_refcnt[fd]);
#ifdef USE_THREADS
MUTEX_UNLOCK(&PerlIO_mutex);
#endif
@@ -2228,12 +2231,13 @@ PerlIOUnix_refcnt_inc(int fd)
int
PerlIOUnix_refcnt_dec(int fd)
{
+ dTHX;
int cnt = 0;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
- cnt = --PerlIO_fd_refcnt[fd];
+ cnt = --PL_perlio_fd_refcnt[fd];
PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
#ifdef USE_THREADS
MUTEX_UNLOCK(&PerlIO_mutex);
@@ -2263,7 +2267,7 @@ PerlIO_cleanup(pTHX)
PerlIO_list_free(aTHX_ PL_known_layers);
PL_known_layers = NULL;
}
- if(PL_def_layerlist) {
+ if (PL_def_layerlist) {
PerlIO_list_free(aTHX_ PL_def_layerlist);
PL_def_layerlist = NULL;
}
@@ -2479,6 +2483,10 @@ SSize_t
PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+#ifdef PERLIO_STD_SPECIAL
+ if (fd == 0)
+ return PERLIO_STD_IN(fd, vbuf, count);
+#endif
if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) ||
PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
return 0;
@@ -2505,6 +2513,10 @@ SSize_t
PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+#ifdef PERLIO_STD_SPECIAL
+ if (fd == 1 || fd == 2)
+ return PERLIO_STD_OUT(fd, vbuf, count);
+#endif
while (1) {
SSize_t len = PerlLIO_write(fd, vbuf, count);
if (len >= 0 || errno != EINTR) {
@@ -2554,7 +2566,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
return code;
}
-PerlIO_funcs PerlIO_unix = {
+PERLIO_FUNCS_DECL(PerlIO_unix) = {
sizeof(PerlIO_funcs),
"unix",
sizeof(PerlIOUnix),
@@ -2689,7 +2701,7 @@ PerlIO_importFILE(FILE *stdio, const char *mode)
}
fclose(f2);
}
- if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), &PerlIO_stdio, mode, Nullsv))) {
+ if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, Nullsv))) {
s = PerlIOSelf(f, PerlIOStdio);
s->stdio = stdio;
}
@@ -3303,7 +3315,7 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
-PerlIO_funcs PerlIO_stdio = {
+PERLIO_FUNCS_DECL(PerlIO_stdio) = {
sizeof(PerlIO_funcs),
"stdio",
sizeof(PerlIOStdio),
@@ -3368,7 +3380,7 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
PerlIO *f2;
/* De-link any lower layers so new :stdio sticks */
*f = NULL;
- if ((f2 = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+ if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, Nullsv))) {
PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
s->stdio = stdio;
/* Link previous lower layers under new one */
@@ -3403,6 +3415,7 @@ PerlIO_findFILE(PerlIO *f)
void
PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
+ dVAR;
PerlIOl *l;
while ((l = *p)) {
if (l->tab == &PerlIO_stdio) {
@@ -3890,7 +3903,7 @@ PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
-PerlIO_funcs PerlIO_perlio = {
+PERLIO_FUNCS_DECL(PerlIO_perlio) = {
sizeof(PerlIO_funcs),
"perlio",
sizeof(PerlIOBuf),
@@ -4013,7 +4026,7 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
return got;
}
-PerlIO_funcs PerlIO_pending = {
+PERLIO_FUNCS_DECL(PerlIO_pending) = {
sizeof(PerlIO_funcs),
"pending",
sizeof(PerlIOBuf),
@@ -4344,7 +4357,7 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f)
return 0;
}
-PerlIO_funcs PerlIO_crlf = {
+PERLIO_FUNCS_DECL(PerlIO_crlf) = {
sizeof(PerlIO_funcs),
"crlf",
sizeof(PerlIOCrlf),
@@ -4389,11 +4402,10 @@ typedef struct {
STDCHAR *bbuf; /* malloced buffer if map fails */
} PerlIOMmap;
-static size_t page_size = 0;
-
IV
PerlIOMmap_map(pTHX_ PerlIO *f)
{
+ dVAR;
PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
IV flags = PerlIOBase(f)->flags;
IV code = 0;
@@ -4408,43 +4420,9 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
SSize_t len = st.st_size - b->posn;
if (len > 0) {
Off_t posn;
- if (!page_size) {
-#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
- {
- SETERRNO(0, SS_NORMAL);
-# ifdef _SC_PAGESIZE
- page_size = sysconf(_SC_PAGESIZE);
-# else
- page_size = sysconf(_SC_PAGE_SIZE);
-# endif
- if ((long) page_size < 0) {
- if (errno) {
- SV *error = ERRSV;
- char *msg;
- STRLEN n_a;
- (void) SvUPGRADE(error, SVt_PV);
- msg = SvPVx(error, n_a);
- Perl_croak(aTHX_ "panic: sysconf: %s",
- msg);
- }
- else
- Perl_croak(aTHX_
- "panic: sysconf: pagesize unknown");
- }
- }
-#else
-# ifdef HAS_GETPAGESIZE
- page_size = getpagesize();
-# else
-# if defined(I_SYS_PARAM) && defined(PAGESIZE)
- page_size = PAGESIZE; /* compiletime, bad */
-# endif
-# endif
-#endif
- if ((IV) page_size <= 0)
- Perl_croak(aTHX_ "panic: bad pagesize %" IVdf,
- (IV) page_size);
- }
+ if (PL_mmap_page_size <= 0)
+ Perl_croak(aTHX_ "panic: bad pagesize %" IVdf,
+ PL_mmap_page_size);
if (b->posn < 0) {
/*
* This is a hack - should never happen - open should
@@ -4452,7 +4430,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
*/
b->posn = PerlIO_tell(PerlIONext(f));
}
- posn = (b->posn / page_size) * page_size;
+ posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size;
len = st.st_size - posn;
m->mptr = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
if (m->mptr && m->mptr != (Mmap_t) - 1) {
@@ -4661,7 +4639,7 @@ PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
}
-PerlIO_funcs PerlIO_mmap = {
+PERLIO_FUNCS_DECL(PerlIO_mmap) = {
sizeof(PerlIO_funcs),
"mmap",
sizeof(PerlIOMmap),
@@ -4887,19 +4865,17 @@ PerlIO_tmpfile(void)
{
dTHX;
PerlIO *f = NULL;
- int fd = -1;
#ifdef WIN32
- fd = win32_tmpfd();
+ int fd = win32_tmpfd();
if (fd >= 0)
f = PerlIO_fdopen(fd, "w+b");
#else /* WIN32 */
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
-
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
- fd = mkstemp(SvPVX(sv));
+ int fd = mkstemp(SvPVX(sv));
if (fd >= 0) {
f = PerlIO_fdopen(fd, "w+");
if (f)
@@ -4912,7 +4888,8 @@ PerlIO_tmpfile(void)
if (stdio) {
if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
- &PerlIO_stdio, "w+", Nullsv))) {
+ PERLIO_FUNCS_CAST(&PerlIO_stdio),
+ "w+", Nullsv))) {
PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
if (s)
@@ -5025,6 +5002,7 @@ vfprintf(FILE *fd, char *pat, char *args)
int
PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
+ dVAR;
int val = vsprintf(s, fmt, ap);
if (n >= 0) {
if (strlen(s) >= (STRLEN) n) {
diff --git a/perlio.h b/perlio.h
index adea6b74fe..ba9b067684 100644
--- a/perlio.h
+++ b/perlio.h
@@ -102,14 +102,28 @@ typedef PerlIOl *PerlIO;
#define PerlIO PerlIO
#define PERLIO_LAYERS 1
-extern void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab);
-extern PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, STRLEN len,
- int load);
-extern PerlIO *PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab,
- const char *mode, SV *arg);
-extern void PerlIO_pop(pTHX_ PerlIO *f);
-extern AV* PerlIO_get_layers(pTHX_ PerlIO *f);
-extern void PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param);
+/* Making the big PerlIO_funcs vtables const is good (enables placing
+ * them in the const section which is good for speed, security, and
+ * embeddability) but this cannot be done by default because of
+ * backward compatibility. */
+#ifdef PERLIO_FUNCS_CONST
+#define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
+#define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
+#else
+#define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
+#define PERLIO_FUNCS_CAST(funcs) (funcs)
+#endif
+
+PERL_EXPORT_C void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab);
+PERL_EXPORT_C PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name,
+ STRLEN len,
+ int load);
+PERL_EXPORT_C PerlIO *PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab),
+ const char *mode, SV *arg);
+PERL_EXPORT_C void PerlIO_pop(pTHX_ PerlIO *f);
+PERL_EXPORT_C AV* PerlIO_get_layers(pTHX_ PerlIO *f);
+PERL_EXPORT_C void PerlIO_clone(pTHX_ PerlInterpreter *proto,
+ CLONE_PARAMS *param);
#endif /* PerlIO */
@@ -211,165 +225,165 @@ START_EXTERN_C
#endif
#endif
#ifndef PerlIO_init
-extern void PerlIO_init(pTHX);
+PERL_EXPORT_C void PerlIO_init(pTHX);
#endif
#ifndef PerlIO_stdoutf
-extern int PerlIO_stdoutf(const char *, ...)
+PERL_EXPORT_C int PerlIO_stdoutf(const char *, ...)
__attribute__format__(__printf__, 1, 2);
#endif
#ifndef PerlIO_puts
-extern int PerlIO_puts(PerlIO *, const char *);
+PERL_EXPORT_C int PerlIO_puts(PerlIO *, const char *);
#endif
#ifndef PerlIO_open
-extern PerlIO *PerlIO_open(const char *, const char *);
+PERL_EXPORT_C PerlIO *PerlIO_open(const char *, const char *);
#endif
#ifndef PerlIO_openn
-extern PerlIO *PerlIO_openn(pTHX_ const char *layers, const char *mode,
- int fd, int imode, int perm, PerlIO *old,
- int narg, SV **arg);
+PERL_EXPORT_C PerlIO *PerlIO_openn(pTHX_ const char *layers, const char *mode,
+ int fd, int imode, int perm, PerlIO *old,
+ int narg, SV **arg);
#endif
#ifndef PerlIO_eof
-extern int PerlIO_eof(PerlIO *);
+PERL_EXPORT_C int PerlIO_eof(PerlIO *);
#endif
#ifndef PerlIO_error
-extern int PerlIO_error(PerlIO *);
+PERL_EXPORT_C int PerlIO_error(PerlIO *);
#endif
#ifndef PerlIO_clearerr
-extern void PerlIO_clearerr(PerlIO *);
+PERL_EXPORT_C void PerlIO_clearerr(PerlIO *);
#endif
#ifndef PerlIO_getc
-extern int PerlIO_getc(PerlIO *);
+PERL_EXPORT_C int PerlIO_getc(PerlIO *);
#endif
#ifndef PerlIO_putc
-extern int PerlIO_putc(PerlIO *, int);
+PERL_EXPORT_C int PerlIO_putc(PerlIO *, int);
#endif
#ifndef PerlIO_ungetc
-extern int PerlIO_ungetc(PerlIO *, int);
+PERL_EXPORT_C int PerlIO_ungetc(PerlIO *, int);
#endif
#ifndef PerlIO_fdopen
-extern PerlIO *PerlIO_fdopen(int, const char *);
+PERL_EXPORT_C PerlIO *PerlIO_fdopen(int, const char *);
#endif
#ifndef PerlIO_importFILE
-extern PerlIO *PerlIO_importFILE(FILE *, const char *);
+PERL_EXPORT_C PerlIO *PerlIO_importFILE(FILE *, const char *);
#endif
#ifndef PerlIO_exportFILE
-extern FILE *PerlIO_exportFILE(PerlIO *, const char *);
+PERL_EXPORT_C FILE *PerlIO_exportFILE(PerlIO *, const char *);
#endif
#ifndef PerlIO_findFILE
-extern FILE *PerlIO_findFILE(PerlIO *);
+PERL_EXPORT_C FILE *PerlIO_findFILE(PerlIO *);
#endif
#ifndef PerlIO_releaseFILE
-extern void PerlIO_releaseFILE(PerlIO *, FILE *);
+PERL_EXPORT_C void PerlIO_releaseFILE(PerlIO *, FILE *);
#endif
#ifndef PerlIO_read
-extern SSize_t PerlIO_read(PerlIO *, void *, Size_t);
+PERL_EXPORT_C SSize_t PerlIO_read(PerlIO *, void *, Size_t);
#endif
#ifndef PerlIO_unread
-extern SSize_t PerlIO_unread(PerlIO *, const void *, Size_t);
+PERL_EXPORT_C SSize_t PerlIO_unread(PerlIO *, const void *, Size_t);
#endif
#ifndef PerlIO_write
-extern SSize_t PerlIO_write(PerlIO *, const void *, Size_t);
+PERL_EXPORT_C SSize_t PerlIO_write(PerlIO *, const void *, Size_t);
#endif
#ifndef PerlIO_setlinebuf
-extern void PerlIO_setlinebuf(PerlIO *);
+PERL_EXPORT_C void PerlIO_setlinebuf(PerlIO *);
#endif
#ifndef PerlIO_printf
-extern int PerlIO_printf(PerlIO *, const char *, ...)
+PERL_EXPORT_C int PerlIO_printf(PerlIO *, const char *, ...)
__attribute__format__(__printf__, 2, 3);
#endif
#ifndef PerlIO_sprintf
-extern int PerlIO_sprintf(char *, int, const char *, ...)
+PERL_EXPORT_C int PerlIO_sprintf(char *, int, const char *, ...)
__attribute__format__(__printf__, 3, 4);
#endif
#ifndef PerlIO_vprintf
-extern int PerlIO_vprintf(PerlIO *, const char *, va_list);
+PERL_EXPORT_C int PerlIO_vprintf(PerlIO *, const char *, va_list);
#endif
#ifndef PerlIO_tell
-extern Off_t PerlIO_tell(PerlIO *);
+PERL_EXPORT_C Off_t PerlIO_tell(PerlIO *);
#endif
#ifndef PerlIO_seek
-extern int PerlIO_seek(PerlIO *, Off_t, int);
+PERL_EXPORT_C int PerlIO_seek(PerlIO *, Off_t, int);
#endif
#ifndef PerlIO_rewind
-extern void PerlIO_rewind(PerlIO *);
+PERL_EXPORT_C void PerlIO_rewind(PerlIO *);
#endif
#ifndef PerlIO_has_base
-extern int PerlIO_has_base(PerlIO *);
+PERL_EXPORT_C int PerlIO_has_base(PerlIO *);
#endif
#ifndef PerlIO_has_cntptr
-extern int PerlIO_has_cntptr(PerlIO *);
+PERL_EXPORT_C int PerlIO_has_cntptr(PerlIO *);
#endif
#ifndef PerlIO_fast_gets
-extern int PerlIO_fast_gets(PerlIO *);
+PERL_EXPORT_C int PerlIO_fast_gets(PerlIO *);
#endif
#ifndef PerlIO_canset_cnt
-extern int PerlIO_canset_cnt(PerlIO *);
+PERL_EXPORT_C int PerlIO_canset_cnt(PerlIO *);
#endif
#ifndef PerlIO_get_ptr
-extern STDCHAR *PerlIO_get_ptr(PerlIO *);
+PERL_EXPORT_C STDCHAR *PerlIO_get_ptr(PerlIO *);
#endif
#ifndef PerlIO_get_cnt
-extern int PerlIO_get_cnt(PerlIO *);
+PERL_EXPORT_C int PerlIO_get_cnt(PerlIO *);
#endif
#ifndef PerlIO_set_cnt
-extern void PerlIO_set_cnt(PerlIO *, int);
+PERL_EXPORT_C void PerlIO_set_cnt(PerlIO *, int);
#endif
#ifndef PerlIO_set_ptrcnt
-extern void PerlIO_set_ptrcnt(PerlIO *, STDCHAR *, int);
+PERL_EXPORT_C void PerlIO_set_ptrcnt(PerlIO *, STDCHAR *, int);
#endif
#ifndef PerlIO_get_base
-extern STDCHAR *PerlIO_get_base(PerlIO *);
+PERL_EXPORT_C STDCHAR *PerlIO_get_base(PerlIO *);
#endif
#ifndef PerlIO_get_bufsiz
-extern int PerlIO_get_bufsiz(PerlIO *);
+PERL_EXPORT_C int PerlIO_get_bufsiz(PerlIO *);
#endif
#ifndef PerlIO_tmpfile
-extern PerlIO *PerlIO_tmpfile(void);
+PERL_EXPORT_C PerlIO *PerlIO_tmpfile(void);
#endif
#ifndef PerlIO_stdin
-extern PerlIO *PerlIO_stdin(void);
+PERL_EXPORT_C PerlIO *PerlIO_stdin(void);
#endif
#ifndef PerlIO_stdout
-extern PerlIO *PerlIO_stdout(void);
+PERL_EXPORT_C PerlIO *PerlIO_stdout(void);
#endif
#ifndef PerlIO_stderr
-extern PerlIO *PerlIO_stderr(void);
+PERL_EXPORT_C PerlIO *PerlIO_stderr(void);
#endif
#ifndef PerlIO_getpos
-extern int PerlIO_getpos(PerlIO *, SV *);
+PERL_EXPORT_C int PerlIO_getpos(PerlIO *, SV *);
#endif
#ifndef PerlIO_setpos
-extern int PerlIO_setpos(PerlIO *, SV *);
+PERL_EXPORT_C int PerlIO_setpos(PerlIO *, SV *);
#endif
#ifndef PerlIO_fdupopen
-extern PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *, int);
+PERL_EXPORT_C PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *, int);
#endif
#if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO)
-extern char *PerlIO_modestr(PerlIO *, char *buf);
+PERL_EXPORT_C char *PerlIO_modestr(PerlIO *, char *buf);
#endif
#ifndef PerlIO_isutf8
-extern int PerlIO_isutf8(PerlIO *);
+PERL_EXPORT_C int PerlIO_isutf8(PerlIO *);
#endif
#ifndef PerlIO_apply_layers
-extern int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode,
- const char *names);
+PERL_EXPORT_C int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode,
+ const char *names);
#endif
#ifndef PerlIO_binmode
-extern int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int omode,
- const char *names);
+PERL_EXPORT_C int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int omode,
+ const char *names);
#endif
#ifndef PerlIO_getname
-extern char *PerlIO_getname(PerlIO *, char *);
+PERL_EXPORT_C char *PerlIO_getname(PerlIO *, char *);
#endif
-extern void PerlIO_destruct(pTHX);
+PERL_EXPORT_C void PerlIO_destruct(pTHX);
-extern int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
+PERL_EXPORT_C int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
#ifdef PERLIO_LAYERS
-extern void PerlIO_cleanup(pTHX);
+PERL_EXPORT_C void PerlIO_cleanup(pTHX);
-extern void PerlIO_debug(const char *fmt, ...);
+PERL_EXPORT_C void PerlIO_debug(const char *fmt, ...);
typedef struct PerlIO_list_s PerlIO_list_t;
diff --git a/perliol.h b/perliol.h
index 80e7c7d5da..8697d9bc1e 100644
--- a/perliol.h
+++ b/perliol.h
@@ -96,23 +96,29 @@ struct _PerlIO {
#define PerlIOValid(f) ((f) && *(f))
/*--------------------------------------------------------------------------------------*/
-/* Data exports - EXT rather than extern is needed for Cygwin */
-EXT PerlIO_funcs PerlIO_unix;
-EXT PerlIO_funcs PerlIO_perlio;
-EXT PerlIO_funcs PerlIO_stdio;
-EXT PerlIO_funcs PerlIO_crlf;
-EXT PerlIO_funcs PerlIO_utf8;
-EXT PerlIO_funcs PerlIO_byte;
-EXT PerlIO_funcs PerlIO_raw;
-EXT PerlIO_funcs PerlIO_pending;
+/* Data exports - EXTCONST rather than extern is needed for Cygwin */
+#undef EXTPERLIO
+#ifdef PERLIO_FUNCS_CONST
+#define EXTPERLIO EXTCONST
+#else
+#define EXTPERLIO EXT
+#endif
+EXTPERLIO PerlIO_funcs PerlIO_unix;
+EXTPERLIO PerlIO_funcs PerlIO_perlio;
+EXTPERLIO PerlIO_funcs PerlIO_stdio;
+EXTPERLIO PerlIO_funcs PerlIO_crlf;
+EXTPERLIO PerlIO_funcs PerlIO_utf8;
+EXTPERLIO PerlIO_funcs PerlIO_byte;
+EXTPERLIO PerlIO_funcs PerlIO_raw;
+EXTPERLIO PerlIO_funcs PerlIO_pending;
#ifdef HAS_MMAP
-EXT PerlIO_funcs PerlIO_mmap;
+EXTPERLIO PerlIO_funcs PerlIO_mmap;
#endif
#ifdef WIN32
-EXT PerlIO_funcs PerlIO_win32;
+EXTPERLIO PerlIO_funcs PerlIO_win32;
#endif
-extern PerlIO *PerlIO_allocate(pTHX);
-extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n);
+PERL_EXPORT_C PerlIO *PerlIO_allocate(pTHX);
+PERL_EXPORT_C SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n);
#define PerlIOArg PerlIO_arg_fetch(layers,n)
#ifdef PERLIO_USING_CRLF
@@ -124,23 +130,24 @@ extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n);
/*--------------------------------------------------------------------------------------*/
/* Generic, or stub layer functions */
-extern IV PerlIOBase_fileno(pTHX_ PerlIO *f);
-extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
-extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
-extern IV PerlIOBase_popped(pTHX_ PerlIO *f);
-extern IV PerlIOBase_binmode(pTHX_ PerlIO *f);
-extern SSize_t PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
-extern SSize_t PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf,
- Size_t count);
-extern IV PerlIOBase_eof(pTHX_ PerlIO *f);
-extern IV PerlIOBase_error(pTHX_ PerlIO *f);
-extern void PerlIOBase_clearerr(pTHX_ PerlIO *f);
-extern IV PerlIOBase_close(pTHX_ PerlIO *f);
-extern void PerlIOBase_setlinebuf(pTHX_ PerlIO *f);
-extern void PerlIOBase_flush_linebuf(pTHX);
-
-extern IV PerlIOBase_noop_ok(pTHX_ PerlIO *f);
-extern IV PerlIOBase_noop_fail(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBase_fileno(pTHX_ PerlIO *f);
+PERL_EXPORT_C PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
+PERL_EXPORT_C IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+PERL_EXPORT_C IV PerlIOBase_popped(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBase_binmode(pTHX_ PerlIO *f);
+PERL_EXPORT_C SSize_t PerlIOBase_read(pTHX_ PerlIO *f,
+ void *vbuf, Size_t count);
+PERL_EXPORT_C SSize_t PerlIOBase_unread(pTHX_ PerlIO *f,
+ const void *vbuf, Size_t count);
+PERL_EXPORT_C IV PerlIOBase_eof(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBase_error(pTHX_ PerlIO *f);
+PERL_EXPORT_C void PerlIOBase_clearerr(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBase_close(pTHX_ PerlIO *f);
+PERL_EXPORT_C void PerlIOBase_setlinebuf(pTHX_ PerlIO *f);
+PERL_EXPORT_C void PerlIOBase_flush_linebuf(pTHX);
+
+PERL_EXPORT_C IV PerlIOBase_noop_ok(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBase_noop_fail(pTHX_ PerlIO *f);
/*--------------------------------------------------------------------------------------*/
/* perlio buffer layer
@@ -158,36 +165,36 @@ typedef struct {
IV oneword; /* Emergency buffer */
} PerlIOBuf;
-extern int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode,
+PERL_EXPORT_C int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode,
PerlIO_list_t *layers, IV n, IV max);
-extern int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names);
-extern void PerlIO_list_free(pTHX_ PerlIO_list_t *list);
-extern PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def);
+PERL_EXPORT_C int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names);
+PERL_EXPORT_C void PerlIO_list_free(pTHX_ PerlIO_list_t *list);
+PERL_EXPORT_C PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def);
-extern SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
-extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self,
+PERL_EXPORT_C SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
+PERL_EXPORT_C PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self,
PerlIO_list_t *layers, IV n,
const char *mode, int fd, int imode,
int perm, PerlIO *old, int narg, SV **args);
-extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
-extern IV PerlIOBuf_popped(pTHX_ PerlIO *f);
-extern PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
-extern SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
-extern SSize_t PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
-extern SSize_t PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
-extern IV PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
-extern Off_t PerlIOBuf_tell(pTHX_ PerlIO *f);
-extern IV PerlIOBuf_close(pTHX_ PerlIO *f);
-extern IV PerlIOBuf_flush(pTHX_ PerlIO *f);
-extern IV PerlIOBuf_fill(pTHX_ PerlIO *f);
-extern STDCHAR *PerlIOBuf_get_base(pTHX_ PerlIO *f);
-extern Size_t PerlIOBuf_bufsiz(pTHX_ PerlIO *f);
-extern STDCHAR *PerlIOBuf_get_ptr(pTHX_ PerlIO *f);
-extern SSize_t PerlIOBuf_get_cnt(pTHX_ PerlIO *f);
-extern void PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
-
-extern int PerlIOUnix_oflags(const char *mode);
+PERL_EXPORT_C IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+PERL_EXPORT_C IV PerlIOBuf_popped(pTHX_ PerlIO *f);
+PERL_EXPORT_C PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
+PERL_EXPORT_C SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
+PERL_EXPORT_C SSize_t PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
+PERL_EXPORT_C SSize_t PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
+PERL_EXPORT_C IV PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
+PERL_EXPORT_C Off_t PerlIOBuf_tell(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBuf_close(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBuf_flush(pTHX_ PerlIO *f);
+PERL_EXPORT_C IV PerlIOBuf_fill(pTHX_ PerlIO *f);
+PERL_EXPORT_C STDCHAR *PerlIOBuf_get_base(pTHX_ PerlIO *f);
+PERL_EXPORT_C Size_t PerlIOBuf_bufsiz(pTHX_ PerlIO *f);
+PERL_EXPORT_C STDCHAR *PerlIOBuf_get_ptr(pTHX_ PerlIO *f);
+PERL_EXPORT_C SSize_t PerlIOBuf_get_cnt(pTHX_ PerlIO *f);
+PERL_EXPORT_C void PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt);
+
+PERL_EXPORT_C int PerlIOUnix_oflags(const char *mode);
/*--------------------------------------------------------------------------------------*/
diff --git a/perlvars.h b/perlvars.h
index 00b0e1ff38..2ddd0acf64 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -31,11 +31,12 @@ PERLVAR(Gcurinterp, PerlInterpreter *)
PERLVAR(Gthr_key, perl_key) /* key to retrieve per-thread struct */
#endif
-/* constants (these are not literals to facilitate pointer comparisons) */
-PERLVARIC(GYes, char *, "1")
-PERLVARIC(GNo, char *, "")
-PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEF")
-PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
+/* constants (these are not literals to facilitate pointer comparisons)
+ * (PERLVARISC really does create variables, despite its looks) */
+PERLVARISC(GYes, "1")
+PERLVARISC(GNo, "")
+PERLVARISC(Ghexdigit, "0123456789abcdef0123456789ABCDEF")
+PERLVARISC(Gpatleave, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
/* XXX does anyone even use this? */
PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */
@@ -72,3 +73,55 @@ PERLVARI(Gcsighandlerp, Sighandler_t, &Perl_csighandler) /* Pointer to C-level s
#ifndef PERL_USE_SAFE_PUTENV
PERLVARI(Guse_safe_putenv, int, 1)
#endif
+
+#ifdef USE_PERLIO
+PERLVARA(Gperlio_fd_refcnt, 2048, int) /* PERLIO_MAX_REFCOUNTABLE_FD */
+PERLVARI(Gperlio_debug_fd, int, 0) /* the fd to write perlio debug into, 0 means not set yet */
+#endif
+
+#ifdef HAS_MMAP
+PERLVARI(Gmmap_page_size, IV, 0)
+#endif
+
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+PERLVARI(Gsig_handlers_initted, int, 0)
+#endif
+#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
+PERLVARA(Gsig_ignoring, SIG_SIZE, int) /* which signals we are ignoring */
+#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+PERLVAR(Gsig_defaulting, SIG_SIZE, int)
+#endif
+
+#ifndef PERL_IMPLICIT_CONTEXT
+PERLVAR(Gsig_sv, SV*)
+#endif
+
+/* XXX signals are process-wide anyway, so we
+ * ignore the implications of this for threading */
+#ifndef HAS_SIGACTION
+PERLVARI(Gsig_trapped, int, 0)
+#endif
+
+#ifdef DEBUGGING
+PERLVAR(Gwatch_pvx, char*)
+#endif
+
+#ifdef PERL_GLOBAL_STRUCT
+PERLVAR(Gppaddr, Perl_ppaddr_t*) /* or opcode.h */
+PERLVAR(Gcheck, Perl_check_t *) /* or opcode.h */
+PERLVARA(Gfold_locale, 256, unsigned char) /* or perl.h */
+#endif
+
+#ifdef PERL_NEED_APPCTX
+PERLVAR(Gappctx, void*) /* the application context */
+#endif
+
+PERLVAR(Gop_sequence, HV*) /* dump.c */
+PERLVARI(Gop_seq, UV, 0) /* dump.c */
+
+#if defined(HAS_TIMES) && defined(PERL_NEED_TIMESBASE)
+PERLVAR(Gtimesbase, struct tms)
+#endif
+
+
diff --git a/pod.lst b/pod.lst
index 46c7a83a59..52a4cf5f32 100644
--- a/pod.lst
+++ b/pod.lst
@@ -178,6 +178,7 @@ r perlos400 Perl notes for OS/400
r perlplan9 Perl notes for Plan 9
r perlqnx Perl notes for QNX
r perlsolaris Perl notes for Solaris
+r perlsymbian Perl notes for Symbian
r perltru64 Perl notes for Tru64
r perluts Perl notes for UTS
r perlvmesa Perl notes for VM/ESA
diff --git a/pod/perl.pod b/pod/perl.pod
index d1365a2865..ba24f7c59e 100644
--- a/pod/perl.pod
+++ b/pod/perl.pod
@@ -189,6 +189,7 @@ For ease of access, the Perl manual has been split up into several sections.
perlplan9 Perl notes for Plan 9
perlqnx Perl notes for QNX
perlsolaris Perl notes for Solaris
+ perlsymbian Perl notes for Symbian
perltru64 Perl notes for Tru64
perluts Perl notes for UTS
perlvmesa Perl notes for VM/ESA
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index d95d3e4c03..df90f9e137 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1871,6 +1871,26 @@ PERL_IMPLICIT_CONTEXT is also normally defined, and enables the
support for passing in a "hidden" first argument that represents all three
data structures.
+Two other "encapsulation" macros are the PERL_GLOBAL_STRUCT and
+PERL_GLOBAL_STRUCT_PRIVATE (the latter turns on the former, and the
+former turns on MULTIPLICITY.) The PERL_GLOBAL_STRUCT causes all the
+internal variables of Perl to be wrapped inside a single global struct,
+struct perl_vars, accessible as (globals) &PL_Vars or PL_VarsPtr or
+the function Perl_GetVars(). The PERL_GLOBAL_STRUCT_PRIVATE goes
+one step further, there is still a single struct (allocated in main()
+either from heap or from stack) but there are no global data symbols
+pointing to it. In either case the global struct should be initialised
+as the very first thing in main() using Perl_init_global_struct() and
+correspondingly tear it down after perl_free() using Perl_free_global_struct(),
+please see F<miniperlmain.c> for usage details. You may also need
+to use C<dVAR> in your coding to "declare the global variables"
+when you are using them. dTHX does this for you automatically.
+
+For backward compatibility reasons defining just PERL_GLOBAL_STRUCT
+doesn't actually hide all symbols inside a big global struct: some
+PerlIO_xxx vtables are left visible. The PERL_GLOBAL_STRUCT_PRIVATE
+then hides everything (see how the PERLIO_FUNCS_DECL is used).
+
All this obviously requires a way for the Perl internal functions to be
either subroutines taking some kind of structure as the first
argument, or subroutines taking nothing as the first argument. To
@@ -2072,6 +2092,13 @@ Never add a comma after C<pTHX> yourself--always use the form of the
macro with the underscore for functions that take explicit arguments,
or the form without the argument for functions with no explicit arguments.
+If one is compiling Perl with the C<-DPERL_GLOBAL_STRUCT> the C<dVAR>
+definition is needed if the Perl global variables (see F<perlvars.h>
+or F<globvar.sym>) are accessed in the function and C<dTHX> is not
+used (the C<dTHX> includes the C<dVAR> if necessary). One notices
+the need for C<dVAR> only with the said compile-time define, because
+otherwise the Perl global variables are visible as-is.
+
=head2 Should I do anything special if I call perl from multiple threads?
If you create interpreters in one thread and then proceed to call them in
diff --git a/pod/perlintern.pod b/pod/perlintern.pod
index 6ff01563a9..006c66c219 100644
--- a/pod/perlintern.pod
+++ b/pod/perlintern.pod
@@ -135,6 +135,16 @@ compiling pad (lvalue). Note that C<SvCUR> is hijacked for this purpose.
=for hackers
Found in file pad.h
+=item PAD_COMPNAME_GEN_set
+
+Sets the generation number of the name at offset C<po> in the current
+ling pad (lvalue) to C<gen>. Note that C<SvCUR_set> is hijacked for this purpose.
+
+ STRLEN PAD_COMPNAME_GEN_set(PADOFFSET po, int gen)
+
+=for hackers
+Found in file pad.h
+
=item PAD_COMPNAME_OURSTASH
Return the stash associated with an C<our> variable.
diff --git a/pp.c b/pp.c
index 3b52e7145c..e3773b229e 100644
--- a/pp.c
+++ b/pp.c
@@ -2524,7 +2524,7 @@ STATIC
PP(pp_i_modulo_0)
{
/* This is the vanilla old i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
@@ -2541,7 +2541,7 @@ PP(pp_i_modulo_1)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
@@ -2554,7 +2554,7 @@ PP(pp_i_modulo_1)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
@@ -3396,8 +3396,8 @@ PP(pp_chr)
PP(pp_crypt)
{
- dSP; dTARGET;
#ifdef HAS_CRYPT
+ dSP; dTARGET;
dPOPTOPssrl;
STRLEN n_a;
STRLEN len;
@@ -4145,7 +4145,7 @@ PP(pp_anonhash)
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
@@ -4352,7 +4352,7 @@ PP(pp_splice)
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
@@ -4407,7 +4407,7 @@ PP(pp_shift)
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
@@ -4509,7 +4509,7 @@ PP(pp_reverse)
PP(pp_split)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
diff --git a/pp_ctl.c b/pp_ctl.c
index 79c38f0805..2db8d7e051 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -890,7 +890,7 @@ PP(pp_formline)
PP(pp_grepstart)
{
- dSP;
+ dVAR; dSP;
SV *src;
if (PL_stack_base + *PL_markstack_ptr == SP) {
@@ -932,7 +932,7 @@ PP(pp_mapstart)
PP(pp_mapwhile)
{
- dSP;
+ dVAR; dSP;
I32 gimme = GIMME_V;
I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
I32 count;
@@ -1184,7 +1184,7 @@ PP(pp_flop)
/* Control. */
-static const char *context_name[] = {
+static const char * const context_name[] = {
"pseudo-block",
"subroutine",
"eval",
@@ -1385,6 +1385,7 @@ Perl_qerror(pTHX_ SV *err)
OP *
Perl_die_where(pTHX_ const char *message, STRLEN msglen)
{
+ dVAR;
STRLEN n_a;
if (PL_in_eval) {
@@ -1728,6 +1729,7 @@ PP(pp_lineseq)
PP(pp_dbstate)
{
+ dVAR;
PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
@@ -1779,7 +1781,7 @@ PP(pp_scope)
PP(pp_enteriter)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
@@ -1866,7 +1868,7 @@ PP(pp_enteriter)
PP(pp_enterloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
@@ -1882,7 +1884,7 @@ PP(pp_enterloop)
PP(pp_leaveloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
@@ -1922,7 +1924,7 @@ PP(pp_leaveloop)
PP(pp_return)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
@@ -2037,7 +2039,7 @@ PP(pp_return)
PP(pp_last)
{
- dSP;
+ dVAR; dSP;
I32 cxix;
register PERL_CONTEXT *cx;
I32 pop2 = 0;
@@ -2125,6 +2127,7 @@ PP(pp_last)
PP(pp_next)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 inner;
@@ -2153,6 +2156,7 @@ PP(pp_next)
PP(pp_redo)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 oldsave;
@@ -2232,7 +2236,7 @@ PP(pp_dump)
PP(pp_goto)
{
- dSP;
+ dVAR; dSP;
OP *retop = 0;
I32 ix;
register PERL_CONTEXT *cx;
@@ -2732,7 +2736,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
/* startop op_free() this to undo. */
/* code Short string id of the caller. */
{
- dSP; /* Make POPBLOCK work. */
+ dVAR; dSP; /* Make POPBLOCK work. */
PERL_CONTEXT *cx;
SV **newsp;
I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */
@@ -2864,7 +2868,7 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
STATIC OP *
S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
- dSP;
+ dVAR; dSP;
OP *saveop = PL_op;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
@@ -3036,7 +3040,7 @@ S_doopen_pm(pTHX_ const char *name, const char *mode)
PP(pp_require)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
SV *sv;
char *name;
@@ -3239,15 +3243,29 @@ PP(pp_require)
MacPerl_CanonDir(name, buf2, 1);
Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
#else
-#ifdef VMS
+# ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
continue;
sv_setpv(namesv, unixdir);
sv_catpv(namesv, unixname);
-#else
+# else
+# ifdef SYMBIAN
+ if (PL_origfilename[0] &&
+ PL_origfilename[1] == ':' &&
+ !(dir[0] && dir[1] == ':'))
+ Perl_sv_setpvf(aTHX_ namesv,
+ "%c:%s\\%s",
+ PL_origfilename[0],
+ dir, name);
+ else
+ Perl_sv_setpvf(aTHX_ namesv,
+ "%s\\%s",
+ dir, name);
+# else
Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
-#endif
+# endif
+# endif
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
@@ -3364,7 +3382,7 @@ PP(pp_dofile)
PP(pp_entereval)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = PL_sub_generation;
@@ -3448,7 +3466,7 @@ PP(pp_entereval)
PP(pp_leaveeval)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
@@ -3516,7 +3534,7 @@ PP(pp_leaveeval)
PP(pp_entertry)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
@@ -3535,7 +3553,7 @@ PP(pp_entertry)
PP(pp_leavetry)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
@@ -3829,6 +3847,7 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize)
static I32
run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
SV *datasv = FILTER_DATA(idx);
int filter_has_file = IoLINES(datasv);
GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
diff --git a/pp_hot.c b/pp_hot.c
index ba724ffbd5..767188be9a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -571,7 +571,7 @@ PP(pp_pushre)
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
@@ -943,7 +943,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
PP(pp_aassign)
{
- dSP;
+ dVAR; dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
@@ -1444,7 +1444,7 @@ ret_no:
OP *
Perl_do_readline(pTHX)
{
- dSP; dTARGETSTACKED;
+ dVAR; dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
@@ -1642,7 +1642,7 @@ Perl_do_readline(pTHX)
PP(pp_enter)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = OP_GIMME(PL_op, -1);
@@ -1752,7 +1752,7 @@ PP(pp_helem)
PP(pp_leave)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
register SV **mark;
SV **newsp;
@@ -2287,7 +2287,7 @@ ret_no:
PP(pp_grepwhile)
{
- dSP;
+ dVAR; dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
@@ -2338,7 +2338,7 @@ PP(pp_grepwhile)
PP(pp_leavesub)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
@@ -2398,7 +2398,7 @@ PP(pp_leavesub)
* get any slower by more conditions */
PP(pp_leavesublv)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
@@ -2593,7 +2593,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
PP(pp_entersub)
{
- dSP; dPOPss;
+ dVAR; dSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
diff --git a/pp_pack.c b/pp_pack.c
index 5ee841b925..9a7cc53ab1 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1177,7 +1177,7 @@ STATIC
I32
S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char **new_s )
{
- dSP;
+ dVAR; dSP;
SV *sv;
I32 start_sp_offset = SP - PL_stack_base;
howlen_t howlen;
diff --git a/pp_sort.c b/pp_sort.c
index 380194df2c..649375a900 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1490,7 +1490,7 @@ S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register SV **p1 = ORIGMARK+1, **p2;
register I32 max, i;
AV* av = Nullav;
@@ -1714,6 +1714,7 @@ PP(pp_sort)
static I32
sortcv(pTHX_ SV *a, SV *b)
{
+ dVAR;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
@@ -1737,6 +1738,7 @@ sortcv(pTHX_ SV *a, SV *b)
static I32
sortcv_stacked(pTHX_ SV *a, SV *b)
{
+ dVAR;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
@@ -1778,7 +1780,7 @@ sortcv_stacked(pTHX_ SV *a, SV *b)
static I32
sortcv_xsub(pTHX_ SV *a, SV *b)
{
- dSP;
+ dVAR; dSP;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
diff --git a/pp_sys.c b/pp_sys.c
index 300ea6d94c..d908a1ccfd 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -118,7 +118,12 @@ extern int h_errno;
# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */
# undef my_chsize
# endif
-# define my_chsize PerlLIO_chsize
+#else
+# ifdef HAS_TRUNCATE
+# define my_chsize PerlLIO_chsize
+# else
+I32 my_chsize(int fd, Off_t length);
+# endif
#endif
#ifdef HAS_FLOCK
@@ -167,7 +172,7 @@ extern int h_errno;
#endif /* no flock() */
#define ZBTLEN 10
-static char zero_but_true[ZBTLEN + 1] = "0 but true";
+static const char zero_but_true[ZBTLEN + 1] = "0 but true";
#if defined(I_SYS_ACCESS) && !defined(R_OK)
# include <sys/access.h>
@@ -380,6 +385,7 @@ PP(pp_backtick)
PP(pp_glob)
{
+ dVAR;
OP *result;
tryAMAGICunTARGET(iter, -1);
@@ -517,7 +523,7 @@ PP(pp_die)
PP(pp_open)
{
- dSP;
+ dVAR; dSP;
dMARK; dORIGMARK;
dTARGET;
GV *gv;
@@ -568,7 +574,7 @@ PP(pp_open)
PP(pp_close)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
@@ -653,7 +659,7 @@ badexit:
PP(pp_fileno)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
@@ -691,8 +697,9 @@ PP(pp_fileno)
PP(pp_umask)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_UMASK
+ dTARGET;
Mode_t anum;
if (MAXARG < 1) {
@@ -716,7 +723,7 @@ PP(pp_umask)
PP(pp_binmode)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
PerlIO *fp;
@@ -776,8 +783,7 @@ PP(pp_binmode)
PP(pp_tie)
{
- dSP;
- dMARK;
+ dVAR; dSP; dMARK;
SV *varsv;
HV* stash;
GV *gv;
@@ -866,7 +872,7 @@ PP(pp_tie)
PP(pp_untie)
{
- dSP;
+ dVAR; dSP;
MAGIC *mg;
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
@@ -926,7 +932,7 @@ PP(pp_tied)
PP(pp_dbmopen)
{
- dSP;
+ dVAR; dSP;
HV *hv;
dPOPPOPssrl;
HV* stash;
@@ -1190,7 +1196,7 @@ PP(pp_select)
PP(pp_getc)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io = NULL;
MAGIC *mg;
@@ -1247,6 +1253,7 @@ PP(pp_read)
STATIC OP *
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
+ dVAR;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
@@ -1308,7 +1315,7 @@ PP(pp_enterwrite)
PP(pp_leavewrite)
{
- dSP;
+ dVAR; dSP;
GV *gv = cxstack[cxstack_ix].blk_sub.gv;
register IO *io = GvIOp(gv);
PerlIO *ofp = IoOFP(io);
@@ -1436,7 +1443,7 @@ PP(pp_leavewrite)
PP(pp_prtf)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
PerlIO *fp;
@@ -1540,7 +1547,7 @@ PP(pp_sysopen)
PP(pp_sysread)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
int offset;
GV *gv;
IO *io;
@@ -1679,7 +1686,7 @@ PP(pp_sysread)
(should be 2 * length + offset + 1, or possibly something longer if
PL_encoding is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
- if (offset > bufsize) { /* Zero any newly allocated space */
+ if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */
Zero(buffer+bufsize, offset-bufsize, char);
}
buffer = buffer + offset;
@@ -1794,7 +1801,7 @@ PP(pp_sysread)
PP(pp_syswrite)
{
- dSP;
+ dVAR; dSP;
int items = (SP - PL_stack_base) - TOPMARK;
if (items == 2) {
SV *sv;
@@ -1808,7 +1815,7 @@ PP(pp_syswrite)
PP(pp_send)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
SV *bufsv;
@@ -1950,7 +1957,7 @@ PP(pp_recv)
PP(pp_eof)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
@@ -1997,7 +2004,7 @@ PP(pp_eof)
PP(pp_tell)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
MAGIC *mg;
@@ -2035,7 +2042,7 @@ PP(pp_seek)
PP(pp_sysseek)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
int whence = POPi;
@@ -3963,7 +3970,7 @@ nope:
PP(pp_telldir)
{
#if defined(HAS_TELLDIR) || defined(telldir)
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
/* XXX does _anyone_ need this? --AD 2/20/1998 */
/* XXX netbsd still seemed to.
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
@@ -4174,7 +4181,6 @@ PP(pp_system)
I32 value;
STRLEN n_a;
int result;
- I32 did_pipes = 0;
if (PL_tainting) {
TAINT_ENV();
@@ -4191,6 +4197,7 @@ PP(pp_system)
{
Pid_t childpid;
int pp[2];
+ I32 did_pipes = 0;
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
@@ -4272,14 +4279,14 @@ PP(pp_system)
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
-# if defined(WIN32) || defined(OS2)
+# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2)
+# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
value = (I32)do_aspawn(Nullsv, MARK, SP);
# else
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
@@ -4524,9 +4531,11 @@ PP(pp_gmtime)
dSP;
Time_t when;
const struct tm *tmbuf;
- static const char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
- static const char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
+ static const char * const dayname[] =
+ {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
+ static const char * const monname[] =
+ {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
if (MAXARG < 1)
(void)time(&when);
diff --git a/proto.h b/proto.h
index 0866d7dc41..c26f87b229 100644
--- a/proto.h
+++ b/proto.h
@@ -160,7 +160,7 @@ PERL_CALLCONV void Perl_do_chop(pTHX_ SV* asv, SV* sv);
PERL_CALLCONV bool Perl_do_close(pTHX_ GV* gv, bool not_implicit);
PERL_CALLCONV bool Perl_do_eof(pTHX_ GV* gv);
PERL_CALLCONV bool Perl_do_exec(pTHX_ char* cmd);
-#if defined(WIN32)
+#if defined(WIN32) || defined(SYMBIAN)
PERL_CALLCONV int Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp);
PERL_CALLCONV int Perl_do_spawn(pTHX_ char* cmd);
PERL_CALLCONV int Perl_do_spawn_nowait(pTHX_ char* cmd);
@@ -228,7 +228,7 @@ PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv);
PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method);
PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash);
PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, const GV* gv);
-/* PERL_CALLCONV void gv_efullname3(pTHX_ SV* sv, const GV* gv, const char* prefix); */
+/* PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, const GV* gv, const char* prefix); */
PERL_CALLCONV void Perl_gv_efullname4(pTHX_ SV* sv, const GV* gv, const char* prefix, bool keepmain);
PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name);
PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level);
@@ -237,7 +237,7 @@ PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name);
PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload);
PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type);
PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, const GV* gv);
-/* PERL_CALLCONV void gv_fullname3(pTHX_ SV* sv, const GV* gv, const char* prefix); */
+/* PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, const GV* gv, const char* prefix); */
PERL_CALLCONV void Perl_gv_fullname4(pTHX_ SV* sv, const GV* gv, const char* prefix, bool keepmain);
PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi);
PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create);
@@ -1237,8 +1237,10 @@ STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, HV *name_stash, int l
#endif
#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT)
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
STATIC char* S_stdize_locale(pTHX_ char* locs);
#endif
+#endif
#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
STATIC COP* S_closest_cop(pTHX_ COP *cop, OP *o);
@@ -1421,4 +1423,7 @@ PERL_CALLCONV bool Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags);
PERL_CALLCONV char* Perl_savesvpv(pTHX_ SV* sv);
+PERL_CALLCONV struct perl_vars* Perl_init_global_struct(pTHX);
+PERL_CALLCONV void Perl_free_global_struct(pTHX_ struct perl_vars*);
+
END_EXTERN_C
diff --git a/reentr.pl b/reentr.pl
index c100115b2a..53a76e2d57 100644
--- a/reentr.pl
+++ b/reentr.pl
@@ -798,7 +798,7 @@ Perl_reentrant_free(pTHX) {
void*
Perl_reentrant_retry(const char *f, ...)
{
- dTHX;
+ dVAR; dTHX;
void *retptr = NULL;
#ifdef USE_REENTRANT_API
# if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
diff --git a/regcomp.c b/regcomp.c
index ab1c218819..d4640eae83 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -206,8 +206,8 @@ typedef struct scan_data_t {
* Forward declarations for pregcomp()'s friends.
*/
-static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0};
+static const scan_data_t zero_scan_data =
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
#define SF_BEFORE_SEOL 0x1
@@ -834,6 +834,7 @@ and would end up looking like:
STATIC I32
S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
{
+ dVAR;
/* first pass, loop through and scan words */
reg_trie_data *trie;
regnode *cur;
@@ -3227,6 +3228,7 @@ STATIC regnode *
S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
/* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
{
+ dVAR;
register regnode *ret; /* Will be the head of the group. */
register regnode *br;
register regnode *lastbr;
@@ -6123,6 +6125,7 @@ Perl_re_intuit_string(pTHX_ regexp *prog)
void
Perl_pregfree(pTHX_ struct regexp *r)
{
+ dVAR;
#ifdef DEBUGGING
SV *dsv = PERL_DEBUG_PAD_ZERO(0);
SV *re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
diff --git a/regexec.c b/regexec.c
index 17ee6af0f7..8947cce1ae 100644
--- a/regexec.c
+++ b/regexec.c
@@ -965,6 +965,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
STATIC char *
S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun)
{
+ dVAR;
I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
char *m;
STRLEN ln;
@@ -2380,6 +2381,7 @@ typedef union re_unwind_t {
STATIC I32 /* 0 failure, 1 success */
S_regmatch(pTHX_ regnode *prog)
{
+ dVAR;
register regnode *scan; /* Current node. */
regnode *next; /* Next node. */
regnode *inner; /* Next node in internal branch. */
@@ -4359,6 +4361,7 @@ do_no:
STATIC I32
S_regrepeat(pTHX_ regnode *p, I32 max)
{
+ dVAR;
register char *scan;
register I32 c;
register char *loceol = PL_regeol;
@@ -4706,6 +4709,7 @@ Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV
STATIC bool
S_reginclass(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register bool do_utf8)
{
+ dVAR;
char flags = ANYOF_FLAGS(n);
bool match = FALSE;
UV c = *p;
diff --git a/scope.h b/scope.h
index 73b94cbda4..2fa7f60370 100644
--- a/scope.h
+++ b/scope.h
@@ -331,3 +331,4 @@ typedef struct jmpenv JMPENV;
#define CATCH_GET (PL_top_env->je_mustcatch)
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+
diff --git a/sv.c b/sv.c
index 7bfd7a5083..ab9603fc9a 100644
--- a/sv.c
+++ b/sv.c
@@ -645,6 +645,7 @@ Perl_sv_free_arenas(pTHX)
STATIC SV*
S_find_hash_subscript(pTHX_ HV *hv, SV* val)
{
+ dVAR;
register HE **array;
register HE *entry;
I32 i;
@@ -790,6 +791,7 @@ PL_comppad/PL_curpad points to the currently executing pad.
STATIC SV *
S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
{
+ dVAR;
SV *sv;
AV *av;
SV **svp;
@@ -3666,6 +3668,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
return SvPVX(tsv);
}
else {
+ dVAR;
STRLEN len;
const char *t;
@@ -5506,7 +5509,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
}
/* Rest of work is done else where */
- mg = sv_magicext(sv,obj,how,vtable,name,namlen);
+ mg = sv_magicext(sv,obj,how,(MGVTBL*)vtable,name,namlen);
switch (how) {
case PERL_MAGIC_taint:
@@ -5826,6 +5829,7 @@ instead.
void
Perl_sv_clear(pTHX_ register SV *sv)
{
+ dVAR;
HV* stash;
assert(sv);
assert(SvREFCNT(sv) == 0);
@@ -6075,6 +6079,7 @@ Normally called via a wrapper macro C<SvREFCNT_dec>.
void
Perl_sv_free(pTHX_ SV *sv)
{
+ dVAR;
if (!sv)
return;
if (SvREFCNT(sv) == 0) {
@@ -6103,6 +6108,7 @@ Perl_sv_free(pTHX_ SV *sv)
void
Perl_sv_free2(pTHX_ SV *sv)
{
+ dVAR;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
@@ -6213,7 +6219,7 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offse
if (SvMAGICAL(sv) && !SvREADONLY(sv)) {
if (!*mgp)
- *mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, &PL_vtbl_utf8, 0, 0);
+ *mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, (MGVTBL*)&PL_vtbl_utf8, 0, 0);
assert(*mgp);
if ((*mgp)->mg_ptr)
@@ -7137,17 +7143,7 @@ thats_really_all_folks:
else
{
/*The big, slow, and stupid way. */
-
- /* Any stack-challenged places. */
-#if defined(EPOC)
- /* EPOC: need to work around SDK features. *
- * On WINS: MS VC5 generates calls to _chkstk, *
- * if a "large" stack frame is allocated. *
- * gcc on MARM does not generate calls like these. */
-# define USEHEAPINSTEADOFSTACK
-#endif
-
-#ifdef USEHEAPINSTEADOFSTACK
+#ifdef USE_HEAP_INSTEAD_OF_STACK /* Even slower way. */
STDCHAR *buf = 0;
New(0, buf, 8192, STDCHAR);
assert(buf);
@@ -7202,7 +7198,7 @@ screamer2:
goto screamer2;
}
-#ifdef USEHEAPINSTEADOFSTACK
+#ifdef USE_HEAP_INSTEAD_OF_STACK
Safefree(buf);
#endif
}
@@ -7555,6 +7551,7 @@ and C<sv_mortalcopy>.
SV *
Perl_sv_2mortal(pTHX_ register SV *sv)
{
+ dVAR;
if (!sv)
return sv;
if (SvREADONLY(sv) && SvIMMORTAL(sv))
@@ -7832,6 +7829,7 @@ Note that the perl-level function is vaguely deprecated.
void
Perl_sv_reset(pTHX_ register const char *s, HV *stash)
{
+ dVAR;
register HE *entry;
register GV *gv;
register SV *sv;
@@ -7964,6 +7962,7 @@ possible to set C<*st> and C<*gvp> to the stash and GV associated with it.
CV *
Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
{
+ dVAR;
GV *gv = Nullgv;
CV *cv = Nullcv;
@@ -9116,7 +9115,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
char *patend;
STRLEN origlen;
I32 svix = 0;
- static char nullstr[] = "(null)";
+ static const char nullstr[] = "(null)";
SV *argsv = Nullsv;
bool has_utf8; /* has the result utf8? */
bool pat_utf8; /* the pattern is in utf8? */
@@ -9519,7 +9518,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
#endif
elen = strlen(eptr);
else {
- eptr = nullstr;
+ eptr = (char *)nullstr;
elen = sizeof nullstr - 1;
}
}
@@ -10142,6 +10141,7 @@ ptr_table_* functions.
REGEXP *
Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
{
+ dVAR;
REGEXP *ret;
int i, len, npar;
struct reg_substr_datum *s;
@@ -10534,10 +10534,6 @@ Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl)
Safefree(tbl);
}
-#ifdef DEBUGGING
-char *PL_watch_pvx;
-#endif
-
/* attempt to make everything in the typeglob readonly */
STATIC SV *
@@ -10655,6 +10651,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
SV *
Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
{
+ dVAR;
SV *dstr;
if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
@@ -11504,6 +11501,7 @@ perl_clone_host(PerlInterpreter* proto_perl, UV flags);
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
+ dVAR;
#ifdef PERL_IMPLICIT_SYS
/* perlhost.h so we need to call into it
@@ -12322,6 +12320,7 @@ The PV of the sv is returned.
char *
Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
{
+ dVAR;
if (SvPOK(sv) && !SvUTF8(sv) && !IN_BYTES && SvROK(encoding)) {
SV *uni;
STRLEN len;
@@ -12383,6 +12382,7 @@ bool
Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
SV *ssv, int *offset, char *tstr, int tlen)
{
+ dVAR;
bool ret = FALSE;
if (SvPOK(ssv) && SvPOK(dsv) && SvROK(encoding) && offset) {
SV *offsv;
diff --git a/symbian/PerlApp.cpp b/symbian/PerlApp.cpp
new file mode 100644
index 0000000000..319a59118c
--- /dev/null
+++ b/symbian/PerlApp.cpp
@@ -0,0 +1,549 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlApp application is licensed under the same terms as Perl itself. */
+
+#include "PerlApp.h"
+
+#include <avkon.hrh>
+#include <aknnotewrappers.h>
+#include <apparc.h>
+#include <e32base.h>
+#include <e32cons.h>
+#include <eikenv.h>
+#include <bautils.h>
+#include <eikappui.h>
+#include <utf.h>
+#include <f32file.h>
+
+#include <AknCommonDialogs.h>
+
+#ifndef __SERIES60_1X__
+#include <CAknFileSelectionDialog.h>
+#endif
+
+#include <coemain.h>
+
+#include "PerlApp.hrh"
+#include "PerlApp.rsg"
+
+#include "patchlevel.h"
+#include "PerlBase.h"
+
+const TUid KPerlAppUid = { 0x102015F6 };
+
+// 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}
+#endif // #ifndef _LIT_NO_L
+
+_LIT(KAppName, "PerlApp");
+_LIT_NO_L(KFlavor, PERL_SYMBIANSDK_FLAVOR);
+_LIT(KAboutFormat,
+ "Perl %d.%d.%d, Symbian port %d.%d.%d, built for %S SDK %d.%d");
+_LIT(KCopyrightFormat,
+ "Copyright 1987-2005 Larry Wall and others, Symbian port Copyright Nokia 2004-2005");
+_LIT(KInboxPrefix, "\\System\\Mail\\");
+_LIT(KScriptPrefix, "\\Perl\\");
+
+_LIT8(KModulePrefix, SITELIB); // SITELIB from Perl config.h
+
+typedef TBuf<256> TMessageBuffer;
+typedef TBuf8<256> TPeekBuffer;
+typedef TBuf8<256> TFileName8;
+
+// Usage: DEBUG_PRINTF((_L("%S"), &aStr))
+#if 1
+#define DEBUG_PRINTF(s) {TMessageBuffer message; message.Format s; YesNoDialogL(message);}
+#endif
+
+TUid CPerlAppApplication::AppDllUid() const
+{
+ return KPerlAppUid;
+}
+
+enum TPerlAppPanic
+{
+ EPerlAppCommandUnknown = 1
+};
+
+void Panic(TPerlAppPanic aReason)
+{
+ User::Panic(KAppName, aReason);
+}
+
+void CPerlAppUi::ConstructL()
+{
+ BaseConstructL();
+ iAppView = CPerlAppView::NewL(ClientRect());
+ AddToStackL(iAppView);
+ iFs = NULL;
+ CEikonEnv::Static()->DisableExitChecks(ETrue); // Symbian FAQ-0577.
+}
+
+CPerlAppUi::~CPerlAppUi()
+{
+ if (iAppView) {
+ iEikonEnv->RemoveFromStack(iAppView);
+ delete iAppView;
+ iAppView = NULL;
+ }
+ if (iFs) {
+ delete iFs;
+ iFs = NULL;
+ }
+ if (iDoorObserver) // Otherwise the embedding application waits forever.
+ iDoorObserver->NotifyExit(MApaEmbeddedDocObserver::EEmpty);
+}
+
+static TBool DlgOk(CAknNoteDialog* dlg)
+{
+ return dlg && dlg->RunDlgLD() == EAknSoftkeyOk;
+}
+
+static TBool OkCancelDialogL(TDesC& aMessage)
+{
+ CAknNoteDialog* dlg =
+ new (ELeave) CAknNoteDialog(CAknNoteDialog::EConfirmationTone);
+ dlg->PrepareLC(R_OK_CANCEL_DIALOG);
+ dlg->SetTextL(aMessage);
+ return DlgOk(dlg);
+}
+
+static TBool YesNoDialogL(TDesC& aMessage)
+{
+ CAknNoteDialog* dlg =
+ new (ELeave) CAknNoteDialog(CAknNoteDialog::EConfirmationTone);
+ dlg->PrepareLC(R_YES_NO_DIALOG);
+ dlg->SetTextL(aMessage);
+ return DlgOk(dlg);
+}
+
+static TInt InformationNoteL(TDesC& aMessage)
+{
+ CAknInformationNote* note = new (ELeave) CAknInformationNote;
+ return note->ExecuteLD(aMessage);
+}
+
+static TInt ConfirmationNoteL(TDesC& aMessage)
+{
+ CAknConfirmationNote* note = new (ELeave) CAknConfirmationNote;
+ return note->ExecuteLD(aMessage);
+}
+
+static TInt WarningNoteL(TDesC& aMessage)
+{
+ CAknWarningNote* note = new (ELeave) CAknWarningNote;
+ return note->ExecuteLD(aMessage);
+}
+
+static TInt TextQueryDialogL(const TDesC& aPrompt, TDes& aData, const TInt aMaxLength)
+{
+ CAknTextQueryDialog* dlg =
+ new (ELeave) CAknTextQueryDialog(aData);
+ dlg->SetPromptL(aPrompt);
+ dlg->SetMaxLength(aMaxLength);
+ return dlg->ExecuteLD(R_TEXT_QUERY_DIALOG);
+}
+
+// The isXXX() come from the Perl headers.
+#define FILENAME_IS_ABSOLUTE(n) \
+ (isALPHA(((n)[0])) && ((n)[1]) == ':' && ((n)[2]) == '\\')
+
+static TBool IsInPerl(TFileName aFileName)
+{
+ TInt offset = aFileName.FindF(KScriptPrefix);
+ return ((offset == 0 && // \foo
+ aFileName[0] == '\\')
+ ||
+ (offset == 2 && // x:\foo
+ FILENAME_IS_ABSOLUTE(aFileName)));
+}
+
+static TBool IsInInbox(TFileName aFileName)
+{
+ TInt offset = aFileName.FindF(KInboxPrefix);
+ return ((offset == 0 && // \foo
+ aFileName[0] == '\\')
+ ||
+ (offset == 2 && // x:\foo
+ FILENAME_IS_ABSOLUTE(aFileName)));
+}
+
+static TBool IsPerlModule(TParsePtrC aParsed)
+{
+ return aParsed.Ext().CompareF(_L(".pm")) == 0;
+}
+
+static TBool IsPerlScript(TParsePtrC aParsed)
+{
+ return aParsed.Ext().CompareF(_L(".pl")) == 0;
+}
+
+static void CopyFromInboxL(RFs aFs, const TFileName& aSrc, const TFileName& aDst)
+{
+ TBool proceed = ETrue;
+ TMessageBuffer message;
+
+ message.Format(_L("%S is untrusted. Install only if you trust provider."), &aDst);
+ if (OkCancelDialogL(message)) {
+ message.Format(_L("Install as %S?"), &aDst);
+ if (OkCancelDialogL(message)) {
+ if (BaflUtils::FileExists(aFs, aDst)) {
+ message.Format(_L("Replace old %S?"), &aDst);
+ if (!OkCancelDialogL(message))
+ proceed = EFalse;
+ }
+ if (proceed) {
+ // Create directory?
+ TInt err = BaflUtils::CopyFile(aFs, aSrc, aDst);
+ if (err == KErrNone) {
+ message.Format(_L("Installed %S"), &aDst);
+ ConfirmationNoteL(message);
+ }
+ else {
+ message.Format(_L("Failure %d installing %S"), err, &aDst);
+ WarningNoteL(message);
+ }
+ }
+ }
+ }
+}
+
+static TBool FindPerlPackageName(TPeekBuffer aPeekBuffer, TInt aOff, TFileName& aFn)
+{
+ aFn.SetMax();
+ TInt m = aFn.MaxLength();
+ TInt n = aPeekBuffer.Length();
+ TInt i = 0;
+ TInt j = aOff;
+
+ aFn.SetMax();
+ // The following is a little regular expression
+ // engine that matches Perl package names.
+ if (j < n && isSPACE(aPeekBuffer[j])) {
+ while (j < n && isSPACE(aPeekBuffer[j])) j++;
+ if (j < n && isALPHA(aPeekBuffer[j])) {
+ while (j < n && isALNUM(aPeekBuffer[j])) {
+ while (j < n &&
+ isALNUM(aPeekBuffer[j]) &&
+ i < m)
+ aFn[i++] = aPeekBuffer[j++];
+ if (j + 1 < n &&
+ aPeekBuffer[j ] == ':' &&
+ aPeekBuffer[j + 1] == ':' &&
+ i < m) {
+ aFn[i++] = '\\';
+ j += 2;
+ if (j < n &&
+ isALPHA(aPeekBuffer[j])) {
+ while (j < n &&
+ isALNUM(aPeekBuffer[j]) &&
+ i < m)
+ aFn[i++] = aPeekBuffer[j++];
+ }
+ }
+ }
+ while (j < n && isSPACE(aPeekBuffer[j])) j++;
+ if (j < n && aPeekBuffer[j] == ';' && i + 3 < m) {
+ aFn.SetLength(i);
+ aFn.Append(_L(".pm"));
+ return ETrue;
+ }
+ }
+ }
+ return EFalse;
+}
+
+static void GuessPerlModule(TFileName& aGuess, TPeekBuffer aPeekBuffer, TParse aDrive)
+{
+ TInt offset = aPeekBuffer.Find(_L8("package"));
+ if (offset != KErrNotFound) {
+ const TInt KPackageLen = 7;
+ TFileName q;
+
+ if (!FindPerlPackageName(aPeekBuffer, offset + KPackageLen, q))
+ return;
+
+ TFileName8 p;
+ p.Copy(aDrive.Drive());
+ p.Append(KModulePrefix);
+
+ aGuess.SetMax();
+ if (p.Length() + 1 + q.Length() < aGuess.MaxLength()) {
+ TInt i = 0, j;
+
+ for (j = 0; j < p.Length(); j++)
+ aGuess[i++] = p[j];
+ aGuess[i++] = '\\';
+ for (j = 0; j < q.Length(); j++)
+ aGuess[i++] = q[j];
+ aGuess.SetLength(i);
+ }
+ else
+ aGuess.SetLength(0);
+ }
+}
+
+static TBool LooksLikePerlL(TPeekBuffer aPeekBuffer)
+{
+ return aPeekBuffer.Left(2).Compare(_L8("#!")) == 0 &&
+ aPeekBuffer.Find(_L8("perl")) != KErrNotFound;
+}
+
+static TBool InstallStuffL(const TFileName &aSrc, TParse aDrive, TParse aFile, TPeekBuffer aPeekBuffer, RFs aFs)
+{
+ TFileName aDst;
+ TPtrC drive = aDrive.Drive();
+ TPtrC namext = aFile.NameAndExt();
+
+ aDst.Format(_L("%S%S%S"), &drive, &KScriptPrefix, &namext);
+ if (!IsPerlScript(aDst) && !LooksLikePerlL(aPeekBuffer)) {
+ aDst.SetLength(0);
+ if (IsPerlModule(aDst))
+ GuessPerlModule(aDst, aPeekBuffer, aDrive);
+ }
+ if (aDst.Length() > 0) {
+ CopyFromInboxL(aFs, aSrc, aDst);
+ return ETrue;
+ }
+
+ 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;
+
+ if (IsInPerl(aScriptName) &&
+ (IsPerlScript(aScriptName) ||
+ (isModule = IsPerlModule(aScriptName)) ||
+ LooksLikePerlL(aPeekBuffer))) {
+ TMessageBuffer message;
+
+ if (isModule)
+ message.Format(_L("Really run module %S?"), &aScriptName);
+ else
+ message.Format(_L("Run %S?"), &aScriptName);
+ if (YesNoDialogL(message))
+ DoRunScriptL(aScriptName);
+
+ return ETrue;
+ }
+
+ return EFalse;
+}
+
+void CPerlAppUi::InstallOrRunL(const TFileName& aFileName)
+{
+ TParse aFile;
+ TParse aDrive;
+ TMessageBuffer message;
+
+ aFile.Set(aFileName, NULL, NULL);
+ if (FILENAME_IS_ABSOLUTE(aFileName)) {
+ aDrive.Set(aFileName, NULL, NULL);
+ } else {
+ TFileName appName =
+ CEikonEnv::Static()->EikAppUi()->Application()->AppFullName();
+ aDrive.Set(appName, NULL, NULL);
+ }
+ if (!iFs)
+ iFs = &CEikonEnv::Static()->FsSession();
+ RFile f;
+ TInt err = f.Open(*iFs, aFileName, EFileRead);
+ if (err == KErrNone) {
+ TPeekBuffer aPeekBuffer;
+ err = f.Read(aPeekBuffer);
+ f.Close(); // Release quickly.
+ if (err == KErrNone) {
+ if (!(IsInInbox(aFileName) ?
+ InstallStuffL(aFileName, aDrive, aFile, aPeekBuffer, *iFs) :
+ RunStuffL(aFileName, aPeekBuffer))) {
+ message.Format(_L("Failed for file %S"), &aFileName);
+ WarningNoteL(message);
+ }
+ } else {
+ message.Format(_L("Error %d reading %S"), err, &aFileName);
+ WarningNoteL(message);
+ }
+ } else {
+ message.Format(_L("Error %d opening %S"), err, &aFileName);
+ WarningNoteL(message);
+ }
+ if (iDoorObserver)
+ delete CEikonEnv::Static()->EikAppUi();
+ else
+ Exit();
+}
+
+void CPerlAppUi::OpenFileL(const TDesC& aFileName)
+{
+ InstallOrRunL(aFileName);
+ return;
+}
+
+TBool CPerlAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName */, const TDesC8& /* aTail */)
+{
+ return aCommand == EApaCommandOpen ? ETrue : EFalse;
+}
+
+void CPerlAppUi::SetFs(const RFs& aFs)
+{
+ iFs = (RFs*) &aFs;
+}
+
+void CPerlAppUi::HandleCommandL(TInt aCommand)
+{
+ TMessageBuffer message;
+
+ switch(aCommand)
+ {
+ case EEikCmdExit:
+ case EAknSoftkeyExit:
+ Exit();
+ break;
+ case EPerlAppCommandAbout:
+ {
+ message.Format(KAboutFormat,
+ PERL_REVISION,
+ PERL_VERSION,
+ PERL_SUBVERSION,
+ PERL_SYMBIANPORT_MAJOR,
+ PERL_SYMBIANPORT_MINOR,
+ PERL_SYMBIANPORT_PATCH,
+ &KFlavor,
+ PERL_SYMBIANSDK_MAJOR,
+ PERL_SYMBIANSDK_MINOR
+ );
+ InformationNoteL(message);
+ }
+ break;
+ case EPerlAppCommandTime:
+ {
+ CPerlBase* perl = CPerlBase::NewInterpreterLC();
+ const char *const argv[] =
+ { "perl", "-le",
+ "print 'Running in ', $^O, \"\\n\", scalar localtime" };
+ perl->ParseAndRun(sizeof(argv)/sizeof(char*), (char **)argv, 0);
+ CleanupStack::PopAndDestroy(perl);
+ }
+ break;
+ case EPerlAppCommandRunFile:
+ {
+ InformationNoteL(message);
+ TFileName aScriptUtf16;
+ if (AknCommonDialogs::RunSelectDlgLD(aScriptUtf16,
+ R_MEMORY_SELECTION_DIALOG))
+ DoRunScriptL(aScriptUtf16);
+ }
+ break;
+ case EPerlAppCommandOneLiner:
+ {
+ _LIT(prompt, "Oneliner:");
+ if (TextQueryDialogL(prompt, iOneLiner, KPerlAppOneLinerSize)) {
+ const TUint KPerlAppUtf8Multi = 3;
+ TBuf8<KPerlAppUtf8Multi * KPerlAppOneLinerSize> utf8;
+
+ CnvUtfConverter::ConvertFromUnicodeToUtf8(utf8, iOneLiner);
+ CPerlBase* perl = CPerlBase::NewInterpreterLC();
+ int argc = 3;
+ char **argv = (char**) malloc(argc * sizeof(char *));
+ User::LeaveIfNull(argv);
+
+ TCleanupItem argvCleanupItem = TCleanupItem(free, argv);
+ CleanupStack::PushL(argvCleanupItem);
+ argv[0] = (char *) "perl";
+ argv[1] = (char *) "-le";
+ argv[2] = (char *) utf8.PtrZ();
+ perl->ParseAndRun(argc, argv);
+ CleanupStack::PopAndDestroy(2, perl);
+ }
+ }
+ break;
+ case EPerlAppCommandCopyright:
+ {
+ message.Format(KCopyrightFormat);
+ InformationNoteL(message);
+ }
+ break;
+
+ default:
+ Panic(EPerlAppCommandUnknown);
+ break;
+ }
+}
+
+CPerlAppView* CPerlAppView::NewL(const TRect& aRect)
+{
+ CPerlAppView* self = CPerlAppView::NewLC(aRect);
+ CleanupStack::Pop(self);
+ return self;
+}
+
+CPerlAppView* CPerlAppView::NewLC(const TRect& aRect)
+{
+ CPerlAppView* self = new (ELeave) CPerlAppView;
+ CleanupStack::PushL(self);
+ self->ConstructL(aRect);
+ return self;
+}
+
+void CPerlAppView::ConstructL(const TRect& aRect)
+{
+ CreateWindowL();
+ SetRect(aRect);
+ ActivateL();
+}
+
+void CPerlAppView::Draw(const TRect& /*aRect*/) const
+{
+ CWindowGc& gc = SystemGc();
+ TRect rect = Rect();
+ gc.Clear(rect);
+}
+
+CApaDocument* CPerlAppApplication::CreateDocumentL()
+{
+ CPerlAppDocument* document = new (ELeave) CPerlAppDocument(*this);
+ return document;
+}
+
+CEikAppUi* CPerlAppDocument::CreateAppUiL()
+{
+ CPerlAppUi* appui = new (ELeave) CPerlAppUi();
+ return appui;
+}
+
+CFileStore* CPerlAppDocument::OpenFileL(TBool /* aDoOpen */, const TDesC& aFileName, RFs& aFs)
+{
+ CPerlAppUi* appui =
+ STATIC_CAST(CPerlAppUi*, CEikonEnv::Static()->EikAppUi());
+ appui->SetFs(aFs);
+ appui->OpenFileL(aFileName);
+ return NULL;
+}
+
+EXPORT_C CApaApplication* NewApplication()
+{
+ return new CPerlAppApplication;
+}
+
+GLDEF_C TInt E32Dll(TDllReason /*aReason*/)
+{
+ return KErrNone;
+}
+
diff --git a/symbian/PerlApp.h b/symbian/PerlApp.h
new file mode 100644
index 0000000000..37a02f2502
--- /dev/null
+++ b/symbian/PerlApp.h
@@ -0,0 +1,60 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlApp application is licensed under the same terms as Perl itself. */
+
+#ifndef __PerlApp_h__
+#define __PerlApp_h__
+
+#include <aknapp.h>
+#include <aknappui.h>
+#include <akndoc.h>
+#include <coecntrl.h>
+#include <f32file.h>
+
+class CPerlAppDocument : public CAknDocument
+{
+ public:
+ CPerlAppDocument(CEikApplication& aApp):CAknDocument(aApp) {;}
+ CFileStore* OpenFileL(TBool aDoOpen, const TDesC& aFilename, RFs& aFs);
+ private: // from CEikDocument
+ CEikAppUi* CreateAppUiL();
+};
+
+class CPerlAppApplication : public CAknApplication
+{
+ private:
+ CApaDocument* CreateDocumentL();
+ TUid AppDllUid() const;
+};
+
+const TUint KPerlAppOneLinerSize = 80;
+
+class CPerlAppView;
+
+class CPerlAppUi : public CAknAppUi
+{
+ public:
+ void ConstructL();
+ ~CPerlAppUi();
+ void HandleCommandL(TInt aCommand);
+ void OpenFileL(const TDesC& aFileName);
+ TBool ProcessCommandParametersL(TApaCommand aCommand, TFileName& aDocumentName, const TDesC8& aTail);
+ void InstallOrRunL(const TFileName& aFileName);
+ void SetFs(const RFs& aFs);
+ private:
+ CPerlAppView* iAppView;
+ RFs* iFs;
+ TBuf<KPerlAppOneLinerSize> iOneLiner;
+};
+
+class CPerlAppView : public CCoeControl
+{
+ public:
+ static CPerlAppView* NewL(const TRect& aRect);
+ static CPerlAppView* NewLC(const TRect& aRect);
+ void Draw(const TRect& aRect) const;
+ private:
+ void ConstructL(const TRect& aRect);
+};
+
+#endif // __PerlApp_h__
diff --git a/symbian/PerlApp.hrh b/symbian/PerlApp.hrh
new file mode 100644
index 0000000000..3b0f23d79a
--- /dev/null
+++ b/symbian/PerlApp.hrh
@@ -0,0 +1,17 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlApp application is licensed under the same terms as Perl itself. */
+
+#ifndef __PerlApp_HRH__
+#define __PerlApp_HRH__
+
+enum TPerlIds
+{
+ EPerlAppCommandAbout = 1024, // start value must not be 0
+ EPerlAppCommandTime = 1025,
+ EPerlAppCommandRunFile = 1026,
+ EPerlAppCommandOneLiner = 1027,
+ EPerlAppCommandCopyright = 1028 // no comma here
+};
+
+#endif // __PerlApp_HRH__
diff --git a/symbian/PerlApp.rss b/symbian/PerlApp.rss
new file mode 100644
index 0000000000..c352c528db
--- /dev/null
+++ b/symbian/PerlApp.rss
@@ -0,0 +1,141 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlApp application is licensed under the same terms as Perl itself. */
+
+NAME PERL
+
+#include <eikon.rh>
+#include <avkon.rh>
+#include <avkon.rsg>
+
+#include "PerlApp.hrh"
+
+RESOURCE RSS_SIGNATURE
+{
+}
+
+RESOURCE TBUF r_default_document_name
+{
+ buf = "";
+}
+
+RESOURCE EIK_APP_INFO
+{
+ menubar = r_Perl_menubar;
+ cba = R_AVKON_SOFTKEYS_OPTIONS_EXIT;
+}
+
+
+RESOURCE MENU_BAR r_Perl_menubar
+{
+ titles = {
+ MENU_TITLE
+ {
+ menu_pane = r_Perl_menu;
+ }
+ };
+}
+
+
+RESOURCE MENU_PANE r_Perl_menu
+{
+ items = {
+ MENU_ITEM {
+ command = EPerlAppCommandAbout;
+ txt = "About";
+ },
+ MENU_ITEM {
+ command = EPerlAppCommandTime;
+ txt = "Time";
+ },
+ MENU_ITEM {
+ command = EPerlAppCommandRunFile;
+ txt = "Run";
+ },
+ MENU_ITEM {
+ command = EPerlAppCommandOneLiner;
+ txt = "Oneliner";
+ },
+ MENU_ITEM {
+ command = EPerlAppCommandCopyright;
+ txt = "Copyright";
+ }
+ };
+}
+
+RESOURCE DIALOG r_ok_cancel_dialog
+{
+ flags = EEikDialogFlagWait | EEikDialogFlagCbaButtons;
+ buttons = R_AVKON_SOFTKEYS_OK_CANCEL;
+ items = {
+ DLG_LINE
+ {
+ type = EAknCtNote;
+ id = EGeneralNote;
+ control = AVKON_NOTE
+ {
+ layout = EGeneralLayout;
+ };
+ }
+ };
+}
+
+RESOURCE DIALOG r_yes_no_dialog
+{
+ flags = EEikDialogFlagWait | EEikDialogFlagCbaButtons;
+ buttons = R_AVKON_SOFTKEYS_YES_NO;
+ items = {
+ DLG_LINE
+ {
+ type = EAknCtNote;
+ id = EGeneralNote;
+ control = AVKON_NOTE
+ {
+ layout = EGeneralLayout;
+ };
+ }
+ };
+}
+
+RESOURCE DIALOG r_text_query_dialog
+{
+ flags = EGeneralQueryFlags;
+ buttons = R_AVKON_SOFTKEYS_OK_CANCEL;
+ items = {
+ DLG_LINE
+ {
+ type = EAknCtQuery;
+ id = EGeneralQuery;
+ control = AVKON_DATA_QUERY
+ {
+ layout = EDataLayout;
+ control = EDWIN {};
+ };
+ }
+ };
+}
+
+RESOURCE AVKON_LIST_QUERY r_list_query_dialog
+{
+ flags = EGeneralQueryFlags;
+ softkeys = R_AVKON_SOFTKEYS_OK_CANCEL;
+ items = {
+ DLG_LINE
+ {
+ type = EAknCtListQueryControl;
+ id = EListQueryControl;
+ control = AVKON_LIST_QUERY_CONTROL
+ {
+ listtype = EAknCtSinglePopupMenuListBox;
+ };
+ }
+ };
+}
+
+#include <CommonDialogs.hrh>
+#include <CommonDialogs.rh>
+
+RESOURCE MEMORYSELECTIONDIALOG r_memory_selection_dialog
+{
+}
+
diff --git a/symbian/PerlAppAif.rss b/symbian/PerlAppAif.rss
new file mode 100644
index 0000000000..fa4d42b0e1
--- /dev/null
+++ b/symbian/PerlAppAif.rss
@@ -0,0 +1,21 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlApp application is licensed under the same terms as Perl itself. */
+
+#include <aiftool.rh>
+
+RESOURCE AIF_DATA
+{
+ app_uid = 0x102015F6;
+ embeddability = KAppEmbeddable;
+ hidden = KAppNotHidden;
+ launch = KAppLaunchInForeground;
+ newfile = KAppDoesNotSupportNewFile;
+ datatype_list = {
+ DATATYPE
+ {
+ priority = EDataTypePriorityNormal;
+ type = "x-application/x-perl";
+ }
+ };
+ }
diff --git a/symbian/PerlBase.cpp b/symbian/PerlBase.cpp
new file mode 100644
index 0000000000..31fe012f80
--- /dev/null
+++ b/symbian/PerlBase.cpp
@@ -0,0 +1,409 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The CPerlBase class is licensed under the same terms as Perl itself. */
+
+/* See PerlBase.pod for documentation. */
+
+#define PERLBASE_CPP
+
+#include <e32cons.h>
+#include <e32keys.h>
+#include <utf.h>
+
+#include "PerlBase.h"
+
+const TUint KPerlConsoleBufferMaxTChars = 0x0200;
+const TUint KPerlConsoleNoPos = 0xffff;
+
+CPerlBase::CPerlBase()
+{
+}
+
+EXPORT_C void CPerlBase::Destruct()
+{
+ iState = EPerlDestroying;
+ if (iConsole) {
+ iConsole->Printf(_L("[Any key to continue]"));
+ iConsole->Getch();
+ }
+ if (iPerl) {
+ (void)perl_destruct(iPerl);
+ perl_free(iPerl);
+ iPerl = NULL;
+ PERL_SYS_TERM();
+ }
+ if (iConsole) {
+ delete iConsole;
+ iConsole = NULL;
+ }
+ if (iConsoleBuffer) {
+ free(iConsoleBuffer);
+ iConsoleBuffer = NULL;
+ }
+#ifdef PERL_GLOBAL_STRUCT
+ if (iVars) {
+ PerlInterpreter* my_perl = NULL;
+ free_global_struct(iVars);
+ iVars = NULL;
+ }
+#endif
+}
+
+CPerlBase::~CPerlBase()
+{
+ Destruct();
+}
+
+EXPORT_C CPerlBase* CPerlBase::NewInterpreterL(TBool aCloseStdlib,
+ void (*aStdioInitFunc)(void*),
+ void *aStdioInitCookie)
+{
+ CPerlBase* self =
+ CPerlBase::NewInterpreterLC(aCloseStdlib,
+ aStdioInitFunc,
+ aStdioInitCookie);
+ CleanupStack::Pop(self);
+ return self;
+}
+
+EXPORT_C CPerlBase* CPerlBase::NewInterpreterLC(TBool aCloseStdlib,
+ void (*aStdioInitFunc)(void*),
+ void *aStdioInitCookie)
+{
+ CPerlBase* self = new (ELeave) CPerlBase;
+ CleanupStack::PushL(self);
+ self->iCloseStdlib = aCloseStdlib;
+ self->iStdioInitFunc = aStdioInitFunc;
+ self->iStdioInitCookie = aStdioInitCookie;
+ self->ConstructL();
+ PERL_APPCTX_SET(self);
+ return self;
+}
+
+static int _console_stdin(void* cookie, char* buf, int n)
+{
+ return ((CPerlBase*)cookie)->ConsoleRead(0, buf, n);
+}
+
+static int _console_stdout(void* cookie, const char* buf, int n)
+{
+ return ((CPerlBase*)cookie)->ConsoleWrite(1, buf, n);
+}
+
+static int _console_stderr(void* cookie, const char* buf, int n)
+{
+ return ((CPerlBase*)cookie)->ConsoleWrite(2, buf, n);
+}
+
+void CPerlBase::StdioRewire(void *arg) {
+ _REENT->_sf[0]._cookie = (void*)this;
+ _REENT->_sf[0]._read = &_console_stdin;
+ _REENT->_sf[0]._write = 0;
+ _REENT->_sf[0]._seek = 0;
+ _REENT->_sf[0]._close = 0;
+
+ _REENT->_sf[1]._cookie = (void*)this;
+ _REENT->_sf[1]._read = 0;
+ _REENT->_sf[1]._write = &_console_stdout;
+ _REENT->_sf[1]._seek = 0;
+ _REENT->_sf[1]._close = 0;
+
+ _REENT->_sf[2]._cookie = (void*)this;
+ _REENT->_sf[2]._read = 0;
+ _REENT->_sf[2]._write = &_console_stderr;
+ _REENT->_sf[2]._seek = 0;
+ _REENT->_sf[2]._close = 0;
+}
+
+void CPerlBase::ConstructL()
+{
+ iState = EPerlNone;
+#ifdef PERL_GLOBAL_STRUCT
+ PerlInterpreter *my_perl = 0;
+ iVars = init_global_struct();
+ User::LeaveIfNull(iVars);
+#endif
+ iPerl = perl_alloc();
+ User::LeaveIfNull(iPerl);
+ iState = EPerlAllocated;
+ perl_construct(iPerl); // returns void
+ if (!iStdioInitFunc) {
+ iConsole =
+ Console::NewL(_L("Perl Console"),
+ TSize(KConsFullScreen, KConsFullScreen));
+ iConsoleBuffer =
+ (TUint16*)malloc(sizeof(TUint) *
+ KPerlConsoleBufferMaxTChars);
+ User::LeaveIfNull(iConsoleBuffer);
+ iConsoleUsed = 0;
+#ifndef USE_PERLIO
+ iStdioInitFunc = &StdioRewire;
+#endif
+ }
+ if (iStdioInitFunc)
+ iStdioInitFunc(iStdioInitCookie);
+ iReadFunc = NULL;
+ iWriteFunc = NULL;
+ iState = EPerlConstructed;
+}
+
+EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
+{
+ return (PerlInterpreter*) iPerl;
+}
+
+#ifdef PERL_MINIPERL
+static void boot_DynaLoader(pTHX_ CV* cv) { }
+#else
+EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
+#endif
+
+static void xs_init(pTHX)
+{
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
+}
+
+EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
+ int argc,
+ char **argv,
+ char *envp[]) {
+ TBuf8<KMaxFileName> scriptUtf8;
+ TInt error;
+ error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
+ User::LeaveIfError(error);
+ char *filename = (char*)scriptUtf8.PtrZ();
+ struct stat st;
+ if (stat(filename, &st) == -1)
+ return KErrNotFound;
+ if (argc < 2)
+ return KErrGeneral; /* Anything better? */
+ char **Argv = (char**)malloc(argc * sizeof(char*));
+ User::LeaveIfNull(Argv);
+ TCleanupItem ArgvCleanupItem = TCleanupItem(free, Argv);
+ CleanupStack::PushL(ArgvCleanupItem);
+ Argv[0] = "perl";
+ if (argv && argc > 2)
+ for (int i = 2; i < argc - 1; i++)
+ Argv[i] = argv[i];
+ Argv[argc - 1] = filename;
+ error = this->ParseAndRun(argc, Argv, envp);
+ CleanupStack::PopAndDestroy(Argv);
+ Argv = 0;
+ return error == 0 ? KErrNone : KErrGeneral;
+}
+
+
+EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
+{
+ if (iState == EPerlConstructed) {
+ const char* const NullArgv[] = { "perl", "-e", "0" };
+ if (argc == 0 || argv == 0) {
+ argc = 3;
+ argv = (char**) NullArgv;
+ }
+ PERL_SYS_INIT(&argc, &argv);
+ int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
+ if (parsed == 0)
+ iState = EPerlParsed;
+ return parsed;
+ } else
+ return -1;
+}
+
+EXPORT_C void CPerlBase::SetupExit()
+{
+ if (iState == EPerlParsed) {
+ diTHX;
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+ // PL_perl_destruct level of 2 would be nice but
+ // it causes "Unbalanced scopes" for some reason.
+ PL_perl_destruct_level = 1;
+ }
+}
+
+EXPORT_C int CPerlBase::Run()
+{
+ if (iState == EPerlParsed) {
+ SetupExit();
+ iState = EPerlRunning;
+ int ran = perl_run(iPerl);
+ iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
+ return ran;
+ } else
+ return -1;
+}
+
+EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
+{
+ int parsed = Parse(argc, argv, envp);
+ int ran = (parsed == 0) ? Run() : -1;
+ return ran;
+}
+
+int CPerlBase::ConsoleReadLine()
+{
+ if (!iConsole)
+ return -EIO;
+
+ TUint currX = KPerlConsoleNoPos;
+ TUint currY = KPerlConsoleNoPos;
+ TUint prevX = KPerlConsoleNoPos;
+ TUint prevY = KPerlConsoleNoPos;
+ TUint maxX = KPerlConsoleNoPos;
+ TUint offset = 0;
+
+ for (;;) {
+ TKeyCode code = iConsole->Getch();
+
+ if (code == EKeyLineFeed || code == EKeyEnter) {
+ if (offset < KPerlConsoleBufferMaxTChars) {
+ iConsoleBuffer[offset++] = '\n';
+ iConsole->Printf(_L("\n"));
+ iConsoleBuffer[offset++] = 0;
+ }
+ break;
+ }
+ else {
+ TBool doBackward = EFalse;
+ TBool doBackspace = EFalse;
+
+ prevX = currX;
+ prevY = currY;
+ if (code == EKeyBackspace) {
+ if (offset > 0) {
+ iConsoleBuffer[--offset] = 0;
+ doBackward = ETrue;
+ doBackspace = ETrue;
+ }
+ }
+ else if (offset < KPerlConsoleBufferMaxTChars) {
+ TChar ch = TChar(code);
+
+ if (ch.IsPrint()) {
+ iConsoleBuffer[offset++] = (unsigned short)code;
+ iConsole->Printf(_L("%c"), code);
+ }
+ }
+ currX = iConsole->WhereX();
+ currY = iConsole->WhereY();
+ if (maxX == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
+ prevY != KPerlConsoleNoPos && currY == prevY + 1)
+ maxX = prevX;
+ if (doBackward) {
+ if (currX > 0)
+ iConsole->SetPos(currX - 1);
+ else if (currY > 0)
+ iConsole->SetPos(maxX, currY - 1);
+ if (doBackspace) {
+ TUint nowX = iConsole->WhereX();
+ TUint nowY = iConsole->WhereY();
+ iConsole->Printf(_L(" ")); /* scrub */
+ iConsole->SetPos(nowX, nowY);
+ }
+ }
+ }
+ }
+
+ return offset;
+}
+
+int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
+{
+ if (iReadFunc)
+ return iReadFunc(fd, buf, n);
+
+ if (!iConsole) {
+ errno = EIO;
+ return -1;
+ }
+
+ if (n < 0) {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (n == 0)
+ return 0;
+
+ TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
+ TBuf16<KPerlConsoleBufferMaxTChars> aBufferUtf16;
+ int length = ConsoleReadLine();
+ int i;
+
+ iConsoleUsed += length;
+
+ aBufferUtf16.SetLength(length);
+ for (i = 0; i < length; i++)
+ aBufferUtf16[i] = iConsoleBuffer[i];
+ aBufferUtf8.SetLength(4 * length);
+
+ CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
+
+ char *pUtf8 = (char*)aBufferUtf8.PtrZ();
+ int nUtf8 = aBufferUtf8.Size();
+ if (nUtf8 > n)
+ nUtf8 = n; /* Potential data loss. */
+#ifdef PERL_SYMBIAN_CONSOLE_UTF8
+ for (i = 0; i < nUtf8; i++)
+ buf[i] = pUtf8[i];
+#else
+ dTHX;
+ for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
+ unsigned long u = utf8_to_uvchr((U8*)(pUtf8 + i), 0);
+ if (u > 0xFF) {
+ iConsole->Printf(_L("(keycode > 0xFF)\n"));
+ buf[i] = 0;
+ return -1;
+ }
+ buf[i] = u;
+ }
+#endif
+ if (nUtf8 < n)
+ buf[nUtf8] = 0;
+ return nUtf8;
+}
+
+int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
+{
+ if (iWriteFunc)
+ return iWriteFunc(fd, buf, n);
+
+ if (!iConsole) {
+ errno = EIO;
+ return -1;
+ }
+
+ if (n < 0) {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (n == 0)
+ return 0;
+
+ int wrote = 0;
+#ifdef PERL_SYMBIAN_CONSOLE_UTF8
+ dTHX;
+ if (is_utf8_string((U8*)buf, n)) {
+ for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
+ TChar u = utf8_to_uvchr((U8*)(buf + i), 0);
+ iConsole->Printf(_L("%c"), u);
+ wrote++;
+ }
+ } else {
+ iConsole->Printf(_L("(malformed utf8: "));
+ for (int i = 0; i < n; i++)
+ iConsole->Printf(_L("%02x "), buf[i]);
+ iConsole->Printf(_L(")\n"));
+ }
+#else
+ for (int i = 0; i < n; i++) {
+ iConsole->Printf(_L("%c"), buf[i]);
+ }
+ wrote = n;
+#endif
+ iConsoleUsed += wrote;
+ return n;
+}
+
diff --git a/symbian/PerlBase.h b/symbian/PerlBase.h
new file mode 100644
index 0000000000..f6765fbed2
--- /dev/null
+++ b/symbian/PerlBase.h
@@ -0,0 +1,118 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The CPerlBase class is licensed under the same terms as Perl itself. */
+
+/* See PerlBase.pod for documentation. */
+
+#ifndef __PerlBase_h__
+#define __PerlBase_h__
+
+#include <e32base.h>
+
+#if !defined(PERL_MINIPERL) && !defined(PERL_PERL)
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+# ifndef PERL_MULTIPLICITY
+# define PERL_MULTIPLICITY
+# endif
+# ifndef PERL_GLOBAL_STRUCT
+# define PERL_GLOBAL_STRUCT
+# endif
+# ifndef PERL_GLOBAL_STRUCT_PRIVATE
+# define PERL_GLOBAL_STRUCT_PRIVATE
+# endif
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+
+typedef enum {
+ EPerlNone,
+ EPerlAllocated,
+ EPerlConstructed,
+ EPerlParsed,
+ EPerlRunning,
+ EPerlTerminated,
+ EPerlPaused,
+ EPerlSuccess,
+ EPerlFailure,
+ EPerlDestroying
+} TPerlState;
+
+class PerlConsole;
+
+class CPerlBase : public CBase
+{
+ public:
+ CPerlBase();
+ IMPORT_C virtual ~CPerlBase();
+ IMPORT_C static CPerlBase* NewInterpreterL(TBool iCloseStdlib = ETrue,
+ void (*aStdioInitFunc)(void*) = NULL,
+ void *aStdioInitCookie = NULL);
+ IMPORT_C static CPerlBase* NewInterpreterLC(TBool iCloseStdlib = ETrue,
+ void (*aStdioInitFunc)(void*) = NULL,
+ void *aStdioInitCookie = NULL);
+ IMPORT_C TInt RunScriptL(const TDesC& aFileName, int argc = 2, char **argv = NULL, char *envp[] = NULL);
+ IMPORT_C int Parse(int argc = 0, char *argv[] = NULL, char *envp[] = NULL);
+ IMPORT_C void SetupExit();
+ IMPORT_C int Run();
+ IMPORT_C int ParseAndRun(int argc = 0, char *argv[] = 0, char *envp[] = 0);
+ IMPORT_C void Destruct();
+
+ IMPORT_C PerlInterpreter* GetInterpreter();
+
+ // These two really should be private but when not using PERLIO
+ // certain C callback functions of STDLIB need to be able to call
+ // these. In general, all the console related functionality is
+ // intentionally hidden and underdocumented.
+ int ConsoleRead(const int fd, char* buf, int n);
+ int ConsoleWrite(const int fd, const char* buf, int n);
+
+ // Having these public does not feel right, but maybe someone needs
+ // to do creative things with them.
+ int (*iReadFunc)(const int fd, char *buf, int n);
+ int (*iWriteFunc)(const int fd, const char *buf, int n);
+
+ protected:
+ PerlInterpreter* iPerl;
+#ifdef PERL_GLOBAL_STRUCT
+ struct perl_vars* iVars;
+#else
+ void* iAppCtx;
+#endif
+ TPerlState iState;
+
+ private:
+
+ void ConstructL();
+ CConsoleBase* iConsole; /* The screen. */
+ TUint16* iConsoleBuffer; /* The UTF-16 characters. */
+ TUint iConsoleUsed; /* How many in iConsoleBuffer. */
+ TBool iCloseStdlib; /* Close STDLIB on exit? */
+
+ void (*iStdioInitFunc)(void *);
+ void* iStdioInitCookie;
+
+ int ConsoleReadLine();
+ void StdioRewire(void*);
+};
+
+#define diTHX PerlInterpreter* my_perl = iPerl
+#define diVAR struct perl_vars* my_vars = iVars
+
+#ifdef PERL_GLOBAL_STRUCT
+# define PERL_APPCTX_SET(c) ((c)->iVars->Gappctx = (c))
+#else
+# define PERL_APPCTX_SET(c) (PL_appctx = (c))
+#endif
+
+#undef Copy
+#undef CopyD /* For symmetry, not for Symbian reasons. */
+#undef New
+#define PerlCopy(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
+#define PerlCopyD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
+#define PerlNew(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+
+#endif /* #ifndef __PerlBase_h__ */
+
diff --git a/symbian/PerlBase.pod b/symbian/PerlBase.pod
new file mode 100644
index 0000000000..265e2d6d8b
--- /dev/null
+++ b/symbian/PerlBase.pod
@@ -0,0 +1,202 @@
+=head1 NAME
+
+CPerlBase - a base class encapsulating a Perl interpreter
+
+=head1 SYNOPSIS
+
+ // in your App.mmp
+ USERINCLUDE \symbian\perl\x.y.z\include
+ LIBRARY perlXYZ.lib
+
+ // in your App
+ #include "PerlBase.h" // includes also EXTERN.h and perl.h
+ CPerlBase* perl = CPerlBase::NewInterpreterLC();
+ ...
+ delete perl;
+
+=head1 DESCRIPTION
+
+CPerlBase is a simple Symbian C++ class that wraps a Perl
+interpreter; its creation, use, and destroying. To understand
+what this is doing, and how to use the interpreter, a fair knowledge
+of L<perlapi>, L<perlguts>, and L<perlembed> is recommended.
+
+One useful thing CPerlBase does compared with just using the raw
+Perl C API is that it redirects the "std streams" (STDOUT et alia)
+to a text console implementation which while being very basic
+is marginally more usable than the Symbian basic text console.
+
+=head2 The Basics
+
+=over 4
+
+=item *
+
+CPerlBase* NewInterpreterL();
+
+The constructor that does not keep the object in the Symbian "cleanup stack".
+perl_alloc() and perl_construct() are called behind the curtains.
+
+Accepts the same arguments as NewInterpreterLC().
+
+=item *
+
+CPerlBase* NewInterpreterLC();
+
+The constructor that keeps the object in the Symbian "cleanup stack".
+perl_alloc() and perl_construct() are called behind the curtains.
+
+Can have three arguments:
+
+=over 8
+
+=item *
+
+TBool aCloseStdlib = ETrue
+
+Should a CPerlBase close the Symbian POSIX STDLIB when closing down.
+Good for one-shot script execution, probably less good for longer term
+embedded interpreter.
+
+=item *
+
+void (*aStdioInitFunc)(void*) = NULL
+
+If set, called with aStdioInitCookie, and the default console is
+not created. You may want to set the iReadFunc() and iWriteFunc().
+
+=item *
+
+void *aStdioInitCookie = NULL
+
+Used as the argument for aStdioInitFunc().
+
+=back
+
+=item *
+
+void Destroy();
+
+The destructor of the interpreter. The class destructor calls
+first this and then the Symbian CloseSTDLIB().
+
+perl_destruct(), perl_free(), and PERL_SYS_TERM() are called
+behind the curtains.
+
+=back
+
+=head2 Utility functions
+
+=over 4
+
+=item *
+
+int Parse(int argc = 0, char *argv[] = 0, char *envp[] = 0);
+
+Prepare an interpreter for executing by parsing input as if a C main()
+had been called. For example to parse a script, use argc of 2 and argv
+of { "perl", script_name }.
+
+All arguments are optional: in case either argc or argv are zero,
+argc of 3 and argv of { "perl", "-e", "0" } is assumed.
+
+PERL_SYS_INIT() and perl_parse() are called behind the curtains.
+
+Note that a call to Parse() is required before Run().
+
+Returns zero if parsing was successful, non-zero if not (and the stderr
+will get the error).
+
+=item *
+
+int Run()
+
+Start executing an interpeter. A Parse() must have been called before
+a Run(): use 3 and { "", "-e", 0 } if you do not have an argv.
+
+Note that a call to Parse() is required before Run().
+
+perl_run() is called behind the curtains.
+
+Returns zero if execution was successful, non-zero if not (and the stderr
+will get the error).
+
+=item *
+
+int ParseAndRun(int argc, char *argv[], char *envp[]);
+
+Combined Parse() and Run(). The Run() is not run if the Parse() fails.
+
+Returns zero if parsing and execution were successful, non-zero if not.
+
+=item *
+
+TInt RunScriptL(TDesC& aFileName, int argc, char **argv, char *envp[])
+
+Like ParseAndRun() but works for Symbian filenames (UTF-16LE).
+The UTF-8 version of aFileName is always argv[argc-1], and argv[0]
+is always "perl".
+
+=head2 Macros
+
+=over 4
+
+=item *
+
+diTHX
+
+Set up my_perl from the current object (like dTHX).
+
+=item *
+
+diVAR
+
+Set up my_vars from the current object (like dVAR).
+
+=back
+
+=head2 Extending CPerlBase (subclassing, deriving from)
+
+Note that it probably isn't worth the trouble to try to wrap the
+whole, rather large, Perl C API into a C++ API. Just use the C API.
+
+The protected members of the class are:
+
+=over 4
+
+=item *
+
+PerlInterpreter* iPerl
+
+The Perl interpreter.
+
+=item *
+
+struct perl_vars* iVars
+
+The global variables of the interpreter.
+
+=item *
+
+TPerlState iState
+
+The state of the Perl interpreter. TPerlState is one of EPerlNone,
+EPerlAllocated, EPerlConstructed, EPerlParsed, EPerlRunning,
+EPerlTerminated, EPerlPaused (these two are currently unused
+but in the future they might be used to indicate that the interpreter
+was stopped either non-resumably or resumably for some reason),
+EPerlSuccess (perl_run() succeeded), EPerlFailure (perl_run() failed),
+EPerlDestroying.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+=head1 LICENSE
+
+The CPerlBase class is licensed under the same terms as Perl itself.
+
+=cut
+
diff --git a/symbian/PerlRecog.cpp b/symbian/PerlRecog.cpp
new file mode 100644
index 0000000000..d2db54491b
--- /dev/null
+++ b/symbian/PerlRecog.cpp
@@ -0,0 +1,57 @@
+/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
+
+/* The PerlRecog application is licensed under the same terms as Perl itself. */
+
+#include <apmrec.h>
+#include <apmstd.h>
+#include <f32file.h>
+
+const TUid KUidPerlRecog = { 0x102015F7 };
+_LIT8(KPerlMimeType, "x-application/x-perl");
+_LIT8(KPerlSig, "#!/usr/bin/perl");
+const TInt KPerlSigLen = 15;
+
+class CApaPerlRecognizer : public CApaDataRecognizerType {
+ public:
+ CApaPerlRecognizer():CApaDataRecognizerType(KUidPerlRecog, EHigh) {
+ iCountDataTypes = 1;
+ }
+ virtual TUint PreferredBufSize() { return KPerlSigLen; }
+ virtual TDataType SupportedDataTypeL(TInt /* aIndex */) const {
+ return TDataType(KPerlMimeType);
+ }
+ private:
+ virtual void DoRecognizeL(const TDesC& aName, const TDesC8& aBuffer);
+};
+
+void CApaPerlRecognizer::DoRecognizeL(const TDesC& aName, const TDesC8& aBuffer)
+{
+ iConfidence = ENotRecognized;
+
+ if (aBuffer.Length() >= KPerlSigLen &&
+ aBuffer.Left(KPerlSigLen).Compare(KPerlSig) == 0) {
+ iConfidence = ECertain;
+ iDataType = TDataType(KPerlMimeType);
+ } else {
+ TParsePtrC p(aName);
+
+ if ((p.Ext().CompareF(_L(".pl")) == 0) ||
+ (p.Ext().CompareF(_L(".pm")) == 0)) {
+ iConfidence = ECertain;
+ iDataType = TDataType(KPerlMimeType);
+ }
+ }
+}
+
+EXPORT_C CApaDataRecognizerType* CreateRecognizer()
+{
+ return new CApaPerlRecognizer;
+}
+
+GLDEF_C TInt E32Dll(TDllReason /* aReason */)
+{
+ return KErrNone;
+}
+
+
+
diff --git a/symbian/PerlRecog.mmp b/symbian/PerlRecog.mmp
new file mode 100644
index 0000000000..6850103b5b
--- /dev/null
+++ b/symbian/PerlRecog.mmp
@@ -0,0 +1,9 @@
+TARGET PerlRecog.mdl
+TARGETTYPE mdl
+UID 0x10003A19 0x102015F7
+TARGETPATH \system\recogs
+SOURCE PerlRecog.cpp
+USERINCLUDE .
+SYSTEMINCLUDE \epoc32\include
+LIBRARY euser.lib efsrv.lib apmime.lib
+
diff --git a/symbian/README b/symbian/README
new file mode 100644
index 0000000000..95ed303851
--- /dev/null
+++ b/symbian/README
@@ -0,0 +1,20 @@
+The PerlApp* files are a demonstration application for the CPerlBase
+class, which is defined and implemented by the PerlBase* files.
+The rest of the files are part of the Symbian base port.
+
+All files are Copyright (c) Nokia, 2004-2005, all rights reserved,
+and licensed under the same terms as Perl itself.
+
+Once the 'sdkinstall' make target has been run in the top level,
+the PerlApp can be built using the standard Symbian way:
+
+ bldmake bldfiles
+ abld build wins udeb
+ abld build thumb urel
+
+and then packaged into a SIS by:
+
+ makesis PerlApp.pkg
+
+--
+
diff --git a/symbian/TODO b/symbian/TODO
new file mode 100644
index 0000000000..78dcd24630
--- /dev/null
+++ b/symbian/TODO
@@ -0,0 +1,150 @@
+=head1 BASE PORT
+
+=head2 Console
+
+- The Console only does "ASCII" input: e.g. pressing the "2"
+ key five times, "aaaaa", does not produce "ä" ("a diaeresis"),
+ but instead the "2" key rotates through "abc2abc2...".
+ This is a pity because the Console is actually capable of full
+ Unicode input and output (if you have the fonts, that is). You
+ can verify this by entering e.g. the euro character, which is
+ U+20AC, well beyond U+00FF. I don't know why the full repertoire
+ of the keyboard is not available.
+- Enhance the console? (line editing, full x-y movement, history)
+- The role of the console needs to be rethought: the best way
+ would be to have the console visible in the same screen as
+ the GUI elements (an "embedded console"?)
+
+=head2 Core Language
+
+- the $^E does not work
+- select() does not work (not our fault)
+- starting external application: what now (0.1.0) works is:
+ - system("app");
+ - system("app&");
+ - and those with arguments:
+ - system("app arg1 arg2")
+ - system("app arg1 arg2 &")
+ but remember that a Symbian process does get only argv[0]
+ and argv[1]: all the arguments of the application are passed
+ in as a single argument ("arg1 arg2" in the above)
+ What does not work:
+ - piped open, in either direction
+ - qx/backtick/`
+ - fork/wait (these unlikely to ever work as in POSIX)
+ - IO redirection or filename globbing in system()
+ (since there is no POSIX shell beneath)
+ What might work in future:
+ - exec() might be made to work
+ - Symbian::spawn("cmd args") returning a process id (what does Win32 do?)
+ - Symbian::waitpid($spawned_pid)
+
+=head2 Platform
+
+- 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
+ FExplorer does not open up the console
+
+=head2 Unicode
+
+- Symbian has Unicode filenames, and Unicode all over the place.
+- Encode and the use of Symbian Unicode in general
+ tie into the overall usefulness of PerlIO.
+
+=head2 Portability
+
+- Slash versus Backslash: where does one need to use "\\"?
+ writing Perl applications, where can one get away with using "/" ?
+
+=head2 Build
+
+- make xsbuild.pl much more robust (for building external extensions)
+- MakeMaker? Pure PM, PM + XS?
+- currently the PerlApp UID is in both config.pl (hardwired) and
+ in makesis.pl (computed), this is quite error prone
+- Enable building also under Cygwin?
+
+=head1 PACKAGING
+
+- subdivide perlext.sis?
+- pm-stripper: strip pod and comments, while inserting the appropriate
+ #line commands to keep linenumbers in sync. Shaves off easily 50%
+ of the code, making install packages smaller.
+- Get MakeMaker to create SIS packages? In non-Win32?
+- Symbian has APIs for opening .zip files
+- Investigate Autrijus Tang's PAR format
+ http://www.autrijus.org/par-intro/
+- "makeplsis" to wrap a script.pl or dir/script.pl as a stand-alone
+ application (and SIS): unshift the "application home" to @INC and
+ chdir to that, then run the script.pl (renamed as default.pl)
+
+=head1 PerlBase
+
+- review for proper Symbian coding practices
+
+=head1 PerlApp
+
+- In "Run" see how one could show also the file extensions.
+- when autostarting also offer to display the file (via Notes?)
+ instead of installing/running it?
+- Allow passing command line options to scripts being run?
+- Add "OneLiner" menu item? (-e, -M) (requires a UI form)
+- Terminate/Pause menu entries?
+- review for proper Symbian coding practices
+
+=head1 CORE LIBRARIES
+
+- Fix Devel::PPPort (worth it?) (Note that there is D::PPP 3.x out by now)
+- Fix Encode to not to have writeable data: seems to be tricky indeed
+ because of copious global non-const data.
+- Verify that the modified File::Spec::Win32 does work in Symbian.
+ (File::Spec::Epoc does not seem to be relevant?)
+- What does Cwd really do since the concept of cwd is a bit fuzzy in Symbian.
+- What should Sys::Hostname return? GPRS? BT? WLAN?
+- ByteLoader problem: byterun.c does not see VERSION and XS_VERSION.
+- POSIX problem: STDLIB POSIX is not that POSIX.
+
+=head1 REGRESSION SUITE
+
+- how to run the standard test suite on a Symbian device?
+
+=head1 CPAN LIBRARIES
+
+- Include/Package more modules (or work harder on getting CPAN.pm working?)
+ (but note that lib/**/*.pm is 3.5 megabytes, probably not worth including
+ all of it, even after pm-stripping):
+ - libnet
+ - Bundle::CPAN
+ - Archive::Tar
+ - Compress::Zlib (zlib?) (there is builtin gz support)
+ - Term::ReadKey (useless?)
+ - Term::ReadLine (useless?)
+ - Bundle::LWP
+ - URI
+ - HTML::TagSet
+ - HTML::Parser
+ - HTML::Entities
+ - HTML::HeadParser
+ - LWP
+ - Crypt::SSLeay? (ssl?)
+ - IO::Zlib? (zlib?)
+ - IMAP?
+ - Net::Telnet?
+ - Archive::Zip?
+ - Mail::Send?
+ - Date::Calc?
+ - XML? XML::Simple? (expat?) (there is builtin xml support)
+ - RSS?
+ - DBI
+ - DBD::SQLite? (sqlite?)
+ - SOAP? XML-RPC?
+
+=head1 FUTURE POSSIBILITIES
+
+- Remote console (Bluetooth/IR)
+- S60 GUI support
+- S60 PDA support
+- Phone APIs
+- S80
+- UIQ
diff --git a/symbian/bld.inf b/symbian/bld.inf
new file mode 100644
index 0000000000..c4489677f0
--- /dev/null
+++ b/symbian/bld.inf
@@ -0,0 +1,4 @@
+PRJ_MMPFILES
+PerlApp.mmp
+PerlRecog.mmp
+
diff --git a/symbian/config.pl b/symbian/config.pl
new file mode 100644
index 0000000000..e2cd2c682a
--- /dev/null
+++ b/symbian/config.pl
@@ -0,0 +1,768 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+use strict;
+use lib "symbian";
+
+print "Configuring...\n";
+print "Configuring with: Perl version $] ($^X)\n";
+
+do "sanity.pl";
+
+my %VERSION = %{ do "version.pl" };
+
+printf "Configuring for: Perl version $VERSION{REVISION}.%03d%03d\n",
+ $VERSION{VERSION}, $VERSION{SUBVERSION};
+
+my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+my $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+
+my $SDK = do "sdk.pl";
+my %PORT = %{ do "port.pl" };
+
+my ( $SYMBIAN_VERSION, $SDK_VERSION ) = ( $SDK =~ m!\\Symbian\\(.+?)\\(.+)$! );
+
+if ($SDK eq 'C:\Symbian\Series60_1_2_CW') {
+ ( $SYMBIAN_VERSION, $SDK_VERSION ) = qw(6.1 1.2);
+}
+
+my $WIN = $ENV{WIN} ; # 'wins', 'winscw' (from sdk.pl)
+my $ARM = 'thumb'; # 'thumb', 'armi'
+my $S60SDK = $ENV{S60SDK}; # qw(1.2 2.0 2.1 2.6) (from sdk.pl)
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+my $UARM = $ENV{UARM}; # from sdk.pl
+
+die "$0: SDK not recognized\n"
+ if !defined($SYMBIAN_VERSION) || !defined($SDK_VERSION) || !defined($S60SDK);
+
+die "$0: does not know which Windows compiler to use\n"
+ unless defined $WIN;
+
+print "Symbian $SYMBIAN_VERSION SDK $S60SDK ($WIN) installed at $SDK\n";
+
+my $CWD = do "cwd.pl";
+print "Build directory $CWD\n";
+
+die "$0: '+' in cwd does not work with SDK 1.2\n"
+ if $S60SDK eq '1.2' && $CWD =~ /\+/;
+
+my @unclean;
+my @mmp;
+
+sub create_mmp {
+ my ( $target, $type, @x ) = @_;
+ my $miniperl = $target eq 'miniperl';
+ my $perl = $target eq 'perl';
+ my $mmp = "$target.mmp";
+ my $targetpath = $miniperl
+ || $perl ? "TARGETPATH\t\\System\\Apps\\Perl" : "";
+ if ( open( my $fh, ">$mmp" ) ) {
+ print "\t$mmp\n";
+ push @mmp, $mmp;
+ push @unclean, $mmp;
+ print $fh <<__EOF__;
+TARGET $target.$type
+TARGETTYPE $type
+$targetpath
+EPOCHEAPSIZE 1024 8388608
+EPOCSTACKSIZE 65536
+EXPORTUNFROZEN
+SRCDBG
+__EOF__
+ print $fh "MACRO\t__SERIES60_1X__\n" if $S60SDK =~ /^1\./;
+ print $fh "MACRO\t__SERIES60_2X__\n" if $S60SDK =~ /^2\./;
+ my ( @c, %c );
+ @c = map { glob } qw(*.c); # Find the .c files.
+ @c = map { lc } @c; # Lowercase the names.
+ @c = grep { !/malloc\.c/ } @c; # Use the system malloc.
+ @c = grep { !/main\.c/ } @c; # main.c must be explicit.
+ push @c, map { lc } @x;
+ @c = map { s:^\.\./::; $_ } @c; # Remove the leading ../
+ @c = map { $c{$_}++ } @c; # Uniquefy.
+ @c = sort keys %c; # Beautify.
+
+ for (@c) {
+ print $fh "SOURCE\t\t$_\n";
+ }
+ print $fh <<__EOF__;
+SOURCEPATH $CWD
+USERINCLUDE $CWD
+USERINCLUDE $CWD\\ext\\DynaLoader
+USERINCLUDE $CWD\\symbian
+SYSTEMINCLUDE \\epoc32\\include\\libc
+SYSTEMINCLUDE \\epoc32\\include
+LIBRARY euser.lib
+LIBRARY estlib.lib
+__EOF__
+ if ( $miniperl || $perl || $type eq 'dll' ) {
+ print $fh <<__EOF__;
+LIBRARY charconv.lib
+LIBRARY commonengine.lib
+LIBRARY hal.lib
+LIBRARY estor.lib
+__EOF__
+ }
+ if ( $type eq 'exe' ) {
+ print $fh <<__EOF__;
+STATICLIBRARY ecrt0.lib
+__EOF__
+ }
+ if ($miniperl) {
+ print $fh <<__EOF__;
+MACRO PERL_MINIPERL
+__EOF__
+ }
+ if ($perl) {
+ print $fh <<__EOF__;
+MACRO PERL_PERL
+__EOF__
+ }
+ print $fh <<__EOF__;
+MACRO PERL_CORE
+MACRO MULTIPLICITY
+MACRO PERL_IMPLICIT_CONTEXT
+__EOF__
+ unless ( $miniperl || $perl ) {
+ print $fh <<__EOF__;
+MACRO PERL_GLOBAL_STRUCT
+MACRO PERL_GLOBAL_STRUCT_PRIVATE
+__EOF__
+ }
+ close $fh;
+ }
+ else {
+ warn "$0: failed to open $mmp for writing: $!\n";
+ }
+}
+
+sub create_bld_inf {
+ if ( open( BLD_INF, ">bld.inf" ) ) {
+ print "\tbld.inf\n";
+ push @unclean, "bld.inf";
+ print BLD_INF <<__EOF__;
+PRJ_PLATFORMS
+${WIN} ${ARM}
+PRJ_MMPFILES
+__EOF__
+ for (@mmp) { print BLD_INF $_, "\n" }
+ close BLD_INF;
+ }
+ else {
+ warn "$0: failed to open bld.inf for writing: $!\n";
+ }
+}
+
+my %config;
+
+sub load_config_sh {
+ if ( open( CONFIG_SH, "symbian/config.sh" ) ) {
+ while (<CONFIG_SH>) {
+ if (/^(\w+)=['"]?(.*?)["']?$/) {
+ my ( $var, $val ) = ( $1, $2 );
+ $val =~ s/x.y.z/$R_V_SV/gi;
+ $val =~ s/thumb/$ARM/gi;
+ $val = "'$SYMBIAN_VERSION'" if $var eq 'osvers';
+ $val = "'$SDK_VERSION'" if $var eq 'sdkvers';
+ $config{$var} = $val;
+ }
+ }
+ close CONFIG_SH;
+ }
+ else {
+ warn "$0: failed to open symbian\\config.sh for reading: $!\n";
+ }
+}
+
+sub create_config_h {
+ load_config_sh();
+ if ( open( CONFIG_H, ">config.h" ) ) {
+ print "\tconfig.h\n";
+ push @unclean, "config.h";
+ if ( open( CONFIG_H_SH, "config_h.SH" ) ) {
+ while (<CONFIG_H_SH>) {
+ last if /\#ifndef _config_h_/;
+ }
+ print CONFIG_H <<__EOF__;
+/*
+ * Package name : perl
+ * Source directory : .
+ * Configuration time:
+ * Configured by :
+ * Target system : symbian
+ */
+
+#ifndef _config_h_
+__EOF__
+ while (<CONFIG_H_SH>) {
+ last if /!GROK!THIS/;
+ s/\$(\w+)/exists $config{$1} ? $config{$1} : ""/eg;
+ s/^#undef\s+(\S+).+/#undef $1/g;
+ s:\Q/**/::;
+ print CONFIG_H;
+ }
+ close CONFIG_H_SH;
+ }
+ else {
+ warn "$0: failed to open ../config_h.SH for reading: $!\n";
+ }
+ close CONFIG_H;
+ }
+ else {
+ warn "$0: failed to open config.h for writing: $!\n";
+ }
+}
+
+sub create_DynaLoader_cpp {
+ print "\text\\DynaLoader\\DynaLoader.cpp\n";
+ system(
+q[perl -Ilib lib\ExtUtils\xsubpp ext\DynaLoader\dl_symbian.xs >ext\DynaLoader\DynaLoader.cpp]
+ ) == 0
+ or die "$0: creating DynaLoader.cpp failed: $!\n";
+ push @unclean, 'ext\DynaLoader\DynaLoader.cpp';
+
+}
+
+sub create_symbian_port_h {
+ print "\tsymbian\\symbian_port.h\n";
+ if ( open( SYMBIAN_PORT_H, ">symbian/symbian_port.h" ) ) {
+ $S60SDK =~ /^(\d+)\.(\d+)$/;
+ my ($sdkmajor, $sdkminor) = ($1, $2);
+ print SYMBIAN_PORT_H <<__EOF__;
+/* Copyright (c) 2004-2005, Nokia. All rights reserved. */
+
+#ifndef __symbian_port_h__
+#define __symbian_port_h__
+
+#define PERL_SYMBIANPORT_MAJOR $PORT{dll}->{MAJOR}
+#define PERL_SYMBIANPORT_MINOR $PORT{dll}->{MINOR}
+#define PERL_SYMBIANPORT_PATCH $PORT{dll}->{PATCH}
+
+#define PERL_SYMBIANSDK_FLAVOR L"Series 60"
+#define PERL_SYMBIANSDK_MAJOR $sdkmajor
+#define PERL_SYMBIANSDK_MINOR $sdkminor
+
+#endif /* #ifndef __symbian_port_h__ */
+__EOF__
+ close(SYMBIAN_PORT_H);
+ push @unclean, 'symbian\symbian_port.h';
+ }
+ else {
+ warn "$0: failed to open symbian/symbian_port.h for writing: $!\n";
+ }
+}
+
+sub create_perlmain_c {
+ print "\tperlmain.c\n";
+ system(
+q[perl -ne "print qq[ char *file = __FILE__;\n] if /dXSUB_SYS/;print;print qq[ newXS(\"DynaLoader::boot_DynaLoader\", boot_DynaLoader, file);\n] if /dXSUB_SYS/;print qq[EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);\n] if /Do not delete this line/" miniperlmain.c > perlmain.c]
+ ) == 0
+ or die "$0: Creating perlmain.c failed: $!\n";
+ push @unclean, 'perlmain.c';
+}
+
+sub create_PerlApp_pkg {
+ print "\tsymbian\\PerlApp.pkg\n";
+ if ( open( PERLAPP_PKG, ">symbian\\PerlApp.pkg" ) ) {
+ my $APPS = $UREL;
+ if ($S60SDK ne '1.2' || $SDK =~ m/_CW$/) { # Do only if not in 1.2 VC.
+ $APPS =~ s!\\epoc32\\release\\(.+)\\$UARM$!\\epoc32\\data\\z\\system\\apps\\PerlApp!i;
+ }
+ print PERLAPP_PKG <<__EOF__;
+; !!!!!! DO NOT EDIT THIS FILE !!!!!!
+; This file is built by symbian\\config.pl.
+; Any changes made here will be lost!
+;
+; PerlApp.pkg
+;
+; Note that the demo_pl needs to be run to create the demo .pl scripts.
+;
+; Languages
+&EN;
+
+; Standard SIS file header
+#{"PerlApp"},(0x102015F6),0,1,0
+
+; Supports Series 60 v0.9
+(0x101F6F88), 0, 0, 0, {"Series60ProductID"}
+
+; Files
+"$UREL\\PerlApp.APP"-"!:\\system\\apps\\PerlApp\\PerlApp.app"
+"$UREL\\PerlRecog.mdl"-"!:\\system\\recogs\\PerlRecog.mdl"
+"$APPS\\PerlApp.rsc"-"!:\\system\\apps\\PerlApp\\PerlApp.rsc"
+"$APPS\\PerlApp.aif"-"!:\\system\\apps\\PerlApp\\PerlApp.aif"
+__EOF__
+ if ( open( DEMOS, "perl symbian\\demo_pl list |" ) ) {
+ while (<DEMOS>) {
+ chomp;
+ print PERLAPP_PKG qq["$_"-"!:\\Perl\\$_"\n];
+ }
+ close(DEMOS);
+ }
+ close(PERLAPP_PKG);
+ }
+ else {
+ die "$0: symbian\\PerlApp.pkg: $!\n";
+ }
+ push @unclean, 'symbian\PerlApp.pkg';
+}
+
+print "Creating...\n";
+create_mmp(
+ 'miniperl', 'exe',
+ 'miniperlmain.c', 'symbian\symbian_stubs.c',
+ 'symbian\PerlBase.cpp', 'symbian\symbian_utils.cpp',
+);
+create_mmp(
+ "perl", 'exe',
+ 'perlmain.c', 'symbian\symbian_stubs.c',
+ 'symbian\symbian_utils.cpp', 'symbian\PerlBase.cpp',
+ 'ext\DynaLoader\DynaLoader.cpp',
+);
+
+create_mmp(
+ "perl$VERSION", 'dll',
+ 'symbian\symbian_dll.cpp', 'symbian\symbian_stubs.c',
+ 'symbian\symbian_utils.cpp', 'symbian\PerlBase.cpp',
+ 'ext\DynaLoader\DynaLoader.cpp',
+);
+
+create_bld_inf();
+create_config_h();
+create_perlmain_c();
+create_symbian_port_h();
+create_DynaLoader_cpp();
+create_PerlApp_pkg();
+
+if ( open( PERLAPP_MMP, ">symbian/PerlApp.mmp" ) ) {
+ my @MACRO;
+ push @MACRO, '__SERIES60_1X__' if $S60SDK =~ /^1\./;
+ push @MACRO, '__SERIES60_2X__' if $S60SDK =~ /^2\./;
+ print PERLAPP_MMP <<__EOF__;
+// !!!!!! DO NOT EDIT THIS FILE !!!!!!
+// This file is built by symbian\\config.pl.
+// Any changes made here will be lost!
+TARGET PerlApp.app
+TARGETTYPE app
+UID 0x100039CE 0x102015F6
+TARGETPATH \\system\\apps\\PerlApp
+SRCDBG
+EXPORTUNFROZEN
+SOURCEPATH .
+SOURCE PerlApp.cpp
+
+RESOURCE PerlApp.rss
+
+USERINCLUDE .
+USERINCLUDE ..
+USERINCLUDE \\symbian\\perl\\$R_V_SV\\include
+
+SYSTEMINCLUDE \\epoc32\\include
+SYSTEMINCLUDE \\epoc32\\include\\libc
+
+LIBRARY apparc.lib
+LIBRARY avkon.lib
+LIBRARY bafl.lib
+LIBRARY charconv.lib
+LIBRARY commondialogs.lib
+LIBRARY cone.lib
+LIBRARY efsrv.lib
+LIBRARY eikcore.lib
+LIBRARY estlib.lib
+LIBRARY euser.lib
+LIBRARY perl$VERSION.lib
+
+AIF PerlApp.aif . PerlAppAif.rss
+__EOF__
+ if (@MACRO) {
+ for my $macro (@MACRO) {
+ print PERLAPP_MMP <<__EOF__;
+MACRO $macro
+__EOF__
+ }
+ }
+ close(PERLAPP_MMP);
+ push @unclean, 'symbian\PerlApp.mmp';
+}
+else {
+ warn "$0: failed to create symbian\\PerlApp.mmp";
+}
+
+if ( open( MAKEFILE, ">Makefile" ) ) {
+ my $perl = "perl$VERSION";
+ my $windef1 = "$SDK\\Epoc32\\Build$CWD\\$perl\\$WIN\\$perl.def";
+ my $windef2 = "..\\BWINS\\${perl}u.def";
+ my $armdef1 = "$SDK\\Epoc32\\Build$CWD\\$perl\\$ARM\\$perl.def";
+ my $armdef2 = "..\\BMARM\\${perl}u.def";
+ print "\tMakefile\n";
+ print MAKEFILE <<__EOF__;
+help:
+ \@echo === Perl for Symbian ===
+ \@echo Useful targets:
+ \@echo all win arm clean
+ \@echo perldll.sis perlext.sis perlsdk.zip
+
+WIN = ${WIN}
+ARM = ${ARM}
+
+all: build
+
+build: rename_makedef build_win build_arm
+
+@unclean: symbian\\config.pl
+ perl symbian\\config.pl
+
+build_win: abld.bat win_perl.mf win_miniperl.mf win_${VERSION}.mf perldll_win
+
+build_vc6: abld.bat win_perl.mf win_miniperl.mf win_${VERSION}.mf vc6.mf perldll_win
+
+build_arm: abld.bat perl_arm miniperl_arm arm_${VERSION}.mf perldll_arm
+
+miniperl_win: miniperl.mmp abld.bat win_miniperl.mf rename_makedef
+ abld build \$(WIN) udeb miniperl
+
+miniperl_arm: miniperl.mmp abld.bat arm_miniperl.mf rename_makedef
+ abld build \$(ARM) $UARM miniperl
+
+miniperl: miniperl_win miniperl_arm
+
+perl: perl_win perl_arm
+
+perl_win: perl.mmp abld.bat win_perl.mf rename_makedef
+ abld build \$(WIN) perl
+
+perl_arm: perl.mmp abld.bat arm_perl.mf rename_makedef
+ abld build \$(ARM) $UARM perl
+
+perldll_win: perl${VERSION}_win freeze_win perl${VERSION}_win
+
+perl${VERSION}_win: perl$VERSION.mmp abld.bat rename_makedef
+ abld build \$(WIN) perl$VERSION
+
+perldll_arm: perl${VERSION}_arm freeze_arm perl${VERSION}_arm
+
+perl${VERSION}_arm: perl$VERSION.mmp arm_${VERSION}.mf abld.bat rename_makedef
+ abld build \$(ARM) $UARM perl$VERSION
+
+perldll perl$VERSION: perldll_win perldll_arm
+
+win: miniperl_win perl_win perldll_win
+
+arm: miniperl_arm perl_arm perldll_arm
+
+rename_makedef:
+ -ren makedef.pl nomakedef.pl
+
+# Symbian SDK has a makedef.pl of its own,
+# and we don't need Perl's.
+rerename_makedef:
+ -ren nomakedef.pl makedef.pl
+
+abld.bat abld: bld.inf
+ bldmake bldfiles
+
+makefiles: win.mf arm.mf vc6.mf
+
+vc6: win.mf vc6.mf build_vc6
+
+win_miniperl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) miniperl
+ echo > win_miniperl.mf
+
+win_perl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) perl
+ echo > win_perl.mf
+
+win_${VERSION}.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) perl${VERSION}
+ echo > win_${VERSION}.mf
+
+symbian\\win.mf:
+ cd symbian; make win.mf
+
+win.mf: win_miniperl.mf win_perl.mf win_${VERSION}.mf symbian\\win.mf
+
+arm_miniperl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) miniperl
+ echo > arm_miniperl.mf
+
+arm_perl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) perl
+ echo > arm_perl.mf
+
+arm_${VERSION}.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) perl${VERSION}
+ echo > arm_${VERSION}.mf
+
+arm.mf: arm_miniperl.mf arm_perl.mf arm_${VERSION}.mf
+
+vc6.mf: abld.bat symbian\\config.pl
+ abld makefile vc6
+ echo > vc6.mf
+
+PM = lib\\Config.pm lib\\Cross.pm lib\\lib.pm ext\\DynaLoader\\DynaLoader.pm ext\\DynaLoader\\XSLoader.pm ext\\Errno\\Errno.pm
+POD = lib\\Config.pod
+
+pm: \$(PM)
+
+XLIB = -Ixlib\\symbian
+
+XSBOPT = --win=\$(WIN) --arm=\$(ARM)
+
+lib\\Config.pm:
+ copy symbian\\config.sh config.sh
+ perl -pi.bak -e "s:x\\.y\\.z+:$R_V_SV:g" config.sh
+ perl \$(XLIB) configpm --cross=symbian
+ copy xlib\\symbian\\Config.pm lib\\Config.pm
+ perl -pi.bak -e "s:x\\.y\\.z:$R_V_SV:g" lib\\Config.pm
+ perl -pi.bak -e "s:5\\.\\d+\\.\\d+:$R_V_SV:g" lib\\Config.pm
+ -perl -pi.bak -e "s:x\\.y\\.z:$R_V_SV:g" xlib\\symbian\\Config_heavy.pl
+
+lib\\lib.pm:
+ perl lib\\lib_pm.PL
+
+ext\\DynaLoader\\DynaLoader.pm:
+ -del /f ext\\DynaLoader\\DynaLoader.pm
+ perl -Ixlib\\symbian ext\\DynaLoader\\DynaLoader_pm.PL
+ perl -pi.bak -e "s/__END__//" DynaLoader.pm
+ copy /y DynaLoader.pm ext\\DynaLoader\\DynaLoader.pm
+ -del /f DynaLoader.pm DynaLoader.pm.bak
+
+ext\\DynaLoader\\XSLoader.pm:
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) XSLoader
+
+ext\\Errno\\Errno.pm:
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) Errno
+
+miniperlexe.sis: miniperl_arm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl miniperl
+
+perlexe.sis: perl_arm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl perl
+
+
+allsis: all miniperlexe.sis perlexe.sis perldll.sis perllib.sis perlext.sis perlapp.sis
+
+perldll.sis perl$VERSION.sis: perldll_arm pm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl perl${VERSION}dll
+
+perllib.sis: \$(PM)
+ perl \$(XLIB) symbian\\makesis.pl perl${VERSION}lib
+
+perlext.sis: perldll_arm buildext_sis
+ perl symbian\\makesis.pl perl${VERSION}ext
+
+EXT = Cwd Data::Dumper Devel::Peek Digest::MD5 Errno Fcntl File::Glob Filter::Util::Call IO List::Util MIME::Base64 PerlIO::scalar PerlIO::via SDBM_File Socket Storable Time::HiRes XSLoader attrs
+
+buildext: perldll symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) \$(EXT)
+
+buildext_sis: perldll.sis symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --sis \$(EXT)
+
+cleanext: symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --clean \$(EXT)
+
+distcleanext: symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --distclean \$(EXT)
+
+sis makesis: miniperl perl perldll pm buildext perlapp.sis
+ perl \$(XLIB) symbian\\makesis.pl
+
+APIDIR = \\Symbian\\perl\\$R_V_SV
+
+sdkinstall:
+ -mkdir \\Symbian\\perl
+ -mkdir \\Symbian\\perl\\$R_V_SV
+ -mkdir \$(APIDIR)\\include
+ -mkdir \$(APIDIR)\\include\\symbian
+ -mkdir \$(APIDIR)\\lib
+ -mkdir \$(APIDIR)\\lib\\ExtUtils
+ -mkdir \$(APIDIR)\\pod
+ -mkdir \$(APIDIR)\\bin
+ -mkdir \$(BINDIR)
+ copy /y *.h \$(APIDIR)\\include
+ - copy /y *.inc \$(APIDIR)\\include
+ copy /y lib\\ExtUtils\\xsubpp \$(APIDIR)\\lib\\ExtUtils
+ copy /y lib\\ExtUtils\\typemap \$(APIDIR)\\lib\\ExtUtils
+ copy /y symbian\\xsbuild.pl \$(APIDIR)\\bin
+ copy /y symbian\\PerlBase.h \$(APIDIR)\\include
+ copy /y symbian\\symbian*.h \$(APIDIR)\\include\\symbian
+ copy /y symbian\\PerlBase.pod \$(APIDIR)\\pod
+
+RELDIR = $SDK\\epoc32\\release
+RELWIN = \$(RELDIR)\\\$(WIN)\\udeb
+RELARM = \$(RELDIR)\\\$(ARM)\\$UARM
+
+perlsdk.zip: perldll sdkinstall
+ zip -r perl${VERSION}sdk.zip \$(RELWIN)\\perl$VERSION.* \$(RELARM)\\perl$VERSION.* \$(APIDIR)
+ \@echo perl${VERSION}sdk.zip created.
+
+perlapp: sdkinstall perlapp_win perlapp_arm
+
+perlapp_win: config.h
+ cd symbian; make perlapp_win
+
+perlapp_arm: config.h
+ cd symbian; make perlapp_arm
+
+perlapp_demo_extract:
+ cd symbian; make perlapp_demo_extract
+
+perlapp.sis: perlapp_arm
+ cd symbian; make perlapp.sis
+
+perlapp.zip:
+ cd symbian; zip perlapp.zip PerlApp.* PerlRecog.* PerlBase.* demo_pl
+
+zip: perlsdk.zip perlapp.zip
+
+freeze: freeze_win freeze_arm
+
+freeze_win:
+ abld freeze \$(WIN) perl$VERSION
+
+freeze_arm:
+ abld freeze \$(ARM) perl$VERSION
+
+defrost: defrost_win defrost_arm
+
+defrost_win:
+ -del /f $windef1
+ -del /f $windef2
+
+defrost_arm:
+ -del /f $armdef1
+ -del /f $armdef2
+
+clean_win: abld.bat
+ abld clean \$(WIN)
+
+clean_arm: abld.bat
+ abld clean \$(ARM)
+
+clean: clean_win clean_arm rerename_makedef
+ -del /f \$(PM)
+ -del /f \$(POD)
+ -del /f lib\\Config.pm.bak
+ -del /f xlib\\symbian\\Config_heavy.pl
+ -rmdir /s /q xlib
+ -del /f config.sh
+ -del /f DynaLoader.pm ext\\DynaLoader\\DynaLoader.pm
+ -del /f ext\\DynaLoader\\Makefile
+ -del /f ext\\SDBM_File\\sdbm\\Makefile
+ -del /f symbian\\*.lst
+ -del /f abld.bat @unclean *.pkg *.sis *.zip
+ -del /f symbian\\abld.bat symbian\\*.sis symbian\\*.zip
+ -del /f symbian\\perl5*.pkg symbian\\miniperl.pkg
+ -del arm_*.mf win_*.mf vc6*.mf
+ -perl symbian\\xsbuild.pl \$(XSBOPT) --clean \$(EXT)
+ -rmdir /s /q perl${VERSION}_Data
+ -cd symbian; make clean
+
+reallyclean: abld.bat
+ abld reallyclean
+
+distclean: defrost reallyclean clean
+ -perl symbian\\xsbuild.pl \$(XSBOPT) --distclean \$(EXT)
+ -del /f config.h config.sh.bak symbian\\symbian_port.h
+ -del /f Makefile symbian\\PerlApp.mmp
+ -del /f BMARM\\*.def
+ -del /f *.cwlink *.resources *.pref
+ -del /f perl${VERSION}.xml perl${VERSION}.mcp uid.cpp
+ -rmdir /s /q BMARM
+ cd symbian; make distclean
+ -del /f symbian\\Makefile
+__EOF__
+ close MAKEFILE;
+}
+else {
+ warn "$0: failed to create Makefile: $!\n";
+}
+
+if ( open( MAKEFILE, ">symbian/Makefile")) {
+ my $wrap = $S60SDK eq '1.2' && $SDK !~ /_CW$/;
+ my $ABLD = $wrap ? 'perl b.pl': 'abld';
+ print "\tsymbian/Makefile\n";
+ print MAKEFILE <<__EOF__;
+WIN = $WIN
+ARM = $ARM
+ABLD = $ABLD
+
+abld.bat:
+ bldmake bldfiles
+
+perlapp_win: abld.bat ..\\config.h PerlApp.h PerlApp.cpp
+ bldmake bldfiles
+ \$(ABLD) build \$(WIN) udeb
+
+perlapp_arm: ..\\config.h PerlApp.h PerlApp.cpp
+ bldmake bldfiles
+ \$(ABLD) build \$(ARM) $UARM
+
+win.mf:
+ bldmake bldfiles
+ abld makefile vc6
+
+perlapp_demo_extract:
+ perl demo_pl extract
+
+perlapp.sis: perlapp_arm perlapp_demo_extract
+ -del /f perlapp.SIS
+ makesis perlapp.pkg
+ copy /y perlapp.SIS ..\\perlapp.SIS
+
+clean:
+ -perl demo_pl cleanup
+ -del /f perlapp.sis
+ -del /f b.pl
+
+distclean: clean
+ -del /f *.cwlink *.resources *.pref
+ -del /f PerlApp.xml PerlApp.mcp uid.cpp
+ -rmdir /s /q PerlApp_Data
+ -del /f abld.bat
+__EOF__
+ close(MAKEFILE);
+ if ($wrap) {
+ if ( open( B_PL, ">symbian/b.pl")) {
+ print B_PL <<'__EOF__';
+# abld.pl wrapper.
+
+# nmake doesn't like MFLAGS and MAKEFLAGS being set to -w and w.
+delete $ENV{MFLAGS};
+delete $ENV{MAKEFLAGS};
+
+system("abld @ARGV");
+__EOF__
+ close(B_PL);
+ } else {
+ warn "$0: failed to create symbian/b.pl: $!\n";
+ }
+ }
+} else {
+ warn "$0: failed to create symbian/Makefile: $!\n";
+}
+
+print "Deleting...\n";
+for my $config (
+ # Do not delete config.h here.
+ "config.sh",
+ "lib\\Config.pm",
+ "xlib\\symbian\\Config.pm",
+ "xlib\\symbian\\Config_heavy.pl",
+ ) {
+ print "\t$config\n";
+ unlink($config);
+}
+
+print <<__EOM__;
+Configuring done.
+Now you can run:
+ make all
+ make allsis
+__EOM__
+
+1; # Happy End.
diff --git a/symbian/config.sh b/symbian/config.sh
new file mode 100644
index 0000000000..1c1fa01b99
--- /dev/null
+++ b/symbian/config.sh
@@ -0,0 +1,768 @@
+#!\\bin\\sh
+PERL_CONFIG_SH='true'
+_a='.a'
+_o='.o'
+afs='false'
+afsroot='/afs'
+alignbytes='4'
+apiversion='5.005'
+ar=':'
+archlib='\\system\\libs\\perl\\x.y.z\\thumb-symbian'
+archlibexp='\\system\\libs\\perl\\x.y.z\\thumb-symbian'
+archname='thumb-symbian'
+asctime_r_proto='0'
+bin='\\system\\apps\\perl'
+binexp='\\system\\apps\\perl'
+bincompat5005='n'
+byteorder='1234'
+castflags='0'
+cc='gcc'
+cccdlflags=''
+ccdlflags=''
+charsize='1'
+clocktype='clock_t'
+cpp_stuff='42'
+cppminus='-'
+cpprun='gcc -E'
+cppstdin='gcc -E'
+crypt_r_proto='0'
+ctermid_r_proto='0'
+ctime_r_proto='0'
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
+d_PRId64='undef'
+d_PRIeldbl='undef'
+d_PRIfldbl='undef'
+d_PRIgldbl='undef'
+d_PRIi64='undef'
+d_PRIo64='undef'
+d_PRIu64='undef'
+d_PRIx64='undef'
+d_SCNfldbl='undef'
+d__fwalk='undef'
+d_access='undef'
+d_accessx='undef'
+d_aintl='undef'
+d_alarm='undef'
+d_archlib='define'
+d_asctime_r='undef'
+d_atolf='undef'
+d_atoll='undef'
+d_attribut='undef'
+d_bcmp='undef'
+d_bcopy='undef'
+d_bsd='undef'
+d_bsdgetpgrp='undef'
+d_bsdsetpgrp='undef'
+d_bzero='undef'
+d_casti32='undef'
+d_castneg='undef'
+d_charvspr='undef'
+d_chown='undef'
+d_chroot='undef'
+d_chsize='undef'
+d_class='undef'
+d_closedir='undef'
+d_cmsghdr_s='undef'
+d_const='define'
+d_copysignl='undef'
+d_crypt='undef'
+d_crypt_r='undef'
+d_csh='undef'
+d_ctermid_r='undef'
+d_ctime_r='undef'
+d_cuserid='undef'
+d_dbl_dig='undef'
+d_dbminitproto='undef'
+d_difftime='undef'
+d_dirfd='undef'
+d_dirnamlen='define'
+d_dlerror='undef'
+d_dlopen='undef'
+d_dlsymun='undef'
+d_dosuid='undef'
+d_drand48_r='undef'
+d_drand48proto='undef'
+d_dup2='undef'
+d_eaccess='undef'
+d_endgrent='undef'
+d_endgrent_r='undef'
+d_endhent='undef'
+d_endhostent_r='undef'
+d_endnent='undef'
+d_endnetent_r='undef'
+d_endpent='undef'
+d_endprotoent_r='undef'
+d_endpwent='undef'
+d_endpwent_r='undef'
+d_endsent='undef'
+d_endservent_r='undef'
+d_eofnblk='undef'
+d_eunice='undef'
+d_faststdio='undef'
+d_fchdir='undef'
+d_fchmod='undef'
+d_fchown='undef'
+d_fcntl='undef'
+d_fcntl_can_lock='undef'
+d_fd_macros='undef'
+d_fd_set='undef'
+d_fds_bits='undef'
+d_fgetpos='undef'
+d_finite='undef'
+d_finitel='undef'
+d_flexfnam='undef'
+d_flock='undef'
+d_flockproto='undef'
+d_fork='undef'
+d_fp_class='undef'
+d_fpathconf='undef'
+d_fpclass='undef'
+d_fpclassify='undef'
+d_fpclassl='undef'
+d_fpos64_t='undef'
+d_frexpl='undef'
+d_fs_data_s='undef'
+d_fseeko='undef'
+d_fsetpos='define'
+d_fstatfs='undef'
+d_fstatvfs='undef'
+d_fsync='undef'
+d_ftello='undef'
+d_ftime='undef'
+d_getcwd='define'
+d_getespwnam='undef'
+d_getfsstat='undef'
+d_getgrent='undef'
+d_getgrent_r='undef'
+d_getgrgid_r='undef'
+d_getgrnam_r='undef'
+d_getgrps='undef'
+d_gethbyaddr='define'
+d_gethbyname='define'
+d_gethent='undef'
+d_gethname='define'
+d_gethostbyaddr_r='undef'
+d_gethostbyname_r='undef'
+d_gethostent_r='undef'
+d_gethostprotos='define'
+d_getitimer='undef'
+d_getlogin='undef'
+d_getlogin_r='undef'
+d_getmnt='undef'
+d_getmntent='undef'
+d_getnbyaddr='undef'
+d_getnbyname='undef'
+d_getnent='undef'
+d_getnetbyaddr_r='undef'
+d_getnetbyname_r='undef'
+d_getnetent_r='undef'
+d_getnetprotos='undef'
+d_getpagsz='undef'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='undef'
+d_getpgid='undef'
+d_getpgrp2='undef'
+d_getpgrp='undef'
+d_getppid='undef'
+d_getprior='undef'
+d_getprotobyname_r='undef'
+d_getprotobynumber_r='undef'
+d_getprotoent_r='undef'
+d_getprotoprotos='define'
+d_getprpwnam='undef'
+d_getpwent='undef'
+d_getpwent_r='undef'
+d_getpwnam_r='undef'
+d_getpwuid_r='undef'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='undef'
+d_getservbyname_r='undef'
+d_getservbyport_r='undef'
+d_getservent_r='undef'
+d_getservprotos='define'
+d_getspent='undef'
+d_getspnam='undef'
+d_getspnam_r='undef'
+d_gettimeod='define'
+d_gmtime_r='undef'
+d_gnulibc='undef'
+d_grpasswd='undef'
+d_hasmntopt='undef'
+d_htonl='define'
+d_ilogbl='undef'
+d_index='undef'
+d_inetaton='undef'
+d_int64_t='undef'
+d_isascii='undef'
+d_isfinite='undef'
+d_isinf='undef'
+d_isnan='undef'
+d_isnanl='undef'
+d_killpg='undef'
+d_lchown='undef'
+d_ldbl_dig='undef'
+d_libm_lib_version='undef'
+d_link='undef'
+d_localtime_r='undef'
+d_locconv='undef'
+d_lockf='undef'
+d_longdbl='undef'
+d_longlong='undef'
+d_lseekproto='undef'
+d_lstat='undef'
+d_madvise='undef'
+d_mblen='undef'
+d_mbstowcs='undef'
+d_mbtowc='undef'
+d_memchr='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_mkdtemp='undef'
+d_mkfifo='undef'
+d_mkstemp='undef'
+d_mkstemps='undef'
+d_mktime='undef'
+d_mmap='undef'
+d_modfl='undef'
+d_modfl_pow32_bug='undef'
+d_modflproto='undef'
+d_mprotect='undef'
+d_msg='undef'
+d_msg_ctrunc='undef'
+d_msg_dontroute='undef'
+d_msg_oob='undef'
+d_msg_peek='undef'
+d_msg_proxy='undef'
+d_msgctl='undef'
+d_msgget='undef'
+d_msghdr_s='undef'
+d_msgrcv='undef'
+d_msgsnd='undef'
+d_msync='undef'
+d_munmap='undef'
+d_mymalloc='undef'
+d_nice='undef'
+d_nl_langinfo='undef'
+d_nv_preserves_uv='undef'
+d_off64_t='undef'
+d_old_pthread_create_joinable='undef'
+d_oldpthreads='undef'
+d_oldsock='undef'
+d_open3='undef'
+d_pathconf='undef'
+d_pause='undef'
+d_perl_otherlibdirs='undef'
+d_phostname='undef'
+d_pipe='undef'
+d_poll='undef'
+d_portable='undef'
+d_procselfexe='undef'
+d_pthread_atfork='undef'
+d_pthread_attr_setscope='undef'
+d_pthread_yield='undef'
+d_pwage='undef'
+d_pwchange='undef'
+d_pwclass='undef'
+d_pwcomment='undef'
+d_pwexpire='undef'
+d_pwgecos='undef'
+d_pwpasswd='undef'
+d_pwquota='undef'
+d_qgcvt='undef'
+d_quad='undef'
+d_random_r='undef'
+d_readdir64_r='undef'
+d_readdir='define'
+d_readdir_r='undef'
+d_readlink='undef'
+d_readv='undef'
+d_recvmsg='undef'
+d_rename='define'
+d_rewinddir='define'
+d_rmdir='define'
+d_safebcpy='undef'
+d_safemcpy='undef'
+d_sanemcmp='undef'
+d_sbrkproto='undef'
+d_scalbnl='undef'
+d_sched_yield='undef'
+d_scm_rights='undef'
+d_seekdir='define'
+d_select='undef'
+d_sem='undef'
+d_semctl='undef'
+d_semctl_semid_ds='undef'
+d_semctl_semun='undef'
+d_semget='undef'
+d_semop='undef'
+d_sendmsg='undef'
+d_setegid='undef'
+d_seteuid='undef'
+d_setgrent='undef'
+d_setgrent_r='undef'
+d_setgrps='undef'
+d_sethent='undef'
+d_sethostent_r='undef'
+d_setitimer='undef'
+d_setlinebuf='undef'
+d_setlocale='undef'
+d_setlocale_r='undef'
+d_setnent='undef'
+d_setnetent_r='undef'
+d_setpent='undef'
+d_setpgid='undef'
+d_setpgrp2='undef'
+d_setpgrp='undef'
+d_setprior='undef'
+d_setproctitle='undef'
+d_setprotoent_r='undef'
+d_setpwent='undef'
+d_setpwent_r='undef'
+d_setregid='undef'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+d_setsent='undef'
+d_setservent_r='undef'
+d_setsid='undef'
+d_setvbuf='define'
+d_sfio='undef'
+d_shm='undef'
+d_shmat='undef'
+d_shmatprototype='undef'
+d_shmctl='undef'
+d_shmdt='undef'
+d_shmget='undef'
+d_sigaction='undef'
+d_sigprocmask='undef'
+d_sigsetjmp='undef'
+d_sitecustomize='undef'
+d_sockatmark='undef'
+d_sockatmarkproto='undef'
+d_socket='define'
+d_socklen_t='undef'
+d_sockpair='undef'
+d_socks5_init='undef'
+d_sqrtl='undef'
+d_srand48_r='undef'
+d_srandom_r='undef'
+d_sresgproto='undef'
+d_sresuproto='undef'
+d_statblks='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
+d_statvfs='undef'
+d_stdio_cnt_lval='undef'
+d_stdio_ptr_lval='undef'
+d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_sets_cnt='undef'
+d_stdio_stream_array='undef'
+d_stdiobase='undef'
+d_stdstdio='undef'
+d_strchr='define'
+d_strcoll='undef'
+d_strctcpy='undef'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strerror_r='undef'
+d_strftime='undef'
+d_strlcat='undef'
+d_strlcpy='undef'
+d_strtod='define'
+d_strtol='define'
+d_strtold='undef'
+d_strtoll='undef'
+d_strtoq='undef'
+d_strtoul='define'
+d_strtoull='undef'
+d_strtouq='undef'
+d_strxfrm='undef'
+d_suidsafe='undef'
+d_symlink='undef'
+d_syscall='undef'
+d_syscallproto='undef'
+d_sysconf='undef'
+d_sysernlst=''
+d_syserrlst='undef'
+d_system='define'
+d_tcgetpgrp='undef'
+d_tcsetpgrp='undef'
+d_telldir='define'
+d_telldirproto='define'
+d_time='define'
+d_times='define'
+d_tm_tm_gmtoff='undef'
+d_tm_tm_zone='undef'
+d_tmpnam_r='undef'
+d_truncate='undef'
+d_ttyname_r='undef'
+d_tzname='undef'
+d_u32align='define'
+d_ualarm='undef'
+d_umask='undef'
+d_uname='undef'
+d_union_semun='undef'
+d_unordered='undef'
+d_sitecustomize='undef'
+d_usleep='define'
+d_usleepproto='undef'
+d_ustat='undef'
+d_vendorarch='undef'
+d_vendorbin='undef'
+d_vendorlib='undef'
+d_vfork='undef'
+d_void_closedir='undef'
+d_voidsig='undef'
+d_voidtty=''
+d_volatile='define'
+d_vprintf='define'
+d_wait4='undef'
+d_waitpid='undef'
+d_wcstombs='undef'
+d_wctomb='undef'
+d_writev='undef'
+d_xenix='undef'
+db_hashtype='u_int32_t'
+db_prefixtype='size_t'
+defvoidused=1
+direntrytype='struct dirent'
+dlext='dll'
+dlsrc='dl_symbian.xs'
+doublesize='8'
+drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))"
+drand48_r_proto='0'
+eagain='EAGAIN'
+ebcdic='undef'
+endgrent_r_proto='0'
+endhostent_r_proto='0'
+endnetent_r_proto='0'
+endprotoent_r_proto='0'
+endpwent_r_proto='0'
+endservent_r_proto='0'
+eunicefix=':'
+exe_ext='.exe'
+fflushNULL='undef'
+fflushall='undef'
+firstmakefile='makefile'
+fpossize='4'
+fpostype=fpos_t
+freetype=void
+full_ar=':'
+getgrent_r_proto='0'
+getgrgid_r_proto='0'
+getgrnam_r_proto='0'
+gethostbyaddr_r_proto='0'
+gethostbyname_r_proto='0'
+gethostent_r_proto='0'
+getlogin_r_proto='0'
+getnetbyaddr_r_proto='0'
+getnetbyname_r_proto='0'
+getnetent_r_proto='0'
+getprotobyname_r_proto='0'
+getprotobynumber_r_proto='0'
+getprotoent_r_proto='0'
+getpwent_r_proto='0'
+getpwnam_r_proto='0'
+getpwuid_r_proto='0'
+getservbyname_r_proto='0'
+getservbyport_r_proto='0'
+getservent_r_proto='0'
+getspnam_r_proto='0'
+gidformat='"lu"'
+gidsign='1'
+gidsize='4'
+gidtype=int
+gmtime_r_proto='0'
+groupstype=int
+h_fcntl='false'
+h_sysfile='true'
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='int64_t'
+i8size='1'
+i8type='char'
+i_arpainet='undef'
+i_bsdioctl=''
+i_crypt='undef'
+i_db='undef'
+i_dbm='undef'
+i_dirent='define'
+i_dld='undef'
+i_dlfcn='undef'
+i_fcntl='define'
+i_float='undef'
+i_fp='undef'
+i_fp_class='undef'
+i_gdbm='undef'
+i_grp='undef'
+i_ieeefp='undef'
+i_inttypes='undef'
+i_langinfo='undef'
+i_libutil='undef'
+i_limits='define'
+i_locale='define'
+i_machcthr='undef'
+i_malloc='undef'
+i_math='define'
+i_memory='undef'
+i_mntent='undef'
+i_ndbm='undef'
+i_netdb='define'
+i_neterrno='undef'
+i_netinettcp='undef'
+i_niin='define'
+i_poll='undef'
+i_prot='undef'
+i_pthread='undef'
+i_pwd='define'
+i_rpcsvcdbm='undef'
+i_sfio='undef'
+i_sgtty='undef'
+i_shadow='undef'
+i_socks='undef'
+i_stdarg='define'
+i_stddef='undef'
+i_stdlib='define'
+i_string='define'
+i_sunmath='undef'
+i_sysaccess='undef'
+i_sysdir='undef'
+i_sysfile='undef'
+i_sysfilio='undef'
+i_sysin='undef'
+i_sysioctl='define'
+i_syslog='undef'
+i_sysmman='undef'
+i_sysmode='undef'
+i_sysmount='undef'
+i_sysndir='undef'
+i_sysparam='undef'
+i_sysresrc='undef'
+i_syssecrt='undef'
+i_sysselct='undef'
+i_syssockio='undef'
+i_sysstat='define'
+i_sysstatfs='undef'
+i_sysstatvfs='undef'
+i_systime='define'
+i_systimek='undef'
+i_systimes='define'
+i_systypes='define'
+i_sysuio='undef'
+i_sysun='undef'
+i_sysutsname='undef'
+i_sysvfs='undef'
+i_syswait='undef'
+i_termio='undef'
+i_termios='undef'
+i_time='define'
+i_unistd='define'
+i_ustat='undef'
+i_utime='undef'
+i_values='undef'
+i_varargs='undef'
+i_varhdr='stdarg.h'
+i_vfork='undef'
+ignore_versioned_solibs='y'
+inc_version_list='0'
+inc_version_list_init='0'
+installprefix='\\system'
+installprefixexp='\\system'
+installsitearch='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+installsitelib='\\system\\libs\\perl\\siteperl\\x.y.z'
+installstyle='lib\\perl5'
+installusrbinperl='undef'
+intsize='4'
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+lib_ext='.a'
+lddlflags=''
+ld=':'
+ldflags=''
+libc='stdlib'
+libm_lib_version='0'
+libperl='libperl.a'
+localtime_r_proto='0'
+longdblsize=8
+longlongsize=8
+longsize='4'
+lseeksize=4
+lseektype=int
+make='make'
+malloctype='int*'
+malloctype='void *'
+modetype='mode_t'
+modetype=int
+multiarch='undef'
+myarchname='thumb-symbian'
+myuname='symbian'
+need_va_copy='undef'
+netdb_hlen_type='int'
+netdb_host_type='const char *'
+netdb_name_type='const char *'
+netdb_net_type='unsigned long'
+nroff='nroff'
+nv_preserves_uv_bits='0'
+nveformat='"e"'
+nvfformat='"f"'
+nvgformat='"g"'
+nvsize='8'
+nvtype='double'
+o_nonblock='O_NONBLOCK'
+obj_ext='.o'
+old_pthread_create_joinable=''
+optimize='-O2'
+orderlib='false'
+osname='symbian'
+osvers='7.0s'
+otherlibdirs=''
+path_sep=';';
+phostname='hostname'
+pidtype='int'
+pm_apiversion='5.005'
+privlib='\\system\\libs\\perl\\x.y.z'
+privlibexp='\\system\\libs\\perl\\x.y.z'
+procselfexe=''
+prototype='undef'
+ptrsize='4'
+quadkind='4'
+quadtype='int64_t'
+randbits='48'
+randfunc='drand48'
+random_r_proto='0'
+randseedtype='int'
+ranlib=':'
+rd_nodata='-1'
+readdir64_r_proto='0'
+readdir_r_proto='0'
+sPRIEUldbl='"llE"'
+sPRIFUldbl='"llF"'
+sPRIGUldbl='"llG"'
+sPRIXU64='"LX"'
+sPRId64='"Ld"'
+sPRIeldbl=''
+sPRIfldbl=''
+sPRIgldbl=''
+sPRIi64='"Li"'
+sPRIo64='"Lo"'
+sPRIu64='"Lu"'
+sPRIx64='"Lx"'
+sSCNfldbl=''
+sched_yield='sched_yield()'
+scriptdir='\\system\\apps\\perl'
+scriptdirexp='\\system\\apps\\perl'
+sdkvers=''
+seedfunc='srand'
+selectminbits='32'
+selecttype=int
+setgrent_r_proto='0'
+sethostent_r_proto='0'
+setlocale_r_proto='0'
+setnetent_r_proto='0'
+setprotoent_r_proto='0'
+setpwent_r_proto='0'
+setservent_r_proto='0'
+shmattype='void *'
+shortsize=2
+sig_name_init='0'
+sig_num_init='0'
+sig_size='1'
+signal_t=void
+sitearch='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+sitearchexp='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+sitelib='\\system\\libs\\perl\\siteperl\\x.y.z'
+sitelib_stem='\\system\\libs\\perl'
+sitelibexp='\\system\\libs\\perl\\siteperl\\x.y.z'
+siteprefix='\\system'
+siteprefixexp='\\system'
+sizesize=4
+sizetype=size_t
+so='o'
+socksizetype='unsigned int'
+srand48_r_proto='0'
+srandom_r_proto='0'
+ssizetype=int
+stdchar=char
+stdio_base='((fp)->_IO_read_base)'
+stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)'
+stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
+stdio_filbuf=''
+stdio_ptr='((fp)->_IO_read_ptr)'
+stdio_stream_array=''
+strerror_r_proto='0'
+targetarch='thumb-symbian'
+timetype=time_t
+tmpnam_r_proto='0'
+touch='touch'
+ttyname_r_proto='0'
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='uint64_t'
+u8size='1'
+u8type='unsigned char'
+uidformat='"lu"'
+uidsign='1'
+uidsize='4'
+uidtype=int
+uquadtype='uint64_t'
+use5005threads='undef'
+use64bitall='undef'
+use64bitint='undef'
+usecrosscompile='define'
+usedl='undef'
+usefaststdio='undef'
+useithreads='undef'
+uselargefiles='undef'
+uselongdouble='undef'
+usemallocwrap='define'
+usemorebits='undef'
+usemultiplicity='undef'
+usemymalloc='n'
+usenm='false'
+useopcode='true'
+useperlio='define'
+useposix='true'
+usereentrant='undef'
+userelocatableinc='undef'
+usesfio='false'
+useshrplib='false'
+usesitecustomize='undef'
+usesocks='undef'
+usethreads='undef'
+usevendorprefix='n'
+usevfork='false'
+uvXUformat='"lX"'
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+vendorlib_stem=''
+vendorlib=''
+vendorlibexp=''
+vendorarch=''
+vendorarchexp=''
+vendorprefix=''
+vendorprefixexp=''
+version='x.y.z'
+uvxformat='"lx"'
+versiononly='undef'
+voidflags=1
+xs_apiversion='5.008'
diff --git a/symbian/cwd.pl b/symbian/cwd.pl
new file mode 100644
index 0000000000..d3272d2de5
--- /dev/null
+++ b/symbian/cwd.pl
@@ -0,0 +1,6 @@
+use strict;
+use Cwd;
+my $CWD = getcwd();
+$CWD =~ s!^C:!!i;
+$CWD =~ s!/!\\!g;
+$CWD;
diff --git a/symbian/demo_pl b/symbian/demo_pl
new file mode 100644
index 0000000000..fbba5f4bf9
--- /dev/null
+++ b/symbian/demo_pl
@@ -0,0 +1,128 @@
+#!/usr/bin/perl -w
+
+#
+# demo_pl
+#
+# A "self-extracting archive" for some demo scripts.
+#
+# hello - the classic
+# helloyou - advanced classic
+# httpget1 - simple sockets
+# httpget2 - simple sockets done complex
+# md5 - core extension
+# time - system call
+# times - more system calls
+#
+
+use strict;
+
+unless (@ARGV && $ARGV[0] =~ /^(?:list|extract|cleanup)$/) {
+ die "$0: Usage: $0 [list|extract|cleanup]\n";
+}
+
+my $action = shift;
+my $list = $action eq 'list';
+my $extract = $action eq 'extract';
+my $cleanup = $action eq 'cleanup';
+
+my $fh;
+while (<DATA>) {
+ if (/^-- (.+\.pl)$/) {
+ if ($cleanup) {
+ print "Deleting $1\n";
+ unlink $1 or warn "$0: $1: $!\n";
+ } elsif ($extract) {
+ defined $fh && close($fh);
+ open($fh, ">$1") or die "$0: '$1': $!\n";
+ print "Extracting $1\n";
+ } elsif ($list) {
+ print "$1\n";
+ }
+ } else {
+ print $fh $_ if $extract;
+ }
+}
+defined $fh && close($fh);
+exit(0);
+__END__
+-- hello.pl
+print "hello world!\n";
+-- helloyou.pl
+print "What is your name?\n";
+chomp(my $name = <STDIN>);
+print "Hello, $name!\n";
+print "Amazing fact #1:\n";
+printf "Your name has\n%d character%s!\n",
+ length($name), length($name) == 1 ? "" : "s";
+print "Amazing fact #2:\n";
+printf "Your name is\n%s backwards!\n", scalar reverse $name;
+-- httpget1.pl
+print "(Using plain sockets)\n";
+use Socket;
+print "Host? ";
+my $host = <STDIN>;
+chomp($host);
+$host = 'www.nokia.com' unless length $host;
+my $port = 80;
+my $iaddr = inet_aton($host) || die "no host: $host";
+my $paddr = sockaddr_in($port, $iaddr);
+my $proto = getprotobyname("tcp");
+socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+connect(S, $paddr) || die "connect: $!";
+print "$host:$port:\nConnected.\n";
+select(S); $| = 1; select(STDOUT);
+print S "GET / HTTP/1.0\012\012" || die "GET /: $!";
+my @line;
+print "Receiving...\n";
+while (my $line = <S>) {
+ push @line, $line;
+}
+close(S) || die "close: $!";
+printf "Got %d lines.\n", scalar @line;
+-- httpget2.pl
+use IO::Socket;
+print "(Using IO::Socket)\n";
+print "Host? ";
+my $host = <STDIN>;
+chomp($host);
+$host = 'www.nokia.com' unless length $host;
+my $port = 80;
+my $remote =
+ IO::Socket::INET->new(Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port);
+print "$host:$port:\nConnected.\n";
+select($remote); $| = 1; select(STDOUT);
+print $remote "GET / HTTP/1.0\012\012" || die "GET /: $!";
+my @line;
+print "Receiving...\n";
+while (my $line = <$remote>) {
+ push @line, $line;
+}
+close($remote) || die "close: $!";
+printf "Got %d lines.\n", scalar @line;
+-- md5.pl
+use Digest::MD5 'md5_hex';
+print "(Using Digest::MD5)\nMD5 of 'Perl' is:\n";
+print md5_hex('Perl'), "\n";
+-- time.pl
+print "Running in $^O\n";
+print scalar localtime, "\n";
+-- times.pl
+use Time::HiRes qw(time sleep);
+print CORE::time(), "\n";
+print "Hires\n";
+print time(), "\n";
+print "Sleep 1.5 s...\n";
+sleep(1.5);
+print time(), "\n";
+print "To one million...\n";
+my $t0 = time();
+print $t0, "\n";
+print "Cpu ", scalar times(), "\n";
+for(my $i = 0; $i < 1e6; $i++) {}
+print "Cpu ", scalar times(), "\n";
+my $t1 = time();
+print $t1, "\n";
+print "Wall ", $t1 - $t0, "\n";
+
diff --git a/symbian/install.cfg b/symbian/install.cfg
new file mode 100644
index 0000000000..8cc7b10b9c
--- /dev/null
+++ b/symbian/install.cfg
@@ -0,0 +1,108 @@
+# install.cfg
+#
+# Copyright (c) 2004-2005 Nokia. All Rights Reserved.
+#
+# This file details what library files to include in the perlXYZlib.sis,
+# and what extensions to build for the perlXYZext.sis.
+# The lines beginning with "lib" are # included as-is from the lib/.
+# The lines beginning with "ext" tell either how to build and package
+# the extensions - or not.
+
+#
+# Libraries.
+#
+lib AnyDBM_File.pm
+lib AutoLoader.pm
+lib base.pm
+lib Benchmark.pm
+lib Carp.pm
+lib Carp/Heavy.pm
+lib Cwd.pm
+lib constant.pm
+lib DBM_Filter.pm
+lib Digest/base.pm
+lib DirHandle.pm
+lib Exporter.pm
+lib Exporter/Heavy.pm
+lib File/Basename.pm
+lib File/Compare.pm
+lib File/Copy.pm
+lib File/DosGlob.pm
+lib File/Find.pm
+lib File/Path.pm
+lib File/Spec.pm
+lib File/Spec/Unix.pm
+lib File/Spec/Win32.pm
+lib File/Temp.pm
+lib FileHandle.pm
+lib Filter/Simple.pm
+lib if.pm
+lib integer.pm
+lib lib.pm
+lib Net/Cmd.pm
+lib Net/Config.pm
+lib Net/Domain.pm
+lib Net/FTP.pm
+lib Net/FTP/A.pm
+lib Net/FTP/E.pm
+lib Net/FTP/I.pm
+lib Net/FTP/L.pm
+lib Net/FTP/dataconn.pm
+lib Net/NNTP.pm
+lib Net/Netrc.pm
+lib Net/Ping.pm
+lib Net/POP3.pm
+lib Net/SMTP.pm
+lib Net/Time.pm
+lib NEXT.pm
+lib overload.pm
+lib SelectSaver.pm
+lib strict.pm
+lib Symbol.pm
+lib UNIVERSAL.pm
+# lib utf8.pm
+# lib utf8_heavy.pl
+lib vars.pm
+lib warnings.pm
+lib warnings/register.pm
+#
+# Extensions.
+#
+ext attrs
+ext Cwd
+ext Data/Dumper
+ext Devel/Peek
+ext Digest/MD5
+ext Errno
+ext Fcntl CONST
+ext File/Glob CONST
+ext Filter/Util/Call
+ext IO
+ext List/Util
+ext MIME/Base64
+ext PerlIO/scalar
+ext PerlIO/via
+ext SDBM_File -sdbm/db?.c -sdbm/util.c
+ext Socket CONST
+ext Storable
+ext Time/HiRes CONST
+ext XSLoader
+# ext B ERROR
+# ext ByteLoader byterun.c ERROR VERSION
+# ext Devel/DProf nonconst
+# ext Devel/PPPort PORT
+# ext Encode nonconst Encode/encode.h def_t.c encengine.c
+# ext I18N/Langinfo PORT
+# ext IPC/SysV PORT
+# ext Opcode ERROR
+# ext PerlIO/encoding Encode
+# ext POSIX CONST USELESS
+# ext re ERROR
+# ext Sys/Hostname PORT
+# ext Sys/Syslog PORT
+# ext threads PORT
+# ext threads/shared PORT
+# ext Unicode/Normalize nonconst
+# ext XS/APItest USELESS
+# ext XS/Typemap nonconst USELESS
+
diff --git a/symbian/makesis.pl b/symbian/makesis.pl
new file mode 100644
index 0000000000..1ee5e8dc2f
--- /dev/null
+++ b/symbian/makesis.pl
@@ -0,0 +1,185 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+use strict;
+use lib "symbian";
+
+do "sanity.pl";
+
+my %VERSION = %{ do "version.pl" };
+my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+my $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+
+my $SDK = do "sdk.pl";
+my $UID = do "uid.pl";
+my %PORT = %{ do "port.pl" };
+
+my $ARM = 'thumb'; # TODO
+my $S60SK = $ENV{S60SDK}; # from sdk.pl
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+
+my $app = '!:\System\Apps\Perl';
+my $lib = '!:\System\Libs';
+
+my @target = @ARGV
+ ? @ARGV
+ : (
+ "miniperl", "perl",
+ "perl${VERSION}dll", "perl${VERSION}lib",
+ "perl${VERSION}ext"
+ );
+
+my %suffix;
+@suffix{ "miniperl", "perl", "perl$VERSION" } = ( "exe", "exe", "dll", );
+
+for my $target (@target) {
+ $target = "perl${VERSION}" if $target eq "perl${VERSION}dll";
+
+ my %copy;
+ my $pkg = "$target.pkg";
+ print "\nCreating $pkg...\n";
+
+ my $suffix = $suffix{$target} || "";
+ my $dst = $suffix eq "dll" ? $lib : $app;
+
+ my $srctarget = "$UREL\\$target.$suffix";
+
+ if ( $target =~ /^(miniperl|perl|perl${VERSION}(?:dll)?)$/ ) {
+ $copy{$srctarget} = "$dst\\$target.$suffix";
+ print "\t$target.$suffix\n";
+ }
+ if ( $target eq "perl${VERSION}lib" ) {
+ print "Libraries...\n";
+
+ print "\tConfig.pm\n";
+ $copy{"lib\\Config.pm"} =
+ "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config.pm";
+
+ print "\tConfig_heavy.pl\n";
+ $copy{"xlib\\symbian\\Config_heavy.pl"} =
+ "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config_heavy.pl";
+
+ print "\tDynaLoader.pm\n";
+ $copy{"ext\\DynaLoader\\DynaLoader.pm"} =
+ "$lib\\Perl\\$R_V_SV\\DynaLoader.pm";
+
+ print "\tErrno.pm\n";
+ $copy{"ext\\Errno\\Errno.pm"} = "$lib\\Perl\\$R_V_SV\\Errno.pm";
+
+ open( my $cfg, "symbian/install.cfg" )
+ or die "$!: symbian/install.cfg: $!\n";
+ while (<$cfg>) {
+ next unless /^lib\s+(.+)/;
+ chomp;
+ my $f = $1;
+ $f =~ s:/:\\:g;
+ $copy{"lib\\$f"} = "$lib\\Perl\\$R_V_SV\\$f";
+ print "\t$f\n";
+ }
+ close($cfg);
+ }
+
+ if ( $target eq "perl${VERSION}ext" ) {
+ my @lst = glob("symbian/*.lst");
+ print "Extensions...\n";
+ print "\t(none found)\n" unless @lst;
+ for my $lst (@lst) {
+ $lst =~ m:^symbian/(.+)\.:;
+ my $ext = $1;
+ $ext =~ s!-!::!g;
+ print "\t$ext\n";
+ if ( open( my $pkg, $lst ) ) {
+ while (<$pkg>) {
+ if (m!^"(.+)"-"(.+)"$!) {
+ my ( $src, $dst ) = ( $1, $2 );
+ $copy{$src} = $dst;
+ }
+ else {
+ warn "$0: $lst: $.: unknown syntax\n";
+ }
+ }
+ close($pkg);
+ }
+ else {
+ warn "$0: $lst: $!\n";
+ }
+ }
+ }
+
+ for my $file ( keys %copy ) {
+ warn "$0: $file does not exist\n" unless -f $file;
+ }
+
+ my @copy = map { qq["$_"-"$copy{$_}"] } sort keys %copy;
+ my $copy = join( "\n", @copy );
+
+ my %UID = (
+ "miniperl" => 0,
+ "perl" => 0,
+ "perl${VERSION}" => $UID + 0,
+ "perl${VERSION}dll" => $UID + 0,
+ "perl${VERSION}ext" => $UID + 1,
+ "perl${VERSION}lib" => $UID + 2,
+
+ # app = + 3
+ # rec = + 4
+ );
+
+ die "$0: target has no UID\n" unless defined $UID{$target};
+
+ my $uid = sprintf( "0x%08X", $UID{$target} );
+
+ my ( $MAJOR, $MINOR, $PATCH ) = ( 0, 0, 0 );
+
+ if ( $target =~ m:^perl$VERSION(dll|ext|lib)?$: ) {
+ my $pkg = defined $1 ? $1 : "dll";
+ $MAJOR = $PORT{$pkg}->{MAJOR};
+ $MINOR = $PORT{$pkg}->{MINOR};
+ $PATCH = $PORT{$pkg}->{PATCH};
+ }
+
+ die "$0: Bad version for $target\n"
+ unless defined $MAJOR
+ && ( $MAJOR eq 0 || $MAJOR > 0 )
+ && defined $MINOR
+ && ( $MINOR eq 0 || $MINOR > 0 )
+ && defined $PATCH
+ && ( $PATCH eq 0 || $PATCH > 0 );
+
+ open PKG, ">$pkg" or die "$0: failed to create $pkg: $!\n";
+ print PKG <<__EOF__;
+; \u$target installation script
+;
+; The supported languages
+&EN;
+;
+; The installation name and header data
+;
+#{"\u$target"},($uid),$MAJOR,$MINOR,$PATCH
+;
+; Private key and certificate (unused)
+;
+;* "\u$target.key", "\u$target.cer"
+;
+; Supports Series60 v0.9
+(0x101F6F88), 0, 0, 0, {"Series60ProductID"}
+; The files to install
+;
+$copy
+__EOF__
+ close PKG;
+
+ print "Created $pkg\n";
+
+ print "Running makesis...\n";
+
+ unlink("$target.sis");
+
+ system("makesis $pkg") == 0
+ || die "$0: makesis $pkg failed: $!\n";
+}
+
+exit(0);
diff --git a/symbian/port.pl b/symbian/port.pl
new file mode 100644
index 0000000000..affb42c461
--- /dev/null
+++ b/symbian/port.pl
@@ -0,0 +1,6 @@
+{
+ dll => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+ ext => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+ lib => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+}
+
diff --git a/symbian/sanity.pl b/symbian/sanity.pl
new file mode 100644
index 0000000000..eb50244dde
--- /dev/null
+++ b/symbian/sanity.pl
@@ -0,0 +1,28 @@
+use strict;
+
+if (exists $ENV{'!C:'}) {
+ print "You are running this under Cygwin, aren't you?\n";
+ print "I'm sorry but only cmd.exe will work.\n";
+ exit(1);
+}
+
+if (# SDK 2.x
+ $ENV{PATH} !~ m!c:\\program files\\common files\\symbian\\tools!i
+ &&
+ # SDK 1.2
+ $ENV{PATH} !~ m!c:\\symbian\\6.1\\shared\\epoc32\\tools!i) {
+ print "I think you have not installed the Symbian SDK.\n";
+ exit(1);
+}
+
+unless (-f "symbian/symbianish.h") {
+ print "You must run this in the top level directory.\n";
+ exit(1);
+}
+
+if ($] < 5.008) {
+ print "You must configure with Perl 5.8 or later.\n";
+ exit(1);
+}
+
+1;
diff --git a/symbian/sdk.pl b/symbian/sdk.pl
new file mode 100644
index 0000000000..1dc4d2f552
--- /dev/null
+++ b/symbian/sdk.pl
@@ -0,0 +1,48 @@
+use strict;
+
+my $SDK;
+my $WIN;
+
+if ($ENV{PATH} =~ m!\\Symbian\\(.+?)\\gcc\\bin!) {
+ my $cc = $1;
+ $WIN = $cc =~ m!_CW!i ? 'winscw' : 'wins';
+ $ENV{WIN} = $WIN;
+ if ($cc =~ m!Series60_v20!) {
+ $ENV{S60SDK} = '2.0';
+ } elsif ($cc =~ m!Series60_v21!) {
+ $ENV{S60SDK} = '2.1';
+ } elsif ($cc =~ m!S60_2nd_FP2!) {
+ $ENV{S60SDK} = '2.6';
+ }
+}
+
+if (open(GCC, "gcc -v 2>&1|")) {
+ while (<GCC>) {
+ if (/Reading specs from ((?:C:)?\\Symbian.+?)\\Epoc32\\/i) {
+ $SDK = $1;
+ # The S60SDK tells the Series 60 SDK version.
+ if ($SDK eq 'C:\Symbian\6.1\Shared') { # Visual C.
+ $SDK = 'C:\Symbian\6.1\Series60';
+ $ENV{S60SDK} = '1.2';
+ } elsif ($SDK eq 'C:\Symbian\Series60_1_2_CW') { # CodeWarrior.
+ $ENV{S60SDK} = '1.2';
+ }
+ last;
+ }
+ }
+ close GCC;
+} else {
+ die "$0: failed to run gcc: $!\n";
+}
+
+my $UARM = $ENV{UARM} ? $ENV{UARM} : "urel";
+my $UREL = "$SDK\\epoc32\\release\\-ARM-\\$UARM";
+if ($SDK eq 'C:\Symbian\6.1\Series60' && $ENV{WIN} eq 'winscw') {
+ $UREL = "C:\\Symbian\\Series60_1_2_CW\\epoc32\\release\\-ARM-\\urel";
+}
+$ENV{UREL} = $UREL;
+$ENV{UARM} = $UARM;
+
+die "$0: failed to locate the Symbian SDK\n" unless defined $SDK;
+
+$SDK;
diff --git a/symbian/symbian_dll.cpp b/symbian/symbian_dll.cpp
new file mode 100644
index 0000000000..92a06b883f
--- /dev/null
+++ b/symbian/symbian_dll.cpp
@@ -0,0 +1,20 @@
+/*
+ * symbian_dll.cpp
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#define SYMBIAN_DLL_CPP
+#include <e32base.h>
+#include "PerlBase.h"
+
+EXPORT_C GLDEF_C TInt E32Dll(TDllReason /*aReason*/) { return KErrNone; }
+
+extern "C" {
+ EXPORT_C void* symbian_get_vars(void) { return Dll::Tls(); }
+ EXPORT_C void symbian_set_vars(const void *p) { Dll::SetTls((TAny*)p); }
+ EXPORT_C void symbian_unset_vars(void) { Dll::SetTls(0); }
+}
+
diff --git a/symbian/symbian_proto.h b/symbian/symbian_proto.h
new file mode 100644
index 0000000000..f50de34af8
--- /dev/null
+++ b/symbian/symbian_proto.h
@@ -0,0 +1,72 @@
+/*
+ * symbian_proto.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#ifndef SYMBIAN_PROTO_H
+#define SYMBIAN_PROTO_H
+
+#include <sys/types.h>
+#include <sys/times.h>
+
+#if defined(PERL_CORE) || defined(PERL_EXT)
+
+/* We can't include the <string.h> unconditionally
+ * since it has prototypes conflicting with the gcc builtins. */
+extern void *memchr(const void *s, int c, size_t n);
+#ifndef DL_SYMBIAN_XS
+/* dl_symbian.xs needs to see the C++ prototype of memset() instead */
+extern void *memset(void *s, int c, size_t n);
+extern size_t strlen(const char *s);
+#endif
+extern void *memmove(void *dst, const void *src, size_t n);
+extern char *strcat(char *dst, const char *src);
+extern char *strchr(const char *s, int c);
+extern char *strerror(int errnum);
+extern int strncmp(const char *s1, const char *s2, size_t n);
+extern char *strrchr(const char *s, int c);
+
+extern int setmode(int fd, long flags);
+
+#ifndef __GNUC__
+#define memcpy _e32memcpy /* GCC intrinsic */
+extern void *memcpy(const void *s1, const void *s2, size_t n);
+extern int strcmp(const char *s1, const char *s2);
+extern char* strcpy(char *dst, const char *src);
+extern char* strncpy(char *dst, const char *src, size_t n);
+#endif
+
+#endif /* PERL_CORE || PERL_EXT */
+
+#if defined(SYMBIAN_DLL_CPP) || defined(SYMBIAN_UTILS_CPP) || defined(PERLBASE_CPP)
+# define PERL_SYMBIAN_START_EXTERN_C extern "C" {
+# define PERL_SYMBIAN_EXPORT_C EXPORT_C
+# define PERL_SYMBIAN_END_EXTERN_C }
+#else
+# define PERL_SYMBIAN_START_EXTERN_C
+# define PERL_SYMBIAN_EXPORT_C
+# define PERL_SYMBIAN_END_EXTERN_C
+#endif
+
+PERL_SYMBIAN_START_EXTERN_C
+PERL_SYMBIAN_EXPORT_C int symbian_sys_init(int *argcp, char ***argvp);
+PERL_SYMBIAN_EXPORT_C void* symbian_get_vars(void);
+PERL_SYMBIAN_EXPORT_C void symbian_set_vars(const void *);
+PERL_SYMBIAN_EXPORT_C void symbian_unset_vars(void);
+PERL_SYMBIAN_EXPORT_C SSize_t symbian_read_stdin(const int fd, char *b, int n);
+PERL_SYMBIAN_EXPORT_C SSize_t symbian_write_stdout(const int fd, const char *b, int n);
+PERL_SYMBIAN_EXPORT_C char* symbian_get_error_string(const int error);
+PERL_SYMBIAN_EXPORT_C void symbian_sleep_usec(const long usec);
+PERL_SYMBIAN_EXPORT_C int symbian_get_cpu_time(long* sec, long* usec);
+PERL_SYMBIAN_EXPORT_C clock_t symbian_times(struct tms* buf);
+PERL_SYMBIAN_EXPORT_C int symbian_usleep(unsigned int usec);
+PERL_SYMBIAN_EXPORT_C int symbian_do_aspawn(void* vreally, void *vmark, void* sp);
+PERL_SYMBIAN_EXPORT_C int symbian_do_spawn(const char* command);
+PERL_SYMBIAN_EXPORT_C int symbian_do_spawn_nowait(const char* command);
+PERL_SYMBIAN_END_EXTERN_C
+
+#endif /* !SYMBIAN_PROTO_H */
+
diff --git a/symbian/symbian_stubs.c b/symbian/symbian_stubs.c
new file mode 100644
index 0000000000..1505698703
--- /dev/null
+++ b/symbian/symbian_stubs.c
@@ -0,0 +1,112 @@
+/*
+ * symbian_stubs.c
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "symbian_stubs.h"
+
+static int setENOSYS(void) { errno = ENOSYS; return -1; }
+
+uid_t getuid(void) { return setENOSYS(); }
+gid_t getgid(void) { return setENOSYS(); }
+uid_t geteuid(void) { return setENOSYS(); }
+gid_t getegid(void) { return setENOSYS(); }
+
+int setuid(uid_t uid) { return setENOSYS(); }
+int setgid(gid_t gid) { return setENOSYS(); }
+int seteuid(uid_t uid) { return setENOSYS(); }
+int setegid(gid_t gid) { return setENOSYS(); }
+
+int execv(const char* path, char* const argv []) { return setENOSYS(); }
+int execvp(const char* path, char* const argv []) { return setENOSYS(); }
+
+#ifndef USE_PERLIO
+FILE *popen(const char *command, const char *mode) { return 0; }
+int pclose(FILE *stream) { return setENOSYS(); }
+#endif
+int pipe(int fd[2]) { return setENOSYS(); }
+
+int setmode(int fd, long flags) { return -1; }
+
+_sig_func_ptr signal(int signum, _sig_func_ptr handler) { return (_sig_func_ptr)setENOSYS(); }
+int kill(pid_t pid, int signum) { return setENOSYS(); }
+pid_t wait(int *status) { return setENOSYS(); }
+
+#if PERL_VERSION <= 8
+void Perl_my_setenv(pTHX_ char *var, char *val) { }
+#else
+void Perl_my_setenv(pTHX_ const char *var, const char *val) { }
+#endif
+
+bool Perl_do_exec(pTHX_ char *cmd) { return FALSE; }
+bool Perl_do_exec3(pTHX_ char *cmd, int fd, int flag) { return FALSE; }
+
+int Perl_do_spawn(pTHX_ char *cmd) { return symbian_do_spawn(cmd); }
+int Perl_do_aspawn(pTHX_ SV *really, SV** mark, SV **sp) { return symbian_do_aspawn(really, mark, sp); }
+
+static const struct protoent protocols[] = {
+ { "tcp", 0, 6 },
+ { "udp", 0, 17 }
+};
+
+/* The protocol field (the last) is left empty to save both space
+ * and time because practically all services have both tcp and udp
+ * allocations in IANA. */
+static const struct servent services[] = {
+ { "http", 0, 80, 0 }, /* Optimization. */
+ { "https", 0, 443, 0 },
+ { "imap", 0, 143, 0 },
+ { "imaps", 0, 993, 0 },
+ { "smtp", 0, 25, 0 },
+ { "irc", 0, 194, 0 },
+
+ { "ftp", 0, 21, 0 },
+ { "ssh", 0, 22, 0 },
+ { "tftp", 0, 69, 0 },
+ { "pop3", 0, 110, 0 },
+ { "sftp", 0, 115, 0 },
+ { "nntp", 0, 119, 0 },
+ { "ntp", 0, 123, 0 },
+ { "snmp", 0, 161, 0 },
+ { "ldap", 0, 389, 0 },
+ { "rsync", 0, 873, 0 },
+ { "socks", 0, 1080, 0 }
+};
+
+struct protoent* getprotobynumber(int number) {
+ int i;
+ for (i = 0; i < sizeof(protocols)/sizeof(struct protoent); i++)
+ if (protocols[i].p_proto == number)
+ return (struct protoent*)(&(protocols[i]));
+ return 0;
+}
+
+struct protoent* getprotobyname(const char* name) {
+ int i;
+ for (i = 0; i < sizeof(protocols)/sizeof(struct protoent); i++)
+ if (strcmp(name, protocols[i].p_name) == 0)
+ return (struct protoent*)(&(protocols[i]));
+ return 0;
+}
+
+struct servent* getservbyname(const char* name, const char* proto) {
+ int i;
+ for (i = 0; i < sizeof(services)/sizeof(struct servent); i++)
+ if (strcmp(name, services[i].s_name) == 0)
+ return (struct servent*)(&(services[i]));
+ return 0;
+}
+
+struct servent* getservbyport(int port, const char* proto) {
+ int i;
+ for (i = 0; i < sizeof(services)/sizeof(struct servent); i++)
+ if (services[i].s_port == port)
+ return (struct servent*)(&(services[i]));
+ return 0;
+}
+
diff --git a/symbian/symbian_stubs.h b/symbian/symbian_stubs.h
new file mode 100644
index 0000000000..ab6b9616cd
--- /dev/null
+++ b/symbian/symbian_stubs.h
@@ -0,0 +1,22 @@
+/*
+ * symbian_stubs.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#ifndef PERL_SYMBIAN_STUBS_H
+#define PERL_SYMBIAN_STUBS_H
+
+int execv(const char* path, char* const argv []);
+int execvp(const char* path, char* const argv []);
+
+#ifndef USE_PERLIO
+FILE *popen(const char *command, const char *mode);
+int pclose(FILE *stream);
+#endif
+int pipe(int fd[2]);
+
+#endif /* PERL_SYMBIAN_STUBS_H */
+
diff --git a/symbian/symbian_utils.cpp b/symbian/symbian_utils.cpp
new file mode 100644
index 0000000000..16e911c81e
--- /dev/null
+++ b/symbian/symbian_utils.cpp
@@ -0,0 +1,299 @@
+/*
+ * symbian_utils.cpp
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#define SYMBIAN_UTILS_CPP
+#include <e32base.h>
+#include <e32std.h>
+#include <textresolver.h>
+#include <utf.h>
+#include <hal.h>
+
+#include <string.h>
+#include <ctype.h>
+
+#include "PerlBase.h"
+
+extern "C" {
+ EXPORT_C int symbian_sys_init(int *argcp, char ***argvp)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ (void)times(&PL_timesbase);
+ return 0;
+ }
+ EXPORT_C SSize_t symbian_read_stdin(const int fd, char *b, int n)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ return ((CPerlBase*)PL_appctx)->ConsoleRead(fd, b, n);
+ }
+ EXPORT_C SSize_t symbian_write_stdout(const int fd, const char *b, int n)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ return ((CPerlBase*)PL_appctx)->ConsoleWrite(fd, b, n);
+ }
+ static const char NullErr[] = "";
+ EXPORT_C char* symbian_get_error_string(const TInt error)
+ {
+ 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;
+ }
+ }
+ 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)
+ {
+ User::After((TTimeIntervalMicroSeconds32) usec);
+ }
+#define PERL_SYMBIAN_CLK_TCK 100
+ EXPORT_C int symbian_get_cpu_time(long* sec, long* usec)
+ {
+ // The RThread().GetCpuTime() does not seem to work?
+ // (it always returns KErrNotSupported)
+ // TTimeIntervalMicroSeconds ti;
+ // TInt err = me.GetCpuTime(ti);
+ dTHX;
+ TInt periodus; /* tick period in microseconds */
+ if (HAL::Get(HALData::ESystemTickPeriod, periodus) != KErrNone)
+ return -1;
+ TUint tick = User::TickCount();
+ if (PL_timesbase.tms_utime == 0) {
+ PL_timesbase.tms_utime = tick;
+ PL_clocktick = PERL_SYMBIAN_CLK_TCK;
+ }
+ tick -= PL_timesbase.tms_utime;
+ TInt64 tickus = TInt64(tick) * TInt64(periodus);
+ TInt64 tmps = tickus / 1000000;
+ if (sec) *sec = tmps.Low();
+ if (usec) *usec = tickus.Low() - tmps.Low() * 1000000;
+ return 0;
+ }
+ EXPORT_C int symbian_usleep(unsigned int usec)
+ {
+ if (usec >= 1000000) {
+ errno = EINVAL;
+ return -1;
+ }
+ symbian_sleep_usec((const long) usec);
+ return 0;
+ }
+#define SEC_USEC_TO_CLK_TCK(s, u) \
+ (((s) * PERL_SYMBIAN_CLK_TCK) + (u / (1000000 / PERL_SYMBIAN_CLK_TCK)))
+ EXPORT_C clock_t symbian_times(struct tms *tmsbuf)
+ {
+ long s, u;
+ if (symbian_get_cpu_time(&s, &u) == -1) {
+ errno = EINVAL;
+ return -1;
+ } else {
+ tmsbuf->tms_utime = SEC_USEC_TO_CLK_TCK(s, u);
+ tmsbuf->tms_stime = 0;
+ tmsbuf->tms_cutime = 0;
+ tmsbuf->tms_cstime = 0;
+ return tmsbuf->tms_utime;
+ }
+ }
+ class CE32ProcessWait : public CActive
+ {
+ public:
+ CE32ProcessWait() : CActive(EPriorityStandard) {
+ CActiveScheduler::Add(this);
+ }
+#ifdef __WINS__
+ TInt Wait(RThread& aProcess)
+#else
+ TInt Wait(RProcess& aProcess)
+#endif
+ {
+ aProcess.Logon(iStatus);
+ aProcess.Resume();
+ SetActive();
+ CActiveScheduler::Start();
+ return iStatus.Int();
+ }
+ private:
+ void DoCancel() {;}
+ void RunL() {
+ CActiveScheduler::Stop();
+ }
+ CActiveSchedulerWait iWait;
+ };
+ class CSpawnIoRedirect : public CBase
+ {
+ public:
+ CSpawnIoRedirect();
+ // NOTE: there is no real implementation of I/O redirection yet.
+ protected:
+ private:
+ };
+ CSpawnIoRedirect::CSpawnIoRedirect()
+ {
+ }
+ typedef enum {
+ ESpawnNone = 0x00000000,
+ ESpawnWait = 0x00000001
+ } TSpawnFlag;
+ static int symbian_spawn(const TDesC& aFilename,
+ const TDesC& aCommand,
+ const TSpawnFlag aFlag,
+ const CSpawnIoRedirect& aIoRedirect) {
+ TInt error = KErrNone;
+#ifdef __WINS__
+ const TInt KStackSize = 0x1000;
+ const TInt KHeapMin = 0x1000;
+ const TInt KHeapMax = 0x100000;
+ RThread proc;
+ RLibrary lib;
+ HBufC* command = aCommand.Alloc();
+ error = lib.Load(aFilename);
+ if (error == KErrNone) {
+ TThreadFunction func = (TThreadFunction)(lib.Lookup(1));
+ if (func)
+ error = proc.Create(aFilename,
+ func,
+ KStackSize,
+ (TAny*)command,
+ &lib,
+ RThread().Heap(),
+ KHeapMin,
+ KHeapMax,
+ EOwnerProcess);
+ else
+ error = KErrNotFound;
+ lib.Close();
+ }
+ else
+ delete command;
+#else
+ RProcess proc;
+ error = proc.Create(aFilename, aCommand);
+#endif
+ if (error == KErrNone) {
+ if ((TInt)aFlag & (TInt)ESpawnWait) {
+ CE32ProcessWait* w = new CE32ProcessWait();
+ if (w) {
+ error = w->Wait(proc);
+ delete w;
+ } else
+ error = KErrNoMemory;
+ } else
+ proc.Resume();
+ proc.Close();
+ }
+ return error;
+ }
+ static int symbian_spawner(const char *command, TSpawnFlag aFlags)
+ {
+ TBuf<KMaxFileName> aFilename;
+ TBuf<KMaxFileName> aCommand;
+ TSpawnFlag aSpawnFlags = ESpawnWait;
+ CSpawnIoRedirect iord;
+ char *p = (char*)command;
+
+ // The recognized syntax is: "cmd [args] [&]". Since one
+ // cannot pass more than (an argv[0] and) an argv[1] to a
+ // Symbian process anyway, not much is done to the cmd or
+ // the args, only backslash quoting.
+
+ // Strip leading whitespace.
+ while (*p && isspace(*p)) p++;
+ if (*p) {
+ // Build argv[0].
+ while (*p && !isspace(*p) && *p != '&') {
+ if (*p == '\\') {
+ if (p[1]) {
+ aFilename.Append(p[1]);
+ p++;
+ }
+
+ }
+ else
+ aFilename.Append(*p);
+ p++;
+ }
+
+ if (*p) {
+ // Skip whitespace between argv[0] and argv[1].
+ while(*p && isspace(*p)) p++;
+ // Build argv[1].
+ if (*p) {
+ char *a = p;
+ char *b = p + 1;
+
+ while (*b) b++;
+ if (isspace(b[-1])) {
+ b--;
+ while (b > a && isspace(*b)) b--;
+ b++;
+ }
+ if (b > a && b[-1] == '&') {
+ // Parse backgrounding in any case,
+ // but turn it off only if wanted.
+ if ((aFlags & ESpawnWait))
+ aSpawnFlags =
+ (TSpawnFlag) (aSpawnFlags & ~ESpawnWait);
+ b--;
+ if (isspace(b[-1])) {
+ b--;
+ while (b > a && isspace(*b)) b--;
+ b++;
+ }
+ }
+ for (p = a; p < b; p++) {
+ if (*p == '\\') {
+ if (p[1])
+ aCommand.Append(p[1]);
+ p++;
+ }
+ else
+ aCommand.Append(*p);
+ }
+ }
+ // NOTE: I/O redirection is not yet done.
+ // Implementing that may require a separate server.
+ }
+ }
+ int spawned = symbian_spawn(aFilename, aCommand, aSpawnFlags, iord);
+ return spawned == KErrNone ? 0 : -1;
+ }
+ EXPORT_C int symbian_do_spawn(const char *command)
+ {
+ return symbian_spawner(command, ESpawnWait);
+ }
+ EXPORT_C int symbian_do_spawn_nowait(const char *command)
+ {
+ return symbian_spawner(command, ESpawnNone);
+ }
+ EXPORT_C int symbian_do_aspawn(void* vreally, void* vmark, void* sp)
+ {
+ return -1;
+ }
+}
+
diff --git a/symbian/symbianish.h b/symbian/symbianish.h
new file mode 100644
index 0000000000..1aebaf1007
--- /dev/null
+++ b/symbian/symbianish.h
@@ -0,0 +1,209 @@
+/*
+ * symbianish.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#include "symbian/symbian_port.h"
+
+/*
+ * The following symbols are defined if your operating system supports
+ * functions by that name. All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+
+#ifndef PERL_MICRO
+
+/* HAS_IOCTL:
+ * This symbol, if defined, indicates that the ioctl() routine is
+ * available to set I/O characteristics
+ */
+#define HAS_IOCTL / **/
+
+/* HAS_UTIME:
+ * This symbol, if defined, indicates that the routine utime() is
+ * available to update the access and modification times of files.
+ */
+/* #define HAS_UTIME / **/
+
+/* HAS_GROUP
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
+ */
+#undef HAS_GROUP /**/
+
+/* HAS_PASSWD
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
+ */
+#undef HAS_PASSWD /**/
+
+#undef HAS_KILL
+#undef HAS_WAIT
+
+#endif /* !PERL_MICRO */
+
+/* USEMYBINMODE
+ * This symbol, if defined, indicates that the program should
+ * use the routine my_binmode(FILE *fp, char iotype) to insure
+ * that a file is in "binary" mode -- that is, that no translation
+ * of bytes occurs on read or write operations.
+ */
+#undef USEMYBINMODE
+
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
+/* USE_STAT_RDEV:
+ * This symbol is defined if this system has a stat structure declaring
+ * st_rdev
+ */
+#define USE_STAT_RDEV /**/
+
+/* ACME_MESS:
+ * This symbol, if defined, indicates that error messages should be
+ * should be generated in a format that allows the use of the Acme
+ * GUI/editor's autofind feature.
+ */
+#undef ACME_MESS /**/
+
+/* UNLINK_ALL_VERSIONS:
+ * This symbol, if defined, indicates that the program should arrange
+ * to remove all versions of a file if unlink() is called. This is
+ * probably only relevant for VMS.
+ */
+/* #define UNLINK_ALL_VERSIONS / **/
+
+/* VMS:
+ * This symbol, if defined, indicates that the program is running under
+ * VMS. It is currently automatically set by cpps running under VMS,
+ * and is included here for completeness only.
+ */
+/* #define VMS / **/
+
+/* ALTERNATE_SHEBANG:
+ * This symbol, if defined, contains a "magic" string which may be used
+ * as the first line of a Perl program designed to be executed directly
+ * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
+ * begins with a character other then #, then Perl will only treat
+ * it as a command line if it finds the string "perl" in the first
+ * word; otherwise it's treated as the first line of code in the script.
+ * (IOW, Perl won't hand off to another interpreter via an alternate
+ * shebang sequence that might be legal Perl code.)
+ */
+/* #define ALTERNATE_SHEBANG "#!" / **/
+
+#include <signal.h>
+#define ABORT() abort()
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define Stat(fname,bufptr) stat((fname),(bufptr))
+#define Fstat(fd,bufptr) fstat((fd),(bufptr))
+#define Fflush(fp) fflush(fp)
+#define Mkdir(path,mode) mkdir((path),(mode))
+
+#ifndef PERL_SYS_TERM
+#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM; CloseSTDLIB();
+#endif
+
+#define BIT_BUCKET "NUL:"
+
+#define dXSUB_SYS
+
+#define NO_ENVIRON_ARRAY
+
+int kill(pid_t pid, int signo);
+pid_t wait(int *status);
+
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# undef PERL_GET_VARS
+# undef PERL_SET_VARS
+# undef PERL_UNSET_VARS
+# define PERL_GET_VARS() symbian_get_vars()
+# define PERL_SET_VARS(v) symbian_set_vars(v)
+# define PERL_UNSET_VARS(v) symbian_unset_vars()
+#endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
+
+#undef PERL_EXPORT_C
+#define PERL_EXPORT_C EXPORT_C /* for perlio.h */
+#define PERL_CALLCONV EXPORT_C /* for prototype.h */
+#undef PERL_XS_EXPORT_C
+#define PERL_XS_EXPORT_C EXPORT_C
+
+#ifndef PERL_CORE
+#define PERL_CORE /* for WINS builds under VC */
+#endif
+
+#ifdef USE_PERLIO
+#define PERL_NEED_APPCTX /* need storing the PerlBase* */
+#define PERLIO_STD_SPECIAL
+#define PERLIO_STD_IN(f, b, n) symbian_read_stdin(f, b, n)
+#define PERLIO_STD_OUT(f, b, n) symbian_write_stdout(f, b, n)
+/* The console (the STD*) streams are seen by Perl in UTF-8. */
+#define PERL_SYMBIAN_CONSOLE_UTF8
+
+#endif
+
+#undef Strerror
+#undef strerror
+#define Strerror(eno) ((eno) < 0 ? symbian_get_error_string(eno) : strerror(eno))
+
+#define PERL_NEED_TIMESBASE
+
+#define times(b) symbian_times(b)
+#define usleep(u) symbian_usleep(u)
+
+#define PERL_SYS_INIT(c, v) symbian_sys_init(c, v)
+
+#ifdef __SERIES60_1X__
+# error "Unfortunately Perl does not work in S60 1.2 (see FAQ-0929)"
+#endif
+
+#ifdef _MSC_VER
+
+/* The Symbian SDK insists on the /W4 flag for Visual C.
+ * The Perl sources are not _that_ clean (Perl builds for Win32 use
+ * the /W3 flag, and gcc builds always use -Wall, so the sources are
+ * quite clean). To avoid a flood of warnings let's shut up most
+ * (for VC 6.0 SP 5). */
+
+#pragma warning(disable: 4054) /* function pointer to data pointer */
+#pragma warning(disable: 4055) /* data pointer to function pointer */
+#pragma warning(disable: 4100) /* unreferenced formal parameter */
+#pragma warning(disable: 4101) /* unreferenced local variable */
+#pragma warning(disable: 4102) /* unreferenced label */
+#pragma warning(disable: 4113) /* prototype difference */
+#pragma warning(disable: 4127) /* conditional expression is constant */
+#pragma warning(disable: 4132) /* const object should be initialized */
+#pragma warning(disable: 4133) /* incompatible types */
+#pragma warning(disable: 4189) /* initialized but not referenced */
+#pragma warning(disable: 4244) /* conversion from ... possible loss ... */
+#pragma warning(disable: 4245) /* signed/unsigned char */
+#pragma warning(disable: 4310) /* cast truncates constant value */
+#pragma warning(disable: 4505) /* function has been removed */
+#pragma warning(disable: 4510) /* default constructor could not ... */
+#pragma warning(disable: 4610) /* struct ... can never be instantiated */
+#pragma warning(disable: 4701) /* used without having been initialized */
+#pragma warning(disable: 4702) /* unreachable code */
+#pragma warning(disable: 4706) /* assignment within conditional */
+#pragma warning(disable: 4761) /* integral size mismatch */
+
+#endif /* _MSC_VER */
+
diff --git a/symbian/uid.pl b/symbian/uid.pl
new file mode 100644
index 0000000000..6eae8a9bcb
--- /dev/null
+++ b/symbian/uid.pl
@@ -0,0 +1 @@
+0x102015F3
diff --git a/symbian/version.pl b/symbian/version.pl
new file mode 100644
index 0000000000..c8bb82ebf7
--- /dev/null
+++ b/symbian/version.pl
@@ -0,0 +1,22 @@
+use strict;
+
+my %VERSION;
+
+if (open(PATCHLEVEL_H, "patchlevel.h")) {
+ while (<PATCHLEVEL_H>) {
+ if (/#define\s+PERL_(REVISION|VERSION|SUBVERSION)\s+(\d+)/) {
+ $VERSION{$1} = $2;
+ }
+ }
+ close PATCHLEVEL_H;
+} else {
+ die "$0: patchlevel.h: $!\n";
+}
+
+die "$0: Perl release looks funny.\n"
+ unless (defined $VERSION{REVISION} && $VERSION{REVISION} == 5 &&
+ defined $VERSION{VERSION} && $VERSION{VERSION} >= 8 &&
+ defined $VERSION{SUBVERSION});
+
+
+\%VERSION;
diff --git a/symbian/xsbuild.pl b/symbian/xsbuild.pl
new file mode 100644
index 0000000000..ff743bda79
--- /dev/null
+++ b/symbian/xsbuild.pl
@@ -0,0 +1,861 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Getopt::Long;
+use File::Basename;
+use Cwd;
+
+do "sanity.pl";
+
+my $CoreBuild = -d "ext" && -f "perl.h" && -d "symbian" && -f "perl.c";
+
+my $SymbianVersion = $ENV{XSBUILD_SYMBIAN_VERSION};
+my $PerlVersion = $ENV{XSBUILD_PERL_VERSION};
+my $CSuffix = '.c';
+my $CPlusPlus;
+my $Config;
+my $Build;
+my $Clean;
+my $DistClean;
+my $Sis;
+
+sub usage {
+ die <<__EOF__;
+$0: Usage: $0 [--symbian=version] [--perl=version]
+ [--csuffix=csuffix] [--cplusplus]
+ [--win=win] [--arm=arm]
+ [--config|--build|--clean|--distclean|--sis] ext
+__EOF__
+}
+
+my $CWD;
+my $SDK;
+my $VERSION;
+my $R_V_SV;
+my $PERLSDK;
+my $WIN;
+my $ARM;
+my $HOME = getcwd();
+
+if ( !defined $PerlVersion && $0 =~ m:\\symbian\\perl\\(.+)\\bin\\xsbuild.pl:i )
+{
+ $PerlVersion = $1;
+}
+
+if ( !defined $SymbianVersion) {
+ ($SymbianVersion) = ($ENV{PATH} =~ m!C:\\Symbian\\(.+?)\\!i);
+}
+
+my $S60SDK;
+
+if ($CoreBuild) {
+ unshift @INC, "symbian";
+ do "sanity.pl";
+ my %VERSION = %{ do "version.pl" };
+ $SDK = do "sdk.pl";
+ $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+ $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+ $HOME = do "cwd.pl";
+ $SymbianVersion = $1 if $SDK =~ m:\\Symbian\\([^\\]+):;
+ $PerlVersion = $R_V_SV;
+ $S60SDK = $ENV{S60SDK}; # from sdk.pl
+}
+
+usage()
+ unless GetOptions(
+ 'symbian=s' => \$SymbianVersion,
+ 'perl=s' => \$PerlVersion,
+ 'csuffix=s' => \$CSuffix,
+ 'cplusplus' => \$CPlusPlus,
+ 'win=s' => \$WIN,
+ 'arm=s' => \$ARM,
+ 'config' => \$Config,
+ 'build' => \$Build,
+ 'clean' => \$Clean,
+ 'distclean' => \$DistClean,
+ 'sis' => \$Sis
+ );
+
+usage() unless @ARGV;
+
+$CSuffix = '.cpp' if $CPlusPlus;
+$Build = !( $Config || $Clean || $DistClean ) || $Sis unless defined $Build;
+
+die "$0: Symbian version undefined\n" unless defined $SymbianVersion;
+
+$SymbianVersion =~ s:/:\\:g;
+
+die "$0: Symbian version '$SymbianVersion' not found\n"
+ unless -d "\\Symbian\\$SymbianVersion";
+
+die "$0: Perl version undefined\n" unless defined $PerlVersion;
+
+die "$0: Perl version '$PerlVersion' not found\n"
+ if !$CoreBuild && !-d "\\Symbian\\Perl\\$PerlVersion";
+
+print "Configuring with Symbian $SymbianVersion and Perl $PerlVersion...\n";
+
+$SDK = "\\Symbian\\$SymbianVersion" unless defined $SDK;
+$PERLSDK = "\\Symbian\\Perl\\$PerlVersion";
+
+$R_V_SV = $PerlVersion;
+
+$VERSION =~ tr/.//d;
+
+$ENV{SDK} = $SDK; # For the Errno extension
+$ENV{CROSS} = 1; # For the Encode extension
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+my $UARM = $ENV{UARM}; # from sdk.pl
+my $SRCDBG = $UARM eq 'udeb' ? "SRCDBG" : "";
+
+my %CONF;
+my %EXTCFG;
+
+sub write_bld_inf {
+ my ($base) = @_;
+ print "\tbld.inf\n";
+ open( BLD_INF, ">bld.inf" ) or die "$0: bld.inf: $!\n";
+ print BLD_INF <<__EOF__;
+PRJ_MMPFILES
+$base.mmp
+PRJ_PLATFORMS
+$WIN $ARM
+__EOF__
+ close(BLD_INF);
+}
+
+sub system_echo {
+ my $cmd = shift;
+ print "xsbuild: ", $cmd, "\n";
+ return system($cmd);
+}
+
+sub run_PL {
+ my ( $PL, $dir, $file ) = @_;
+ if ( defined $file ) {
+ print "\t(Running $dir\\$PL to create $file)\n";
+ unlink($file);
+ }
+ else {
+ print "\t(Running $dir\\$PL)\n";
+ }
+ my $cmd;
+ if ($CoreBuild) {
+ # Problem: the Config.pm we have in $HOME\\lib carries the
+ # version number of the Perl we are building, while the Perl
+ # we are running might have some other version. Solution:
+ # temporarily replace the Config.pm with a patched version.
+ my $V = sprintf "%vd", $^V;
+ unlink("$HOME\\lib\\Config.pm.bak");
+ system_echo("perl -pi.bak -e \"s:\\Q$R_V_SV:$V:\" $HOME\\lib\\Config.pm");
+ }
+ system_echo("perl -I$HOME\\lib -I$HOME\\xlib\\symbian $PL") == 0
+ or warn "$0: $PL failed.\n";
+ if ($CoreBuild) {
+ system_echo("copy $HOME\\lib\\Config.pm.bak $HOME\\lib\\Config.pm");
+ }
+ if ( defined $file ) { -s $file or die "$0: No $file created.\n" }
+}
+
+sub read_old_multi {
+ my ( $conf, $k ) = @_;
+ push @{ $conf->{$k} }, split( ' ', $1 ) if /^$k\s(.+)$/;
+}
+
+sub uniquefy_filenames {
+ my $b = [];
+ my %c = ();
+ for my $i (@{$_[0]}) {
+ $i =~ s!/!\\!g;
+ $i = lc $i if $i =~ m!\\!;
+ $i =~ s!^c:!!;
+ push @$b, $i unless $c{$i}++;
+ }
+ return $b;
+}
+
+sub read_mmp {
+ my ( $conf, $mmp ) = @_;
+ if ( -r $mmp && open( MMP, "<$mmp" ) ) {
+ print "\tReading $mmp...\n";
+ while (<MMP>) {
+ chomp;
+ $conf->{TARGET} = $1 if /^TARGET\s+(.+)$/;
+ $conf->{TARGETPATH} = $1 if /^TARGETPATH\s+(.+)$/;
+ $conf->{EXTVERSION} = $1 if /^EXTVERSION\s+(.+)$/;
+ read_old_multi( $conf, "SOURCE" );
+ read_old_multi( $conf, "SOURCEPATH" );
+ read_old_multi( $conf, "USERINCLUDE" );
+ read_old_multi( $conf, "SYSTEMINCLUDE" );
+ read_old_multi( $conf, "LIBRARY" );
+ read_old_multi( $conf, "MACRO" );
+ }
+ close(MMP);
+ }
+}
+
+sub write_mmp {
+ my ( $base, $userinclude, @src ) = @_;
+
+ print "\t$base.mmp\n";
+ $CONF{TARGET} = "$base.dll";
+ $CONF{TARGETPATH} = "\\System\\Libs\\Perl\\$R_V_SV";
+ $CONF{SOURCE} = [@src];
+ $CONF{SOURCEPATH} = [ $CWD, $HOME ];
+ $CONF{USERINCLUDE} = [ $CWD, $HOME ];
+ $CONF{SYSTEMINCLUDE} = ["$PERLSDK\\include"] unless $CoreBuild;
+ $CONF{SYSTEMINCLUDE} = [ $HOME ] if $CoreBuild;
+ $CONF{LIBRARY} = [];
+ $CONF{MACRO} = [];
+ read_mmp( \%CONF, "_init.mmp" );
+ read_mmp( \%CONF, "$base.mmp" );
+
+ for my $ui ( @{$userinclude} ) {
+ $ui =~ s!/!\\!g;
+ if ( $ui =~ m!^(?:[CD]:)?\\! ) {
+ push @{ $CONF{USERINCLUDE} }, $ui;
+ }
+ else {
+ push @{ $CONF{USERINCLUDE} }, "$HOME\\$ui";
+ }
+ }
+ push @{ $CONF{SYSTEMINCLUDE} }, "\\epoc32\\include";
+ push @{ $CONF{SYSTEMINCLUDE} }, "\\epoc32\\include\\libc";
+ push @{ $CONF{LIBRARY} }, "euser.lib";
+ push @{ $CONF{LIBRARY} }, "estlib.lib";
+ push @{ $CONF{LIBRARY} }, "perl$VERSION.lib";
+ push @{ $CONF{MACRO} }, "SYMBIAN" unless $CoreBuild;
+ push @{ $CONF{MACRO} }, "PERL_EXT" if $CoreBuild;
+ push @{ $CONF{MACRO} }, "MULTIPLICITY";
+ push @{ $CONF{MACRO} }, "PERL_IMPLICIT_CONTEXT";
+ push @{ $CONF{MACRO} }, "PERL_GLOBAL_STRUCT";
+ push @{ $CONF{MACRO} }, "PERL_GLOBAL_STRUCT_PRIVATE";
+
+ for my $u (qw(SOURCE SOURCEPATH SYSTEMINCLUDE USERINCLUDE LIBRARY MACRO)) {
+ $CONF{$u} = uniquefy_filenames( $CONF{$u} );
+ }
+ open( BASE_MMP, ">$base.mmp" ) or die "$0: $base.mmp: $!\n";
+
+ print BASE_MMP <<__EOF__;
+TARGET $CONF{TARGET}
+TARGETTYPE dll
+TARGETPATH $CONF{TARGETPATH}
+SOURCE @{$CONF{SOURCE}}
+$SRCDBG
+__EOF__
+ for my $u (qw(SOURCEPATH SYSTEMINCLUDE USERINCLUDE)) {
+ for my $v ( @{ $CONF{$u} } ) {
+ print BASE_MMP "$u\t$v\n";
+ }
+ }
+ # OPTION does not work in MMPs for pre-2.0 SDKs?
+ print BASE_MMP <<__EOF__;
+LIBRARY @{$CONF{LIBRARY}}
+MACRO @{$CONF{MACRO}}
+// OPTION MSVC /P
+// OPTION GCC -E
+__EOF__
+ close(BASE_MMP);
+
+}
+
+sub write_makefile {
+ my ( $base, $build ) = @_;
+
+ print "\tMakefile\n";
+
+ my $windef1 = "$SDK\\Epoc32\\Build$CWD\\$base\\$WIN\\$base.def";
+ my $windef2 = "..\\BWINS\\${base}u.def";
+ my $armdef1 = "$SDK\\Epoc32\\Build$CWD\\$base\\$ARM\\$base.def";
+ my $armdef2 = "..\\BMARM\\${base}u.def";
+
+ my $wrap = $SDK && $S60SDK eq '1.2' && $SDK !~ /_CW$/;
+ my $ABLD = $wrap ? 'perl b.pl' : 'abld';
+
+ open( MAKEFILE, ">Makefile" ) or die "$0: Makefile: $!\n";
+ print MAKEFILE <<__EOF__;
+WIN = $WIN
+ARM = $ARM
+ABLD = $ABLD
+
+all: build freeze
+
+sis: build_arm freeze_arm
+
+build: abld.bat build_win build_arm
+
+abld.bat:
+ bldmake bldfiles
+
+build_win: abld.bat
+ bldmake bldfiles
+ \$(ABLD) build \$(WIN) udeb
+
+build_arm: abld.bat
+ bldmake bldfiles
+ \$(ABLD) build \$(ARM) $UARM
+
+win: build_win freeze_win
+
+arm: build_arm freeze_arm
+
+freeze: freeze_win freeze_arm
+
+freeze_win:
+ bldmake bldfiles
+ \$(ABLD) freeze \$(WIN) $base
+
+freeze_arm:
+ bldmake bldfiles
+ \$(ABLD) freeze \$(ARM) $base
+
+defrost: defrost_win defrost_arm
+
+defrost_win:
+ -del /f $windef1
+ -del /f $windef2
+
+defrost_arm:
+ -del /f $armdef1
+ -del /f $armdef2
+
+clean: clean_win clean_arm
+
+clean_win:
+ \$(ABLD) clean \$(WIN)
+
+clean_arm:
+ \$(ABLD) clean \$(ARM)
+
+realclean: clean realclean_win realclean_arm
+ -del /f _init.c b.pl
+ -del /f $base.c $base.mmp
+
+realclean_win:
+ \$(ABLD) reallyclean \$(WIN)
+
+realclean_arm:
+ \$(ABLD) reallyclean \$(ARM)
+
+distclean: defrost realclean
+ -rmdir ..\\BWINS ..\\BMARM
+ -del /f const-c.inc const-xs.inc
+ -del /f Makefile abld.bat bld.inf
+__EOF__
+ close(MAKEFILE);
+ if ($wrap) {
+ if(open(B,">b.pl")) {
+ print B <<'__EOF__';
+# abld.pl wrapper.
+
+# nmake doesn't like MFLAGS and MAKEFLAGS being set to -w and w.
+delete $ENV{MFLAGS};
+delete $ENV{MAKEFLAGS};
+
+print "abld @ARGV\n";
+system("abld @ARGV");
+__EOF__
+ close(B);
+ } else {
+ warn "$0: failed to create b.pl: $!\n";
+ }
+ }
+}
+
+sub update_dir {
+ print "[chdir from ", getcwd(), " to ";
+ chdir(shift) or return;
+ update_cwd();
+ print getcwd(), "]\n";
+}
+
+sub xsconfig {
+ my ( $ext, $dir ) = @_;
+ print "Configuring for $ext, directory $dir...\n";
+ my $extu = $CoreBuild ? "$HOME\\lib\\ExtUtils" : "$PERLSDK\\lib\\ExtUtils";
+ update_dir($dir) or die "$0: chdir '$dir': $!\n";
+ my $build = dirname($ext);
+ my $base = basename($ext);
+ my $basexs = "$base.xs";
+ my $basepm = "$base.pm";
+ my $basec = "$base$CSuffix";
+ my $extdir = ".";
+ if ( $dir =~ m:^ext\\(.+): ) {
+ $extdir = $1;
+ }
+ elsif ( $dir ne "." ) {
+ $extdir = $dir;
+ }
+ my $extdirdir = dirname($extdir);
+ my $targetroot = "\\System\\Libs\\Perl\\$R_V_SV";
+ write_bld_inf($base) if -f $basexs;
+
+ my %src;
+ $src{$basec}++;
+
+ $extdirdir = $extdirdir eq "." ? "" : "$extdirdir\\";
+
+ my %lst;
+ $lst{"$UREL\\$base.dll"} =
+ "$targetroot\\$ARM-symbian\\$base.dll"
+ if -f $basexs;
+ $lst{"$dir\\$base.pm"} = "$targetroot\\$extdirdir$base.pm"
+ if -f $basepm && $base ne 'XSLoader';
+
+ my %incdir;
+ my $ran_PL;
+ if ( -d 'lib' ) {
+ use File::Find;
+ my @found;
+ find( sub { push @found, $File::Find::name if -f $_ }, 'lib' );
+ for my $found (@found) {
+ my ($short) = ( $found =~ m/^lib.(.+)/ );
+ $short =~ s!/!\\!g;
+ $found =~ s!/!\\!g;
+ $lst{"$dir\\$found"} = "$targetroot\\$short";
+ }
+ }
+ if ( my @pm = glob("*.pm */*.pm") ) {
+ for my $pm (@pm) {
+ next if $pm =~ m:^t/:;
+ $pm =~ s:/:\\:g;
+ $lst{"$dir\\$pm"} = "$targetroot\\$extdirdir$pm";
+ }
+ }
+ if ( my @c = glob("*.c *.cpp */*.c */*.cpp") ) {
+ for my $c (@c) {
+ $c =~ s:/:\\:g;
+ $src{$c}++;
+ }
+ }
+ if ( my @h = glob("*.h */*.h") ) {
+ for my $h (@h) {
+ $h =~ s:/:\\:g;
+ $h = dirname($h);
+ $incdir{"$dir\\$h"}++ unless $h eq ".";
+ }
+ }
+ if ( exists $EXTCFG{$ext} ) {
+ for my $cfg ( @{ $EXTCFG{$ext} } ) {
+ if ( $cfg =~ /^([-+])?(.+\.(c|cpp|h))$/ ) {
+ my $o = defined $1 ? $1 : '+';
+ my $f = $2;
+ $f =~ s:/:\\:g;
+ for my $f ( glob($f) ) {
+ if ( $o eq '+' ) {
+ warn "$0: no source file $dir\\$f\n" unless -f $f;
+ $src{$f}++ unless $cfg =~ /\.h$/;
+ if ( $f =~ m:^(.+)\\[^\\]+$: ) {
+ $incdir{$1}++;
+ }
+ }
+ elsif ( $o eq '-' ) {
+ delete $src{$f};
+ }
+ }
+ }
+ if ( $cfg =~ /^([-+])?(.+\.(pm|pl|inc))$/ ) {
+ my $o = defined $1 ? $1 : '+';
+ my $f = $2;
+ $f =~ s:/:\\:g;
+ for my $f ( glob($f) ) {
+ if ( $o eq '+' ) {
+ warn "$0: no Perl file $dir\\$f\n" unless -f $f;
+ $lst{"$dir\\$f"} = "$targetroot\\$extdir\\$f";
+ }
+ elsif ( $o eq '-' ) {
+ delete $lst{"$dir\\$f"};
+ }
+ }
+ }
+ if ( $cfg eq 'CONST' && !$ran_PL++ ) {
+ run_PL( "Makefile.PL", $dir, "const-xs.inc" );
+ }
+ }
+ }
+ unless ( $ran_PL++ ) {
+ run_PL( "Makefile.PL", $dir ) if -f "Makefile.PL";
+ }
+ if ( $dir eq "ext\\Errno" ) {
+ run_PL( "Errno_pm.PL", $dir, "Errno.pm" );
+ $lst{"$dir\\Errno.pm"} = "$targetroot\\Errno.pm";
+ }
+ elsif ( $dir eq "ext\\Devel\\PPPort" ) {
+ run_PL( "ppport_h.PL", $dir, "ppport.h" );
+ }
+ elsif ( $dir eq "ext\\DynaLoader" ) {
+ run_PL( "XSLoader_pm.PL", $dir, "XSLoader.pm" );
+ $lst{"ext\\DynaLoader\\XSLoader.pm"} = "$targetroot\\XSLoader.pm";
+ }
+ elsif ( $dir eq "ext\\Encode" ) {
+ system_echo("perl bin\\enc2xs -Q -O -o def_t.c -f def_t.fnm") == 0
+ or die "$0: running enc2xs failed: $!\n";
+ }
+
+ my @lst = sort keys %lst;
+
+ read_mmp( \%CONF, "_init.mmp" );
+ read_mmp( \%CONF, "$base.mmp" );
+
+ if ( -f $basexs ) {
+ my %MM; # MakeMaker results
+ my @MM = qw(VERSION XS_VERSION);
+ if ( -f "Makefile" ) {
+ print "\tReading MakeMaker Makefile...\n";
+ if ( open( MAKEFILE, "Makefile" ) ) {
+ while (<MAKEFILE>) {
+ for my $m (@MM) {
+ if (m!^$m = (.+)!) {
+ $MM{$m} = $1;
+ print "\t$m = $1\n";
+ }
+ }
+ }
+ close(MAKEFILE);
+ }
+ else {
+ warn "$0: Makefile: $!";
+ }
+ print "\tDeleting MakeMaker Makefile.\n";
+ unlink("Makefile");
+ }
+
+ unlink($basec);
+ print "\t$basec\n";
+ if ( defined $CONF{EXTVERSION} ) {
+ my $EXTVERSION = $CONF{EXTVERSION};
+ print "\tUsing $EXTVERSION for version...\n";
+ $MM{VERSION} = $MM{XS_VERSION} = $EXTVERSION;
+ }
+ die "VERSION or XS_VERSION undefined\n"
+ unless defined $MM{VERSION} && defined $MM{XS_VERSION};
+ if ( open( BASE_C, ">$basec" ) ) {
+ print BASE_C <<__EOF__;
+#ifndef VERSION
+#define VERSION "$MM{VERSION}"
+#endif
+#ifndef XS_VERSION
+#define XS_VERSION "$MM{XS_VERSION}"
+#endif
+__EOF__
+ close(BASE_C);
+ }
+ else {
+ warn "$0: $basec: $!";
+ }
+ unless (
+ system(
+"perl -I$PERLSDK\\lib $extu\\xsubpp -C++ -csuffix .cpp -typemap $extu\\typemap -noprototypes $basexs >> $basec"
+ ) == 0
+ && -s $basec
+ )
+ {
+ die "$0: perl xsubpp failed: $!\n";
+ }
+
+ print "\t_init.c\n";
+ open( _INIT_C, ">_init.c" ) or die "$!: _init.c: $!\n";
+ print _INIT_C <<__EOF__;
+ #include "EXTERN.h"
+ #include "perl.h"
+ EXPORT_C void _init(void *handle) {
+ }
+__EOF__
+ close(_INIT_C);
+
+ my @src = ( "_init.c", sort keys %src );
+
+ if ( $base eq "Encode" ) { # Currently unused.
+ for my $submf ( glob("*/Makefile") ) {
+ my $d = dirname($submf);
+ print "Configuring Encode::$d...\n";
+ if ( open( SUBMF, $submf ) ) {
+ if ( update_dir($d) ) {
+ my @subsrc;
+ while (<SUBMF>) {
+ next if 1 .. /postamble/;
+ if (m!^(\w+_t)\.c : !) {
+ system(
+ "perl ..\\bin\\enc2xs -Q -o $1.c -f $1.fnm")
+ == 0
+ or warn "$0: enc2xs: $!\n";
+ push @subsrc, "$1.c";
+ }
+ }
+ close(SUBMF);
+ unlink($submf);
+ my $subbase = $d;
+ $subbase =~ s!/!::!g;
+ write_mmp( $subbase, ["..\\Encode"], "$subbase.c",
+ @subsrc );
+ write_makefile( $subbase, $build );
+ write_bld_inf($subbase);
+
+ unless (
+ system(
+"perl -I$HOME\\lib ..\\$extu\\xsubpp -C++ -csuffix .cpp -typemap ..\\$extu\\typemap -noprototypes $subbase.xs > $subbase.c"
+ ) == 0
+ && -s "$subbase.c"
+ )
+ {
+ die "$0: perl xsubpp failed: $!\n";
+ }
+ update_dir("..");
+ }
+ else {
+ warn "$0: chdir $d: $!\n";
+ }
+ }
+ else {
+ warn "$0: $submf: $!";
+ }
+ }
+ print "Configuring Encode...\n";
+ }
+
+ write_mmp( $base, [ keys %incdir ], @src );
+ write_makefile( $base, $build );
+ }
+ my $lstname = $ext;
+ $lstname =~ s:^ext\\::;
+ $lstname =~ s:\\:-:g;
+ print "\t$lstname.lst\n";
+ my $lstout =
+ $CoreBuild ? "$HOME/symbian/$lstname.lst" : "$HOME/$lstname.lst";
+ if ( open( my $lst, ">$lstout" ) ) {
+ for my $f (@lst) { print $lst qq["$f"-"!:$lst{$f}"\n] }
+ close($lst);
+ }
+ else {
+ die "$0: $lstout: $!\n";
+ }
+ update_dir($HOME);
+}
+
+sub update_cwd {
+ $CWD = getcwd();
+ $CWD =~ s!^[CD]:!!i;
+ $CWD =~ s!/!\\!g;
+}
+
+for my $ext (@ARGV) {
+
+ $ext =~ s!::!\\!g;
+ $ext =~ s!/!\\!g;
+
+ my $cfg;
+
+ $cfg = $2 if $ext =~ s/(.+?),(.+)/$1/;
+
+ my $dir;
+
+ unless ( -e $ext ) {
+ if ( $ext =~ /\.xs$/ && !-f $ext ) {
+ if ( -f "ext\\$ext" ) {
+ $ext = "ext\\$ext";
+ $dir = dirname($ext);
+ }
+ }
+ elsif ( !-d $ext ) {
+ if ( -d "ext\\$ext" ) {
+ $ext = "ext\\$ext";
+ $dir = $ext;
+ }
+ }
+ $dir = "." unless defined $dir;
+ }
+ else {
+ if ( $ext =~ /\.xs$/ && -f $ext ) {
+ $ext = dirname($ext);
+ $dir = $ext;
+ }
+ elsif ( -d $ext ) {
+ $dir = $ext;
+ }
+ }
+
+ if ( $ext eq "XSLoader" ) {
+ $ext = "ext\\XSLoader";
+ }
+ if ( $ext eq "ext\\XSLoader" ) {
+ $dir = "ext\\DynaLoader";
+ }
+
+ $EXTCFG{$ext} = [ split( /,/, $cfg ) ] if defined $cfg;
+
+ die "$0: no lib\\Config.pm\n"
+ if $CoreBuild && $Build && !-f "lib\\Config.pm";
+
+ if ($CoreBuild) {
+ open( my $cfg, "symbian/install.cfg" )
+ or die "$0: symbian/install.cfg: $!\n";
+ my $extdir = $dir;
+ $extdir =~ s:^ext\\::;
+ while (<$cfg>) {
+ next unless /^ext\s+(.+)/;
+ chomp;
+ my $ext = $1;
+ my @ext = split( ' ', $ext );
+ $EXTCFG{"ext\\$ext[0]"} = [@ext];
+ }
+ close($cfg);
+ }
+
+ if ( $Config || $Build ) {
+ xsconfig( $ext, $dir ) or die "$0: xsconfig '$ext' failed\n";
+ next if $Config;
+ }
+
+ my $chdir = $ext eq "ext\\XSLoader" ? "ext\\DynaLoader" : $dir;
+ die "$0: no directory '$chdir'\n" unless -d $chdir;
+ update_dir($chdir) or die "$0: chdir '$chdir' failed: $!\n";
+
+ my %CONF;
+
+ my @ext = split( /\\/, $ext );
+ my $base = $ext[-1];
+
+ if ( $Clean || $DistClean ) {
+ print "Cleaning $ext...\n";
+ unlink("bld.inf");
+ unlink("$base.mmp");
+ unlink("_init.c");
+ unlink("const-c.inc");
+ unlink("const-xs.inc");
+ rmdir("..\\bmarm");
+ }
+
+ if ( $Build && $ext ne "ext\\XSLoader" && $ext ne "ext\\Errno" ) {
+
+ # We compile the extension three (3) times.
+ # (1) Only the _init.c to get _init() as the ordinal 1 function in the DLL.
+ # (2) With the rest and the _init.c to get ordinals for the rest.
+ # (3) With an updated _init.c that carries the symbols from step (2).
+
+ system("make clean");
+ system("make defrost") == 0 or die "$0: make defrost failed\n";
+
+ my @TARGET;
+
+ push @TARGET, 'sis' if $Sis;
+
+ # Compile #1.
+ # Hide all but the _init.c.
+ print "\n*** $ext - Compile 1 of 3.\n\n";
+ system(
+"perl -pi.bak -e \"s:^SOURCE\\s+_init.c:SOURCE\\t_init.c // :\" $base.mmp"
+ );
+ system("bldmake bldfiles");
+ system("make @TARGET") == 0 or die "$0: make #1 failed\n";
+
+ # Compile #2.
+ # Reveal the rest again.
+ print "\n*** $ext - Compile 2 of 3.\n\n";
+ system(
+"perl -pi.bak -e \"s:^SOURCE\\t_init.c // :SOURCE\\t_init.c :\" $base.mmp"
+ );
+ system("make @TARGET") == 0 or die "$0: make #2 failed\n";
+ unlink("$base.mmp.bak");
+
+ open( _INIT_C, ">_init.c" ) or die "$0: _init.c: $!\n";
+ print _INIT_C <<'__EOF__';
+#include "EXTERN.h"
+#include "perl.h"
+
+/* This is a different but matching definition from in dl_symbian.xs. */
+typedef struct {
+ void* handle;
+ int error;
+ HV* symbols;
+} PerlSymbianLibHandle;
+
+EXPORT_C void _init(void* handle) {
+__EOF__
+
+ my %symbol;
+ my $def;
+ my $basef;
+ for my $f ("$SDK\\Epoc32\\Build$CWD\\$base\\WINS\\$base.def",
+ "..\\BMARM\\${base}u.def") {
+ print "\t($f - ";
+ if ( open( $def, $f ) ) {
+ print "OK)\n";
+ $basef = $f;
+ last;
+ } else {
+ print "no)\n";
+ }
+ }
+ unless (defined $basef) {
+ die "$0: failed to find .def for $base\n";
+ }
+ while (<$def>) {
+ next while 1 .. /^EXPORTS/;
+ if (/^\s*(\w+) \@ (\d+) /) {
+ $symbol{$1} = $2;
+ }
+ }
+ close($def);
+
+ my @symbol = sort keys %symbol;
+ if (@symbol) {
+ print _INIT_C <<'__EOF__';
+ dTHX;
+ PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+ if (!h->symbols)
+ h->symbols = newHV();
+ if (h->symbols) {
+__EOF__
+ for my $sym (@symbol) {
+ my $len = length($sym);
+ print _INIT_C <<__EOF__;
+ hv_store(h->symbols, "$sym", $len, newSViv($symbol{$sym}), 0);
+__EOF__
+ }
+ }
+ else {
+ die "$0: $basef: no exports found\n";
+ }
+
+ print _INIT_C <<'__EOF__';
+ }
+}
+__EOF__
+ close(_INIT_C);
+
+ # Compile #3. This is for real.
+ print "\n*** $ext - Compile 3 of 3.\n\n";
+ system("make @TARGET") == 0 or die "$0: make #3 failed\n";
+
+ }
+ elsif ( $Clean || $DistClean ) {
+ if ( $ext eq "ext\\Errno" ) {
+ unlink( "Errno.pm", "Makefile" );
+ }
+ else {
+ if ( -f "Makefile" ) {
+ if ($Clean) {
+ system("make clean") == 0 or die "$0: make clean failed\n";
+ }
+ elsif ($DistClean) {
+ system("make distclean") == 0
+ or die "$0: make distclean failed\n";
+ }
+ }
+ if ( $ext eq "ext\\Devel\\PPPort" ) {
+ unlink("ppport.h");
+ }
+ }
+ my @B = glob("ext/BWINS ext/BMARM ext/*/BWINS ext/*/BMARM Makefile");
+ rmdir(@B) if @B;
+ }
+
+ update_dir($HOME);
+
+} # for my $ext
+
+exit(0);
+
diff --git a/taint.c b/taint.c
index f21aedcdb4..03bdedc3d5 100644
--- a/taint.c
+++ b/taint.c
@@ -74,8 +74,8 @@ Perl_taint_env(pTHX)
{
SV** svp;
MAGIC* mg;
- const char** e;
- static const char* misc_env[] = {
+ const char* const *e;
+ static const char* const misc_env[] = {
"IFS", /* most shells' inter-field separators */
"CDPATH", /* ksh dain bramage #1 */
"ENV", /* ksh dain bramage #2 */
diff --git a/toke.c b/toke.c
index cd2cfe56b1..d35227fae4 100644
--- a/toke.c
+++ b/toke.c
@@ -26,9 +26,12 @@
#define yychar (*PL_yycharp)
#define yylval (*PL_yylvalp)
-static char const ident_too_long[] = "Identifier too long";
-static char const c_without_g[] = "Use of /c modifier is meaningless without /g";
-static char const c_in_subst[] = "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] =
+ "Identifier too long";
+static const char c_without_g[] =
+ "Use of /c modifier is meaningless without /g";
+static const char c_in_subst[] =
+ "Use of /c modifier is meaningless in s///";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
@@ -76,7 +79,7 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
#define LEX_KNOWNEXT 0
#ifdef DEBUGGING
-static char const* lex_state_names[] = {
+static const char* const lex_state_names[] = {
"KNOWNEXT",
"FORMLINE",
"INTERPCONST",
@@ -199,7 +202,8 @@ enum token_type {
TOKENTYPE_GVVAL
};
-static struct debug_tokens { const int token, type; const char *name; } debug_tokens[] =
+static struct debug_tokens { const int token, type; const char *name; }
+ const debug_tokens[] =
{
{ ADDOP, TOKENTYPE_OPNUM, "ADDOP" },
{ ANDAND, TOKENTYPE_NONE, "ANDAND" },
@@ -1167,6 +1171,7 @@ S_sublex_start(pTHX)
STATIC I32
S_sublex_push(pTHX)
{
+ dVAR;
ENTER;
PL_lex_state = PL_sublex_info.super_state;
@@ -1225,6 +1230,7 @@ S_sublex_push(pTHX)
STATIC I32
S_sublex_done(pTHX)
{
+ dVAR;
if (!PL_lex_starts++) {
SV *sv = newSVpvn("",0);
if (SvUTF8(PL_linestr))
@@ -2271,7 +2277,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
}
#ifdef DEBUGGING
- static char const* exp_name[] =
+ static const char* const exp_name[] =
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
"ATTRTERM", "TERMBLOCK", "TERMORDORDOR"
};
@@ -2831,6 +2837,7 @@ Perl_yylex(pTHX)
!instr(s,"indir") &&
instr(PL_origargv[0],"perl"))
{
+ dVAR;
char **newargv;
*ipathend = '\0';
@@ -8939,7 +8946,7 @@ STATIC SV *
S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
const char *type)
{
- dSP;
+ dVAR; dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV **cvp;
@@ -9285,6 +9292,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
STATIC char *
S_scan_subst(pTHX_ char *start)
{
+ dVAR;
register char *s;
register PMOP *pm;
I32 first_start;
@@ -10151,16 +10159,17 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
I32 shift;
bool overflowed = FALSE;
bool just_zero = TRUE; /* just plain 0 or binary number? */
- static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
- static char const* bases[5] = { "", "binary", "", "octal",
- "hexadecimal" };
- static char const* Bases[5] = { "", "Binary", "", "Octal",
- "Hexadecimal" };
- static char const *maxima[5] = { "",
- "0b11111111111111111111111111111111",
- "",
- "037777777777",
- "0xffffffff" };
+ static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
+ static const char* const bases[5] =
+ { "", "binary", "", "octal", "hexadecimal" };
+ static const char* const Bases[5] =
+ { "", "Binary", "", "Octal", "Hexadecimal" };
+ static const char* const maxima[5] =
+ { "",
+ "0b11111111111111111111111111111111",
+ "",
+ "037777777777",
+ "0xffffffff" };
const char *base, *Base, *max;
/* check for hex */
diff --git a/universal.c b/universal.c
index a90ba5d58f..e93a7c19ad 100644
--- a/universal.c
+++ b/universal.c
@@ -168,9 +168,9 @@ Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
#include "XSUB.h"
-void XS_UNIVERSAL_isa(pTHX_ CV *cv);
-void XS_UNIVERSAL_can(pTHX_ CV *cv);
-void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
XS(XS_version_new);
XS(XS_version_stringify);
XS(XS_version_numify);
diff --git a/utf8.c b/utf8.c
index 4f41a97c82..20f94df6dd 100644
--- a/utf8.c
+++ b/utf8.c
@@ -25,7 +25,8 @@
#define PERL_IN_UTF8_C
#include "perl.h"
-static char unees[] = "Malformed UTF-8 character (unexpected end of string)";
+static const char unees[] =
+ "Malformed UTF-8 character (unexpected end of string)";
/*
=head1 Unicode Support
@@ -1570,6 +1571,7 @@ Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
SV*
Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none)
{
+ dVAR;
SV* retval;
SV* tokenbufsv = sv_newmortal();
dSP;
@@ -1643,6 +1645,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
UV
Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
{
+ dVAR;
HV* hv = (HV*)SvRV(sv);
U32 klen;
U32 off;
@@ -1693,7 +1696,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
if (hv == PL_last_swash_hv &&
klen == PL_last_swash_klen &&
- (!klen || memEQ(ptr, PL_last_swash_key, klen)) )
+ (!klen || memEQ((char *)ptr, (char *)PL_last_swash_key, klen)) )
{
tmps = PL_last_swash_tmps;
slen = PL_last_swash_slen;
diff --git a/utf8.h b/utf8.h
index a8d440d3bf..c87bbf248c 100644
--- a/utf8.h
+++ b/utf8.h
@@ -42,7 +42,7 @@ EXTCONST unsigned char PL_utf8skip[];
#endif
END_EXTERN_C
-#define UTF8SKIP(s) PL_utf8skip[*(const U8*)s]
+#define UTF8SKIP(s) PL_utf8skip[*(const U8*)(s)]
/* Native character to iso-8859-1 */
#define NATIVE_TO_ASCII(ch) (ch)
diff --git a/util.c b/util.c
index fd5e04150e..5c1cdea1f3 100644
--- a/util.c
+++ b/util.c
@@ -141,6 +141,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
Free_t
Perl_safesysfree(Malloc_t where)
{
+ dVAR;
#ifdef PERL_IMPLICIT_SYS
dTHX;
#endif
@@ -446,7 +447,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
&& ((STRLEN)(bigend - big) == littlelen - 1)
&& (littlelen == 1
|| (*big == *little &&
- memEQ(big, little, littlelen - 1))))
+ memEQ((char *)big, (char *)little, littlelen - 1))))
return (char*)big;
return Nullch;
}
@@ -729,6 +730,7 @@ Perl_ibcmp(pTHX_ const char *s1, const char *s2, register I32 len)
I32
Perl_ibcmp_locale(pTHX_ const char *s1, const char *s2, register I32 len)
{
+ dVAR;
register const U8 *a = (const U8 *)s1;
register const U8 *b = (const U8 *)s2;
while (len--) {
@@ -986,7 +988,7 @@ SV *
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
SV *sv = mess_alloc();
- static char dgd[] = " during global destruction.\n";
+ static const char dgd[] = " during global destruction.\n";
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
@@ -1021,6 +1023,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
void
Perl_write_to_stderr(pTHX_ const char* message, int msglen)
{
+ dVAR;
IO *io;
MAGIC *mg;
@@ -1072,6 +1075,7 @@ STATIC char *
S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
I32* utf8)
{
+ dVAR;
char *message;
if (pat) {
@@ -1255,6 +1259,7 @@ Perl_croak(pTHX_ const char *pat, ...)
void
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
+ dVAR;
char *message;
HV *stash;
GV *gv;
@@ -1334,7 +1339,7 @@ Perl_warn(pTHX_ const char *pat, ...)
void
Perl_warner_nocontext(U32 err, const char *pat, ...)
{
- dTHX;
+ dTHX;
va_list args;
va_start(args, pat);
vwarner(err, pat, &args);
@@ -1354,6 +1359,7 @@ Perl_warner(pTHX_ U32 err, const char* pat,...)
void
Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
{
+ dVAR;
if (ckDEAD(err)) {
SV *msv = vmess(pat, args);
STRLEN msglen;
@@ -1393,6 +1399,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
+ dVAR;
#ifdef USE_ITHREADS
/* only parent thread can modify process environment */
if (PL_curinterp == aTHX)
@@ -1442,7 +1449,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
-# if defined(__CYGWIN__) || defined( EPOC)
+# if defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN)
setenv(nam, val, 1);
# else
char *new_env;
@@ -1467,6 +1474,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
+ dVAR;
register char *envstr;
const int nlen = strlen(nam);
int vlen;
@@ -1573,7 +1581,7 @@ Perl_my_memcmp(const char *s1, const char *s2, register I32 len)
register I32 tmp;
while (len--) {
- if (tmp = *a++ - *b++)
+ if ((tmp = *a++ - *b++))
return tmp;
}
return 0;
@@ -2131,8 +2139,6 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
#ifndef OS2
if (doexec) {
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
- int fd;
-
#ifndef NOFILE
#define NOFILE 20
#endif
@@ -2246,6 +2252,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
void
Perl_atfork_lock(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
/* locks must be held in locking order (if any) */
# ifdef MYMALLOC
@@ -2259,6 +2266,7 @@ Perl_atfork_lock(void)
void
Perl_atfork_unlock(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
/* locks must be released in same order as in atfork_lock() */
# ifdef MYMALLOC
@@ -2303,6 +2311,7 @@ Perl_dump_fds(pTHX_ char *s)
PerlIO_printf(Perl_debug_log," %d",fd);
}
PerlIO_printf(Perl_debug_log,"\n");
+ return;
}
#endif /* DUMP_FDS */
@@ -2351,6 +2360,7 @@ dup2(int oldfd, int newfd)
Sighandler_t
Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
{
+ dVAR;
struct sigaction act, oact;
#ifdef USE_ITHREADS
@@ -2390,6 +2400,7 @@ Perl_rsignal_state(pTHX_ int signo)
int
Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
{
+ dVAR;
struct sigaction act;
#ifdef USE_ITHREADS
@@ -2415,6 +2426,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
int
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
+ dVAR;
#ifdef USE_ITHREADS
/* only "parent" interpreter can diddle signals */
if (PL_curinterp != aTHX)
@@ -2438,19 +2450,18 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
return PerlProc_signal(signo, handler);
}
-static int sig_trapped; /* XXX signals are process-wide anyway, so we
- ignore the implications of this for threading */
-
static
Signal_t
sig_trap(int signo)
{
- sig_trapped++;
+ dVAR;
+ PL_sig_trapped++;
}
Sighandler_t
Perl_rsignal_state(pTHX_ int signo)
{
+ dVAR;
Sighandler_t oldsig;
#if defined(USE_ITHREADS) && !defined(WIN32)
@@ -2459,10 +2470,10 @@ Perl_rsignal_state(pTHX_ int signo)
return SIG_ERR;
#endif
- sig_trapped = 0;
+ PL_sig_trapped = 0;
oldsig = PerlProc_signal(signo, sig_trap);
PerlProc_signal(signo, oldsig);
- if (sig_trapped)
+ if (PL_sig_trapped)
PerlProc_kill(PerlProc_getpid(), signo);
return oldsig;
}
@@ -2560,16 +2571,15 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
- I32 result;
+ I32 result = 0;
if (!pid)
return -1;
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
{
- SV *sv;
- SV** svp;
char spid[TYPE_CHARS(IV)];
if (pid > 0) {
+ SV** svp;
sprintf(spid, "%"IVdf, (IV)pid);
svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
if (svp && *svp != &PL_sv_undef) {
@@ -2583,8 +2593,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
hv_iterinit(PL_pidstatus);
if ((entry = hv_iternext(PL_pidstatus))) {
+ SV *sv = hv_iterval(PL_pidstatus,entry);
+
pid = atoi(hv_iterkey(entry,(I32*)statusp));
- sv = hv_iterval(PL_pidstatus,entry);
*statusp = SvIVX(sv);
sprintf(spid, "%"IVdf, (IV)pid);
(void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
@@ -2606,7 +2617,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
goto finish;
#endif
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#if defined(HAS_WAITPID) && defined(HAS_WAITPID_RUNTIME)
hard_way:
+#endif
{
if (flags)
Perl_croak(aTHX_ "Can't do waitpid with flags");
@@ -2618,7 +2631,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
}
}
#endif
+#if defined(HAS_WAITPID) || defined(HAS_WAIT4)
finish:
+#endif
if (result < 0 && errno == EINTR) {
PERL_ASYNC_CHECK();
}
@@ -2967,6 +2982,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
void *
Perl_get_context(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
# ifdef OLD_PTHREADS_API
pthread_addr_t t;
@@ -2988,6 +3004,7 @@ Perl_get_context(void)
void
Perl_set_context(void *t)
{
+ dVAR;
#if defined(USE_ITHREADS)
# ifdef I_MACH_CTHREADS
cthread_set_data(cthread_self(), t);
@@ -3000,7 +3017,7 @@ Perl_set_context(void *t)
#endif /* !PERL_GET_CONTEXT_DEFINED */
-#ifdef PERL_GLOBAL_STRUCT
+#if defined(PERL_GLOBAL_STRUCT) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
struct perl_vars *
Perl_GetVars(pTHX)
{
@@ -3011,13 +3028,13 @@ Perl_GetVars(pTHX)
char **
Perl_get_op_names(pTHX)
{
- return PL_op_name;
+ return (char **)PL_op_name;
}
char **
Perl_get_op_descs(pTHX)
{
- return PL_op_desc;
+ return (char **)PL_op_desc;
}
const char *
@@ -3029,12 +3046,13 @@ Perl_get_no_modify(pTHX)
U32 *
Perl_get_opargs(pTHX)
{
- return PL_opargs;
+ return (U32 *)PL_opargs;
}
PPADDR_t*
Perl_get_ppaddr(pTHX)
{
+ dVAR;
return (PPADDR_t*)PL_ppaddr;
}
@@ -3053,7 +3071,7 @@ Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len)
MGVTBL*
Perl_get_vtbl(pTHX_ int vtbl_id)
{
- MGVTBL* result = Null(MGVTBL*);
+ const MGVTBL* result = Null(MGVTBL*);
switch(vtbl_id) {
case want_vtbl_sv:
@@ -3149,7 +3167,7 @@ Perl_get_vtbl(pTHX_ int vtbl_id)
result = &PL_vtbl_utf8;
break;
}
- return result;
+ return (MGVTBL*)result;
}
I32
@@ -3613,6 +3631,7 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
}
#else
Perl_croak(aTHX_ "panic: no strftime");
+ return NULL;
#endif
}
@@ -4425,7 +4444,15 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
return 0;
abort_tidy_up_and_fail:
- errno = ECONNABORTED; /* I hope this is portable and appropriate. */
+#ifdef ECONNABORTED
+ errno = ECONNABORTED; /* This would be the standard thing to do. */
+#else
+# ifdef ECONNREFUSED
+ errno = ECONNREFUSED; /* E.g. Symbian does not have ECONNABORTED. */
+# else
+ errno = ETIMEDOUT; /* Desperation time. */
+# endif
+#endif
tidy_up_and_fail:
{
int save_errno = errno;
@@ -4609,7 +4636,7 @@ Perl_seed(pTHX)
#endif
fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
if (fd != -1) {
- if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+ if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
u = 0;
PerlLIO_close(fd);
if (u)
@@ -4673,3 +4700,73 @@ Perl_get_hash_seed(pTHX)
return myseed;
}
+
+#ifdef PERL_GLOBAL_STRUCT
+
+struct perl_vars *
+Perl_init_global_struct(pTHX)
+{
+ struct perl_vars *plvarsp = NULL;
+#ifdef PERL_GLOBAL_STRUCT
+# define PERL_GLOBAL_STRUCT_INIT
+# include "opcode.h" /* the ppaddr and check */
+ IV nppaddr = sizeof(Gppaddr)/sizeof(Perl_ppaddr_t);
+ IV ncheck = sizeof(Gcheck) /sizeof(Perl_check_t);
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ /* PerlMem_malloc() because can't use even safesysmalloc() this early. */
+ plvarsp = (struct perl_vars*)PerlMem_malloc(sizeof(struct perl_vars));
+ if (!plvarsp)
+ exit(1);
+# else
+ plvarsp = PL_VarsPtr;
+# endif /* PERL_GLOBAL_STRUCT_PRIVATE */
+# define PERLVAR(var,type) /**/
+# define PERLVARA(var,n,type) /**/
+# define PERLVARI(var,type,init) plvarsp->var = init;
+# define PERLVARIC(var,type,init) plvarsp->var = init;
+# define PERLVARISC(var,init) Copy(init, plvarsp->var, sizeof(init), char);
+# include "perlvars.h"
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
+# undef PERLVARISC
+# ifdef PERL_GLOBAL_STRUCT
+ plvarsp->Gppaddr = PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
+ if (!plvarsp->Gppaddr)
+ exit(1);
+ plvarsp->Gcheck = PerlMem_malloc(ncheck * sizeof(Perl_check_t));
+ if (!plvarsp->Gcheck)
+ exit(1);
+ Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t);
+ Copy(Gcheck, plvarsp->Gcheck, ncheck, Perl_check_t);
+# endif
+# ifdef PERL_SET_VARS
+ PERL_SET_VARS(plvarsp);
+# endif
+# undef PERL_GLOBAL_STRUCT_INIT
+#endif
+ return plvarsp;
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
+#ifdef PERL_GLOBAL_STRUCT
+
+void
+Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
+{
+#ifdef PERL_GLOBAL_STRUCT
+# ifdef PERL_UNSET_VARS
+ PERL_UNSET_VARS(plvarsp);
+# endif
+ free(plvarsp->Gppaddr);
+ free(plvarsp->Gcheck);
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ free(plvarsp);
+# endif
+#endif
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
diff --git a/util.h b/util.h
index 1a1c9ff190..7d373525bf 100644
--- a/util.h
+++ b/util.h
@@ -27,11 +27,11 @@
|| ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \
|| ((f)[3] == ':')) /* volume name, currently only sys */
# else /* !NETWARE */
-# if defined( DOSISH) || defined(EPOC)
+# if defined( DOSISH) || defined(EPOC) || defined(SYMBIAN)
# define PERL_FILE_IS_ABSOLUTE(f) \
(*(f) == '/' \
|| ((f)[0] && (f)[1] == ':')) /* drive name */
-# else /* NEITHER DOSISH NOR EPOCISH */
+# else /* NEITHER DOSISH NOR EPOCISH NOR SYMBIANISH */
# ifdef MACOS_TRADITIONAL
# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':') && *(f) != ':')
# else /* !MACOS_TRADITIONAL */
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 519332f5fb..cfd929a315 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -394,11 +394,12 @@ pod16 = [.lib.pod]perlnetware.pod [.lib.pod]perlnewmod.pod [.lib.pod]perlnumber.
pod17 = [.lib.pod]perlos2.pod [.lib.pod]perlos390.pod [.lib.pod]perlos400.pod [.lib.pod]perlothrtut.pod [.lib.pod]perlpacktut.pod [.lib.pod]perlplan9.pod
pod18 = [.lib.pod]perlpod.pod [.lib.pod]perlpodspec.pod [.lib.pod]perlport.pod [.lib.pod]perlqnx.pod [.lib.pod]perlre.pod [.lib.pod]perlref.pod
pod19 = [.lib.pod]perlreftut.pod [.lib.pod]perlrequick.pod [.lib.pod]perlreref.pod [.lib.pod]perlretut.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod
-pod20 = [.lib.pod]perlsolaris.pod [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perlthrtut.pod [.lib.pod]perltie.pod
-pod21 = [.lib.pod]perltoc.pod [.lib.pod]perltodo.pod [.lib.pod]perltooc.pod [.lib.pod]perltoot.pod [.lib.pod]perltrap.pod [.lib.pod]perltru64.pod
-pod22 = [.lib.pod]perltw.pod [.lib.pod]perlunicode.pod [.lib.pod]perluniintro.pod [.lib.pod]perlutil.pod [.lib.pod]perluts.pod [.lib.pod]perlvar.pod
-pod23 = [.lib.pod]perlvmesa.pod [.lib.pod]perlvms.pod [.lib.pod]perlvos.pod [.lib.pod]perlwin32.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
-pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23)
+pod20 = [.lib.pod]perlsolaris.pod [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsymbian.pod [.lib.pod]perlsyn.pod [.lib.pod]perlthrtut.pod
+pod21 = [.lib.pod]perltie.pod [.lib.pod]perltoc.pod [.lib.pod]perltodo.pod [.lib.pod]perltooc.pod [.lib.pod]perltoot.pod [.lib.pod]perltrap.pod
+pod22 = [.lib.pod]perltru64.pod [.lib.pod]perltw.pod [.lib.pod]perlunicode.pod [.lib.pod]perluniintro.pod [.lib.pod]perlutil.pod [.lib.pod]perluts.pod
+pod23 = [.lib.pod]perlvar.pod [.lib.pod]perlvmesa.pod [.lib.pod]perlvms.pod [.lib.pod]perlvos.pod [.lib.pod]perlwin32.pod [.lib.pod]perlxs.pod
+pod24 = [.lib.pod]perlxstut.pod
+pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23) $(pod24)
# Would be useful to automate the generation of this rule from pod/buildtoc
# Plus its corresponding delete in the clean target.
@@ -1147,6 +1148,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+[.lib.pod]perlsymbian.pod : [.pod]perlsymbian.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+
[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
diff --git a/win32/Makefile b/win32/Makefile
index 6138ee75c5..fdac9c1993 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -1077,6 +1077,7 @@ utils: $(PERLEXE) $(X2P)
copy ..\README.plan9 ..\pod\perlplan9.pod
copy ..\README.qnx ..\pod\perlqnx.pod
copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.symbian ..\pod\perlsymbian.pod
copy ..\README.tru64 ..\pod\perltru64.pod
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.uts ..\pod\perluts.pod
@@ -1159,9 +1160,9 @@ distclean: realclean
perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
- perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
- perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
- perlwin32.pod \
+ perlqnx.pod perlsolaris.pod perlsymbian.pod perltru64.pod \
+ perltw.pod perluts.pod perlvmesa.pod perlvms.pod perlvms.pod \
+ perlvos.pod perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 3e549412c9..92cd12b849 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -1239,6 +1239,7 @@ utils: $(PERLEXE) $(X2P)
copy ..\README.plan9 ..\pod\perlplan9.pod
copy ..\README.qnx ..\pod\perlqnx.pod
copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.symbian ..\pod\perlsymbian.pod
copy ..\README.tru64 ..\pod\perltru64.pod
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.uts ..\pod\perluts.pod
@@ -1318,9 +1319,9 @@ distclean: realclean
perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
- perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
- perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
- perlwin32.pod \
+ perlqnx.pod perlsolaris.pod perlsymbian.pod perltru64.pod \
+ perltw.pod perluts.pod perlvmesa.pod perlvms.pod perlvms.pod \
+ perlvos.pod perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
diff --git a/win32/win32io.c b/win32/win32io.c
index f0f71e7860..80185fe048 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -340,7 +340,7 @@ PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
return f;
}
-PerlIO_funcs PerlIO_win32 = {
+PERLIO_FUNCS_DECL(PerlIO_win32) = {
sizeof(PerlIO_funcs),
"win32",
sizeof(PerlIOWin32),
diff --git a/xsutils.c b/xsutils.c
index a8a95e292d..4f7324f90b 100644
--- a/xsutils.c
+++ b/xsutils.c
@@ -23,12 +23,12 @@
*/
/* package attributes; */
-void XS_attributes__warn_reserved(pTHX_ CV *cv);
-void XS_attributes_reftype(pTHX_ CV *cv);
-void XS_attributes__modify_attrs(pTHX_ CV *cv);
-void XS_attributes__guess_stash(pTHX_ CV *cv);
-void XS_attributes__fetch_attrs(pTHX_ CV *cv);
-void XS_attributes_bootstrap(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__warn_reserved(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes_reftype(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__modify_attrs(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__guess_stash(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__fetch_attrs(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes_bootstrap(pTHX_ CV *cv);
/*