This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Symbian port of Perl
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 18 Apr 2005 13:18:30 +0000 (16:18 +0300)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Thu, 21 Apr 2005 15:38:30 +0000 (15:38 +0000)
Message-ID: <B356D8F434D20B40A8CEDAEC305A1F2453D653@esebe105.NOE.Nokia.com>

p4raw-id: //depot/perl@24271

119 files changed:
EXTERN.h
INTERN.h
MANIFEST
Porting/curliff.pl
Porting/makerel
README.symbian [new file with mode: 0644]
XSUB.h
av.c
bytecode.pl
configpm
doio.c
dump.c
embed.fnc
embed.h
embed.pl
embedvar.h
ext/B/B.xs
ext/ByteLoader/byterun.c
ext/Data/Dumper/Dumper.xs
ext/Digest/MD5/MD5.xs
ext/Digest/MD5/t/files.t
ext/DynaLoader/DynaLoader_pm.PL
ext/DynaLoader/dl_symbian.xs [new file with mode: 0644]
ext/DynaLoader/dlutils.c
ext/Errno/Errno_pm.PL
ext/IO/lib/IO/Socket.pm
ext/List/Util/Util.xs
ext/MIME/Base64/Base64.xs
ext/POSIX/POSIX.xs
ext/PerlIO/scalar/scalar.xs
ext/PerlIO/via/via.xs
ext/SDBM_File/sdbm/sdbm.c
ext/Storable/Storable.xs
ext/Time/HiRes/HiRes.xs
global.sym
globvar.sym
gv.c
hv.c
intrpvar.h
lib/ExtUtils/t/Embed.t
lib/ExtUtils/xsubpp
lib/File/Spec.pm
lib/File/Spec/Win32.pm
locale.c
mg.c
miniperlmain.c
numeric.c
op.c
opcode.h
opcode.pl
pad.c
patchlevel.h
perl.c
perl.h
perlapi.c
perlapi.h
perlio.c
perlio.h
perliol.h
perlvars.h
pod.lst
pod/perl.pod
pod/perlguts.pod
pod/perlintern.pod
pp.c
pp_ctl.c
pp_hot.c
pp_pack.c
pp_sort.c
pp_sys.c
proto.h
reentr.pl
regcomp.c
regexec.c
scope.h
sv.c
symbian/PerlApp.cpp [new file with mode: 0644]
symbian/PerlApp.h [new file with mode: 0644]
symbian/PerlApp.hrh [new file with mode: 0644]
symbian/PerlApp.rss [new file with mode: 0644]
symbian/PerlAppAif.rss [new file with mode: 0644]
symbian/PerlBase.cpp [new file with mode: 0644]
symbian/PerlBase.h [new file with mode: 0644]
symbian/PerlBase.pod [new file with mode: 0644]
symbian/PerlRecog.cpp [new file with mode: 0644]
symbian/PerlRecog.mmp [new file with mode: 0644]
symbian/README [new file with mode: 0644]
symbian/TODO [new file with mode: 0644]
symbian/bld.inf [new file with mode: 0644]
symbian/config.pl [new file with mode: 0644]
symbian/config.sh [new file with mode: 0644]
symbian/cwd.pl [new file with mode: 0644]
symbian/demo_pl [new file with mode: 0644]
symbian/install.cfg [new file with mode: 0644]
symbian/makesis.pl [new file with mode: 0644]
symbian/port.pl [new file with mode: 0644]
symbian/sanity.pl [new file with mode: 0644]
symbian/sdk.pl [new file with mode: 0644]
symbian/symbian_dll.cpp [new file with mode: 0644]
symbian/symbian_proto.h [new file with mode: 0644]
symbian/symbian_stubs.c [new file with mode: 0644]
symbian/symbian_stubs.h [new file with mode: 0644]
symbian/symbian_utils.cpp [new file with mode: 0644]
symbian/symbianish.h [new file with mode: 0644]
symbian/uid.pl [new file with mode: 0644]
symbian/version.pl [new file with mode: 0644]
symbian/xsbuild.pl [new file with mode: 0644]
taint.c
toke.c
universal.c
utf8.c
utf8.h
util.c
util.h
vms/descrip_mms.template
win32/Makefile
win32/makefile.mk
win32/win32io.c
xsutils.c

index fe8a0ee..58ca37a 100644 (file)
--- 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
index d2fb950..da3057a 100644 (file)
--- a/INTERN.h
+++ b/INTERN.h
 #  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
index c791a84..b0361c8 100644 (file)
--- 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
index 636dccd..f3937b9 100644 (file)
@@ -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
index 42b24d6..d4022bb 100644 (file)
@@ -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 (file)
index 0000000..e6cb4dc
--- /dev/null
@@ -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 7c059c1..b611581 100644 (file)
--- 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 549f2df..bc35333 100644 (file)
--- 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");
index adf1d1f..59069b3 100644 (file)
@@ -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];
index c9f5e34..e986664 100755 (executable)
--- 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 3847da6..1d7e56f 100644 (file)
--- 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 cc500e0..2ee5483 100644 (file)
--- 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;
index 66fb8bf..7373929 100644 (file)
--- 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 3072781..54c887f 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
 #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
 #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)
 #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)
 #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)
index ac0822f..1d816b1 100755 (executable)
--- 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
 
index 4496582..b7ce358 100644 (file)
 
 #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 */
 
index 32556ec..a5aecbb 100644 (file)
@@ -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
 
index 3432eb3..bdc9555 100644 (file)
@@ -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 */
index 0626977..ee1bc14 100644 (file)
@@ -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);
index 1abe4c4..a89bbd7 100644 (file)
@@ -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");
            }
index 3f18320..615590e 100644 (file)
@@ -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
 }
index 8476dad..426d3a5 100644 (file)
@@ -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 (file)
index 0000000..6cf1d1f
--- /dev/null
@@ -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.
index 474c93d..956848a 100644 (file)
@@ -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
 
index 39e2c19..5c76d89 100644 (file)
@@ -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";
index e706894..353785a 100644 (file)
@@ -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);
 
index 3a03488..790a2b9 100644 (file)
@@ -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;
index 8fd14cf..99ff0e4 100644 (file)
@@ -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,
index 561dc30..9f76b47 100644 (file)
@@ -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;
index 074da92..55a5fd8 100644 (file)
@@ -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
 }
 
index d95d631..ad27416 100644 (file)
@@ -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
 }
 
index a3c4acf..f705db5 100644 (file)
@@ -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,
index 702644e..7c6a755 100644 (file)
@@ -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));
 
index 3272748..b9040eb 100644 (file)
@@ -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
 
index 3624874..3887879 100644 (file)
@@ -675,3 +675,5 @@ Perl_hv_scalar
 Perl_gv_fetchpvn_flags
 Perl_gv_fetchsv
 Perl_savesvpv
+Perl_init_global_struct
+Perl_free_global_struct
index 0d76888..2e528e3 100644 (file)
@@ -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 8ad546d..8ea4171 100644 (file)
--- 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 8c6ec39..8345ee5 100644 (file)
--- 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;
index 3159b28..3fe5adb 100644 (file)
@@ -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)
index fc0ed3c..1c82cd9 100644 (file)
@@ -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();
index 7ae8020..9be40e6 100755 (executable)
@@ -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})
 #[[
index e1986a9..7cb7192 100644 (file)
@@ -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');
 
index de560ce..e5d3810 100644 (file)
@@ -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',
                              '/'  );
index 7f336a6..94609a4 100644 (file)
--- 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 af52790..39b8fd8 100644 (file)
--- 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
 }
 
index 252a48d..53ab947 100644 (file)
@@ -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);
index 38f00fc..297dbdd 100644 (file)
--- 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 8264232..ef8dfca 100644 (file)
--- 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));
 }
index 356145f..8e52cf6 100644 (file)
--- a/opcode.h
+++ b/opcode.h
  *  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 */
index d9c81b3..ac9499d 100755 (executable)
--- 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 14649fc..ce6ef3f 100644 (file)
--- 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);
index 302e4f9..86b87be 100644 (file)
@@ -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 1e39037..cf8a76e 100644 (file)
--- 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 c867ab2..e0b1a94 100644 (file)
--- a/perl.h
+++ b/perl.h
 #  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
 #   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       
 #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
 #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,
 #  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
  * 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
 #  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
index e0bf9fb..b1ed782 100644 (file)
--- 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
 
index 28edb59..c9ccd69 100644 (file)
--- 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 */
index 04677b8..9085480 100644 (file)
--- 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) {
index adea6b7..ba9b067 100644 (file)
--- 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;
 
 
index 80e7c7d..8697d9b 100644 (file)
--- 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);
 
 /*--------------------------------------------------------------------------------------*/
 
index 00b0e1f..2ddd0ac 100644 (file)
@@ -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 46c7a83..52a4cf5 100644 (file)
--- 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
index d1365a2..ba24f7c 100644 (file)
@@ -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
index d95d3e4..df90f9e 100644 (file)
@@ -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
index 6ff0156..006c66c 100644 (file)
@@ -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 3b52e71..e3773b2 100644 (file)
--- 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;
index 79c38f0..2db8d7e 100644 (file)
--- 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);
index ba724ff..767188b 100644 (file)
--- 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;
index 5ee841b..9a7cc53 100644 (file)
--- 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;
index 380194d..649375a 100644 (file)
--- 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;
index 300ea6d..d908a1c 100644 (file)
--- 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 0866d7d..c26f87b 100644 (file)
--- 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
index c100115..53a76e2 100644 (file)
--- 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)
index ab1c218..d4640ea 100644 (file)
--- 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);
index 17ee6af..8947cce 100644 (file)
--- 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 73b94cb..2fa7f60 100644 (file)
--- 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 7bfd7a5..ab9603f 100644 (file)
--- 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 (file)
index 0000000..319a591
--- /dev/null
@@ -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 (file)
index 0000000..37a02f2
--- /dev/null
@@ -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 (file)
index 0000000..3b0f23d
--- /dev/null
@@ -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 (file)
index 0000000..c352c52
--- /dev/null
@@ -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 (file)
index 0000000..fa4d42b
--- /dev/null
@@ -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 (file)
index 0000000..31fe012
--- /dev/null
@@ -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 (file)
index 0000000..f6765fb
--- /dev/null
@@ -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 (file)
index 0000000..265e2d6
--- /dev/null
@@ -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 (file)
index 0000000..d2db544
--- /dev/null
@@ -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 (file)
index 0000000..6850103
--- /dev/null
@@ -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 (file)
index 0000000..95ed303
--- /dev/null
@@ -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 (file)
index 0000000..78dcd24
--- /dev/null
@@ -0,0 +1,150 @@
+=head1 BASE PORT
+
+=head2 Console
+
+- The Console only does "ASCII" input: e.g. pressing the "2"
<