# 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
# 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
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
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
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
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
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
--- /dev/null
+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
+
#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
void
Perl_av_push(pTHX_ register AV *av, SV *val)
{
+ dVAR;
MAGIC *mg;
if (!av)
return;
SV *
Perl_av_pop(pTHX_ register AV *av)
{
+ dVAR;
SV *retval;
MAGIC* mg;
void
Perl_av_unshift(pTHX_ register AV *av, register I32 num)
{
+ dVAR;
register I32 i;
register SV **ary;
MAGIC* mg;
SV *
Perl_av_shift(pTHX_ register AV *av)
{
+ dVAR;
SV *retval;
MAGIC* mg;
void
Perl_av_fill(pTHX_ register AV *av, I32 fill)
{
+ dVAR;
MAGIC *mg;
if (!av)
Perl_croak(aTHX_ "panic: null array");
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
+ dVAR;
register int insn;
U32 ix;
SV *specialsv_list[6];
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) {
# 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;
int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
I32 num_svs)
{
+ dVAR;
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
PerlIO *saveofp = Nullfp;
}
#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 */
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 */
}
}
-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)
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;
}
}
-#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)
bool
Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
{
+ dVAR;
register char **a;
register char *s;
PerlIO *
Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
{
+ dVAR;
SV *tmpcmd = NEWSV(55, 0);
PerlIO *fp;
ENTER;
#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, ...)
char *
Perl_sv_peek(pTHX_ SV *sv)
{
+ dVAR;
SV *t = sv_newmortal();
STRLEN n_a;
int unref = 0;
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;
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;
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:
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);
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);
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);
break;
default:
- hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
}
oldop = o;
STATIC UV
sequence_num(pTHX_ const OP *o)
{
+ dVAR;
SV *op,
**seq;
char *key;
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");
* (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(*)" },
{
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;
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
|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 \
|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
#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
Apd |char* |savesvpv |SV* sv
+Ap |struct perl_vars*|init_global_struct
+Ap |void |free_global_struct|struct perl_vars*
+
END_EXTERN_C
#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)
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"
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';
#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"
#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
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
#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"
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
};
#endif /* DOINIT */
#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"
#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
#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 */
#endif
-static char *svclassnames[] = {
+static const char* const svclassnames[] = {
"B::NULL",
"B::IV",
"B::NV",
OPc_COP /* 11 */
} opclass;
-static char *opclassnames[] = {
+static const char* const opclassnames[] = {
"B::NULL",
"B::OP",
"B::UNOP",
"B::COP"
};
-static size_t opsizes[] = {
+static const size_t opsizes[] = {
0,
sizeof(OP),
sizeof(UNOP),
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;
#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
OP_name(o)
B::OP o
CODE:
- RETVAL = PL_op_name[o->op_type];
+ RETVAL = (char *)PL_op_name[o->op_type];
OUTPUT:
RETVAL
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
+ dVAR;
register int insn;
U32 ix;
SV *specialsv_list[6];
{
svindex arg;
BGET_svindex(arg);
- SvRV(bstate->bs_sv) = arg;
+ BSET_xrv(bstate->bs_sv, arg);
break;
}
case INSN_XPV: /* 22 */
{
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 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&SvSTASH(bstate->bs_sv) = arg;
+ bstate->bs_sv = arg;
break;
}
case INSN_GV_FETCHPV: /* 77 */
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);
* 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
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;
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;
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
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");
}
15e4c91ad67f5ff238033305376c9140 Changes
0565ec21b15c0f23f4c51fb327c8926d README
f0f77710cd8d5ba7d9faedec8d02dc2f MD5.pm
-f9848c0ee3b20a9177465eec19361e6c MD5.xs
+f6314d62d3aa97dcf4cba66b4c39b105 MD5.xs
276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
EOT
} elsif ("\n" eq "\015") { # MacOS
dea016b088ab4d88a5e7cbd9c15a9c88 Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
} else {
0f09886e2c129bdabf57674c6822bd4f Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
#
# -- 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) {
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 {
}
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 {
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);
--- /dev/null
+/* 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.
* 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
}
+#ifndef SYMBIAN
/* SaveError() takes printf style args and saves the result in dl_last_error */
static void
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
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;
}
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')) {
return;
}
}
-
+
if ($^O eq 'MacOS') {
while(<FH>) {
$err{$1} = $2
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);
}
} 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";
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";
}
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 {
}
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;
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";
$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";
# 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);
# 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
PROTOTYPE: &@
CODE:
{
+ dVAR;
SV *ret = sv_newmortal();
int index;
GV *agv,*bgv,*gv;
PROTOTYPE: &@
CODE:
{
+ dVAR;
int index;
GV *gv;
HV *stash;
PROTOTYPE: @
CODE:
{
+ dVAR;
int index;
struct op dmy_op;
struct op *old_op = PL_op;
#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,
#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() */
# 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>
POSIX::SigSet sigset
int sig
-
MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
POSIX::Termios
# interface look beautiful, which is hard.
{
+ dVAR;
POSIX__SigAction action;
GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
return f;
}
-PerlIO_funcs PerlIO_scalar = {
+PERLIO_FUNCS_DECL(PerlIO_scalar) = {
sizeof(PerlIO_funcs),
"scalar",
sizeof(PerlIOScalar),
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_scalar);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
#endif
}
-PerlIO_funcs PerlIO_object = {
+PERLIO_FUNCS_DECL(PerlIO_object) = {
sizeof(PerlIO_funcs),
"via",
sizeof(PerlIOVia),
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_object);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
#endif
}
#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,
#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
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])
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);
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)])
*/
static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
{
+ dVAR;
I32 len =
#ifdef HAS_RESTRICTED_HASHES
HvTOTALKEYS(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;
static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
{
I32 len;
- static char buf[80];
+ char buf[80];
TRACEME(("store_other"));
*/
static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
{
+ dVAR;
I32 len;
I32 size;
I32 i;
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));
*/
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));
#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
Perl_gv_fetchpvn_flags
Perl_gv_fetchsv
Perl_savesvpv
+Perl_init_global_struct
+Perl_free_global_struct
# 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
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;
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;
STATIC void
S_require_errno(pTHX_ GV *gv)
{
+ dVAR;
HV* stash = gv_stashpvn("Errno",5,FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
+ dVAR;
MAGIC *mg;
CV *cv=NULL;
CV **cvp=NULL, **ocvp=NULL;
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;
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;
void
Perl_hv_clear(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv;
if (!hv)
return;
void
Perl_hv_clear_placeholders(pTHX_ HV *hv)
{
+ dVAR;
I32 items = (I32)HvPLACEHOLDERS(hv);
I32 i = HvMAX(hv);
HE *
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
+ dVAR;
register XPVHV* xhv;
register HE *entry;
HE *oldentry;
void
Perl_hv_assert(pTHX_ HV *hv)
{
+ dVAR;
HE* entry;
int withflags = 0;
int placeholders = 0;
/* 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)
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();
perl_free(my_perl);
+#ifdef PERL_GLOBAL_STRUCT
+ free_global_struct(plvarsp);
+#endif /* PERL_GLOBAL_STRUCT */
+
my_puts("ok 8");
PERL_SYS_TERM();
=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
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.
$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('\$%&*@;[]') . "]" ;
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';
}
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;
}
undef(%var_types);
undef(%defaults);
undef($class);
+ undef($externC);
undef($static);
undef($elipsis);
undef($wantRETVAL) ;
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
$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})
#[[
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');
$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.
my $self = shift;
$tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
'SYS:/temp',
+ 'C:\system\temp',
'C:/temp',
'/tmp',
'/' );
#include "reentr.h"
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
return locs;
}
+#endif
void
Perl_set_numeric_radix(pTHX)
Perl_new_ctype(pTHX_ char *newctype)
{
#ifdef USE_LOCALE_CTYPE
-
+ dVAR;
int i;
for (i = 0; i < 256; i++) {
int
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register I32 paren;
register char *s = NULL;
register I32 i;
int
Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register char *s;
char *ptr;
STRLEN len, klen;
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) {
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)
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
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)
/* 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);
#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);
#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
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
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
#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];
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);
if (i)
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
{
- sig_defaulting[i] = 1;
+ PL_sig_defaulting[i] = 1;
(void)rsignal(i, PL_csighandlerp);
}
#else
STATIC int
S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
{
- dSP;
+ dVAR; dSP;
ENTER;
SAVETMPS;
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);
U32
Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
U32 retval = 0;
ENTER;
int
Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
{
- dSP;
+ dVAR; dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
int
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
- dSP;
+ dVAR; dSP;
const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
ENTER;
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));
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))
return -1;
}
-#if !defined(PERL_IMPLICIT_CONTEXT)
-static SV* sig_sv;
-#endif
-
Signal_t
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();
static void
unwind_handler_stack(pTHX_ const void *p)
{
+ dVAR;
const U32 flags = *(const U32*)p;
if (flags & 1)
/* 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
}
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);
perl_free(my_perl);
+#ifdef PERL_GLOBAL_STRUCT
+ free_global_struct(plvarsp);
+#endif /* PERL_GLOBAL_STRUCT */
+
PERL_SYS_TERM();
exit(exitstatus);
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;
void
Perl_op_free(pTHX_ OP *o)
{
+ dVAR;
OPCODE type;
PADOFFSET refcnt;
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. */
void
Perl_op_null(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_NULL)
return;
op_clear(o);
void
Perl_op_refcnt_lock(pTHX)
{
+ dVAR;
OP_REFCNT_LOCK;
}
void
Perl_op_refcnt_unlock(pTHX)
{
+ dVAR;
OP_REFCNT_UNLOCK;
}
OP *
Perl_scalar(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
/* assumes no premature commitment */
OP *
Perl_scalarvoid(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
const char* useless = 0;
SV* sv;
OP *
Perl_list(pTHX_ OP *o)
{
+ dVAR;
OP *kid;
/* assumes no premature commitment */
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;
OP *
Perl_ref(pTHX_ OP *o, I32 type)
{
+ dVAR;
OP *kid;
if (!o || PL_error_count)
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> */
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);
OP *
Perl_fold_constants(pTHX_ register OP *o)
{
+ dVAR;
register OP *curop;
I32 type = o->op_type;
SV *sv;
OP *
Perl_gen_constant_list(pTHX_ register OP *o)
{
+ dVAR;
register OP *curop;
const I32 oldtmps_floor = PL_tmps_floor;
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
OP *
Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
+ dVAR;
LISTOP *listop;
NewOp(1101, listop, 1, LISTOP);
OP *
Perl_newOP(pTHX_ I32 type, I32 flags)
{
+ dVAR;
OP *o;
NewOp(1101, o, 1, OP);
o->op_type = (OPCODE)type;
OP *
Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
{
+ dVAR;
UNOP *unop;
if (!first)
OP *
Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
+ dVAR;
BINOP *binop;
NewOp(1101, binop, 1, BINOP);
OP *
Perl_newPMOP(pTHX_ I32 type, I32 flags)
{
+ dVAR;
PMOP *pmop;
NewOp(1101, pmop, 1, PMOP);
OP *
Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
{
+ dVAR;
PMOP *pm;
LOGOP *rcop;
I32 repl_has_vars = 0;
OP *
Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
{
+ dVAR;
SVOP *svop;
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
OP *
Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
{
+ dVAR;
PADOP *padop;
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
+ dVAR;
#ifdef USE_ITHREADS
if (gv)
GvIN_PAD_on(gv);
OP *
Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
{
+ dVAR;
PVOP *pvop;
NewOp(1101, pvop, 1, PVOP);
pvop->op_type = (OPCODE)type;
OP *
Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
{
+ dVAR;
const U32 seq = intro_my();
register COP *cop;
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;
OP *
Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
{
+ dVAR;
LOGOP *logop;
OP *start;
OP *o;
OP *
Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
{
+ dVAR;
LOGOP *range;
OP *flip;
OP *flop;
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;
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;
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__ */
CV *
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
+ dVAR;
STRLEN n_a;
const char *name;
const char *aname;
CV *
Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
{
+ dVAR;
CV* cv;
ENTER;
OP *
Perl_oopsAV(pTHX_ OP *o)
{
+ dVAR;
switch (o->op_type) {
case OP_PADSV:
o->op_type = OP_PADAV;
OP *
Perl_oopsHV(pTHX_ OP *o)
{
+ dVAR;
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
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];
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];
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];
OP *
Perl_ck_spair(pTHX_ OP *o)
{
+ dVAR;
if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
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;
OP *
Perl_ck_rvconst(pTHX_ register OP *o)
{
+ dVAR;
SVOP *kid = (SVOP*)cUNOPo->op_first;
o->op_private |= (PL_hints & HINT_STRICT_REFS);
OP *
Perl_ck_ftst(pTHX_ OP *o)
{
+ dVAR;
const I32 type = o->op_type;
if (o->op_flags & OPf_REF) {
OP *
Perl_ck_glob(pTHX_ OP *o)
{
+ dVAR;
GV *gv;
o = ck_fun(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;
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 */
OP *
Perl_ck_split(pTHX_ OP *o)
{
+ dVAR;
register OP *kid;
if (o->op_flags & OPf_STACKED)
void
Perl_peep(pTHX_ register OP *o)
{
+ dVAR;
register OP* oldop = 0;
if (!o || o->op_opt)
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));
}
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));
}
* 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",
#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",
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),
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 */
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 */
#endif
END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
* 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
# 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) {
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) {
END_EXTERN_C
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
+
END
# Emit function declarations.
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) {
}
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) {
}
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 = (
#endif
END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
END
if (keys %OP_IS_SOCKET) {
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
+ dVAR;
PADOFFSET ix;
ASSERT_CURPAD_ACTIVE("pad_tidy");
CV *
Perl_cv_clone(pTHX_ CV *proto)
{
+ dVAR;
I32 ix;
AV* protopadlist = CvPADLIST(proto);
const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
-static const char *local_patches[] = {
+static const char * const local_patches[] = {
NULL
,"DEVEL24148"
,NULL
static void
S_init_tls_and_interp(PerlInterpreter *my_perl)
{
+ dVAR;
if (!PL_curinterp) {
PERL_SET_INTERP(my_perl);
#if defined(USE_ITHREADS)
void
perl_construct(pTHXx)
{
+ dVAR;
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
/* 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)
(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;
}
int
perl_destruct(pTHXx)
{
+ dVAR;
volatile int destruct_level; /* 0=none, 1=full, 2=full with checks */
HV *hv;
}
#endif
-
- if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
dJMPENV;
int x = 0;
static void __attribute__((destructor))
perl_fini()
{
+ dVAR;
if (PL_curinterp)
FREE_THREAD_KEY;
}
int
perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
+ dVAR;
I32 oldscope;
int ret;
dJMPENV;
STATIC void *
S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
{
+ dVAR;
int argc = PL_origargc;
char **argv = PL_origargv;
const char *scriptname = NULL;
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) {
PL_op = PL_main_start;
CALLRUNOPS(aTHX);
}
-
my_exit(0);
/* NOTREACHED */
}
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;
/* 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",
"\n",
NULL
};
- const char **p = usage_msg;
+ const char * const *p = usage_msg;
PerlIO_printf(PerlIO_stdout(),
"\nUsage: %s [switches] [--] [programfile] [arguments]",
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)",
char *
Perl_moreswitches(pTHX_ char *s)
{
+ dVAR;
STRLEN numlen;
UV rschar;
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
# 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;
const char *cpp_discard_flag;
const char *perl;
#endif
+ dVAR;
PL_fdscript = -1;
PL_suidscript = -1;
STATIC void
S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
{
+ dVAR;
#ifdef IAMSUID
/* int which; */
#endif /* IAMSUID */
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);
}
if (env) {
char** origenv = environ;
+ char *s;
+ SV *sv;
for (; *env; env++) {
if (!(s = strchr(*env,'=')) || s == *env)
continue;
#endif /* MACOS_TRADITIONAL */
}
-#if defined(DOSISH) || defined(EPOC)
+#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
# define PERLLIB_SEP ';'
#else
# if defined(VMS)
void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
+ dVAR;
SV *atsv;
const line_t oldline = CopLINE(PL_curcop);
CV *cv;
STATIC void
S_my_exit_jump(pTHX)
{
+ dVAR;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
# 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
#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
# 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
# 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
# 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)
# 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
#endif
#ifndef __cplusplus
-#ifndef UNDER_CE
+#if !(defined(UNDER_CE) || defined(SYMBIAN))
Uid_t getuid (void);
Uid_t geteuid (void);
Gid_t getgid (void);
#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,
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,
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,
#ifdef DEBUGGING
#ifdef DOINIT
-EXTCONST char* PL_block_type[] = {
+EXTCONST char* const PL_block_type[] = {
"NULL",
"SUB",
"EVAL",
#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 {
};
# 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
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
/* Types used by pack/unpack */
typedef enum {
#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
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(
#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
#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"
#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
#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"
#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
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
#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"
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
};
#endif /* DOINIT */
#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
#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 */
#include "XSUB.h"
+#define PERLIO_MAX_REFCOUNTABLE_FD 2048
+
#ifdef __Lynx__
/* Missing proto on LynxOS */
int mkstemp(char*);
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
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
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;
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
}
PerlIO_funcs *
PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
{
+ dVAR;
IV i;
if ((SSize_t) len <= 0)
len = strlen(name);
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
return -1;
}
-PerlIO_funcs PerlIO_remove = {
+PERLIO_FUNCS_DECL(PerlIO_remove) = {
sizeof(PerlIO_funcs),
"pop",
0,
{
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);
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)
}
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:
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;
}
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;
}
}
/* 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;
}
}
return -1;
}
-PerlIO_funcs PerlIO_utf8 = {
+PERLIO_FUNCS_DECL(PerlIO_utf8) = {
sizeof(PerlIO_funcs),
"utf8",
0,
NULL, /* set_ptrcnt */
};
-PerlIO_funcs PerlIO_byte = {
+PERLIO_FUNCS_DECL(PerlIO_byte) = {
sizeof(PerlIO_funcs),
"bytes",
0,
return NULL;
}
-PerlIO_funcs PerlIO_raw = {
+PERLIO_FUNCS_DECL(PerlIO_raw) = {
sizeof(PerlIO_funcs),
"raw",
0,
*/
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;
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
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);
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;
}
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;
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) {
return code;
}
-PerlIO_funcs PerlIO_unix = {
+PERLIO_FUNCS_DECL(PerlIO_unix) = {
sizeof(PerlIO_funcs),
"unix",
sizeof(PerlIOUnix),
}
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;
}
-PerlIO_funcs PerlIO_stdio = {
+PERLIO_FUNCS_DECL(PerlIO_stdio) = {
sizeof(PerlIO_funcs),
"stdio",
sizeof(PerlIOStdio),
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 */
void
PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
+ dVAR;
PerlIOl *l;
while ((l = *p)) {
if (l->tab == &PerlIO_stdio) {
-PerlIO_funcs PerlIO_perlio = {
+PERLIO_FUNCS_DECL(PerlIO_perlio) = {
sizeof(PerlIO_funcs),
"perlio",
sizeof(PerlIOBuf),
return got;
}
-PerlIO_funcs PerlIO_pending = {
+PERLIO_FUNCS_DECL(PerlIO_pending) = {
sizeof(PerlIO_funcs),
"pending",
sizeof(PerlIOBuf),
return 0;
}
-PerlIO_funcs PerlIO_crlf = {
+PERLIO_FUNCS_DECL(PerlIO_crlf) = {
sizeof(PerlIO_funcs),
"crlf",
sizeof(PerlIOCrlf),
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;
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
*/
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) {
}
-PerlIO_funcs PerlIO_mmap = {
+PERLIO_FUNCS_DECL(PerlIO_mmap) = {
sizeof(PerlIO_funcs),
"mmap",
sizeof(PerlIOMmap),
{
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)
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)
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) {
#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 */
#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;
#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
/*--------------------------------------------------------------------------------------*/
/* 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
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);
/*--------------------------------------------------------------------------------------*/
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? */
#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
+
+
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
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
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
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
=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.
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)
/* 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)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_crypt)
{
- dSP; dTARGET;
#ifdef HAS_CRYPT
+ dSP; dTARGET;
dPOPTOPssrl;
STRLEN n_a;
STRLEN len;
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
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;
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
PP(pp_split)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
PP(pp_grepstart)
{
- dSP;
+ dVAR; dSP;
SV *src;
if (PL_stack_base + *PL_markstack_ptr == SP) {
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;
/* Control. */
-static const char *context_name[] = {
+static const char * const context_name[] = {
"pseudo-block",
"subroutine",
"eval",
OP *
Perl_die_where(pTHX_ const char *message, STRLEN msglen)
{
+ dVAR;
STRLEN n_a;
if (PL_in_eval) {
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;
PP(pp_enteriter)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
PP(pp_enterloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leaveloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
PP(pp_return)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
PP(pp_last)
{
- dSP;
+ dVAR; dSP;
I32 cxix;
register PERL_CONTEXT *cx;
I32 pop2 = 0;
PP(pp_next)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 inner;
PP(pp_redo)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 oldsave;
PP(pp_goto)
{
- dSP;
+ dVAR; dSP;
OP *retop = 0;
I32 ix;
register PERL_CONTEXT *cx;
/* 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 */
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)
PP(pp_require)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
SV *sv;
char *name;
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);
PP(pp_entereval)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = PL_sub_generation;
PP(pp_leaveeval)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
PP(pp_entertry)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leavetry)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
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);
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
PP(pp_aassign)
{
- dSP;
+ dVAR; dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
OP *
Perl_do_readline(pTHX)
{
- dSP; dTARGETSTACKED;
+ dVAR; dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
PP(pp_enter)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = OP_GIMME(PL_op, -1);
PP(pp_leave)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
register SV **mark;
SV **newsp;
PP(pp_grepwhile)
{
- dSP;
+ dVAR; dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
PP(pp_leavesub)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
* get any slower by more conditions */
PP(pp_leavesublv)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
PP(pp_entersub)
{
- dSP; dPOPss;
+ dVAR; dSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
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;
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register SV **p1 = ORIGMARK+1, **p2;
register I32 max, i;
AV* av = Nullav;
static I32
sortcv(pTHX_ SV *a, SV *b)
{
+ dVAR;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
static I32
sortcv_stacked(pTHX_ SV *a, SV *b)
{
+ dVAR;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
static I32
sortcv_xsub(pTHX_ SV *a, SV *b)
{
- dSP;
+ dVAR; dSP;
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
I32 result;
# 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
#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>
PP(pp_glob)
{
+ dVAR;
OP *result;
tryAMAGICunTARGET(iter, -1);
PP(pp_open)
{
- dSP;
+ dVAR; dSP;
dMARK; dORIGMARK;
dTARGET;
GV *gv;
PP(pp_close)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_fileno)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_umask)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_UMASK
+ dTARGET;
Mode_t anum;
if (MAXARG < 1) {
PP(pp_binmode)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_tie)
{
- dSP;
- dMARK;
+ dVAR; dSP; dMARK;
SV *varsv;
HV* stash;
GV *gv;
PP(pp_untie)
{
- dSP;
+ dVAR; dSP;
MAGIC *mg;
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
PP(pp_dbmopen)
{
- dSP;
+ dVAR; dSP;
HV *hv;
dPOPPOPssrl;
HV* stash;
PP(pp_getc)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io = NULL;
MAGIC *mg;
STATIC OP *
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
+ dVAR;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leavewrite)
{
- dSP;
+ dVAR; dSP;
GV *gv = cxstack[cxstack_ix].blk_sub.gv;
register IO *io = GvIOp(gv);
PerlIO *ofp = IoOFP(io);
PP(pp_prtf)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_sysread)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
int offset;
GV *gv;
IO *io;
(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;
PP(pp_syswrite)
{
- dSP;
+ dVAR; dSP;
int items = (SP - PL_stack_base) - TOPMARK;
if (items == 2) {
SV *sv;
PP(pp_send)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
SV *bufsv;
PP(pp_eof)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_tell)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
GV *gv;
IO *io;
MAGIC *mg;
PP(pp_sysseek)
{
- dSP;
+ dVAR; dSP;
GV *gv;
IO *io;
int whence = POPi;
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.
I32 value;
STRLEN n_a;
int result;
- I32 did_pipes = 0;
if (PL_tainting) {
TAINT_ENV();
{
Pid_t childpid;
int pp[2];
+ I32 did_pipes = 0;
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
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);
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);
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);
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);
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);
#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);
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
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)
* 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
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;
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;
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);
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;
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. */
STATIC I32
S_regrepeat(pTHX_ regnode *p, I32 max)
{
+ dVAR;
register char *scan;
register I32 c;
register char *loceol = PL_regeol;
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;
#define CATCH_GET (PL_top_env->je_mustcatch)
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+
STATIC SV*
S_find_hash_subscript(pTHX_ HV *hv, SV* val)
{
+ dVAR;
register HE **array;
register HE *entry;
I32 i;
STATIC SV *
S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
{
+ dVAR;
SV *sv;
AV *av;
SV **svp;
return SvPVX(tsv);
}
else {
+ dVAR;
STRLEN len;
const char *t;
}
/* 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:
void
Perl_sv_clear(pTHX_ register SV *sv)
{
+ dVAR;
HV* stash;
assert(sv);
assert(SvREFCNT(sv) == 0);
void
Perl_sv_free(pTHX_ SV *sv)
{
+ dVAR;
if (!sv)
return;
if (SvREFCNT(sv) == 0) {
void
Perl_sv_free2(pTHX_ SV *sv)
{
+ dVAR;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
if (ckWARN_d(WARN_DEBUGGING))
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)
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);
goto screamer2;
}
-#ifdef USEHEAPINSTEADOFSTACK
+#ifdef USE_HEAP_INSTEAD_OF_STACK
Safefree(buf);
#endif
}
SV *
Perl_sv_2mortal(pTHX_ register SV *sv)
{
+ dVAR;
if (!sv)
return sv;
if (SvREADONLY(sv) && SvIMMORTAL(sv))
void
Perl_sv_reset(pTHX_ register const char *s, HV *stash)
{
+ dVAR;
register HE *entry;
register GV *gv;
register SV *sv;
CV *
Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
{
+ dVAR;
GV *gv = Nullgv;
CV *cv = Nullcv;
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? */
#endif
elen = strlen(eptr);
else {
- eptr = nullstr;
+ eptr = (char *)nullstr;
elen = sizeof nullstr - 1;
}
}
REGEXP *
Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
{
+ dVAR;
REGEXP *ret;
int i, len, npar;
struct reg_substr_datum *s;
Safefree(tbl);
}
-#ifdef DEBUGGING
-char *PL_watch_pvx;
-#endif
-
/* attempt to make everything in the typeglob readonly */
STATIC SV *
SV *
Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
{
+ dVAR;
SV *dstr;
if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
+ dVAR;
#ifdef PERL_IMPLICIT_SYS
/* perlhost.h so we need to call into it
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;
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;
--- /dev/null
+/* 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;
+}
+
--- /dev/null
+/* 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__
--- /dev/null
+/* 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__
--- /dev/null
+/* 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
+{
+}
+
--- /dev/null
+/* 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";
+ }
+ };
+ }
--- /dev/null
+/* 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;
+}
+
--- /dev/null
+/* 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__ */
+
--- /dev/null
+=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
+
--- /dev/null
+/* 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;
+}
+
+
+
--- /dev/null
+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
+
--- /dev/null
+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
+
+--
+
--- /dev/null
+=head1 BASE PORT
+
+=head2 Console
+
+- The Console only does "ASCII" input: e.g. pressing the "2"
+ key five times, "aaaaa", does not produce "ä" ("a diaeresis"),
+ but instead the "2" key rotates through "abc2abc2...".
+ This is a pity because the Console is actually capable of full
+ Unicode input and output (if you have the fonts, that is). You
+ can verify this by entering e.g. the euro character, which is
+ U+20AC, well beyond U+00FF. I don't know why the full repertoire
+ of the keyboard is not available.
+- Enhance the console? (line editing, full x-y movement, history)
+- The role of the console needs to be rethought: the best way
+ would be to have the console visible in the same screen as
+ the GUI elements (an "embedded console"?)
+
+=head2 Core Language
+
+- the $^E does not work
+- select() does not work (not our fault)
+- starting external application: what now (0.1.0) works is:
+ - system("app");
+ - system("app&");
+ - and those with arguments:
+ - system("app arg1 arg2")
+ - system("app arg1 arg2 &")
+ but remember that a Symbian process does get only argv[0]
+ and argv[1]: all the arguments of the application are passed
+ in as a single argument ("arg1 arg2" in the above)
+ What does not work:
+ - piped open, in either direction
+ - qx/backtick/`
+ - fork/wait (these unlikely to ever work as in POSIX)
+ - IO redirection or filename globbing in system()
+ (since there is no POSIX shell beneath)
+ What might work in future:
+ - exec() might be made to work
+ - Symbian::spawn("cmd args") returning a process id (what does Win32 do?)
+ - Symbian::waitpid($spawned_pid)
+
+=head2 Platform
+
+- in S60 1.2 (at least in 3650 Nokia 3650 v3.11) setjmp/longjmp is
+ fragile (see Symbian FAQ-0929), intensive debugging and fix needed
+- in S60 2.x (at least in Nokia 6630 v4.03.11) launching scripts via
+ FExplorer does not open up the console
+
+=head2 Unicode
+
+- Symbian has Unicode filenames, and Unicode all over the place.
+- Encode and the use of Symbian Unicode in general
+ tie into the overall usefulness of PerlIO.
+
+=head2 Portability
+
+- Slash versus Backslash: where does one need to use "\\"?
+ writing Perl applications, where can one get away with using "/" ?
+
+=head2 Build
+
+- make xsbuild.pl much more robust (for building external extensions)
+- MakeMaker? Pure PM, PM + XS?
+- currently the PerlApp UID is in both config.pl (hardwired) and
+ in makesis.pl (computed), this is quite error prone
+- Enable building also under Cygwin?
+
+=head1 PACKAGING
+
+- subdivide perlext.sis?
+- pm-stripper: strip pod and comments, while inserting the appropriate
+ #line commands to keep linenumbers in sync. Shaves off easily 50%
+ of the code, making install packages smaller.
+- Get MakeMaker to create SIS packages? In non-Win32?
+- Symbian has APIs for opening .zip files
+- Investigate Autrijus Tang's PAR format
+ http://www.autrijus.org/par-intro/
+- "makeplsis" to wrap a script.pl or dir/script.pl as a stand-alone
+ application (and SIS): unshift the "application home" to @INC and
+ chdir to that, then run the script.pl (renamed as default.pl)
+
+=head1 PerlBase
+
+- review for proper Symbian coding practices
+
+=head1 PerlApp
+
+- In "Run" see how one could show also the file extensions.
+- when autostarting also offer to display the file (via Notes?)
+ instead of installing/running it?
+- Allow passing command line options to scripts being run?
+- Add "OneLiner" menu item? (-e, -M) (requires a UI form)
+- Terminate/Pause menu entries?
+- review for proper Symbian coding practices
+
+=head1 CORE LIBRARIES
+
+- Fix Devel::PPPort (worth it?) (Note that there is D::PPP 3.x out by now)
+- Fix Encode to not to have writeable data: seems to be tricky indeed
+ because of copious global non-const data.
+- Verify that the modified File::Spec::Win32 does work in Symbian.
+ (File::Spec::Epoc does not seem to be relevant?)
+- What does Cwd really do since the concept of cwd is a bit fuzzy in Symbian.
+- What should Sys::Hostname return? GPRS? BT? WLAN?
+- ByteLoader problem: byterun.c does not see VERSION and XS_VERSION.
+- POSIX problem: STDLIB POSIX is not that POSIX.
+
+=head1 REGRESSION SUITE
+
+- how to run the standard test suite on a Symbian device?
+
+=head1 CPAN LIBRARIES
+
+- Include/Package more modules (or work harder on getting CPAN.pm working?)
+ (but note that lib/**/*.pm is 3.5 megabytes, probably not worth including
+ all of it, even after pm-stripping):
+ - libnet
+ - Bundle::CPAN
+ - Archive::Tar
+ - Compress::Zlib (zlib?) (there is builtin gz support)
+ - Term::ReadKey (useless?)
+ - Term::ReadLine (useless?)
+ - Bundle::LWP
+ - URI
+ - HTML::TagSet
+ - HTML::Parser
+ - HTML::Entities
+ - HTML::HeadParser
+ - LWP
+ - Crypt::SSLeay? (ssl?)
+ - IO::Zlib? (zlib?)
+ - IMAP?
+ - Net::Telnet?
+ - Archive::Zip?
+ - Mail::Send?
+ - Date::Calc?
+ - XML? XML::Simple? (expat?) (there is builtin xml support)
+ - RSS?
+ - DBI
+ - DBD::SQLite? (sqlite?)
+ - SOAP? XML-RPC?
+
+=head1 FUTURE POSSIBILITIES
+
+- Remote console (Bluetooth/IR)
+- S60 GUI support
+- S60 PDA support
+- Phone APIs
+- S80
+- UIQ
--- /dev/null
+PRJ_MMPFILES
+PerlApp.mmp
+PerlRecog.mmp
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+use strict;
+use lib "symbian";
+
+print "Configuring...\n";
+print "Configuring with: Perl version $] ($^X)\n";
+
+do "sanity.pl";
+
+my %VERSION = %{ do "version.pl" };
+
+printf "Configuring for: Perl version $VERSION{REVISION}.%03d%03d\n",
+ $VERSION{VERSION}, $VERSION{SUBVERSION};
+
+my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+my $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+
+my $SDK = do "sdk.pl";
+my %PORT = %{ do "port.pl" };
+
+my ( $SYMBIAN_VERSION, $SDK_VERSION ) = ( $SDK =~ m!\\Symbian\\(.+?)\\(.+)$! );
+
+if ($SDK eq 'C:\Symbian\Series60_1_2_CW') {
+ ( $SYMBIAN_VERSION, $SDK_VERSION ) = qw(6.1 1.2);
+}
+
+my $WIN = $ENV{WIN} ; # 'wins', 'winscw' (from sdk.pl)
+my $ARM = 'thumb'; # 'thumb', 'armi'
+my $S60SDK = $ENV{S60SDK}; # qw(1.2 2.0 2.1 2.6) (from sdk.pl)
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+my $UARM = $ENV{UARM}; # from sdk.pl
+
+die "$0: SDK not recognized\n"
+ if !defined($SYMBIAN_VERSION) || !defined($SDK_VERSION) || !defined($S60SDK);
+
+die "$0: does not know which Windows compiler to use\n"
+ unless defined $WIN;
+
+print "Symbian $SYMBIAN_VERSION SDK $S60SDK ($WIN) installed at $SDK\n";
+
+my $CWD = do "cwd.pl";
+print "Build directory $CWD\n";
+
+die "$0: '+' in cwd does not work with SDK 1.2\n"
+ if $S60SDK eq '1.2' && $CWD =~ /\+/;
+
+my @unclean;
+my @mmp;
+
+sub create_mmp {
+ my ( $target, $type, @x ) = @_;
+ my $miniperl = $target eq 'miniperl';
+ my $perl = $target eq 'perl';
+ my $mmp = "$target.mmp";
+ my $targetpath = $miniperl
+ || $perl ? "TARGETPATH\t\\System\\Apps\\Perl" : "";
+ if ( open( my $fh, ">$mmp" ) ) {
+ print "\t$mmp\n";
+ push @mmp, $mmp;
+ push @unclean, $mmp;
+ print $fh <<__EOF__;
+TARGET $target.$type
+TARGETTYPE $type
+$targetpath
+EPOCHEAPSIZE 1024 8388608
+EPOCSTACKSIZE 65536
+EXPORTUNFROZEN
+SRCDBG
+__EOF__
+ print $fh "MACRO\t__SERIES60_1X__\n" if $S60SDK =~ /^1\./;
+ print $fh "MACRO\t__SERIES60_2X__\n" if $S60SDK =~ /^2\./;
+ my ( @c, %c );
+ @c = map { glob } qw(*.c); # Find the .c files.
+ @c = map { lc } @c; # Lowercase the names.
+ @c = grep { !/malloc\.c/ } @c; # Use the system malloc.
+ @c = grep { !/main\.c/ } @c; # main.c must be explicit.
+ push @c, map { lc } @x;
+ @c = map { s:^\.\./::; $_ } @c; # Remove the leading ../
+ @c = map { $c{$_}++ } @c; # Uniquefy.
+ @c = sort keys %c; # Beautify.
+
+ for (@c) {
+ print $fh "SOURCE\t\t$_\n";
+ }
+ print $fh <<__EOF__;
+SOURCEPATH $CWD
+USERINCLUDE $CWD
+USERINCLUDE $CWD\\ext\\DynaLoader
+USERINCLUDE $CWD\\symbian
+SYSTEMINCLUDE \\epoc32\\include\\libc
+SYSTEMINCLUDE \\epoc32\\include
+LIBRARY euser.lib
+LIBRARY estlib.lib
+__EOF__
+ if ( $miniperl || $perl || $type eq 'dll' ) {
+ print $fh <<__EOF__;
+LIBRARY charconv.lib
+LIBRARY commonengine.lib
+LIBRARY hal.lib
+LIBRARY estor.lib
+__EOF__
+ }
+ if ( $type eq 'exe' ) {
+ print $fh <<__EOF__;
+STATICLIBRARY ecrt0.lib
+__EOF__
+ }
+ if ($miniperl) {
+ print $fh <<__EOF__;
+MACRO PERL_MINIPERL
+__EOF__
+ }
+ if ($perl) {
+ print $fh <<__EOF__;
+MACRO PERL_PERL
+__EOF__
+ }
+ print $fh <<__EOF__;
+MACRO PERL_CORE
+MACRO MULTIPLICITY
+MACRO PERL_IMPLICIT_CONTEXT
+__EOF__
+ unless ( $miniperl || $perl ) {
+ print $fh <<__EOF__;
+MACRO PERL_GLOBAL_STRUCT
+MACRO PERL_GLOBAL_STRUCT_PRIVATE
+__EOF__
+ }
+ close $fh;
+ }
+ else {
+ warn "$0: failed to open $mmp for writing: $!\n";
+ }
+}
+
+sub create_bld_inf {
+ if ( open( BLD_INF, ">bld.inf" ) ) {
+ print "\tbld.inf\n";
+ push @unclean, "bld.inf";
+ print BLD_INF <<__EOF__;
+PRJ_PLATFORMS
+${WIN} ${ARM}
+PRJ_MMPFILES
+__EOF__
+ for (@mmp) { print BLD_INF $_, "\n" }
+ close BLD_INF;
+ }
+ else {
+ warn "$0: failed to open bld.inf for writing: $!\n";
+ }
+}
+
+my %config;
+
+sub load_config_sh {
+ if ( open( CONFIG_SH, "symbian/config.sh" ) ) {
+ while (<CONFIG_SH>) {
+ if (/^(\w+)=['"]?(.*?)["']?$/) {
+ my ( $var, $val ) = ( $1, $2 );
+ $val =~ s/x.y.z/$R_V_SV/gi;
+ $val =~ s/thumb/$ARM/gi;
+ $val = "'$SYMBIAN_VERSION'" if $var eq 'osvers';
+ $val = "'$SDK_VERSION'" if $var eq 'sdkvers';
+ $config{$var} = $val;
+ }
+ }
+ close CONFIG_SH;
+ }
+ else {
+ warn "$0: failed to open symbian\\config.sh for reading: $!\n";
+ }
+}
+
+sub create_config_h {
+ load_config_sh();
+ if ( open( CONFIG_H, ">config.h" ) ) {
+ print "\tconfig.h\n";
+ push @unclean, "config.h";
+ if ( open( CONFIG_H_SH, "config_h.SH" ) ) {
+ while (<CONFIG_H_SH>) {
+ last if /\#ifndef _config_h_/;
+ }
+ print CONFIG_H <<__EOF__;
+/*
+ * Package name : perl
+ * Source directory : .
+ * Configuration time:
+ * Configured by :
+ * Target system : symbian
+ */
+
+#ifndef _config_h_
+__EOF__
+ while (<CONFIG_H_SH>) {
+ last if /!GROK!THIS/;
+ s/\$(\w+)/exists $config{$1} ? $config{$1} : ""/eg;
+ s/^#undef\s+(\S+).+/#undef $1/g;
+ s:\Q/**/::;
+ print CONFIG_H;
+ }
+ close CONFIG_H_SH;
+ }
+ else {
+ warn "$0: failed to open ../config_h.SH for reading: $!\n";
+ }
+ close CONFIG_H;
+ }
+ else {
+ warn "$0: failed to open config.h for writing: $!\n";
+ }
+}
+
+sub create_DynaLoader_cpp {
+ print "\text\\DynaLoader\\DynaLoader.cpp\n";
+ system(
+q[perl -Ilib lib\ExtUtils\xsubpp ext\DynaLoader\dl_symbian.xs >ext\DynaLoader\DynaLoader.cpp]
+ ) == 0
+ or die "$0: creating DynaLoader.cpp failed: $!\n";
+ push @unclean, 'ext\DynaLoader\DynaLoader.cpp';
+
+}
+
+sub create_symbian_port_h {
+ print "\tsymbian\\symbian_port.h\n";
+ if ( open( SYMBIAN_PORT_H, ">symbian/symbian_port.h" ) ) {
+ $S60SDK =~ /^(\d+)\.(\d+)$/;
+ my ($sdkmajor, $sdkminor) = ($1, $2);
+ print SYMBIAN_PORT_H <<__EOF__;
+/* Copyright (c) 2004-2005, Nokia. All rights reserved. */
+
+#ifndef __symbian_port_h__
+#define __symbian_port_h__
+
+#define PERL_SYMBIANPORT_MAJOR $PORT{dll}->{MAJOR}
+#define PERL_SYMBIANPORT_MINOR $PORT{dll}->{MINOR}
+#define PERL_SYMBIANPORT_PATCH $PORT{dll}->{PATCH}
+
+#define PERL_SYMBIANSDK_FLAVOR L"Series 60"
+#define PERL_SYMBIANSDK_MAJOR $sdkmajor
+#define PERL_SYMBIANSDK_MINOR $sdkminor
+
+#endif /* #ifndef __symbian_port_h__ */
+__EOF__
+ close(SYMBIAN_PORT_H);
+ push @unclean, 'symbian\symbian_port.h';
+ }
+ else {
+ warn "$0: failed to open symbian/symbian_port.h for writing: $!\n";
+ }
+}
+
+sub create_perlmain_c {
+ print "\tperlmain.c\n";
+ system(
+q[perl -ne "print qq[ char *file = __FILE__;\n] if /dXSUB_SYS/;print;print qq[ newXS(\"DynaLoader::boot_DynaLoader\", boot_DynaLoader, file);\n] if /dXSUB_SYS/;print qq[EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);\n] if /Do not delete this line/" miniperlmain.c > perlmain.c]
+ ) == 0
+ or die "$0: Creating perlmain.c failed: $!\n";
+ push @unclean, 'perlmain.c';
+}
+
+sub create_PerlApp_pkg {
+ print "\tsymbian\\PerlApp.pkg\n";
+ if ( open( PERLAPP_PKG, ">symbian\\PerlApp.pkg" ) ) {
+ my $APPS = $UREL;
+ if ($S60SDK ne '1.2' || $SDK =~ m/_CW$/) { # Do only if not in 1.2 VC.
+ $APPS =~ s!\\epoc32\\release\\(.+)\\$UARM$!\\epoc32\\data\\z\\system\\apps\\PerlApp!i;
+ }
+ print PERLAPP_PKG <<__EOF__;
+; !!!!!! DO NOT EDIT THIS FILE !!!!!!
+; This file is built by symbian\\config.pl.
+; Any changes made here will be lost!
+;
+; PerlApp.pkg
+;
+; Note that the demo_pl needs to be run to create the demo .pl scripts.
+;
+; Languages
+&EN;
+
+; Standard SIS file header
+#{"PerlApp"},(0x102015F6),0,1,0
+
+; Supports Series 60 v0.9
+(0x101F6F88), 0, 0, 0, {"Series60ProductID"}
+
+; Files
+"$UREL\\PerlApp.APP"-"!:\\system\\apps\\PerlApp\\PerlApp.app"
+"$UREL\\PerlRecog.mdl"-"!:\\system\\recogs\\PerlRecog.mdl"
+"$APPS\\PerlApp.rsc"-"!:\\system\\apps\\PerlApp\\PerlApp.rsc"
+"$APPS\\PerlApp.aif"-"!:\\system\\apps\\PerlApp\\PerlApp.aif"
+__EOF__
+ if ( open( DEMOS, "perl symbian\\demo_pl list |" ) ) {
+ while (<DEMOS>) {
+ chomp;
+ print PERLAPP_PKG qq["$_"-"!:\\Perl\\$_"\n];
+ }
+ close(DEMOS);
+ }
+ close(PERLAPP_PKG);
+ }
+ else {
+ die "$0: symbian\\PerlApp.pkg: $!\n";
+ }
+ push @unclean, 'symbian\PerlApp.pkg';
+}
+
+print "Creating...\n";
+create_mmp(
+ 'miniperl', 'exe',
+ 'miniperlmain.c', 'symbian\symbian_stubs.c',
+ 'symbian\PerlBase.cpp', 'symbian\symbian_utils.cpp',
+);
+create_mmp(
+ "perl", 'exe',
+ 'perlmain.c', 'symbian\symbian_stubs.c',
+ 'symbian\symbian_utils.cpp', 'symbian\PerlBase.cpp',
+ 'ext\DynaLoader\DynaLoader.cpp',
+);
+
+create_mmp(
+ "perl$VERSION", 'dll',
+ 'symbian\symbian_dll.cpp', 'symbian\symbian_stubs.c',
+ 'symbian\symbian_utils.cpp', 'symbian\PerlBase.cpp',
+ 'ext\DynaLoader\DynaLoader.cpp',
+);
+
+create_bld_inf();
+create_config_h();
+create_perlmain_c();
+create_symbian_port_h();
+create_DynaLoader_cpp();
+create_PerlApp_pkg();
+
+if ( open( PERLAPP_MMP, ">symbian/PerlApp.mmp" ) ) {
+ my @MACRO;
+ push @MACRO, '__SERIES60_1X__' if $S60SDK =~ /^1\./;
+ push @MACRO, '__SERIES60_2X__' if $S60SDK =~ /^2\./;
+ print PERLAPP_MMP <<__EOF__;
+// !!!!!! DO NOT EDIT THIS FILE !!!!!!
+// This file is built by symbian\\config.pl.
+// Any changes made here will be lost!
+TARGET PerlApp.app
+TARGETTYPE app
+UID 0x100039CE 0x102015F6
+TARGETPATH \\system\\apps\\PerlApp
+SRCDBG
+EXPORTUNFROZEN
+SOURCEPATH .
+SOURCE PerlApp.cpp
+
+RESOURCE PerlApp.rss
+
+USERINCLUDE .
+USERINCLUDE ..
+USERINCLUDE \\symbian\\perl\\$R_V_SV\\include
+
+SYSTEMINCLUDE \\epoc32\\include
+SYSTEMINCLUDE \\epoc32\\include\\libc
+
+LIBRARY apparc.lib
+LIBRARY avkon.lib
+LIBRARY bafl.lib
+LIBRARY charconv.lib
+LIBRARY commondialogs.lib
+LIBRARY cone.lib
+LIBRARY efsrv.lib
+LIBRARY eikcore.lib
+LIBRARY estlib.lib
+LIBRARY euser.lib
+LIBRARY perl$VERSION.lib
+
+AIF PerlApp.aif . PerlAppAif.rss
+__EOF__
+ if (@MACRO) {
+ for my $macro (@MACRO) {
+ print PERLAPP_MMP <<__EOF__;
+MACRO $macro
+__EOF__
+ }
+ }
+ close(PERLAPP_MMP);
+ push @unclean, 'symbian\PerlApp.mmp';
+}
+else {
+ warn "$0: failed to create symbian\\PerlApp.mmp";
+}
+
+if ( open( MAKEFILE, ">Makefile" ) ) {
+ my $perl = "perl$VERSION";
+ my $windef1 = "$SDK\\Epoc32\\Build$CWD\\$perl\\$WIN\\$perl.def";
+ my $windef2 = "..\\BWINS\\${perl}u.def";
+ my $armdef1 = "$SDK\\Epoc32\\Build$CWD\\$perl\\$ARM\\$perl.def";
+ my $armdef2 = "..\\BMARM\\${perl}u.def";
+ print "\tMakefile\n";
+ print MAKEFILE <<__EOF__;
+help:
+ \@echo === Perl for Symbian ===
+ \@echo Useful targets:
+ \@echo all win arm clean
+ \@echo perldll.sis perlext.sis perlsdk.zip
+
+WIN = ${WIN}
+ARM = ${ARM}
+
+all: build
+
+build: rename_makedef build_win build_arm
+
+@unclean: symbian\\config.pl
+ perl symbian\\config.pl
+
+build_win: abld.bat win_perl.mf win_miniperl.mf win_${VERSION}.mf perldll_win
+
+build_vc6: abld.bat win_perl.mf win_miniperl.mf win_${VERSION}.mf vc6.mf perldll_win
+
+build_arm: abld.bat perl_arm miniperl_arm arm_${VERSION}.mf perldll_arm
+
+miniperl_win: miniperl.mmp abld.bat win_miniperl.mf rename_makedef
+ abld build \$(WIN) udeb miniperl
+
+miniperl_arm: miniperl.mmp abld.bat arm_miniperl.mf rename_makedef
+ abld build \$(ARM) $UARM miniperl
+
+miniperl: miniperl_win miniperl_arm
+
+perl: perl_win perl_arm
+
+perl_win: perl.mmp abld.bat win_perl.mf rename_makedef
+ abld build \$(WIN) perl
+
+perl_arm: perl.mmp abld.bat arm_perl.mf rename_makedef
+ abld build \$(ARM) $UARM perl
+
+perldll_win: perl${VERSION}_win freeze_win perl${VERSION}_win
+
+perl${VERSION}_win: perl$VERSION.mmp abld.bat rename_makedef
+ abld build \$(WIN) perl$VERSION
+
+perldll_arm: perl${VERSION}_arm freeze_arm perl${VERSION}_arm
+
+perl${VERSION}_arm: perl$VERSION.mmp arm_${VERSION}.mf abld.bat rename_makedef
+ abld build \$(ARM) $UARM perl$VERSION
+
+perldll perl$VERSION: perldll_win perldll_arm
+
+win: miniperl_win perl_win perldll_win
+
+arm: miniperl_arm perl_arm perldll_arm
+
+rename_makedef:
+ -ren makedef.pl nomakedef.pl
+
+# Symbian SDK has a makedef.pl of its own,
+# and we don't need Perl's.
+rerename_makedef:
+ -ren nomakedef.pl makedef.pl
+
+abld.bat abld: bld.inf
+ bldmake bldfiles
+
+makefiles: win.mf arm.mf vc6.mf
+
+vc6: win.mf vc6.mf build_vc6
+
+win_miniperl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) miniperl
+ echo > win_miniperl.mf
+
+win_perl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) perl
+ echo > win_perl.mf
+
+win_${VERSION}.mf: abld.bat symbian\\config.pl
+ abld makefile \$(WIN) perl${VERSION}
+ echo > win_${VERSION}.mf
+
+symbian\\win.mf:
+ cd symbian; make win.mf
+
+win.mf: win_miniperl.mf win_perl.mf win_${VERSION}.mf symbian\\win.mf
+
+arm_miniperl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) miniperl
+ echo > arm_miniperl.mf
+
+arm_perl.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) perl
+ echo > arm_perl.mf
+
+arm_${VERSION}.mf: abld.bat symbian\\config.pl
+ abld makefile \$(ARM) perl${VERSION}
+ echo > arm_${VERSION}.mf
+
+arm.mf: arm_miniperl.mf arm_perl.mf arm_${VERSION}.mf
+
+vc6.mf: abld.bat symbian\\config.pl
+ abld makefile vc6
+ echo > vc6.mf
+
+PM = lib\\Config.pm lib\\Cross.pm lib\\lib.pm ext\\DynaLoader\\DynaLoader.pm ext\\DynaLoader\\XSLoader.pm ext\\Errno\\Errno.pm
+POD = lib\\Config.pod
+
+pm: \$(PM)
+
+XLIB = -Ixlib\\symbian
+
+XSBOPT = --win=\$(WIN) --arm=\$(ARM)
+
+lib\\Config.pm:
+ copy symbian\\config.sh config.sh
+ perl -pi.bak -e "s:x\\.y\\.z+:$R_V_SV:g" config.sh
+ perl \$(XLIB) configpm --cross=symbian
+ copy xlib\\symbian\\Config.pm lib\\Config.pm
+ perl -pi.bak -e "s:x\\.y\\.z:$R_V_SV:g" lib\\Config.pm
+ perl -pi.bak -e "s:5\\.\\d+\\.\\d+:$R_V_SV:g" lib\\Config.pm
+ -perl -pi.bak -e "s:x\\.y\\.z:$R_V_SV:g" xlib\\symbian\\Config_heavy.pl
+
+lib\\lib.pm:
+ perl lib\\lib_pm.PL
+
+ext\\DynaLoader\\DynaLoader.pm:
+ -del /f ext\\DynaLoader\\DynaLoader.pm
+ perl -Ixlib\\symbian ext\\DynaLoader\\DynaLoader_pm.PL
+ perl -pi.bak -e "s/__END__//" DynaLoader.pm
+ copy /y DynaLoader.pm ext\\DynaLoader\\DynaLoader.pm
+ -del /f DynaLoader.pm DynaLoader.pm.bak
+
+ext\\DynaLoader\\XSLoader.pm:
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) XSLoader
+
+ext\\Errno\\Errno.pm:
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) Errno
+
+miniperlexe.sis: miniperl_arm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl miniperl
+
+perlexe.sis: perl_arm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl perl
+
+
+allsis: all miniperlexe.sis perlexe.sis perldll.sis perllib.sis perlext.sis perlapp.sis
+
+perldll.sis perl$VERSION.sis: perldll_arm pm symbian\\makesis.pl
+ perl \$(XLIB) symbian\\makesis.pl perl${VERSION}dll
+
+perllib.sis: \$(PM)
+ perl \$(XLIB) symbian\\makesis.pl perl${VERSION}lib
+
+perlext.sis: perldll_arm buildext_sis
+ perl symbian\\makesis.pl perl${VERSION}ext
+
+EXT = Cwd Data::Dumper Devel::Peek Digest::MD5 Errno Fcntl File::Glob Filter::Util::Call IO List::Util MIME::Base64 PerlIO::scalar PerlIO::via SDBM_File Socket Storable Time::HiRes XSLoader attrs
+
+buildext: perldll symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) \$(EXT)
+
+buildext_sis: perldll.sis symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --sis \$(EXT)
+
+cleanext: symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --clean \$(EXT)
+
+distcleanext: symbian\\xsbuild.pl
+ perl \$(XLIB) symbian\\xsbuild.pl \$(XSBOPT) --distclean \$(EXT)
+
+sis makesis: miniperl perl perldll pm buildext perlapp.sis
+ perl \$(XLIB) symbian\\makesis.pl
+
+APIDIR = \\Symbian\\perl\\$R_V_SV
+
+sdkinstall:
+ -mkdir \\Symbian\\perl
+ -mkdir \\Symbian\\perl\\$R_V_SV
+ -mkdir \$(APIDIR)\\include
+ -mkdir \$(APIDIR)\\include\\symbian
+ -mkdir \$(APIDIR)\\lib
+ -mkdir \$(APIDIR)\\lib\\ExtUtils
+ -mkdir \$(APIDIR)\\pod
+ -mkdir \$(APIDIR)\\bin
+ -mkdir \$(BINDIR)
+ copy /y *.h \$(APIDIR)\\include
+ - copy /y *.inc \$(APIDIR)\\include
+ copy /y lib\\ExtUtils\\xsubpp \$(APIDIR)\\lib\\ExtUtils
+ copy /y lib\\ExtUtils\\typemap \$(APIDIR)\\lib\\ExtUtils
+ copy /y symbian\\xsbuild.pl \$(APIDIR)\\bin
+ copy /y symbian\\PerlBase.h \$(APIDIR)\\include
+ copy /y symbian\\symbian*.h \$(APIDIR)\\include\\symbian
+ copy /y symbian\\PerlBase.pod \$(APIDIR)\\pod
+
+RELDIR = $SDK\\epoc32\\release
+RELWIN = \$(RELDIR)\\\$(WIN)\\udeb
+RELARM = \$(RELDIR)\\\$(ARM)\\$UARM
+
+perlsdk.zip: perldll sdkinstall
+ zip -r perl${VERSION}sdk.zip \$(RELWIN)\\perl$VERSION.* \$(RELARM)\\perl$VERSION.* \$(APIDIR)
+ \@echo perl${VERSION}sdk.zip created.
+
+perlapp: sdkinstall perlapp_win perlapp_arm
+
+perlapp_win: config.h
+ cd symbian; make perlapp_win
+
+perlapp_arm: config.h
+ cd symbian; make perlapp_arm
+
+perlapp_demo_extract:
+ cd symbian; make perlapp_demo_extract
+
+perlapp.sis: perlapp_arm
+ cd symbian; make perlapp.sis
+
+perlapp.zip:
+ cd symbian; zip perlapp.zip PerlApp.* PerlRecog.* PerlBase.* demo_pl
+
+zip: perlsdk.zip perlapp.zip
+
+freeze: freeze_win freeze_arm
+
+freeze_win:
+ abld freeze \$(WIN) perl$VERSION
+
+freeze_arm:
+ abld freeze \$(ARM) perl$VERSION
+
+defrost: defrost_win defrost_arm
+
+defrost_win:
+ -del /f $windef1
+ -del /f $windef2
+
+defrost_arm:
+ -del /f $armdef1
+ -del /f $armdef2
+
+clean_win: abld.bat
+ abld clean \$(WIN)
+
+clean_arm: abld.bat
+ abld clean \$(ARM)
+
+clean: clean_win clean_arm rerename_makedef
+ -del /f \$(PM)
+ -del /f \$(POD)
+ -del /f lib\\Config.pm.bak
+ -del /f xlib\\symbian\\Config_heavy.pl
+ -rmdir /s /q xlib
+ -del /f config.sh
+ -del /f DynaLoader.pm ext\\DynaLoader\\DynaLoader.pm
+ -del /f ext\\DynaLoader\\Makefile
+ -del /f ext\\SDBM_File\\sdbm\\Makefile
+ -del /f symbian\\*.lst
+ -del /f abld.bat @unclean *.pkg *.sis *.zip
+ -del /f symbian\\abld.bat symbian\\*.sis symbian\\*.zip
+ -del /f symbian\\perl5*.pkg symbian\\miniperl.pkg
+ -del arm_*.mf win_*.mf vc6*.mf
+ -perl symbian\\xsbuild.pl \$(XSBOPT) --clean \$(EXT)
+ -rmdir /s /q perl${VERSION}_Data
+ -cd symbian; make clean
+
+reallyclean: abld.bat
+ abld reallyclean
+
+distclean: defrost reallyclean clean
+ -perl symbian\\xsbuild.pl \$(XSBOPT) --distclean \$(EXT)
+ -del /f config.h config.sh.bak symbian\\symbian_port.h
+ -del /f Makefile symbian\\PerlApp.mmp
+ -del /f BMARM\\*.def
+ -del /f *.cwlink *.resources *.pref
+ -del /f perl${VERSION}.xml perl${VERSION}.mcp uid.cpp
+ -rmdir /s /q BMARM
+ cd symbian; make distclean
+ -del /f symbian\\Makefile
+__EOF__
+ close MAKEFILE;
+}
+else {
+ warn "$0: failed to create Makefile: $!\n";
+}
+
+if ( open( MAKEFILE, ">symbian/Makefile")) {
+ my $wrap = $S60SDK eq '1.2' && $SDK !~ /_CW$/;
+ my $ABLD = $wrap ? 'perl b.pl': 'abld';
+ print "\tsymbian/Makefile\n";
+ print MAKEFILE <<__EOF__;
+WIN = $WIN
+ARM = $ARM
+ABLD = $ABLD
+
+abld.bat:
+ bldmake bldfiles
+
+perlapp_win: abld.bat ..\\config.h PerlApp.h PerlApp.cpp
+ bldmake bldfiles
+ \$(ABLD) build \$(WIN) udeb
+
+perlapp_arm: ..\\config.h PerlApp.h PerlApp.cpp
+ bldmake bldfiles
+ \$(ABLD) build \$(ARM) $UARM
+
+win.mf:
+ bldmake bldfiles
+ abld makefile vc6
+
+perlapp_demo_extract:
+ perl demo_pl extract
+
+perlapp.sis: perlapp_arm perlapp_demo_extract
+ -del /f perlapp.SIS
+ makesis perlapp.pkg
+ copy /y perlapp.SIS ..\\perlapp.SIS
+
+clean:
+ -perl demo_pl cleanup
+ -del /f perlapp.sis
+ -del /f b.pl
+
+distclean: clean
+ -del /f *.cwlink *.resources *.pref
+ -del /f PerlApp.xml PerlApp.mcp uid.cpp
+ -rmdir /s /q PerlApp_Data
+ -del /f abld.bat
+__EOF__
+ close(MAKEFILE);
+ if ($wrap) {
+ if ( open( B_PL, ">symbian/b.pl")) {
+ print B_PL <<'__EOF__';
+# abld.pl wrapper.
+
+# nmake doesn't like MFLAGS and MAKEFLAGS being set to -w and w.
+delete $ENV{MFLAGS};
+delete $ENV{MAKEFLAGS};
+
+system("abld @ARGV");
+__EOF__
+ close(B_PL);
+ } else {
+ warn "$0: failed to create symbian/b.pl: $!\n";
+ }
+ }
+} else {
+ warn "$0: failed to create symbian/Makefile: $!\n";
+}
+
+print "Deleting...\n";
+for my $config (
+ # Do not delete config.h here.
+ "config.sh",
+ "lib\\Config.pm",
+ "xlib\\symbian\\Config.pm",
+ "xlib\\symbian\\Config_heavy.pl",
+ ) {
+ print "\t$config\n";
+ unlink($config);
+}
+
+print <<__EOM__;
+Configuring done.
+Now you can run:
+ make all
+ make allsis
+__EOM__
+
+1; # Happy End.
--- /dev/null
+#!\\bin\\sh
+PERL_CONFIG_SH='true'
+_a='.a'
+_o='.o'
+afs='false'
+afsroot='/afs'
+alignbytes='4'
+apiversion='5.005'
+ar=':'
+archlib='\\system\\libs\\perl\\x.y.z\\thumb-symbian'
+archlibexp='\\system\\libs\\perl\\x.y.z\\thumb-symbian'
+archname='thumb-symbian'
+asctime_r_proto='0'
+bin='\\system\\apps\\perl'
+binexp='\\system\\apps\\perl'
+bincompat5005='n'
+byteorder='1234'
+castflags='0'
+cc='gcc'
+cccdlflags=''
+ccdlflags=''
+charsize='1'
+clocktype='clock_t'
+cpp_stuff='42'
+cppminus='-'
+cpprun='gcc -E'
+cppstdin='gcc -E'
+crypt_r_proto='0'
+ctermid_r_proto='0'
+ctime_r_proto='0'
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
+d_PRId64='undef'
+d_PRIeldbl='undef'
+d_PRIfldbl='undef'
+d_PRIgldbl='undef'
+d_PRIi64='undef'
+d_PRIo64='undef'
+d_PRIu64='undef'
+d_PRIx64='undef'
+d_SCNfldbl='undef'
+d__fwalk='undef'
+d_access='undef'
+d_accessx='undef'
+d_aintl='undef'
+d_alarm='undef'
+d_archlib='define'
+d_asctime_r='undef'
+d_atolf='undef'
+d_atoll='undef'
+d_attribut='undef'
+d_bcmp='undef'
+d_bcopy='undef'
+d_bsd='undef'
+d_bsdgetpgrp='undef'
+d_bsdsetpgrp='undef'
+d_bzero='undef'
+d_casti32='undef'
+d_castneg='undef'
+d_charvspr='undef'
+d_chown='undef'
+d_chroot='undef'
+d_chsize='undef'
+d_class='undef'
+d_closedir='undef'
+d_cmsghdr_s='undef'
+d_const='define'
+d_copysignl='undef'
+d_crypt='undef'
+d_crypt_r='undef'
+d_csh='undef'
+d_ctermid_r='undef'
+d_ctime_r='undef'
+d_cuserid='undef'
+d_dbl_dig='undef'
+d_dbminitproto='undef'
+d_difftime='undef'
+d_dirfd='undef'
+d_dirnamlen='define'
+d_dlerror='undef'
+d_dlopen='undef'
+d_dlsymun='undef'
+d_dosuid='undef'
+d_drand48_r='undef'
+d_drand48proto='undef'
+d_dup2='undef'
+d_eaccess='undef'
+d_endgrent='undef'
+d_endgrent_r='undef'
+d_endhent='undef'
+d_endhostent_r='undef'
+d_endnent='undef'
+d_endnetent_r='undef'
+d_endpent='undef'
+d_endprotoent_r='undef'
+d_endpwent='undef'
+d_endpwent_r='undef'
+d_endsent='undef'
+d_endservent_r='undef'
+d_eofnblk='undef'
+d_eunice='undef'
+d_faststdio='undef'
+d_fchdir='undef'
+d_fchmod='undef'
+d_fchown='undef'
+d_fcntl='undef'
+d_fcntl_can_lock='undef'
+d_fd_macros='undef'
+d_fd_set='undef'
+d_fds_bits='undef'
+d_fgetpos='undef'
+d_finite='undef'
+d_finitel='undef'
+d_flexfnam='undef'
+d_flock='undef'
+d_flockproto='undef'
+d_fork='undef'
+d_fp_class='undef'
+d_fpathconf='undef'
+d_fpclass='undef'
+d_fpclassify='undef'
+d_fpclassl='undef'
+d_fpos64_t='undef'
+d_frexpl='undef'
+d_fs_data_s='undef'
+d_fseeko='undef'
+d_fsetpos='define'
+d_fstatfs='undef'
+d_fstatvfs='undef'
+d_fsync='undef'
+d_ftello='undef'
+d_ftime='undef'
+d_getcwd='define'
+d_getespwnam='undef'
+d_getfsstat='undef'
+d_getgrent='undef'
+d_getgrent_r='undef'
+d_getgrgid_r='undef'
+d_getgrnam_r='undef'
+d_getgrps='undef'
+d_gethbyaddr='define'
+d_gethbyname='define'
+d_gethent='undef'
+d_gethname='define'
+d_gethostbyaddr_r='undef'
+d_gethostbyname_r='undef'
+d_gethostent_r='undef'
+d_gethostprotos='define'
+d_getitimer='undef'
+d_getlogin='undef'
+d_getlogin_r='undef'
+d_getmnt='undef'
+d_getmntent='undef'
+d_getnbyaddr='undef'
+d_getnbyname='undef'
+d_getnent='undef'
+d_getnetbyaddr_r='undef'
+d_getnetbyname_r='undef'
+d_getnetent_r='undef'
+d_getnetprotos='undef'
+d_getpagsz='undef'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='undef'
+d_getpgid='undef'
+d_getpgrp2='undef'
+d_getpgrp='undef'
+d_getppid='undef'
+d_getprior='undef'
+d_getprotobyname_r='undef'
+d_getprotobynumber_r='undef'
+d_getprotoent_r='undef'
+d_getprotoprotos='define'
+d_getprpwnam='undef'
+d_getpwent='undef'
+d_getpwent_r='undef'
+d_getpwnam_r='undef'
+d_getpwuid_r='undef'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='undef'
+d_getservbyname_r='undef'
+d_getservbyport_r='undef'
+d_getservent_r='undef'
+d_getservprotos='define'
+d_getspent='undef'
+d_getspnam='undef'
+d_getspnam_r='undef'
+d_gettimeod='define'
+d_gmtime_r='undef'
+d_gnulibc='undef'
+d_grpasswd='undef'
+d_hasmntopt='undef'
+d_htonl='define'
+d_ilogbl='undef'
+d_index='undef'
+d_inetaton='undef'
+d_int64_t='undef'
+d_isascii='undef'
+d_isfinite='undef'
+d_isinf='undef'
+d_isnan='undef'
+d_isnanl='undef'
+d_killpg='undef'
+d_lchown='undef'
+d_ldbl_dig='undef'
+d_libm_lib_version='undef'
+d_link='undef'
+d_localtime_r='undef'
+d_locconv='undef'
+d_lockf='undef'
+d_longdbl='undef'
+d_longlong='undef'
+d_lseekproto='undef'
+d_lstat='undef'
+d_madvise='undef'
+d_mblen='undef'
+d_mbstowcs='undef'
+d_mbtowc='undef'
+d_memchr='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_mkdtemp='undef'
+d_mkfifo='undef'
+d_mkstemp='undef'
+d_mkstemps='undef'
+d_mktime='undef'
+d_mmap='undef'
+d_modfl='undef'
+d_modfl_pow32_bug='undef'
+d_modflproto='undef'
+d_mprotect='undef'
+d_msg='undef'
+d_msg_ctrunc='undef'
+d_msg_dontroute='undef'
+d_msg_oob='undef'
+d_msg_peek='undef'
+d_msg_proxy='undef'
+d_msgctl='undef'
+d_msgget='undef'
+d_msghdr_s='undef'
+d_msgrcv='undef'
+d_msgsnd='undef'
+d_msync='undef'
+d_munmap='undef'
+d_mymalloc='undef'
+d_nice='undef'
+d_nl_langinfo='undef'
+d_nv_preserves_uv='undef'
+d_off64_t='undef'
+d_old_pthread_create_joinable='undef'
+d_oldpthreads='undef'
+d_oldsock='undef'
+d_open3='undef'
+d_pathconf='undef'
+d_pause='undef'
+d_perl_otherlibdirs='undef'
+d_phostname='undef'
+d_pipe='undef'
+d_poll='undef'
+d_portable='undef'
+d_procselfexe='undef'
+d_pthread_atfork='undef'
+d_pthread_attr_setscope='undef'
+d_pthread_yield='undef'
+d_pwage='undef'
+d_pwchange='undef'
+d_pwclass='undef'
+d_pwcomment='undef'
+d_pwexpire='undef'
+d_pwgecos='undef'
+d_pwpasswd='undef'
+d_pwquota='undef'
+d_qgcvt='undef'
+d_quad='undef'
+d_random_r='undef'
+d_readdir64_r='undef'
+d_readdir='define'
+d_readdir_r='undef'
+d_readlink='undef'
+d_readv='undef'
+d_recvmsg='undef'
+d_rename='define'
+d_rewinddir='define'
+d_rmdir='define'
+d_safebcpy='undef'
+d_safemcpy='undef'
+d_sanemcmp='undef'
+d_sbrkproto='undef'
+d_scalbnl='undef'
+d_sched_yield='undef'
+d_scm_rights='undef'
+d_seekdir='define'
+d_select='undef'
+d_sem='undef'
+d_semctl='undef'
+d_semctl_semid_ds='undef'
+d_semctl_semun='undef'
+d_semget='undef'
+d_semop='undef'
+d_sendmsg='undef'
+d_setegid='undef'
+d_seteuid='undef'
+d_setgrent='undef'
+d_setgrent_r='undef'
+d_setgrps='undef'
+d_sethent='undef'
+d_sethostent_r='undef'
+d_setitimer='undef'
+d_setlinebuf='undef'
+d_setlocale='undef'
+d_setlocale_r='undef'
+d_setnent='undef'
+d_setnetent_r='undef'
+d_setpent='undef'
+d_setpgid='undef'
+d_setpgrp2='undef'
+d_setpgrp='undef'
+d_setprior='undef'
+d_setproctitle='undef'
+d_setprotoent_r='undef'
+d_setpwent='undef'
+d_setpwent_r='undef'
+d_setregid='undef'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+d_setsent='undef'
+d_setservent_r='undef'
+d_setsid='undef'
+d_setvbuf='define'
+d_sfio='undef'
+d_shm='undef'
+d_shmat='undef'
+d_shmatprototype='undef'
+d_shmctl='undef'
+d_shmdt='undef'
+d_shmget='undef'
+d_sigaction='undef'
+d_sigprocmask='undef'
+d_sigsetjmp='undef'
+d_sitecustomize='undef'
+d_sockatmark='undef'
+d_sockatmarkproto='undef'
+d_socket='define'
+d_socklen_t='undef'
+d_sockpair='undef'
+d_socks5_init='undef'
+d_sqrtl='undef'
+d_srand48_r='undef'
+d_srandom_r='undef'
+d_sresgproto='undef'
+d_sresuproto='undef'
+d_statblks='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
+d_statvfs='undef'
+d_stdio_cnt_lval='undef'
+d_stdio_ptr_lval='undef'
+d_stdio_ptr_lval_nochange_cnt='undef'
+d_stdio_ptr_lval_sets_cnt='undef'
+d_stdio_stream_array='undef'
+d_stdiobase='undef'
+d_stdstdio='undef'
+d_strchr='define'
+d_strcoll='undef'
+d_strctcpy='undef'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strerror_r='undef'
+d_strftime='undef'
+d_strlcat='undef'
+d_strlcpy='undef'
+d_strtod='define'
+d_strtol='define'
+d_strtold='undef'
+d_strtoll='undef'
+d_strtoq='undef'
+d_strtoul='define'
+d_strtoull='undef'
+d_strtouq='undef'
+d_strxfrm='undef'
+d_suidsafe='undef'
+d_symlink='undef'
+d_syscall='undef'
+d_syscallproto='undef'
+d_sysconf='undef'
+d_sysernlst=''
+d_syserrlst='undef'
+d_system='define'
+d_tcgetpgrp='undef'
+d_tcsetpgrp='undef'
+d_telldir='define'
+d_telldirproto='define'
+d_time='define'
+d_times='define'
+d_tm_tm_gmtoff='undef'
+d_tm_tm_zone='undef'
+d_tmpnam_r='undef'
+d_truncate='undef'
+d_ttyname_r='undef'
+d_tzname='undef'
+d_u32align='define'
+d_ualarm='undef'
+d_umask='undef'
+d_uname='undef'
+d_union_semun='undef'
+d_unordered='undef'
+d_sitecustomize='undef'
+d_usleep='define'
+d_usleepproto='undef'
+d_ustat='undef'
+d_vendorarch='undef'
+d_vendorbin='undef'
+d_vendorlib='undef'
+d_vfork='undef'
+d_void_closedir='undef'
+d_voidsig='undef'
+d_voidtty=''
+d_volatile='define'
+d_vprintf='define'
+d_wait4='undef'
+d_waitpid='undef'
+d_wcstombs='undef'
+d_wctomb='undef'
+d_writev='undef'
+d_xenix='undef'
+db_hashtype='u_int32_t'
+db_prefixtype='size_t'
+defvoidused=1
+direntrytype='struct dirent'
+dlext='dll'
+dlsrc='dl_symbian.xs'
+doublesize='8'
+drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))"
+drand48_r_proto='0'
+eagain='EAGAIN'
+ebcdic='undef'
+endgrent_r_proto='0'
+endhostent_r_proto='0'
+endnetent_r_proto='0'
+endprotoent_r_proto='0'
+endpwent_r_proto='0'
+endservent_r_proto='0'
+eunicefix=':'
+exe_ext='.exe'
+fflushNULL='undef'
+fflushall='undef'
+firstmakefile='makefile'
+fpossize='4'
+fpostype=fpos_t
+freetype=void
+full_ar=':'
+getgrent_r_proto='0'
+getgrgid_r_proto='0'
+getgrnam_r_proto='0'
+gethostbyaddr_r_proto='0'
+gethostbyname_r_proto='0'
+gethostent_r_proto='0'
+getlogin_r_proto='0'
+getnetbyaddr_r_proto='0'
+getnetbyname_r_proto='0'
+getnetent_r_proto='0'
+getprotobyname_r_proto='0'
+getprotobynumber_r_proto='0'
+getprotoent_r_proto='0'
+getpwent_r_proto='0'
+getpwnam_r_proto='0'
+getpwuid_r_proto='0'
+getservbyname_r_proto='0'
+getservbyport_r_proto='0'
+getservent_r_proto='0'
+getspnam_r_proto='0'
+gidformat='"lu"'
+gidsign='1'
+gidsize='4'
+gidtype=int
+gmtime_r_proto='0'
+groupstype=int
+h_fcntl='false'
+h_sysfile='true'
+i16size='2'
+i16type='short'
+i32size='4'
+i32type='long'
+i64size='8'
+i64type='int64_t'
+i8size='1'
+i8type='char'
+i_arpainet='undef'
+i_bsdioctl=''
+i_crypt='undef'
+i_db='undef'
+i_dbm='undef'
+i_dirent='define'
+i_dld='undef'
+i_dlfcn='undef'
+i_fcntl='define'
+i_float='undef'
+i_fp='undef'
+i_fp_class='undef'
+i_gdbm='undef'
+i_grp='undef'
+i_ieeefp='undef'
+i_inttypes='undef'
+i_langinfo='undef'
+i_libutil='undef'
+i_limits='define'
+i_locale='define'
+i_machcthr='undef'
+i_malloc='undef'
+i_math='define'
+i_memory='undef'
+i_mntent='undef'
+i_ndbm='undef'
+i_netdb='define'
+i_neterrno='undef'
+i_netinettcp='undef'
+i_niin='define'
+i_poll='undef'
+i_prot='undef'
+i_pthread='undef'
+i_pwd='define'
+i_rpcsvcdbm='undef'
+i_sfio='undef'
+i_sgtty='undef'
+i_shadow='undef'
+i_socks='undef'
+i_stdarg='define'
+i_stddef='undef'
+i_stdlib='define'
+i_string='define'
+i_sunmath='undef'
+i_sysaccess='undef'
+i_sysdir='undef'
+i_sysfile='undef'
+i_sysfilio='undef'
+i_sysin='undef'
+i_sysioctl='define'
+i_syslog='undef'
+i_sysmman='undef'
+i_sysmode='undef'
+i_sysmount='undef'
+i_sysndir='undef'
+i_sysparam='undef'
+i_sysresrc='undef'
+i_syssecrt='undef'
+i_sysselct='undef'
+i_syssockio='undef'
+i_sysstat='define'
+i_sysstatfs='undef'
+i_sysstatvfs='undef'
+i_systime='define'
+i_systimek='undef'
+i_systimes='define'
+i_systypes='define'
+i_sysuio='undef'
+i_sysun='undef'
+i_sysutsname='undef'
+i_sysvfs='undef'
+i_syswait='undef'
+i_termio='undef'
+i_termios='undef'
+i_time='define'
+i_unistd='define'
+i_ustat='undef'
+i_utime='undef'
+i_values='undef'
+i_varargs='undef'
+i_varhdr='stdarg.h'
+i_vfork='undef'
+ignore_versioned_solibs='y'
+inc_version_list='0'
+inc_version_list_init='0'
+installprefix='\\system'
+installprefixexp='\\system'
+installsitearch='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+installsitelib='\\system\\libs\\perl\\siteperl\\x.y.z'
+installstyle='lib\\perl5'
+installusrbinperl='undef'
+intsize='4'
+ivdformat='"ld"'
+ivsize='4'
+ivtype='long'
+lib_ext='.a'
+lddlflags=''
+ld=':'
+ldflags=''
+libc='stdlib'
+libm_lib_version='0'
+libperl='libperl.a'
+localtime_r_proto='0'
+longdblsize=8
+longlongsize=8
+longsize='4'
+lseeksize=4
+lseektype=int
+make='make'
+malloctype='int*'
+malloctype='void *'
+modetype='mode_t'
+modetype=int
+multiarch='undef'
+myarchname='thumb-symbian'
+myuname='symbian'
+need_va_copy='undef'
+netdb_hlen_type='int'
+netdb_host_type='const char *'
+netdb_name_type='const char *'
+netdb_net_type='unsigned long'
+nroff='nroff'
+nv_preserves_uv_bits='0'
+nveformat='"e"'
+nvfformat='"f"'
+nvgformat='"g"'
+nvsize='8'
+nvtype='double'
+o_nonblock='O_NONBLOCK'
+obj_ext='.o'
+old_pthread_create_joinable=''
+optimize='-O2'
+orderlib='false'
+osname='symbian'
+osvers='7.0s'
+otherlibdirs=''
+path_sep=';';
+phostname='hostname'
+pidtype='int'
+pm_apiversion='5.005'
+privlib='\\system\\libs\\perl\\x.y.z'
+privlibexp='\\system\\libs\\perl\\x.y.z'
+procselfexe=''
+prototype='undef'
+ptrsize='4'
+quadkind='4'
+quadtype='int64_t'
+randbits='48'
+randfunc='drand48'
+random_r_proto='0'
+randseedtype='int'
+ranlib=':'
+rd_nodata='-1'
+readdir64_r_proto='0'
+readdir_r_proto='0'
+sPRIEUldbl='"llE"'
+sPRIFUldbl='"llF"'
+sPRIGUldbl='"llG"'
+sPRIXU64='"LX"'
+sPRId64='"Ld"'
+sPRIeldbl=''
+sPRIfldbl=''
+sPRIgldbl=''
+sPRIi64='"Li"'
+sPRIo64='"Lo"'
+sPRIu64='"Lu"'
+sPRIx64='"Lx"'
+sSCNfldbl=''
+sched_yield='sched_yield()'
+scriptdir='\\system\\apps\\perl'
+scriptdirexp='\\system\\apps\\perl'
+sdkvers=''
+seedfunc='srand'
+selectminbits='32'
+selecttype=int
+setgrent_r_proto='0'
+sethostent_r_proto='0'
+setlocale_r_proto='0'
+setnetent_r_proto='0'
+setprotoent_r_proto='0'
+setpwent_r_proto='0'
+setservent_r_proto='0'
+shmattype='void *'
+shortsize=2
+sig_name_init='0'
+sig_num_init='0'
+sig_size='1'
+signal_t=void
+sitearch='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+sitearchexp='\\system\\libs\\perl\\siteperl\\x.y.z\\thumb-symbian'
+sitelib='\\system\\libs\\perl\\siteperl\\x.y.z'
+sitelib_stem='\\system\\libs\\perl'
+sitelibexp='\\system\\libs\\perl\\siteperl\\x.y.z'
+siteprefix='\\system'
+siteprefixexp='\\system'
+sizesize=4
+sizetype=size_t
+so='o'
+socksizetype='unsigned int'
+srand48_r_proto='0'
+srandom_r_proto='0'
+ssizetype=int
+stdchar=char
+stdio_base='((fp)->_IO_read_base)'
+stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)'
+stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
+stdio_filbuf=''
+stdio_ptr='((fp)->_IO_read_ptr)'
+stdio_stream_array=''
+strerror_r_proto='0'
+targetarch='thumb-symbian'
+timetype=time_t
+tmpnam_r_proto='0'
+touch='touch'
+ttyname_r_proto='0'
+u16size='2'
+u16type='unsigned short'
+u32size='4'
+u32type='unsigned long'
+u64size='8'
+u64type='uint64_t'
+u8size='1'
+u8type='unsigned char'
+uidformat='"lu"'
+uidsign='1'
+uidsize='4'
+uidtype=int
+uquadtype='uint64_t'
+use5005threads='undef'
+use64bitall='undef'
+use64bitint='undef'
+usecrosscompile='define'
+usedl='undef'
+usefaststdio='undef'
+useithreads='undef'
+uselargefiles='undef'
+uselongdouble='undef'
+usemallocwrap='define'
+usemorebits='undef'
+usemultiplicity='undef'
+usemymalloc='n'
+usenm='false'
+useopcode='true'
+useperlio='define'
+useposix='true'
+usereentrant='undef'
+userelocatableinc='undef'
+usesfio='false'
+useshrplib='false'
+usesitecustomize='undef'
+usesocks='undef'
+usethreads='undef'
+usevendorprefix='n'
+usevfork='false'
+uvXUformat='"lX"'
+uvoformat='"lo"'
+uvsize='4'
+uvtype='unsigned long'
+uvuformat='"lu"'
+vendorlib_stem=''
+vendorlib=''
+vendorlibexp=''
+vendorarch=''
+vendorarchexp=''
+vendorprefix=''
+vendorprefixexp=''
+version='x.y.z'
+uvxformat='"lx"'
+versiononly='undef'
+voidflags=1
+xs_apiversion='5.008'
--- /dev/null
+use strict;
+use Cwd;
+my $CWD = getcwd();
+$CWD =~ s!^C:!!i;
+$CWD =~ s!/!\\!g;
+$CWD;
--- /dev/null
+#!/usr/bin/perl -w
+
+#
+# demo_pl
+#
+# A "self-extracting archive" for some demo scripts.
+#
+# hello - the classic
+# helloyou - advanced classic
+# httpget1 - simple sockets
+# httpget2 - simple sockets done complex
+# md5 - core extension
+# time - system call
+# times - more system calls
+#
+
+use strict;
+
+unless (@ARGV && $ARGV[0] =~ /^(?:list|extract|cleanup)$/) {
+ die "$0: Usage: $0 [list|extract|cleanup]\n";
+}
+
+my $action = shift;
+my $list = $action eq 'list';
+my $extract = $action eq 'extract';
+my $cleanup = $action eq 'cleanup';
+
+my $fh;
+while (<DATA>) {
+ if (/^-- (.+\.pl)$/) {
+ if ($cleanup) {
+ print "Deleting $1\n";
+ unlink $1 or warn "$0: $1: $!\n";
+ } elsif ($extract) {
+ defined $fh && close($fh);
+ open($fh, ">$1") or die "$0: '$1': $!\n";
+ print "Extracting $1\n";
+ } elsif ($list) {
+ print "$1\n";
+ }
+ } else {
+ print $fh $_ if $extract;
+ }
+}
+defined $fh && close($fh);
+exit(0);
+__END__
+-- hello.pl
+print "hello world!\n";
+-- helloyou.pl
+print "What is your name?\n";
+chomp(my $name = <STDIN>);
+print "Hello, $name!\n";
+print "Amazing fact #1:\n";
+printf "Your name has\n%d character%s!\n",
+ length($name), length($name) == 1 ? "" : "s";
+print "Amazing fact #2:\n";
+printf "Your name is\n%s backwards!\n", scalar reverse $name;
+-- httpget1.pl
+print "(Using plain sockets)\n";
+use Socket;
+print "Host? ";
+my $host = <STDIN>;
+chomp($host);
+$host = 'www.nokia.com' unless length $host;
+my $port = 80;
+my $iaddr = inet_aton($host) || die "no host: $host";
+my $paddr = sockaddr_in($port, $iaddr);
+my $proto = getprotobyname("tcp");
+socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+connect(S, $paddr) || die "connect: $!";
+print "$host:$port:\nConnected.\n";
+select(S); $| = 1; select(STDOUT);
+print S "GET / HTTP/1.0\012\012" || die "GET /: $!";
+my @line;
+print "Receiving...\n";
+while (my $line = <S>) {
+ push @line, $line;
+}
+close(S) || die "close: $!";
+printf "Got %d lines.\n", scalar @line;
+-- httpget2.pl
+use IO::Socket;
+print "(Using IO::Socket)\n";
+print "Host? ";
+my $host = <STDIN>;
+chomp($host);
+$host = 'www.nokia.com' unless length $host;
+my $port = 80;
+my $remote =
+ IO::Socket::INET->new(Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port);
+print "$host:$port:\nConnected.\n";
+select($remote); $| = 1; select(STDOUT);
+print $remote "GET / HTTP/1.0\012\012" || die "GET /: $!";
+my @line;
+print "Receiving...\n";
+while (my $line = <$remote>) {
+ push @line, $line;
+}
+close($remote) || die "close: $!";
+printf "Got %d lines.\n", scalar @line;
+-- md5.pl
+use Digest::MD5 'md5_hex';
+print "(Using Digest::MD5)\nMD5 of 'Perl' is:\n";
+print md5_hex('Perl'), "\n";
+-- time.pl
+print "Running in $^O\n";
+print scalar localtime, "\n";
+-- times.pl
+use Time::HiRes qw(time sleep);
+print CORE::time(), "\n";
+print "Hires\n";
+print time(), "\n";
+print "Sleep 1.5 s...\n";
+sleep(1.5);
+print time(), "\n";
+print "To one million...\n";
+my $t0 = time();
+print $t0, "\n";
+print "Cpu ", scalar times(), "\n";
+for(my $i = 0; $i < 1e6; $i++) {}
+print "Cpu ", scalar times(), "\n";
+my $t1 = time();
+print $t1, "\n";
+print "Wall ", $t1 - $t0, "\n";
+
--- /dev/null
+# install.cfg
+#
+# Copyright (c) 2004-2005 Nokia. All Rights Reserved.
+#
+# This file details what library files to include in the perlXYZlib.sis,
+# and what extensions to build for the perlXYZext.sis.
+# The lines beginning with "lib" are # included as-is from the lib/.
+# The lines beginning with "ext" tell either how to build and package
+# the extensions - or not.
+
+#
+# Libraries.
+#
+lib AnyDBM_File.pm
+lib AutoLoader.pm
+lib base.pm
+lib Benchmark.pm
+lib Carp.pm
+lib Carp/Heavy.pm
+lib Cwd.pm
+lib constant.pm
+lib DBM_Filter.pm
+lib Digest/base.pm
+lib DirHandle.pm
+lib Exporter.pm
+lib Exporter/Heavy.pm
+lib File/Basename.pm
+lib File/Compare.pm
+lib File/Copy.pm
+lib File/DosGlob.pm
+lib File/Find.pm
+lib File/Path.pm
+lib File/Spec.pm
+lib File/Spec/Unix.pm
+lib File/Spec/Win32.pm
+lib File/Temp.pm
+lib FileHandle.pm
+lib Filter/Simple.pm
+lib if.pm
+lib integer.pm
+lib lib.pm
+lib Net/Cmd.pm
+lib Net/Config.pm
+lib Net/Domain.pm
+lib Net/FTP.pm
+lib Net/FTP/A.pm
+lib Net/FTP/E.pm
+lib Net/FTP/I.pm
+lib Net/FTP/L.pm
+lib Net/FTP/dataconn.pm
+lib Net/NNTP.pm
+lib Net/Netrc.pm
+lib Net/Ping.pm
+lib Net/POP3.pm
+lib Net/SMTP.pm
+lib Net/Time.pm
+lib NEXT.pm
+lib overload.pm
+lib SelectSaver.pm
+lib strict.pm
+lib Symbol.pm
+lib UNIVERSAL.pm
+# lib utf8.pm
+# lib utf8_heavy.pl
+lib vars.pm
+lib warnings.pm
+lib warnings/register.pm
+#
+# Extensions.
+#
+ext attrs
+ext Cwd
+ext Data/Dumper
+ext Devel/Peek
+ext Digest/MD5
+ext Errno
+ext Fcntl CONST
+ext File/Glob CONST
+ext Filter/Util/Call
+ext IO
+ext List/Util
+ext MIME/Base64
+ext PerlIO/scalar
+ext PerlIO/via
+ext SDBM_File -sdbm/db?.c -sdbm/util.c
+ext Socket CONST
+ext Storable
+ext Time/HiRes CONST
+ext XSLoader
+# ext B ERROR
+# ext ByteLoader byterun.c ERROR VERSION
+# ext Devel/DProf nonconst
+# ext Devel/PPPort PORT
+# ext Encode nonconst Encode/encode.h def_t.c encengine.c
+# ext I18N/Langinfo PORT
+# ext IPC/SysV PORT
+# ext Opcode ERROR
+# ext PerlIO/encoding Encode
+# ext POSIX CONST USELESS
+# ext re ERROR
+# ext Sys/Hostname PORT
+# ext Sys/Syslog PORT
+# ext threads PORT
+# ext threads/shared PORT
+# ext Unicode/Normalize nonconst
+# ext XS/APItest USELESS
+# ext XS/Typemap nonconst USELESS
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# Copyright (c) 2004-2005 Nokia. All rights reserved.
+
+use strict;
+use lib "symbian";
+
+do "sanity.pl";
+
+my %VERSION = %{ do "version.pl" };
+my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+my $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+
+my $SDK = do "sdk.pl";
+my $UID = do "uid.pl";
+my %PORT = %{ do "port.pl" };
+
+my $ARM = 'thumb'; # TODO
+my $S60SK = $ENV{S60SDK}; # from sdk.pl
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+
+my $app = '!:\System\Apps\Perl';
+my $lib = '!:\System\Libs';
+
+my @target = @ARGV
+ ? @ARGV
+ : (
+ "miniperl", "perl",
+ "perl${VERSION}dll", "perl${VERSION}lib",
+ "perl${VERSION}ext"
+ );
+
+my %suffix;
+@suffix{ "miniperl", "perl", "perl$VERSION" } = ( "exe", "exe", "dll", );
+
+for my $target (@target) {
+ $target = "perl${VERSION}" if $target eq "perl${VERSION}dll";
+
+ my %copy;
+ my $pkg = "$target.pkg";
+ print "\nCreating $pkg...\n";
+
+ my $suffix = $suffix{$target} || "";
+ my $dst = $suffix eq "dll" ? $lib : $app;
+
+ my $srctarget = "$UREL\\$target.$suffix";
+
+ if ( $target =~ /^(miniperl|perl|perl${VERSION}(?:dll)?)$/ ) {
+ $copy{$srctarget} = "$dst\\$target.$suffix";
+ print "\t$target.$suffix\n";
+ }
+ if ( $target eq "perl${VERSION}lib" ) {
+ print "Libraries...\n";
+
+ print "\tConfig.pm\n";
+ $copy{"lib\\Config.pm"} =
+ "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config.pm";
+
+ print "\tConfig_heavy.pl\n";
+ $copy{"xlib\\symbian\\Config_heavy.pl"} =
+ "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config_heavy.pl";
+
+ print "\tDynaLoader.pm\n";
+ $copy{"ext\\DynaLoader\\DynaLoader.pm"} =
+ "$lib\\Perl\\$R_V_SV\\DynaLoader.pm";
+
+ print "\tErrno.pm\n";
+ $copy{"ext\\Errno\\Errno.pm"} = "$lib\\Perl\\$R_V_SV\\Errno.pm";
+
+ open( my $cfg, "symbian/install.cfg" )
+ or die "$!: symbian/install.cfg: $!\n";
+ while (<$cfg>) {
+ next unless /^lib\s+(.+)/;
+ chomp;
+ my $f = $1;
+ $f =~ s:/:\\:g;
+ $copy{"lib\\$f"} = "$lib\\Perl\\$R_V_SV\\$f";
+ print "\t$f\n";
+ }
+ close($cfg);
+ }
+
+ if ( $target eq "perl${VERSION}ext" ) {
+ my @lst = glob("symbian/*.lst");
+ print "Extensions...\n";
+ print "\t(none found)\n" unless @lst;
+ for my $lst (@lst) {
+ $lst =~ m:^symbian/(.+)\.:;
+ my $ext = $1;
+ $ext =~ s!-!::!g;
+ print "\t$ext\n";
+ if ( open( my $pkg, $lst ) ) {
+ while (<$pkg>) {
+ if (m!^"(.+)"-"(.+)"$!) {
+ my ( $src, $dst ) = ( $1, $2 );
+ $copy{$src} = $dst;
+ }
+ else {
+ warn "$0: $lst: $.: unknown syntax\n";
+ }
+ }
+ close($pkg);
+ }
+ else {
+ warn "$0: $lst: $!\n";
+ }
+ }
+ }
+
+ for my $file ( keys %copy ) {
+ warn "$0: $file does not exist\n" unless -f $file;
+ }
+
+ my @copy = map { qq["$_"-"$copy{$_}"] } sort keys %copy;
+ my $copy = join( "\n", @copy );
+
+ my %UID = (
+ "miniperl" => 0,
+ "perl" => 0,
+ "perl${VERSION}" => $UID + 0,
+ "perl${VERSION}dll" => $UID + 0,
+ "perl${VERSION}ext" => $UID + 1,
+ "perl${VERSION}lib" => $UID + 2,
+
+ # app = + 3
+ # rec = + 4
+ );
+
+ die "$0: target has no UID\n" unless defined $UID{$target};
+
+ my $uid = sprintf( "0x%08X", $UID{$target} );
+
+ my ( $MAJOR, $MINOR, $PATCH ) = ( 0, 0, 0 );
+
+ if ( $target =~ m:^perl$VERSION(dll|ext|lib)?$: ) {
+ my $pkg = defined $1 ? $1 : "dll";
+ $MAJOR = $PORT{$pkg}->{MAJOR};
+ $MINOR = $PORT{$pkg}->{MINOR};
+ $PATCH = $PORT{$pkg}->{PATCH};
+ }
+
+ die "$0: Bad version for $target\n"
+ unless defined $MAJOR
+ && ( $MAJOR eq 0 || $MAJOR > 0 )
+ && defined $MINOR
+ && ( $MINOR eq 0 || $MINOR > 0 )
+ && defined $PATCH
+ && ( $PATCH eq 0 || $PATCH > 0 );
+
+ open PKG, ">$pkg" or die "$0: failed to create $pkg: $!\n";
+ print PKG <<__EOF__;
+; \u$target installation script
+;
+; The supported languages
+&EN;
+;
+; The installation name and header data
+;
+#{"\u$target"},($uid),$MAJOR,$MINOR,$PATCH
+;
+; Private key and certificate (unused)
+;
+;* "\u$target.key", "\u$target.cer"
+;
+; Supports Series60 v0.9
+(0x101F6F88), 0, 0, 0, {"Series60ProductID"}
+; The files to install
+;
+$copy
+__EOF__
+ close PKG;
+
+ print "Created $pkg\n";
+
+ print "Running makesis...\n";
+
+ unlink("$target.sis");
+
+ system("makesis $pkg") == 0
+ || die "$0: makesis $pkg failed: $!\n";
+}
+
+exit(0);
--- /dev/null
+{
+ dll => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+ ext => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+ lib => { MAJOR => 0, MINOR => 1, PATCH => 0 },
+}
+
--- /dev/null
+use strict;
+
+if (exists $ENV{'!C:'}) {
+ print "You are running this under Cygwin, aren't you?\n";
+ print "I'm sorry but only cmd.exe will work.\n";
+ exit(1);
+}
+
+if (# SDK 2.x
+ $ENV{PATH} !~ m!c:\\program files\\common files\\symbian\\tools!i
+ &&
+ # SDK 1.2
+ $ENV{PATH} !~ m!c:\\symbian\\6.1\\shared\\epoc32\\tools!i) {
+ print "I think you have not installed the Symbian SDK.\n";
+ exit(1);
+}
+
+unless (-f "symbian/symbianish.h") {
+ print "You must run this in the top level directory.\n";
+ exit(1);
+}
+
+if ($] < 5.008) {
+ print "You must configure with Perl 5.8 or later.\n";
+ exit(1);
+}
+
+1;
--- /dev/null
+use strict;
+
+my $SDK;
+my $WIN;
+
+if ($ENV{PATH} =~ m!\\Symbian\\(.+?)\\gcc\\bin!) {
+ my $cc = $1;
+ $WIN = $cc =~ m!_CW!i ? 'winscw' : 'wins';
+ $ENV{WIN} = $WIN;
+ if ($cc =~ m!Series60_v20!) {
+ $ENV{S60SDK} = '2.0';
+ } elsif ($cc =~ m!Series60_v21!) {
+ $ENV{S60SDK} = '2.1';
+ } elsif ($cc =~ m!S60_2nd_FP2!) {
+ $ENV{S60SDK} = '2.6';
+ }
+}
+
+if (open(GCC, "gcc -v 2>&1|")) {
+ while (<GCC>) {
+ if (/Reading specs from ((?:C:)?\\Symbian.+?)\\Epoc32\\/i) {
+ $SDK = $1;
+ # The S60SDK tells the Series 60 SDK version.
+ if ($SDK eq 'C:\Symbian\6.1\Shared') { # Visual C.
+ $SDK = 'C:\Symbian\6.1\Series60';
+ $ENV{S60SDK} = '1.2';
+ } elsif ($SDK eq 'C:\Symbian\Series60_1_2_CW') { # CodeWarrior.
+ $ENV{S60SDK} = '1.2';
+ }
+ last;
+ }
+ }
+ close GCC;
+} else {
+ die "$0: failed to run gcc: $!\n";
+}
+
+my $UARM = $ENV{UARM} ? $ENV{UARM} : "urel";
+my $UREL = "$SDK\\epoc32\\release\\-ARM-\\$UARM";
+if ($SDK eq 'C:\Symbian\6.1\Series60' && $ENV{WIN} eq 'winscw') {
+ $UREL = "C:\\Symbian\\Series60_1_2_CW\\epoc32\\release\\-ARM-\\urel";
+}
+$ENV{UREL} = $UREL;
+$ENV{UARM} = $UARM;
+
+die "$0: failed to locate the Symbian SDK\n" unless defined $SDK;
+
+$SDK;
--- /dev/null
+/*
+ * symbian_dll.cpp
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#define SYMBIAN_DLL_CPP
+#include <e32base.h>
+#include "PerlBase.h"
+
+EXPORT_C GLDEF_C TInt E32Dll(TDllReason /*aReason*/) { return KErrNone; }
+
+extern "C" {
+ EXPORT_C void* symbian_get_vars(void) { return Dll::Tls(); }
+ EXPORT_C void symbian_set_vars(const void *p) { Dll::SetTls((TAny*)p); }
+ EXPORT_C void symbian_unset_vars(void) { Dll::SetTls(0); }
+}
+
--- /dev/null
+/*
+ * symbian_proto.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#ifndef SYMBIAN_PROTO_H
+#define SYMBIAN_PROTO_H
+
+#include <sys/types.h>
+#include <sys/times.h>
+
+#if defined(PERL_CORE) || defined(PERL_EXT)
+
+/* We can't include the <string.h> unconditionally
+ * since it has prototypes conflicting with the gcc builtins. */
+extern void *memchr(const void *s, int c, size_t n);
+#ifndef DL_SYMBIAN_XS
+/* dl_symbian.xs needs to see the C++ prototype of memset() instead */
+extern void *memset(void *s, int c, size_t n);
+extern size_t strlen(const char *s);
+#endif
+extern void *memmove(void *dst, const void *src, size_t n);
+extern char *strcat(char *dst, const char *src);
+extern char *strchr(const char *s, int c);
+extern char *strerror(int errnum);
+extern int strncmp(const char *s1, const char *s2, size_t n);
+extern char *strrchr(const char *s, int c);
+
+extern int setmode(int fd, long flags);
+
+#ifndef __GNUC__
+#define memcpy _e32memcpy /* GCC intrinsic */
+extern void *memcpy(const void *s1, const void *s2, size_t n);
+extern int strcmp(const char *s1, const char *s2);
+extern char* strcpy(char *dst, const char *src);
+extern char* strncpy(char *dst, const char *src, size_t n);
+#endif
+
+#endif /* PERL_CORE || PERL_EXT */
+
+#if defined(SYMBIAN_DLL_CPP) || defined(SYMBIAN_UTILS_CPP) || defined(PERLBASE_CPP)
+# define PERL_SYMBIAN_START_EXTERN_C extern "C" {
+# define PERL_SYMBIAN_EXPORT_C EXPORT_C
+# define PERL_SYMBIAN_END_EXTERN_C }
+#else
+# define PERL_SYMBIAN_START_EXTERN_C
+# define PERL_SYMBIAN_EXPORT_C
+# define PERL_SYMBIAN_END_EXTERN_C
+#endif
+
+PERL_SYMBIAN_START_EXTERN_C
+PERL_SYMBIAN_EXPORT_C int symbian_sys_init(int *argcp, char ***argvp);
+PERL_SYMBIAN_EXPORT_C void* symbian_get_vars(void);
+PERL_SYMBIAN_EXPORT_C void symbian_set_vars(const void *);
+PERL_SYMBIAN_EXPORT_C void symbian_unset_vars(void);
+PERL_SYMBIAN_EXPORT_C SSize_t symbian_read_stdin(const int fd, char *b, int n);
+PERL_SYMBIAN_EXPORT_C SSize_t symbian_write_stdout(const int fd, const char *b, int n);
+PERL_SYMBIAN_EXPORT_C char* symbian_get_error_string(const int error);
+PERL_SYMBIAN_EXPORT_C void symbian_sleep_usec(const long usec);
+PERL_SYMBIAN_EXPORT_C int symbian_get_cpu_time(long* sec, long* usec);
+PERL_SYMBIAN_EXPORT_C clock_t symbian_times(struct tms* buf);
+PERL_SYMBIAN_EXPORT_C int symbian_usleep(unsigned int usec);
+PERL_SYMBIAN_EXPORT_C int symbian_do_aspawn(void* vreally, void *vmark, void* sp);
+PERL_SYMBIAN_EXPORT_C int symbian_do_spawn(const char* command);
+PERL_SYMBIAN_EXPORT_C int symbian_do_spawn_nowait(const char* command);
+PERL_SYMBIAN_END_EXTERN_C
+
+#endif /* !SYMBIAN_PROTO_H */
+
--- /dev/null
+/*
+ * symbian_stubs.c
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "symbian_stubs.h"
+
+static int setENOSYS(void) { errno = ENOSYS; return -1; }
+
+uid_t getuid(void) { return setENOSYS(); }
+gid_t getgid(void) { return setENOSYS(); }
+uid_t geteuid(void) { return setENOSYS(); }
+gid_t getegid(void) { return setENOSYS(); }
+
+int setuid(uid_t uid) { return setENOSYS(); }
+int setgid(gid_t gid) { return setENOSYS(); }
+int seteuid(uid_t uid) { return setENOSYS(); }
+int setegid(gid_t gid) { return setENOSYS(); }
+
+int execv(const char* path, char* const argv []) { return setENOSYS(); }
+int execvp(const char* path, char* const argv []) { return setENOSYS(); }
+
+#ifndef USE_PERLIO
+FILE *popen(const char *command, const char *mode) { return 0; }
+int pclose(FILE *stream) { return setENOSYS(); }
+#endif
+int pipe(int fd[2]) { return setENOSYS(); }
+
+int setmode(int fd, long flags) { return -1; }
+
+_sig_func_ptr signal(int signum, _sig_func_ptr handler) { return (_sig_func_ptr)setENOSYS(); }
+int kill(pid_t pid, int signum) { return setENOSYS(); }
+pid_t wait(int *status) { return setENOSYS(); }
+
+#if PERL_VERSION <= 8
+void Perl_my_setenv(pTHX_ char *var, char *val) { }
+#else
+void Perl_my_setenv(pTHX_ const char *var, const char *val) { }
+#endif
+
+bool Perl_do_exec(pTHX_ char *cmd) { return FALSE; }
+bool Perl_do_exec3(pTHX_ char *cmd, int fd, int flag) { return FALSE; }
+
+int Perl_do_spawn(pTHX_ char *cmd) { return symbian_do_spawn(cmd); }
+int Perl_do_aspawn(pTHX_ SV *really, SV** mark, SV **sp) { return symbian_do_aspawn(really, mark, sp); }
+
+static const struct protoent protocols[] = {
+ { "tcp", 0, 6 },
+ { "udp", 0, 17 }
+};
+
+/* The protocol field (the last) is left empty to save both space
+ * and time because practically all services have both tcp and udp
+ * allocations in IANA. */
+static const struct servent services[] = {
+ { "http", 0, 80, 0 }, /* Optimization. */
+ { "https", 0, 443, 0 },
+ { "imap", 0, 143, 0 },
+ { "imaps", 0, 993, 0 },
+ { "smtp", 0, 25, 0 },
+ { "irc", 0, 194, 0 },
+
+ { "ftp", 0, 21, 0 },
+ { "ssh", 0, 22, 0 },
+ { "tftp", 0, 69, 0 },
+ { "pop3", 0, 110, 0 },
+ { "sftp", 0, 115, 0 },
+ { "nntp", 0, 119, 0 },
+ { "ntp", 0, 123, 0 },
+ { "snmp", 0, 161, 0 },
+ { "ldap", 0, 389, 0 },
+ { "rsync", 0, 873, 0 },
+ { "socks", 0, 1080, 0 }
+};
+
+struct protoent* getprotobynumber(int number) {
+ int i;
+ for (i = 0; i < sizeof(protocols)/sizeof(struct protoent); i++)
+ if (protocols[i].p_proto == number)
+ return (struct protoent*)(&(protocols[i]));
+ return 0;
+}
+
+struct protoent* getprotobyname(const char* name) {
+ int i;
+ for (i = 0; i < sizeof(protocols)/sizeof(struct protoent); i++)
+ if (strcmp(name, protocols[i].p_name) == 0)
+ return (struct protoent*)(&(protocols[i]));
+ return 0;
+}
+
+struct servent* getservbyname(const char* name, const char* proto) {
+ int i;
+ for (i = 0; i < sizeof(services)/sizeof(struct servent); i++)
+ if (strcmp(name, services[i].s_name) == 0)
+ return (struct servent*)(&(services[i]));
+ return 0;
+}
+
+struct servent* getservbyport(int port, const char* proto) {
+ int i;
+ for (i = 0; i < sizeof(services)/sizeof(struct servent); i++)
+ if (services[i].s_port == port)
+ return (struct servent*)(&(services[i]));
+ return 0;
+}
+
--- /dev/null
+/*
+ * symbian_stubs.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#ifndef PERL_SYMBIAN_STUBS_H
+#define PERL_SYMBIAN_STUBS_H
+
+int execv(const char* path, char* const argv []);
+int execvp(const char* path, char* const argv []);
+
+#ifndef USE_PERLIO
+FILE *popen(const char *command, const char *mode);
+int pclose(FILE *stream);
+#endif
+int pipe(int fd[2]);
+
+#endif /* PERL_SYMBIAN_STUBS_H */
+
--- /dev/null
+/*
+ * symbian_utils.cpp
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#define SYMBIAN_UTILS_CPP
+#include <e32base.h>
+#include <e32std.h>
+#include <textresolver.h>
+#include <utf.h>
+#include <hal.h>
+
+#include <string.h>
+#include <ctype.h>
+
+#include "PerlBase.h"
+
+extern "C" {
+ EXPORT_C int symbian_sys_init(int *argcp, char ***argvp)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ (void)times(&PL_timesbase);
+ return 0;
+ }
+ EXPORT_C SSize_t symbian_read_stdin(const int fd, char *b, int n)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ return ((CPerlBase*)PL_appctx)->ConsoleRead(fd, b, n);
+ }
+ EXPORT_C SSize_t symbian_write_stdout(const int fd, const char *b, int n)
+ {
+#ifdef PERL_GLOBAL_STRUCT /* Avoid unused variable warning. */
+ dVAR;
+#endif
+ return ((CPerlBase*)PL_appctx)->ConsoleWrite(fd, b, n);
+ }
+ static const char NullErr[] = "";
+ EXPORT_C char* symbian_get_error_string(const TInt error)
+ {
+ dTHX;
+ if (error >= 0)
+ return strerror(error);
+ CTextResolver* textResolver = CTextResolver::NewL();
+ CleanupStack::PushL(textResolver);
+ TBuf<KErrorResolverMaxTextLength> buf16;
+ TBuf8<KErrorResolverMaxTextLength> buf8;
+ if (error != KErrNone)
+ buf16 = textResolver->ResolveError(error);
+ if (buf16.Length()) {
+ if (CnvUtfConverter::ConvertFromUnicodeToUtf8(buf8, buf16) !=
+ KErrNone) {
+ CleanupStack::PopAndDestroy(textResolver);
+ return (char*)NullErr;
+ }
+ }
+ SV* sv = Perl_get_sv(aTHX_ "\005", TRUE); /* $^E or ${^OS_ERROR} */
+ if (!sv)
+ return (char*)NullErr;
+ sv_setpv(sv, (const char *)buf8.PtrZ());
+ SvUTF8_on(sv);
+ CleanupStack::PopAndDestroy(textResolver);
+ return SvPV_nolen(sv);
+ }
+ EXPORT_C void symbian_sleep_usec(const long usec)
+ {
+ User::After((TTimeIntervalMicroSeconds32) usec);
+ }
+#define PERL_SYMBIAN_CLK_TCK 100
+ EXPORT_C int symbian_get_cpu_time(long* sec, long* usec)
+ {
+ // The RThread().GetCpuTime() does not seem to work?
+ // (it always returns KErrNotSupported)
+ // TTimeIntervalMicroSeconds ti;
+ // TInt err = me.GetCpuTime(ti);
+ dTHX;
+ TInt periodus; /* tick period in microseconds */
+ if (HAL::Get(HALData::ESystemTickPeriod, periodus) != KErrNone)
+ return -1;
+ TUint tick = User::TickCount();
+ if (PL_timesbase.tms_utime == 0) {
+ PL_timesbase.tms_utime = tick;
+ PL_clocktick = PERL_SYMBIAN_CLK_TCK;
+ }
+ tick -= PL_timesbase.tms_utime;
+ TInt64 tickus = TInt64(tick) * TInt64(periodus);
+ TInt64 tmps = tickus / 1000000;
+ if (sec) *sec = tmps.Low();
+ if (usec) *usec = tickus.Low() - tmps.Low() * 1000000;
+ return 0;
+ }
+ EXPORT_C int symbian_usleep(unsigned int usec)
+ {
+ if (usec >= 1000000) {
+ errno = EINVAL;
+ return -1;
+ }
+ symbian_sleep_usec((const long) usec);
+ return 0;
+ }
+#define SEC_USEC_TO_CLK_TCK(s, u) \
+ (((s) * PERL_SYMBIAN_CLK_TCK) + (u / (1000000 / PERL_SYMBIAN_CLK_TCK)))
+ EXPORT_C clock_t symbian_times(struct tms *tmsbuf)
+ {
+ long s, u;
+ if (symbian_get_cpu_time(&s, &u) == -1) {
+ errno = EINVAL;
+ return -1;
+ } else {
+ tmsbuf->tms_utime = SEC_USEC_TO_CLK_TCK(s, u);
+ tmsbuf->tms_stime = 0;
+ tmsbuf->tms_cutime = 0;
+ tmsbuf->tms_cstime = 0;
+ return tmsbuf->tms_utime;
+ }
+ }
+ class CE32ProcessWait : public CActive
+ {
+ public:
+ CE32ProcessWait() : CActive(EPriorityStandard) {
+ CActiveScheduler::Add(this);
+ }
+#ifdef __WINS__
+ TInt Wait(RThread& aProcess)
+#else
+ TInt Wait(RProcess& aProcess)
+#endif
+ {
+ aProcess.Logon(iStatus);
+ aProcess.Resume();
+ SetActive();
+ CActiveScheduler::Start();
+ return iStatus.Int();
+ }
+ private:
+ void DoCancel() {;}
+ void RunL() {
+ CActiveScheduler::Stop();
+ }
+ CActiveSchedulerWait iWait;
+ };
+ class CSpawnIoRedirect : public CBase
+ {
+ public:
+ CSpawnIoRedirect();
+ // NOTE: there is no real implementation of I/O redirection yet.
+ protected:
+ private:
+ };
+ CSpawnIoRedirect::CSpawnIoRedirect()
+ {
+ }
+ typedef enum {
+ ESpawnNone = 0x00000000,
+ ESpawnWait = 0x00000001
+ } TSpawnFlag;
+ static int symbian_spawn(const TDesC& aFilename,
+ const TDesC& aCommand,
+ const TSpawnFlag aFlag,
+ const CSpawnIoRedirect& aIoRedirect) {
+ TInt error = KErrNone;
+#ifdef __WINS__
+ const TInt KStackSize = 0x1000;
+ const TInt KHeapMin = 0x1000;
+ const TInt KHeapMax = 0x100000;
+ RThread proc;
+ RLibrary lib;
+ HBufC* command = aCommand.Alloc();
+ error = lib.Load(aFilename);
+ if (error == KErrNone) {
+ TThreadFunction func = (TThreadFunction)(lib.Lookup(1));
+ if (func)
+ error = proc.Create(aFilename,
+ func,
+ KStackSize,
+ (TAny*)command,
+ &lib,
+ RThread().Heap(),
+ KHeapMin,
+ KHeapMax,
+ EOwnerProcess);
+ else
+ error = KErrNotFound;
+ lib.Close();
+ }
+ else
+ delete command;
+#else
+ RProcess proc;
+ error = proc.Create(aFilename, aCommand);
+#endif
+ if (error == KErrNone) {
+ if ((TInt)aFlag & (TInt)ESpawnWait) {
+ CE32ProcessWait* w = new CE32ProcessWait();
+ if (w) {
+ error = w->Wait(proc);
+ delete w;
+ } else
+ error = KErrNoMemory;
+ } else
+ proc.Resume();
+ proc.Close();
+ }
+ return error;
+ }
+ static int symbian_spawner(const char *command, TSpawnFlag aFlags)
+ {
+ TBuf<KMaxFileName> aFilename;
+ TBuf<KMaxFileName> aCommand;
+ TSpawnFlag aSpawnFlags = ESpawnWait;
+ CSpawnIoRedirect iord;
+ char *p = (char*)command;
+
+ // The recognized syntax is: "cmd [args] [&]". Since one
+ // cannot pass more than (an argv[0] and) an argv[1] to a
+ // Symbian process anyway, not much is done to the cmd or
+ // the args, only backslash quoting.
+
+ // Strip leading whitespace.
+ while (*p && isspace(*p)) p++;
+ if (*p) {
+ // Build argv[0].
+ while (*p && !isspace(*p) && *p != '&') {
+ if (*p == '\\') {
+ if (p[1]) {
+ aFilename.Append(p[1]);
+ p++;
+ }
+
+ }
+ else
+ aFilename.Append(*p);
+ p++;
+ }
+
+ if (*p) {
+ // Skip whitespace between argv[0] and argv[1].
+ while(*p && isspace(*p)) p++;
+ // Build argv[1].
+ if (*p) {
+ char *a = p;
+ char *b = p + 1;
+
+ while (*b) b++;
+ if (isspace(b[-1])) {
+ b--;
+ while (b > a && isspace(*b)) b--;
+ b++;
+ }
+ if (b > a && b[-1] == '&') {
+ // Parse backgrounding in any case,
+ // but turn it off only if wanted.
+ if ((aFlags & ESpawnWait))
+ aSpawnFlags =
+ (TSpawnFlag) (aSpawnFlags & ~ESpawnWait);
+ b--;
+ if (isspace(b[-1])) {
+ b--;
+ while (b > a && isspace(*b)) b--;
+ b++;
+ }
+ }
+ for (p = a; p < b; p++) {
+ if (*p == '\\') {
+ if (p[1])
+ aCommand.Append(p[1]);
+ p++;
+ }
+ else
+ aCommand.Append(*p);
+ }
+ }
+ // NOTE: I/O redirection is not yet done.
+ // Implementing that may require a separate server.
+ }
+ }
+ int spawned = symbian_spawn(aFilename, aCommand, aSpawnFlags, iord);
+ return spawned == KErrNone ? 0 : -1;
+ }
+ EXPORT_C int symbian_do_spawn(const char *command)
+ {
+ return symbian_spawner(command, ESpawnWait);
+ }
+ EXPORT_C int symbian_do_spawn_nowait(const char *command)
+ {
+ return symbian_spawner(command, ESpawnNone);
+ }
+ EXPORT_C int symbian_do_aspawn(void* vreally, void* vmark, void* sp)
+ {
+ return -1;
+ }
+}
+
--- /dev/null
+/*
+ * symbianish.h
+ *
+ * Copyright (c) Nokia 2004-2005. All rights reserved.
+ * This code is licensed under the same terms as Perl itself.
+ *
+ */
+
+#include "symbian/symbian_port.h"
+
+/*
+ * The following symbols are defined if your operating system supports
+ * functions by that name. All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+
+#ifndef PERL_MICRO
+
+/* HAS_IOCTL:
+ * This symbol, if defined, indicates that the ioctl() routine is
+ * available to set I/O characteristics
+ */
+#define HAS_IOCTL / **/
+
+/* HAS_UTIME:
+ * This symbol, if defined, indicates that the routine utime() is
+ * available to update the access and modification times of files.
+ */
+/* #define HAS_UTIME / **/
+
+/* HAS_GROUP
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
+ */
+#undef HAS_GROUP /**/
+
+/* HAS_PASSWD
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
+ */
+#undef HAS_PASSWD /**/
+
+#undef HAS_KILL
+#undef HAS_WAIT
+
+#endif /* !PERL_MICRO */
+
+/* USEMYBINMODE
+ * This symbol, if defined, indicates that the program should
+ * use the routine my_binmode(FILE *fp, char iotype) to insure
+ * that a file is in "binary" mode -- that is, that no translation
+ * of bytes occurs on read or write operations.
+ */
+#undef USEMYBINMODE
+
+/* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+#define Stat_t struct stat
+
+/* USE_STAT_RDEV:
+ * This symbol is defined if this system has a stat structure declaring
+ * st_rdev
+ */
+#define USE_STAT_RDEV /**/
+
+/* ACME_MESS:
+ * This symbol, if defined, indicates that error messages should be
+ * should be generated in a format that allows the use of the Acme
+ * GUI/editor's autofind feature.
+ */
+#undef ACME_MESS /**/
+
+/* UNLINK_ALL_VERSIONS:
+ * This symbol, if defined, indicates that the program should arrange
+ * to remove all versions of a file if unlink() is called. This is
+ * probably only relevant for VMS.
+ */
+/* #define UNLINK_ALL_VERSIONS / **/
+
+/* VMS:
+ * This symbol, if defined, indicates that the program is running under
+ * VMS. It is currently automatically set by cpps running under VMS,
+ * and is included here for completeness only.
+ */
+/* #define VMS / **/
+
+/* ALTERNATE_SHEBANG:
+ * This symbol, if defined, contains a "magic" string which may be used
+ * as the first line of a Perl program designed to be executed directly
+ * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
+ * begins with a character other then #, then Perl will only treat
+ * it as a command line if it finds the string "perl" in the first
+ * word; otherwise it's treated as the first line of code in the script.
+ * (IOW, Perl won't hand off to another interpreter via an alternate
+ * shebang sequence that might be legal Perl code.)
+ */
+/* #define ALTERNATE_SHEBANG "#!" / **/
+
+#include <signal.h>
+#define ABORT() abort()
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define Stat(fname,bufptr) stat((fname),(bufptr))
+#define Fstat(fd,bufptr) fstat((fd),(bufptr))
+#define Fflush(fp) fflush(fp)
+#define Mkdir(path,mode) mkdir((path),(mode))
+
+#ifndef PERL_SYS_TERM
+#define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM; CloseSTDLIB();
+#endif
+
+#define BIT_BUCKET "NUL:"
+
+#define dXSUB_SYS
+
+#define NO_ENVIRON_ARRAY
+
+int kill(pid_t pid, int signo);
+pid_t wait(int *status);
+
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# undef PERL_GET_VARS
+# undef PERL_SET_VARS
+# undef PERL_UNSET_VARS
+# define PERL_GET_VARS() symbian_get_vars()
+# define PERL_SET_VARS(v) symbian_set_vars(v)
+# define PERL_UNSET_VARS(v) symbian_unset_vars()
+#endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
+
+#undef PERL_EXPORT_C
+#define PERL_EXPORT_C EXPORT_C /* for perlio.h */
+#define PERL_CALLCONV EXPORT_C /* for prototype.h */
+#undef PERL_XS_EXPORT_C
+#define PERL_XS_EXPORT_C EXPORT_C
+
+#ifndef PERL_CORE
+#define PERL_CORE /* for WINS builds under VC */
+#endif
+
+#ifdef USE_PERLIO
+#define PERL_NEED_APPCTX /* need storing the PerlBase* */
+#define PERLIO_STD_SPECIAL
+#define PERLIO_STD_IN(f, b, n) symbian_read_stdin(f, b, n)
+#define PERLIO_STD_OUT(f, b, n) symbian_write_stdout(f, b, n)
+/* The console (the STD*) streams are seen by Perl in UTF-8. */
+#define PERL_SYMBIAN_CONSOLE_UTF8
+
+#endif
+
+#undef Strerror
+#undef strerror
+#define Strerror(eno) ((eno) < 0 ? symbian_get_error_string(eno) : strerror(eno))
+
+#define PERL_NEED_TIMESBASE
+
+#define times(b) symbian_times(b)
+#define usleep(u) symbian_usleep(u)
+
+#define PERL_SYS_INIT(c, v) symbian_sys_init(c, v)
+
+#ifdef __SERIES60_1X__
+# error "Unfortunately Perl does not work in S60 1.2 (see FAQ-0929)"
+#endif
+
+#ifdef _MSC_VER
+
+/* The Symbian SDK insists on the /W4 flag for Visual C.
+ * The Perl sources are not _that_ clean (Perl builds for Win32 use
+ * the /W3 flag, and gcc builds always use -Wall, so the sources are
+ * quite clean). To avoid a flood of warnings let's shut up most
+ * (for VC 6.0 SP 5). */
+
+#pragma warning(disable: 4054) /* function pointer to data pointer */
+#pragma warning(disable: 4055) /* data pointer to function pointer */
+#pragma warning(disable: 4100) /* unreferenced formal parameter */
+#pragma warning(disable: 4101) /* unreferenced local variable */
+#pragma warning(disable: 4102) /* unreferenced label */
+#pragma warning(disable: 4113) /* prototype difference */
+#pragma warning(disable: 4127) /* conditional expression is constant */
+#pragma warning(disable: 4132) /* const object should be initialized */
+#pragma warning(disable: 4133) /* incompatible types */
+#pragma warning(disable: 4189) /* initialized but not referenced */
+#pragma warning(disable: 4244) /* conversion from ... possible loss ... */
+#pragma warning(disable: 4245) /* signed/unsigned char */
+#pragma warning(disable: 4310) /* cast truncates constant value */
+#pragma warning(disable: 4505) /* function has been removed */
+#pragma warning(disable: 4510) /* default constructor could not ... */
+#pragma warning(disable: 4610) /* struct ... can never be instantiated */
+#pragma warning(disable: 4701) /* used without having been initialized */
+#pragma warning(disable: 4702) /* unreachable code */
+#pragma warning(disable: 4706) /* assignment within conditional */
+#pragma warning(disable: 4761) /* integral size mismatch */
+
+#endif /* _MSC_VER */
+
--- /dev/null
+0x102015F3
--- /dev/null
+use strict;
+
+my %VERSION;
+
+if (open(PATCHLEVEL_H, "patchlevel.h")) {
+ while (<PATCHLEVEL_H>) {
+ if (/#define\s+PERL_(REVISION|VERSION|SUBVERSION)\s+(\d+)/) {
+ $VERSION{$1} = $2;
+ }
+ }
+ close PATCHLEVEL_H;
+} else {
+ die "$0: patchlevel.h: $!\n";
+}
+
+die "$0: Perl release looks funny.\n"
+ unless (defined $VERSION{REVISION} && $VERSION{REVISION} == 5 &&
+ defined $VERSION{VERSION} && $VERSION{VERSION} >= 8 &&
+ defined $VERSION{SUBVERSION});
+
+
+\%VERSION;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use Getopt::Long;
+use File::Basename;
+use Cwd;
+
+do "sanity.pl";
+
+my $CoreBuild = -d "ext" && -f "perl.h" && -d "symbian" && -f "perl.c";
+
+my $SymbianVersion = $ENV{XSBUILD_SYMBIAN_VERSION};
+my $PerlVersion = $ENV{XSBUILD_PERL_VERSION};
+my $CSuffix = '.c';
+my $CPlusPlus;
+my $Config;
+my $Build;
+my $Clean;
+my $DistClean;
+my $Sis;
+
+sub usage {
+ die <<__EOF__;
+$0: Usage: $0 [--symbian=version] [--perl=version]
+ [--csuffix=csuffix] [--cplusplus]
+ [--win=win] [--arm=arm]
+ [--config|--build|--clean|--distclean|--sis] ext
+__EOF__
+}
+
+my $CWD;
+my $SDK;
+my $VERSION;
+my $R_V_SV;
+my $PERLSDK;
+my $WIN;
+my $ARM;
+my $HOME = getcwd();
+
+if ( !defined $PerlVersion && $0 =~ m:\\symbian\\perl\\(.+)\\bin\\xsbuild.pl:i )
+{
+ $PerlVersion = $1;
+}
+
+if ( !defined $SymbianVersion) {
+ ($SymbianVersion) = ($ENV{PATH} =~ m!C:\\Symbian\\(.+?)\\!i);
+}
+
+my $S60SDK;
+
+if ($CoreBuild) {
+ unshift @INC, "symbian";
+ do "sanity.pl";
+ my %VERSION = %{ do "version.pl" };
+ $SDK = do "sdk.pl";
+ $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
+ $R_V_SV = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
+ $HOME = do "cwd.pl";
+ $SymbianVersion = $1 if $SDK =~ m:\\Symbian\\([^\\]+):;
+ $PerlVersion = $R_V_SV;
+ $S60SDK = $ENV{S60SDK}; # from sdk.pl
+}
+
+usage()
+ unless GetOptions(
+ 'symbian=s' => \$SymbianVersion,
+ 'perl=s' => \$PerlVersion,
+ 'csuffix=s' => \$CSuffix,
+ 'cplusplus' => \$CPlusPlus,
+ 'win=s' => \$WIN,
+ 'arm=s' => \$ARM,
+ 'config' => \$Config,
+ 'build' => \$Build,
+ 'clean' => \$Clean,
+ 'distclean' => \$DistClean,
+ 'sis' => \$Sis
+ );
+
+usage() unless @ARGV;
+
+$CSuffix = '.cpp' if $CPlusPlus;
+$Build = !( $Config || $Clean || $DistClean ) || $Sis unless defined $Build;
+
+die "$0: Symbian version undefined\n" unless defined $SymbianVersion;
+
+$SymbianVersion =~ s:/:\\:g;
+
+die "$0: Symbian version '$SymbianVersion' not found\n"
+ unless -d "\\Symbian\\$SymbianVersion";
+
+die "$0: Perl version undefined\n" unless defined $PerlVersion;
+
+die "$0: Perl version '$PerlVersion' not found\n"
+ if !$CoreBuild && !-d "\\Symbian\\Perl\\$PerlVersion";
+
+print "Configuring with Symbian $SymbianVersion and Perl $PerlVersion...\n";
+
+$SDK = "\\Symbian\\$SymbianVersion" unless defined $SDK;
+$PERLSDK = "\\Symbian\\Perl\\$PerlVersion";
+
+$R_V_SV = $PerlVersion;
+
+$VERSION =~ tr/.//d;
+
+$ENV{SDK} = $SDK; # For the Errno extension
+$ENV{CROSS} = 1; # For the Encode extension
+
+my $UREL = $ENV{UREL}; # from sdk.pl
+$UREL =~ s/-ARM-/$ARM/;
+my $UARM = $ENV{UARM}; # from sdk.pl
+my $SRCDBG = $UARM eq 'udeb' ? "SRCDBG" : "";
+
+my %CONF;
+my %EXTCFG;
+
+sub write_bld_inf {
+ my ($base) = @_;
+ print "\tbld.inf\n";
+ open( BLD_INF, ">bld.inf" ) or die "$0: bld.inf: $!\n";
+ print BLD_INF <<__EOF__;
+PRJ_MMPFILES
+$base.mmp
+PRJ_PLATFORMS
+$WIN $ARM
+__EOF__
+ close(BLD_INF);
+}
+
+sub system_echo {
+ my $cmd = shift;
+ print "xsbuild: ", $cmd, "\n";
+ return system($cmd);
+}
+
+sub run_PL {
+ my ( $PL, $dir, $file ) = @_;
+ if ( defined $file ) {
+ print "\t(Running $dir\\$PL to create $file)\n";
+ unlink($file);
+ }
+ else {
+ print "\t(Running $dir\\$PL)\n";
+ }
+ my $cmd;
+ if ($CoreBuild) {
+ # Problem: the Config.pm we have in $HOME\\lib carries the
+ # version number of the Perl we are building, while the Perl
+ # we are running might have some other version. Solution:
+ # temporarily replace the Config.pm with a patched version.
+ my $V = sprintf "%vd", $^V;
+ unlink("$HOME\\lib\\Config.pm.bak");
+ system_echo("perl -pi.bak -e \"s:\\Q$R_V_SV:$V:\" $HOME\\lib\\Config.pm");
+ }
+ system_echo("perl -I$HOME\\lib -I$HOME\\xlib\\symbian $PL") == 0
+ or warn "$0: $PL failed.\n";
+ if ($CoreBuild) {
+ system_echo("copy $HOME\\lib\\Config.pm.bak $HOME\\lib\\Config.pm");
+ }
+ if ( defined $file ) { -s $file or die "$0: No $file created.\n" }
+}
+
+sub read_old_multi {
+ my ( $conf, $k ) = @_;
+ push @{ $conf->{$k} }, split( ' ', $1 ) if /^$k\s(.+)$/;
+}
+
+sub uniquefy_filenames {
+ my $b = [];
+ my %c = ();
+ for my $i (@{$_[0]}) {
+ $i =~ s!/!\\!g;
+ $i = lc $i if $i =~ m!\\!;
+ $i =~ s!^c:!!;
+ push @$b, $i unless $c{$i}++;
+ }
+ return $b;
+}
+
+sub read_mmp {
+ my ( $conf, $mmp ) = @_;
+ if ( -r $mmp && open( MMP, "<$mmp" ) ) {
+ print "\tReading $mmp...\n";
+ while (<MMP>) {
+ chomp;
+ $conf->{TARGET} = $1 if /^TARGET\s+(.+)$/;
+ $conf->{TARGETPATH} = $1 if /^TARGETPATH\s+(.+)$/;
+ $conf->{EXTVERSION} = $1 if /^EXTVERSION\s+(.+)$/;
+ read_old_multi( $conf, "SOURCE" );
+ read_old_multi( $conf, "SOURCEPATH" );
+ read_old_multi( $conf, "USERINCLUDE" );
+ read_old_multi( $conf, "SYSTEMINCLUDE" );
+ read_old_multi( $conf, "LIBRARY" );
+ read_old_multi( $conf, "MACRO" );
+ }
+ close(MMP);
+ }
+}
+
+sub write_mmp {
+ my ( $base, $userinclude, @src ) = @_;
+
+ print "\t$base.mmp\n";
+ $CONF{TARGET} = "$base.dll";
+ $CONF{TARGETPATH} = "\\System\\Libs\\Perl\\$R_V_SV";
+ $CONF{SOURCE} = [@src];
+ $CONF{SOURCEPATH} = [ $CWD, $HOME ];
+ $CONF{USERINCLUDE} = [ $CWD, $HOME ];
+ $CONF{SYSTEMINCLUDE} = ["$PERLSDK\\include"] unless $CoreBuild;
+ $CONF{SYSTEMINCLUDE} = [ $HOME ] if $CoreBuild;
+ $CONF{LIBRARY} = [];
+ $CONF{MACRO} = [];
+ read_mmp( \%CONF, "_init.mmp" );
+ read_mmp( \%CONF, "$base.mmp" );
+
+ for my $ui ( @{$userinclude} ) {
+ $ui =~ s!/!\\!g;
+ if ( $ui =~ m!^(?:[CD]:)?\\! ) {
+ push @{ $CONF{USERINCLUDE} }, $ui;
+ }
+ else {
+ push @{ $CONF{USERINCLUDE} }, "$HOME\\$ui";
+ }
+ }
+ push @{ $CONF{SYSTEMINCLUDE} }, "\\epoc32\\include";
+ push @{ $CONF{SYSTEMINCLUDE} }, "\\epoc32\\include\\libc";
+ push @{ $CONF{LIBRARY} }, "euser.lib";
+ push @{ $CONF{LIBRARY} }, "estlib.lib";
+ push @{ $CONF{LIBRARY} }, "perl$VERSION.lib";
+ push @{ $CONF{MACRO} }, "SYMBIAN" unless $CoreBuild;
+ push @{ $CONF{MACRO} }, "PERL_EXT" if $CoreBuild;
+ push @{ $CONF{MACRO} }, "MULTIPLICITY";
+ push @{ $CONF{MACRO} }, "PERL_IMPLICIT_CONTEXT";
+ push @{ $CONF{MACRO} }, "PERL_GLOBAL_STRUCT";
+ push @{ $CONF{MACRO} }, "PERL_GLOBAL_STRUCT_PRIVATE";
+
+ for my $u (qw(SOURCE SOURCEPATH SYSTEMINCLUDE USERINCLUDE LIBRARY MACRO)) {
+ $CONF{$u} = uniquefy_filenames( $CONF{$u} );
+ }
+ open( BASE_MMP, ">$base.mmp" ) or die "$0: $base.mmp: $!\n";
+
+ print BASE_MMP <<__EOF__;
+TARGET $CONF{TARGET}
+TARGETTYPE dll
+TARGETPATH $CONF{TARGETPATH}
+SOURCE @{$CONF{SOURCE}}
+$SRCDBG
+__EOF__
+ for my $u (qw(SOURCEPATH SYSTEMINCLUDE USERINCLUDE)) {
+ for my $v ( @{ $CONF{$u} } ) {
+ print BASE_MMP "$u\t$v\n";
+ }
+ }
+ # OPTION does not work in MMPs for pre-2.0 SDKs?
+ print BASE_MMP <<__EOF__;
+LIBRARY @{$CONF{LIBRARY}}
+MACRO @{$CONF{MACRO}}
+// OPTION MSVC /P
+// OPTION GCC -E
+__EOF__
+ close(BASE_MMP);
+
+}
+
+sub write_makefile {
+ my ( $base, $build ) = @_;
+
+ print "\tMakefile\n";
+
+ my $windef1 = "$SDK\\Epoc32\\Build$CWD\\$base\\$WIN\\$base.def";
+ my $windef2 = "..\\BWINS\\${base}u.def";
+ my $armdef1 = "$SDK\\Epoc32\\Build$CWD\\$base\\$ARM\\$base.def";
+ my $armdef2 = "..\\BMARM\\${base}u.def";
+
+ my $wrap = $SDK && $S60SDK eq '1.2' && $SDK !~ /_CW$/;
+ my $ABLD = $wrap ? 'perl b.pl' : 'abld';
+
+ open( MAKEFILE, ">Makefile" ) or die "$0: Makefile: $!\n";
+ print MAKEFILE <<__EOF__;
+WIN = $WIN
+ARM = $ARM
+ABLD = $ABLD
+
+all: build freeze
+
+sis: build_arm freeze_arm
+
+build: abld.bat build_win build_arm
+
+abld.bat:
+ bldmake bldfiles
+
+build_win: abld.bat
+ bldmake bldfiles
+ \$(ABLD) build \$(WIN) udeb
+
+build_arm: abld.bat
+ bldmake bldfiles
+ \$(ABLD) build \$(ARM) $UARM
+
+win: build_win freeze_win
+
+arm: build_arm freeze_arm
+
+freeze: freeze_win freeze_arm
+
+freeze_win:
+ bldmake bldfiles
+ \$(ABLD) freeze \$(WIN) $base
+
+freeze_arm:
+ bldmake bldfiles
+ \$(ABLD) freeze \$(ARM) $base
+
+defrost: defrost_win defrost_arm
+
+defrost_win:
+ -del /f $windef1
+ -del /f $windef2
+
+defrost_arm:
+ -del /f $armdef1
+ -del /f $armdef2
+
+clean: clean_win clean_arm
+
+clean_win:
+ \$(ABLD) clean \$(WIN)
+
+clean_arm:
+ \$(ABLD) clean \$(ARM)
+
+realclean: clean realclean_win realclean_arm
+ -del /f _init.c b.pl
+ -del /f $base.c $base.mmp
+
+realclean_win:
+ \$(ABLD) reallyclean \$(WIN)
+
+realclean_arm:
+ \$(ABLD) reallyclean \$(ARM)
+
+distclean: defrost realclean
+ -rmdir ..\\BWINS ..\\BMARM
+ -del /f const-c.inc const-xs.inc
+ -del /f Makefile abld.bat bld.inf
+__EOF__
+ close(MAKEFILE);
+ if ($wrap) {
+ if(open(B,">b.pl")) {
+ print B <<'__EOF__';
+# abld.pl wrapper.
+
+# nmake doesn't like MFLAGS and MAKEFLAGS being set to -w and w.
+delete $ENV{MFLAGS};
+delete $ENV{MAKEFLAGS};
+
+print "abld @ARGV\n";
+system("abld @ARGV");
+__EOF__
+ close(B);
+ } else {
+ warn "$0: failed to create b.pl: $!\n";
+ }
+ }
+}
+
+sub update_dir {
+ print "[chdir from ", getcwd(), " to ";
+ chdir(shift) or return;
+ update_cwd();
+ print getcwd(), "]\n";
+}
+
+sub xsconfig {
+ my ( $ext, $dir ) = @_;
+ print "Configuring for $ext, directory $dir...\n";
+ my $extu = $CoreBuild ? "$HOME\\lib\\ExtUtils" : "$PERLSDK\\lib\\ExtUtils";
+ update_dir($dir) or die "$0: chdir '$dir': $!\n";
+ my $build = dirname($ext);
+ my $base = basename($ext);
+ my $basexs = "$base.xs";
+ my $basepm = "$base.pm";
+ my $basec = "$base$CSuffix";
+ my $extdir = ".";
+ if ( $dir =~ m:^ext\\(.+): ) {
+ $extdir = $1;
+ }
+ elsif ( $dir ne "." ) {
+ $extdir = $dir;
+ }
+ my $extdirdir = dirname($extdir);
+ my $targetroot = "\\System\\Libs\\Perl\\$R_V_SV";
+ write_bld_inf($base) if -f $basexs;
+
+ my %src;
+ $src{$basec}++;
+
+ $extdirdir = $extdirdir eq "." ? "" : "$extdirdir\\";
+
+ my %lst;
+ $lst{"$UREL\\$base.dll"} =
+ "$targetroot\\$ARM-symbian\\$base.dll"
+ if -f $basexs;
+ $lst{"$dir\\$base.pm"} = "$targetroot\\$extdirdir$base.pm"
+ if -f $basepm && $base ne 'XSLoader';
+
+ my %incdir;
+ my $ran_PL;
+ if ( -d 'lib' ) {
+ use File::Find;
+ my @found;
+ find( sub { push @found, $File::Find::name if -f $_ }, 'lib' );
+ for my $found (@found) {
+ my ($short) = ( $found =~ m/^lib.(.+)/ );
+ $short =~ s!/!\\!g;
+ $found =~ s!/!\\!g;
+ $lst{"$dir\\$found"} = "$targetroot\\$short";
+ }
+ }
+ if ( my @pm = glob("*.pm */*.pm") ) {
+ for my $pm (@pm) {
+ next if $pm =~ m:^t/:;
+ $pm =~ s:/:\\:g;
+ $lst{"$dir\\$pm"} = "$targetroot\\$extdirdir$pm";
+ }
+ }
+ if ( my @c = glob("*.c *.cpp */*.c */*.cpp") ) {
+ for my $c (@c) {
+ $c =~ s:/:\\:g;
+ $src{$c}++;
+ }
+ }
+ if ( my @h = glob("*.h */*.h") ) {
+ for my $h (@h) {
+ $h =~ s:/:\\:g;
+ $h = dirname($h);
+ $incdir{"$dir\\$h"}++ unless $h eq ".";
+ }
+ }
+ if ( exists $EXTCFG{$ext} ) {
+ for my $cfg ( @{ $EXTCFG{$ext} } ) {
+ if ( $cfg =~ /^([-+])?(.+\.(c|cpp|h))$/ ) {
+ my $o = defined $1 ? $1 : '+';
+ my $f = $2;
+ $f =~ s:/:\\:g;
+ for my $f ( glob($f) ) {
+ if ( $o eq '+' ) {
+ warn "$0: no source file $dir\\$f\n" unless -f $f;
+ $src{$f}++ unless $cfg =~ /\.h$/;
+ if ( $f =~ m:^(.+)\\[^\\]+$: ) {
+ $incdir{$1}++;
+ }
+ }
+ elsif ( $o eq '-' ) {
+ delete $src{$f};
+ }
+ }
+ }
+ if ( $cfg =~ /^([-+])?(.+\.(pm|pl|inc))$/ ) {
+ my $o = defined $1 ? $1 : '+';
+ my $f = $2;
+ $f =~ s:/:\\:g;
+ for my $f ( glob($f) ) {
+ if ( $o eq '+' ) {
+ warn "$0: no Perl file $dir\\$f\n" unless -f $f;
+ $lst{"$dir\\$f"} = "$targetroot\\$extdir\\$f";
+ }
+ elsif ( $o eq '-' ) {
+ delete $lst{"$dir\\$f"};
+ }
+ }
+ }
+ if ( $cfg eq 'CONST' && !$ran_PL++ ) {
+ run_PL( "Makefile.PL", $dir, "const-xs.inc" );
+ }
+ }
+ }
+ unless ( $ran_PL++ ) {
+ run_PL( "Makefile.PL", $dir ) if -f "Makefile.PL";
+ }
+ if ( $dir eq "ext\\Errno" ) {
+ run_PL( "Errno_pm.PL", $dir, "Errno.pm" );
+ $lst{"$dir\\Errno.pm"} = "$targetroot\\Errno.pm";
+ }
+ elsif ( $dir eq "ext\\Devel\\PPPort" ) {
+ run_PL( "ppport_h.PL", $dir, "ppport.h" );
+ }
+ elsif ( $dir eq "ext\\DynaLoader" ) {
+ run_PL( "XSLoader_pm.PL", $dir, "XSLoader.pm" );
+ $lst{"ext\\DynaLoader\\XSLoader.pm"} = "$targetroot\\XSLoader.pm";
+ }
+ elsif ( $dir eq "ext\\Encode" ) {
+ system_echo("perl bin\\enc2xs -Q -O -o def_t.c -f def_t.fnm") == 0
+ or die "$0: running enc2xs failed: $!\n";
+ }
+
+ my @lst = sort keys %lst;
+
+ read_mmp( \%CONF, "_init.mmp" );
+ read_mmp( \%CONF, "$base.mmp" );
+
+ if ( -f $basexs ) {
+ my %MM; # MakeMaker results
+ my @MM = qw(VERSION XS_VERSION);
+ if ( -f "Makefile" ) {
+ print "\tReading MakeMaker Makefile...\n";
+ if ( open( MAKEFILE, "Makefile" ) ) {
+ while (<MAKEFILE>) {
+ for my $m (@MM) {
+ if (m!^$m = (.+)!) {
+ $MM{$m} = $1;
+ print "\t$m = $1\n";
+ }
+ }
+ }
+ close(MAKEFILE);
+ }
+ else {
+ warn "$0: Makefile: $!";
+ }
+ print "\tDeleting MakeMaker Makefile.\n";
+ unlink("Makefile");
+ }
+
+ unlink($basec);
+ print "\t$basec\n";
+ if ( defined $CONF{EXTVERSION} ) {
+ my $EXTVERSION = $CONF{EXTVERSION};
+ print "\tUsing $EXTVERSION for version...\n";
+ $MM{VERSION} = $MM{XS_VERSION} = $EXTVERSION;
+ }
+ die "VERSION or XS_VERSION undefined\n"
+ unless defined $MM{VERSION} && defined $MM{XS_VERSION};
+ if ( open( BASE_C, ">$basec" ) ) {
+ print BASE_C <<__EOF__;
+#ifndef VERSION
+#define VERSION "$MM{VERSION}"
+#endif
+#ifndef XS_VERSION
+#define XS_VERSION "$MM{XS_VERSION}"
+#endif
+__EOF__
+ close(BASE_C);
+ }
+ else {
+ warn "$0: $basec: $!";
+ }
+ unless (
+ system(
+"perl -I$PERLSDK\\lib $extu\\xsubpp -C++ -csuffix .cpp -typemap $extu\\typemap -noprototypes $basexs >> $basec"
+ ) == 0
+ && -s $basec
+ )
+ {
+ die "$0: perl xsubpp failed: $!\n";
+ }
+
+ print "\t_init.c\n";
+ open( _INIT_C, ">_init.c" ) or die "$!: _init.c: $!\n";
+ print _INIT_C <<__EOF__;
+ #include "EXTERN.h"
+ #include "perl.h"
+ EXPORT_C void _init(void *handle) {
+ }
+__EOF__
+ close(_INIT_C);
+
+ my @src = ( "_init.c", sort keys %src );
+
+ if ( $base eq "Encode" ) { # Currently unused.
+ for my $submf ( glob("*/Makefile") ) {
+ my $d = dirname($submf);
+ print "Configuring Encode::$d...\n";
+ if ( open( SUBMF, $submf ) ) {
+ if ( update_dir($d) ) {
+ my @subsrc;
+ while (<SUBMF>) {
+ next if 1 .. /postamble/;
+ if (m!^(\w+_t)\.c : !) {
+ system(
+ "perl ..\\bin\\enc2xs -Q -o $1.c -f $1.fnm")
+ == 0
+ or warn "$0: enc2xs: $!\n";
+ push @subsrc, "$1.c";
+ }
+ }
+ close(SUBMF);
+ unlink($submf);
+ my $subbase = $d;
+ $subbase =~ s!/!::!g;
+ write_mmp( $subbase, ["..\\Encode"], "$subbase.c",
+ @subsrc );
+ write_makefile( $subbase, $build );
+ write_bld_inf($subbase);
+
+ unless (
+ system(
+"perl -I$HOME\\lib ..\\$extu\\xsubpp -C++ -csuffix .cpp -typemap ..\\$extu\\typemap -noprototypes $subbase.xs > $subbase.c"
+ ) == 0
+ && -s "$subbase.c"
+ )
+ {
+ die "$0: perl xsubpp failed: $!\n";
+ }
+ update_dir("..");
+ }
+ else {
+ warn "$0: chdir $d: $!\n";
+ }
+ }
+ else {
+ warn "$0: $submf: $!";
+ }
+ }
+ print "Configuring Encode...\n";
+ }
+
+ write_mmp( $base, [ keys %incdir ], @src );
+ write_makefile( $base, $build );
+ }
+ my $lstname = $ext;
+ $lstname =~ s:^ext\\::;
+ $lstname =~ s:\\:-:g;
+ print "\t$lstname.lst\n";
+ my $lstout =
+ $CoreBuild ? "$HOME/symbian/$lstname.lst" : "$HOME/$lstname.lst";
+ if ( open( my $lst, ">$lstout" ) ) {
+ for my $f (@lst) { print $lst qq["$f"-"!:$lst{$f}"\n] }
+ close($lst);
+ }
+ else {
+ die "$0: $lstout: $!\n";
+ }
+ update_dir($HOME);
+}
+
+sub update_cwd {
+ $CWD = getcwd();
+ $CWD =~ s!^[CD]:!!i;
+ $CWD =~ s!/!\\!g;
+}
+
+for my $ext (@ARGV) {
+
+ $ext =~ s!::!\\!g;
+ $ext =~ s!/!\\!g;
+
+ my $cfg;
+
+ $cfg = $2 if $ext =~ s/(.+?),(.+)/$1/;
+
+ my $dir;
+
+ unless ( -e $ext ) {
+ if ( $ext =~ /\.xs$/ && !-f $ext ) {
+ if ( -f "ext\\$ext" ) {
+ $ext = "ext\\$ext";
+ $dir = dirname($ext);
+ }
+ }
+ elsif ( !-d $ext ) {
+ if ( -d "ext\\$ext" ) {
+ $ext = "ext\\$ext";
+ $dir = $ext;
+ }
+ }
+ $dir = "." unless defined $dir;
+ }
+ else {
+ if ( $ext =~ /\.xs$/ && -f $ext ) {
+ $ext = dirname($ext);
+ $dir = $ext;
+ }
+ elsif ( -d $ext ) {
+ $dir = $ext;
+ }
+ }
+
+ if ( $ext eq "XSLoader" ) {
+ $ext = "ext\\XSLoader";
+ }
+ if ( $ext eq "ext\\XSLoader" ) {
+ $dir = "ext\\DynaLoader";
+ }
+
+ $EXTCFG{$ext} = [ split( /,/, $cfg ) ] if defined $cfg;
+
+ die "$0: no lib\\Config.pm\n"
+ if $CoreBuild && $Build && !-f "lib\\Config.pm";
+
+ if ($CoreBuild) {
+ open( my $cfg, "symbian/install.cfg" )
+ or die "$0: symbian/install.cfg: $!\n";
+ my $extdir = $dir;
+ $extdir =~ s:^ext\\::;
+ while (<$cfg>) {
+ next unless /^ext\s+(.+)/;
+ chomp;
+ my $ext = $1;
+ my @ext = split( ' ', $ext );
+ $EXTCFG{"ext\\$ext[0]"} = [@ext];
+ }
+ close($cfg);
+ }
+
+ if ( $Config || $Build ) {
+ xsconfig( $ext, $dir ) or die "$0: xsconfig '$ext' failed\n";
+ next if $Config;
+ }
+
+ my $chdir = $ext eq "ext\\XSLoader" ? "ext\\DynaLoader" : $dir;
+ die "$0: no directory '$chdir'\n" unless -d $chdir;
+ update_dir($chdir) or die "$0: chdir '$chdir' failed: $!\n";
+
+ my %CONF;
+
+ my @ext = split( /\\/, $ext );
+ my $base = $ext[-1];
+
+ if ( $Clean || $DistClean ) {
+ print "Cleaning $ext...\n";
+ unlink("bld.inf");
+ unlink("$base.mmp");
+ unlink("_init.c");
+ unlink("const-c.inc");
+ unlink("const-xs.inc");
+ rmdir("..\\bmarm");
+ }
+
+ if ( $Build && $ext ne "ext\\XSLoader" && $ext ne "ext\\Errno" ) {
+
+ # We compile the extension three (3) times.
+ # (1) Only the _init.c to get _init() as the ordinal 1 function in the DLL.
+ # (2) With the rest and the _init.c to get ordinals for the rest.
+ # (3) With an updated _init.c that carries the symbols from step (2).
+
+ system("make clean");
+ system("make defrost") == 0 or die "$0: make defrost failed\n";
+
+ my @TARGET;
+
+ push @TARGET, 'sis' if $Sis;
+
+ # Compile #1.
+ # Hide all but the _init.c.
+ print "\n*** $ext - Compile 1 of 3.\n\n";
+ system(
+"perl -pi.bak -e \"s:^SOURCE\\s+_init.c:SOURCE\\t_init.c // :\" $base.mmp"
+ );
+ system("bldmake bldfiles");
+ system("make @TARGET") == 0 or die "$0: make #1 failed\n";
+
+ # Compile #2.
+ # Reveal the rest again.
+ print "\n*** $ext - Compile 2 of 3.\n\n";
+ system(
+"perl -pi.bak -e \"s:^SOURCE\\t_init.c // :SOURCE\\t_init.c :\" $base.mmp"
+ );
+ system("make @TARGET") == 0 or die "$0: make #2 failed\n";
+ unlink("$base.mmp.bak");
+
+ open( _INIT_C, ">_init.c" ) or die "$0: _init.c: $!\n";
+ print _INIT_C <<'__EOF__';
+#include "EXTERN.h"
+#include "perl.h"
+
+/* This is a different but matching definition from in dl_symbian.xs. */
+typedef struct {
+ void* handle;
+ int error;
+ HV* symbols;
+} PerlSymbianLibHandle;
+
+EXPORT_C void _init(void* handle) {
+__EOF__
+
+ my %symbol;
+ my $def;
+ my $basef;
+ for my $f ("$SDK\\Epoc32\\Build$CWD\\$base\\WINS\\$base.def",
+ "..\\BMARM\\${base}u.def") {
+ print "\t($f - ";
+ if ( open( $def, $f ) ) {
+ print "OK)\n";
+ $basef = $f;
+ last;
+ } else {
+ print "no)\n";
+ }
+ }
+ unless (defined $basef) {
+ die "$0: failed to find .def for $base\n";
+ }
+ while (<$def>) {
+ next while 1 .. /^EXPORTS/;
+ if (/^\s*(\w+) \@ (\d+) /) {
+ $symbol{$1} = $2;
+ }
+ }
+ close($def);
+
+ my @symbol = sort keys %symbol;
+ if (@symbol) {
+ print _INIT_C <<'__EOF__';
+ dTHX;
+ PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+ if (!h->symbols)
+ h->symbols = newHV();
+ if (h->symbols) {
+__EOF__
+ for my $sym (@symbol) {
+ my $len = length($sym);
+ print _INIT_C <<__EOF__;
+ hv_store(h->symbols, "$sym", $len, newSViv($symbol{$sym}), 0);
+__EOF__
+ }
+ }
+ else {
+ die "$0: $basef: no exports found\n";
+ }
+
+ print _INIT_C <<'__EOF__';
+ }
+}
+__EOF__
+ close(_INIT_C);
+
+ # Compile #3. This is for real.
+ print "\n*** $ext - Compile 3 of 3.\n\n";
+ system("make @TARGET") == 0 or die "$0: make #3 failed\n";
+
+ }
+ elsif ( $Clean || $DistClean ) {
+ if ( $ext eq "ext\\Errno" ) {
+ unlink( "Errno.pm", "Makefile" );
+ }
+ else {
+ if ( -f "Makefile" ) {
+ if ($Clean) {
+ system("make clean") == 0 or die "$0: make clean failed\n";
+ }
+ elsif ($DistClean) {
+ system("make distclean") == 0
+ or die "$0: make distclean failed\n";
+ }
+ }
+ if ( $ext eq "ext\\Devel\\PPPort" ) {
+ unlink("ppport.h");
+ }
+ }
+ my @B = glob("ext/BWINS ext/BMARM ext/*/BWINS ext/*/BMARM Makefile");
+ rmdir(@B) if @B;
+ }
+
+ update_dir($HOME);
+
+} # for my $ext
+
+exit(0);
+
{
SV** svp;
MAGIC* mg;
- const char** e;
- static const char* misc_env[] = {
+ const char* const *e;
+ static const char* const misc_env[] = {
"IFS", /* most shells' inter-field separators */
"CDPATH", /* ksh dain bramage #1 */
"ENV", /* ksh dain bramage #2 */
#define yychar (*PL_yycharp)
#define yylval (*PL_yylvalp)
-static char const ident_too_long[] = "Identifier too long";
-static char const c_without_g[] = "Use of /c modifier is meaningless without /g";
-static char const c_in_subst[] = "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] =
+ "Identifier too long";
+static const char c_without_g[] =
+ "Use of /c modifier is meaningless without /g";
+static const char c_in_subst[] =
+ "Use of /c modifier is meaningless in s///";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
#define LEX_KNOWNEXT 0
#ifdef DEBUGGING
-static char const* lex_state_names[] = {
+static const char* const lex_state_names[] = {
"KNOWNEXT",
"FORMLINE",
"INTERPCONST",
TOKENTYPE_GVVAL
};
-static struct debug_tokens { const int token, type; const char *name; } debug_tokens[] =
+static struct debug_tokens { const int token, type; const char *name; }
+ const debug_tokens[] =
{
{ ADDOP, TOKENTYPE_OPNUM, "ADDOP" },
{ ANDAND, TOKENTYPE_NONE, "ANDAND" },
STATIC I32
S_sublex_push(pTHX)
{
+ dVAR;
ENTER;
PL_lex_state = PL_sublex_info.super_state;
STATIC I32
S_sublex_done(pTHX)
{
+ dVAR;
if (!PL_lex_starts++) {
SV *sv = newSVpvn("",0);
if (SvUTF8(PL_linestr))
}
#ifdef DEBUGGING
- static char const* exp_name[] =
+ static const char* const exp_name[] =
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
"ATTRTERM", "TERMBLOCK", "TERMORDORDOR"
};
!instr(s,"indir") &&
instr(PL_origargv[0],"perl"))
{
+ dVAR;
char **newargv;
*ipathend = '\0';
S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
const char *type)
{
- dSP;
+ dVAR; dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV **cvp;
STATIC char *
S_scan_subst(pTHX_ char *start)
{
+ dVAR;
register char *s;
register PMOP *pm;
I32 first_start;
I32 shift;
bool overflowed = FALSE;
bool just_zero = TRUE; /* just plain 0 or binary number? */
- static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
- static char const* bases[5] = { "", "binary", "", "octal",
- "hexadecimal" };
- static char const* Bases[5] = { "", "Binary", "", "Octal",
- "Hexadecimal" };
- static char const *maxima[5] = { "",
- "0b11111111111111111111111111111111",
- "",
- "037777777777",
- "0xffffffff" };
+ static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
+ static const char* const bases[5] =
+ { "", "binary", "", "octal", "hexadecimal" };
+ static const char* const Bases[5] =
+ { "", "Binary", "", "Octal", "Hexadecimal" };
+ static const char* const maxima[5] =
+ { "",
+ "0b11111111111111111111111111111111",
+ "",
+ "037777777777",
+ "0xffffffff" };
const char *base, *Base, *max;
/* check for hex */
#include "XSUB.h"
-void XS_UNIVERSAL_isa(pTHX_ CV *cv);
-void XS_UNIVERSAL_can(pTHX_ CV *cv);
-void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
XS(XS_version_new);
XS(XS_version_stringify);
XS(XS_version_numify);
#define PERL_IN_UTF8_C
#include "perl.h"
-static char unees[] = "Malformed UTF-8 character (unexpected end of string)";
+static const char unees[] =
+ "Malformed UTF-8 character (unexpected end of string)";
/*
=head1 Unicode Support
SV*
Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits, I32 none)
{
+ dVAR;
SV* retval;
SV* tokenbufsv = sv_newmortal();
dSP;
UV
Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
{
+ dVAR;
HV* hv = (HV*)SvRV(sv);
U32 klen;
U32 off;
if (hv == PL_last_swash_hv &&
klen == PL_last_swash_klen &&
- (!klen || memEQ(ptr, PL_last_swash_key, klen)) )
+ (!klen || memEQ((char *)ptr, (char *)PL_last_swash_key, klen)) )
{
tmps = PL_last_swash_tmps;
slen = PL_last_swash_slen;
#endif
END_EXTERN_C
-#define UTF8SKIP(s) PL_utf8skip[*(const U8*)s]
+#define UTF8SKIP(s) PL_utf8skip[*(const U8*)(s)]
/* Native character to iso-8859-1 */
#define NATIVE_TO_ASCII(ch) (ch)
Free_t
Perl_safesysfree(Malloc_t where)
{
+ dVAR;
#ifdef PERL_IMPLICIT_SYS
dTHX;
#endif
&& ((STRLEN)(bigend - big) == littlelen - 1)
&& (littlelen == 1
|| (*big == *little &&
- memEQ(big, little, littlelen - 1))))
+ memEQ((char *)big, (char *)little, littlelen - 1))))
return (char*)big;
return Nullch;
}
I32
Perl_ibcmp_locale(pTHX_ const char *s1, const char *s2, register I32 len)
{
+ dVAR;
register const U8 *a = (const U8 *)s1;
register const U8 *b = (const U8 *)s2;
while (len--) {
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
SV *sv = mess_alloc();
- static char dgd[] = " during global destruction.\n";
+ static const char dgd[] = " during global destruction.\n";
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
void
Perl_write_to_stderr(pTHX_ const char* message, int msglen)
{
+ dVAR;
IO *io;
MAGIC *mg;
S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
I32* utf8)
{
+ dVAR;
char *message;
if (pat) {
void
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
+ dVAR;
char *message;
HV *stash;
GV *gv;
void
Perl_warner_nocontext(U32 err, const char *pat, ...)
{
- dTHX;
+ dTHX;
va_list args;
va_start(args, pat);
vwarner(err, pat, &args);
void
Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
{
+ dVAR;
if (ckDEAD(err)) {
SV *msv = vmess(pat, args);
STRLEN msglen;
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
+ dVAR;
#ifdef USE_ITHREADS
/* only parent thread can modify process environment */
if (PL_curinterp == aTHX)
my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
-# if defined(__CYGWIN__) || defined( EPOC)
+# if defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN)
setenv(nam, val, 1);
# else
char *new_env;
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
+ dVAR;
register char *envstr;
const int nlen = strlen(nam);
int vlen;
register I32 tmp;
while (len--) {
- if (tmp = *a++ - *b++)
+ if ((tmp = *a++ - *b++))
return tmp;
}
return 0;
#ifndef OS2
if (doexec) {
#if !defined(HAS_FCNTL) || !defined(F_SETFD)
- int fd;
-
#ifndef NOFILE
#define NOFILE 20
#endif
void
Perl_atfork_lock(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
/* locks must be held in locking order (if any) */
# ifdef MYMALLOC
void
Perl_atfork_unlock(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
/* locks must be released in same order as in atfork_lock() */
# ifdef MYMALLOC
PerlIO_printf(Perl_debug_log," %d",fd);
}
PerlIO_printf(Perl_debug_log,"\n");
+ return;
}
#endif /* DUMP_FDS */
Sighandler_t
Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
{
+ dVAR;
struct sigaction act, oact;
#ifdef USE_ITHREADS
int
Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
{
+ dVAR;
struct sigaction act;
#ifdef USE_ITHREADS
int
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
+ dVAR;
#ifdef USE_ITHREADS
/* only "parent" interpreter can diddle signals */
if (PL_curinterp != aTHX)
return PerlProc_signal(signo, handler);
}
-static int sig_trapped; /* XXX signals are process-wide anyway, so we
- ignore the implications of this for threading */
-
static
Signal_t
sig_trap(int signo)
{
- sig_trapped++;
+ dVAR;
+ PL_sig_trapped++;
}
Sighandler_t
Perl_rsignal_state(pTHX_ int signo)
{
+ dVAR;
Sighandler_t oldsig;
#if defined(USE_ITHREADS) && !defined(WIN32)
return SIG_ERR;
#endif
- sig_trapped = 0;
+ PL_sig_trapped = 0;
oldsig = PerlProc_signal(signo, sig_trap);
PerlProc_signal(signo, oldsig);
- if (sig_trapped)
+ if (PL_sig_trapped)
PerlProc_kill(PerlProc_getpid(), signo);
return oldsig;
}
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
- I32 result;
+ I32 result = 0;
if (!pid)
return -1;
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
{
- SV *sv;
- SV** svp;
char spid[TYPE_CHARS(IV)];
if (pid > 0) {
+ SV** svp;
sprintf(spid, "%"IVdf, (IV)pid);
svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
if (svp && *svp != &PL_sv_undef) {
hv_iterinit(PL_pidstatus);
if ((entry = hv_iternext(PL_pidstatus))) {
+ SV *sv = hv_iterval(PL_pidstatus,entry);
+
pid = atoi(hv_iterkey(entry,(I32*)statusp));
- sv = hv_iterval(PL_pidstatus,entry);
*statusp = SvIVX(sv);
sprintf(spid, "%"IVdf, (IV)pid);
(void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
goto finish;
#endif
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#if defined(HAS_WAITPID) && defined(HAS_WAITPID_RUNTIME)
hard_way:
+#endif
{
if (flags)
Perl_croak(aTHX_ "Can't do waitpid with flags");
}
}
#endif
+#if defined(HAS_WAITPID) || defined(HAS_WAIT4)
finish:
+#endif
if (result < 0 && errno == EINTR) {
PERL_ASYNC_CHECK();
}
void *
Perl_get_context(void)
{
+ dVAR;
#if defined(USE_ITHREADS)
# ifdef OLD_PTHREADS_API
pthread_addr_t t;
void
Perl_set_context(void *t)
{
+ dVAR;
#if defined(USE_ITHREADS)
# ifdef I_MACH_CTHREADS
cthread_set_data(cthread_self(), t);
#endif /* !PERL_GET_CONTEXT_DEFINED */
-#ifdef PERL_GLOBAL_STRUCT
+#if defined(PERL_GLOBAL_STRUCT) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
struct perl_vars *
Perl_GetVars(pTHX)
{
char **
Perl_get_op_names(pTHX)
{
- return PL_op_name;
+ return (char **)PL_op_name;
}
char **
Perl_get_op_descs(pTHX)
{
- return PL_op_desc;
+ return (char **)PL_op_desc;
}
const char *
U32 *
Perl_get_opargs(pTHX)
{
- return PL_opargs;
+ return (U32 *)PL_opargs;
}
PPADDR_t*
Perl_get_ppaddr(pTHX)
{
+ dVAR;
return (PPADDR_t*)PL_ppaddr;
}
MGVTBL*
Perl_get_vtbl(pTHX_ int vtbl_id)
{
- MGVTBL* result = Null(MGVTBL*);
+ const MGVTBL* result = Null(MGVTBL*);
switch(vtbl_id) {
case want_vtbl_sv:
result = &PL_vtbl_utf8;
break;
}
- return result;
+ return (MGVTBL*)result;
}
I32
}
#else
Perl_croak(aTHX_ "panic: no strftime");
+ return NULL;
#endif
}
return 0;
abort_tidy_up_and_fail:
- errno = ECONNABORTED; /* I hope this is portable and appropriate. */
+#ifdef ECONNABORTED
+ errno = ECONNABORTED; /* This would be the standard thing to do. */
+#else
+# ifdef ECONNREFUSED
+ errno = ECONNREFUSED; /* E.g. Symbian does not have ECONNABORTED. */
+# else
+ errno = ETIMEDOUT; /* Desperation time. */
+# endif
+#endif
tidy_up_and_fail:
{
int save_errno = errno;
#endif
fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
if (fd != -1) {
- if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+ if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
u = 0;
PerlLIO_close(fd);
if (u)
return myseed;
}
+
+#ifdef PERL_GLOBAL_STRUCT
+
+struct perl_vars *
+Perl_init_global_struct(pTHX)
+{
+ struct perl_vars *plvarsp = NULL;
+#ifdef PERL_GLOBAL_STRUCT
+# define PERL_GLOBAL_STRUCT_INIT
+# include "opcode.h" /* the ppaddr and check */
+ IV nppaddr = sizeof(Gppaddr)/sizeof(Perl_ppaddr_t);
+ IV ncheck = sizeof(Gcheck) /sizeof(Perl_check_t);
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ /* PerlMem_malloc() because can't use even safesysmalloc() this early. */
+ plvarsp = (struct perl_vars*)PerlMem_malloc(sizeof(struct perl_vars));
+ if (!plvarsp)
+ exit(1);
+# else
+ plvarsp = PL_VarsPtr;
+# endif /* PERL_GLOBAL_STRUCT_PRIVATE */
+# define PERLVAR(var,type) /**/
+# define PERLVARA(var,n,type) /**/
+# define PERLVARI(var,type,init) plvarsp->var = init;
+# define PERLVARIC(var,type,init) plvarsp->var = init;
+# define PERLVARISC(var,init) Copy(init, plvarsp->var, sizeof(init), char);
+# include "perlvars.h"
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
+# undef PERLVARISC
+# ifdef PERL_GLOBAL_STRUCT
+ plvarsp->Gppaddr = PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
+ if (!plvarsp->Gppaddr)
+ exit(1);
+ plvarsp->Gcheck = PerlMem_malloc(ncheck * sizeof(Perl_check_t));
+ if (!plvarsp->Gcheck)
+ exit(1);
+ Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t);
+ Copy(Gcheck, plvarsp->Gcheck, ncheck, Perl_check_t);
+# endif
+# ifdef PERL_SET_VARS
+ PERL_SET_VARS(plvarsp);
+# endif
+# undef PERL_GLOBAL_STRUCT_INIT
+#endif
+ return plvarsp;
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
+#ifdef PERL_GLOBAL_STRUCT
+
+void
+Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
+{
+#ifdef PERL_GLOBAL_STRUCT
+# ifdef PERL_UNSET_VARS
+ PERL_UNSET_VARS(plvarsp);
+# endif
+ free(plvarsp->Gppaddr);
+ free(plvarsp->Gcheck);
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ free(plvarsp);
+# endif
+#endif
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
|| ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \
|| ((f)[3] == ':')) /* volume name, currently only sys */
# else /* !NETWARE */
-# if defined( DOSISH) || defined(EPOC)
+# if defined( DOSISH) || defined(EPOC) || defined(SYMBIAN)
# define PERL_FILE_IS_ABSOLUTE(f) \
(*(f) == '/' \
|| ((f)[0] && (f)[1] == ':')) /* drive name */
-# else /* NEITHER DOSISH NOR EPOCISH */
+# else /* NEITHER DOSISH NOR EPOCISH NOR SYMBIANISH */
# ifdef MACOS_TRADITIONAL
# define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':') && *(f) != ':')
# else /* !MACOS_TRADITIONAL */
pod17 = [.lib.pod]perlos2.pod [.lib.pod]perlos390.pod [.lib.pod]perlos400.pod [.lib.pod]perlothrtut.pod [.lib.pod]perlpacktut.pod [.lib.pod]perlplan9.pod
pod18 = [.lib.pod]perlpod.pod [.lib.pod]perlpodspec.pod [.lib.pod]perlport.pod [.lib.pod]perlqnx.pod [.lib.pod]perlre.pod [.lib.pod]perlref.pod
pod19 = [.lib.pod]perlreftut.pod [.lib.pod]perlrequick.pod [.lib.pod]perlreref.pod [.lib.pod]perlretut.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod
-pod20 = [.lib.pod]perlsolaris.pod [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perlthrtut.pod [.lib.pod]perltie.pod
-pod21 = [.lib.pod]perltoc.pod [.lib.pod]perltodo.pod [.lib.pod]perltooc.pod [.lib.pod]perltoot.pod [.lib.pod]perltrap.pod [.lib.pod]perltru64.pod
-pod22 = [.lib.pod]perltw.pod [.lib.pod]perlunicode.pod [.lib.pod]perluniintro.pod [.lib.pod]perlutil.pod [.lib.pod]perluts.pod [.lib.pod]perlvar.pod
-pod23 = [.lib.pod]perlvmesa.pod [.lib.pod]perlvms.pod [.lib.pod]perlvos.pod [.lib.pod]perlwin32.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
-pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23)
+pod20 = [.lib.pod]perlsolaris.pod [.lib.pod]perlstyle.pod [.lib.pod]perlsub.pod [.lib.pod]perlsymbian.pod [.lib.pod]perlsyn.pod [.lib.pod]perlthrtut.pod
+pod21 = [.lib.pod]perltie.pod [.lib.pod]perltoc.pod [.lib.pod]perltodo.pod [.lib.pod]perltooc.pod [.lib.pod]perltoot.pod [.lib.pod]perltrap.pod
+pod22 = [.lib.pod]perltru64.pod [.lib.pod]perltw.pod [.lib.pod]perlunicode.pod [.lib.pod]perluniintro.pod [.lib.pod]perlutil.pod [.lib.pod]perluts.pod
+pod23 = [.lib.pod]perlvar.pod [.lib.pod]perlvmesa.pod [.lib.pod]perlvms.pod [.lib.pod]perlvos.pod [.lib.pod]perlwin32.pod [.lib.pod]perlxs.pod
+pod24 = [.lib.pod]perlxstut.pod
+pod = $(pod0) $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) $(pod11) $(pod12) $(pod13) $(pod14) $(pod15) $(pod16) $(pod17) $(pod18) $(pod19) $(pod20) $(pod21) $(pod22) $(pod23) $(pod24)
# Would be useful to automate the generation of this rule from pod/buildtoc
# Plus its corresponding delete in the clean target.
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+[.lib.pod]perlsymbian.pod : [.pod]perlsymbian.pod
+ @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+ Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
+
[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pod]
copy ..\README.plan9 ..\pod\perlplan9.pod
copy ..\README.qnx ..\pod\perlqnx.pod
copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.symbian ..\pod\perlsymbian.pod
copy ..\README.tru64 ..\pod\perltru64.pod
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.uts ..\pod\perluts.pod
perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
- perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
- perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
- perlwin32.pod \
+ perlqnx.pod perlsolaris.pod perlsymbian.pod perltru64.pod \
+ perltw.pod perluts.pod perlvmesa.pod perlvms.pod perlvms.pod \
+ perlvos.pod perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
copy ..\README.plan9 ..\pod\perlplan9.pod
copy ..\README.qnx ..\pod\perlqnx.pod
copy ..\README.solaris ..\pod\perlsolaris.pod
+ copy ..\README.symbian ..\pod\perlsymbian.pod
copy ..\README.tru64 ..\pod\perltru64.pod
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.uts ..\pod\perluts.pod
perljp.pod perlko.pod perlmachten.pod perlmacos.pod \
perlmacosx.pod perlmint.pod perlmpeix.pod perlnetware.pod \
perlos2.pod perlos390.pod perlos400.pod perlplan9.pod \
- perlqnx.pod perlsolaris.pod perltru64.pod perltw.pod \
- perluts.pod perlvmesa.pod perlvms.pod perlvms.pod perlvos.pod \
- perlwin32.pod \
+ perlqnx.pod perlsolaris.pod perlsymbian.pod perltru64.pod \
+ perltw.pod perluts.pod perlvmesa.pod perlvms.pod perlvms.pod \
+ perlvos.pod perlwin32.pod \
pod2html pod2latex pod2man pod2text pod2usage \
podchecker podselect
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
return f;
}
-PerlIO_funcs PerlIO_win32 = {
+PERLIO_FUNCS_DECL(PerlIO_win32) = {
sizeof(PerlIO_funcs),
"win32",
sizeof(PerlIOWin32),
*/
/* package attributes; */
-void XS_attributes__warn_reserved(pTHX_ CV *cv);
-void XS_attributes_reftype(pTHX_ CV *cv);
-void XS_attributes__modify_attrs(pTHX_ CV *cv);
-void XS_attributes__guess_stash(pTHX_ CV *cv);
-void XS_attributes__fetch_attrs(pTHX_ CV *cv);
-void XS_attributes_bootstrap(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__warn_reserved(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes_reftype(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__modify_attrs(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__guess_stash(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes__fetch_attrs(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_attributes_bootstrap(pTHX_ CV *cv);
/*
projects / p5sagit/p5-mst-13.2.git / commitdiff