summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/B/B.xs14
-rw-r--r--ext/ByteLoader/byterun.c13
-rw-r--r--ext/Data/Dumper/Dumper.xs4
-rw-r--r--ext/Digest/MD5/MD5.xs18
-rw-r--r--ext/Digest/MD5/t/files.t6
-rw-r--r--ext/DynaLoader/DynaLoader_pm.PL19
-rw-r--r--ext/DynaLoader/dl_symbian.xs223
-rw-r--r--ext/DynaLoader/dlutils.c8
-rw-r--r--ext/Errno/Errno_pm.PL34
-rw-r--r--ext/IO/lib/IO/Socket.pm2
-rw-r--r--ext/List/Util/Util.xs21
-rw-r--r--ext/MIME/Base64/Base64.xs4
-rw-r--r--ext/POSIX/POSIX.xs24
-rw-r--r--ext/PerlIO/scalar/scalar.xs4
-rw-r--r--ext/PerlIO/via/via.xs4
-rw-r--r--ext/SDBM_File/sdbm/sdbm.c2
-rw-r--r--ext/Storable/Storable.xs172
-rw-r--r--ext/Time/HiRes/HiRes.xs1
18 files changed, 454 insertions, 119 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 32556ec626..a5aecbb0f9 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -19,7 +19,7 @@ typedef FILE * InputStream;
#endif
-static char *svclassnames[] = {
+static const char* const svclassnames[] = {
"B::NULL",
"B::IV",
"B::NV",
@@ -58,7 +58,7 @@ typedef enum {
OPc_COP /* 11 */
} opclass;
-static char *opclassnames[] = {
+static const char* const opclassnames[] = {
"B::NULL",
"B::OP",
"B::UNOP",
@@ -73,7 +73,7 @@ static char *opclassnames[] = {
"B::COP"
};
-static size_t opsizes[] = {
+static const size_t opsizes[] = {
0,
sizeof(OP),
sizeof(UNOP),
@@ -211,13 +211,13 @@ cc_opclass(pTHX_ OP *o)
static char *
cc_opclassname(pTHX_ OP *o)
{
- return opclassnames[cc_opclass(aTHX_ o)];
+ return (char *)opclassnames[cc_opclass(aTHX_ o)];
}
static SV *
make_sv_object(pTHX_ SV *arg, SV *sv)
{
- char *type = 0;
+ const char *type = 0;
IV iv;
dMY_CXT;
@@ -734,7 +734,7 @@ threadsv_names()
#define OP_next(o) o->op_next
#define OP_sibling(o) o->op_sibling
-#define OP_desc(o) PL_op_desc[o->op_type]
+#define OP_desc(o) (char *)PL_op_desc[o->op_type]
#define OP_targ(o) o->op_targ
#define OP_type(o) o->op_type
#if PERL_VERSION >= 9
@@ -769,7 +769,7 @@ char *
OP_name(o)
B::OP o
CODE:
- RETVAL = PL_op_name[o->op_type];
+ RETVAL = (char *)PL_op_name[o->op_type];
OUTPUT:
RETVAL
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 3432eb326f..bdc9555335 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -47,6 +47,7 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
int
byterun(pTHX_ register struct byteloader_state *bstate)
{
+ dVAR;
register int insn;
U32 ix;
SV *specialsv_list[6];
@@ -216,7 +217,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
svindex arg;
BGET_svindex(arg);
- SvRV(bstate->bs_sv) = arg;
+ BSET_xrv(bstate->bs_sv, arg);
break;
}
case INSN_XPV: /* 22 */
@@ -228,28 +229,28 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
STRLEN arg;
BGET_PADOFFSET(arg);
- SvCUR(bstate->bs_sv) = arg;
+ BSET_xpv_cur(bstate->bs_sv, arg);
break;
}
case INSN_XPV_LEN: /* 24 */
{
STRLEN arg;
BGET_PADOFFSET(arg);
- SvLEN(bstate->bs_sv) = arg;
+ BSET_xpv_len(bstate->bs_sv, arg);
break;
}
case INSN_XIV: /* 25 */
{
IV arg;
BGET_IV(arg);
- SvIVX(bstate->bs_sv) = arg;
+ BSET_xiv(bstate->bs_sv, arg);
break;
}
case INSN_XNV: /* 26 */
{
NV arg;
BGET_NV(arg);
- SvNVX(bstate->bs_sv) = arg;
+ BSET_xnv(bstate->bs_sv, arg);
break;
}
case INSN_XLV_TARGOFF: /* 27 */
@@ -592,7 +593,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&SvSTASH(bstate->bs_sv) = arg;
+ bstate->bs_sv = arg;
break;
}
case INSN_GV_FETCHPV: /* 77 */
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 0626977e00..ee1bc14a65 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -830,8 +830,8 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
SvCUR_set(retval, SvCUR(retval)+i);
if (purity) {
- static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
- static STRLEN sizes[] = { 8, 7, 6 };
+ static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
+ static const STRLEN sizes[] = { 8, 7, 6 };
SV *e;
SV *nname = newSVpvn("", 0);
SV *newapad = newSVpvn("", 0);
diff --git a/ext/Digest/MD5/MD5.xs b/ext/Digest/MD5/MD5.xs
index 1abe4c429c..a89bbd7b8e 100644
--- a/ext/Digest/MD5/MD5.xs
+++ b/ext/Digest/MD5/MD5.xs
@@ -153,7 +153,7 @@ typedef struct {
* padding is also the reason the buffer in MD5_CTX have to be
* 128 bytes.
*/
-static unsigned char PADDING[64] = {
+static const unsigned char PADDING[64] = {
0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
@@ -484,7 +484,7 @@ static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
static char* hex_16(const unsigned char* from, char* to)
{
- static char *hexdigits = "0123456789abcdef";
+ static const char hexdigits[] = "0123456789abcdef";
const unsigned char *end = from + 16;
char *d = to;
@@ -499,7 +499,7 @@ static char* hex_16(const unsigned char* from, char* to)
static char* base64_16(const unsigned char* from, char* to)
{
- static char* base64 =
+ static const char base64[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
const unsigned char *end = from + 16;
unsigned char c1, c2, c3;
@@ -626,10 +626,18 @@ addfile(self, fh)
PREINIT:
MD5_CTX* context = get_md5_ctx(aTHX_ self);
STRLEN fill = context->bytes_low & 0x3F;
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ unsigned char* buffer;
+#else
unsigned char buffer[4096];
+#endif
int n;
CODE:
if (fh) {
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ New(0, buffer, 4096, unsigned char);
+ assert(buffer);
+#endif
if (fill) {
/* The MD5Update() function is faster if it can work with
* complete blocks. This will fill up any buffered block
@@ -646,7 +654,9 @@ addfile(self, fh)
while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
MD5Update(context, buffer, n);
}
-
+#ifdef USE_HEAP_INSTEAD_OF_STACK
+ Safefree(buffer);
+#endif
if (PerlIO_error(fh)) {
croak("Reading from filehandle failed");
}
diff --git a/ext/Digest/MD5/t/files.t b/ext/Digest/MD5/t/files.t
index 3f183206dd..615590e704 100644
--- a/ext/Digest/MD5/t/files.t
+++ b/ext/Digest/MD5/t/files.t
@@ -23,7 +23,7 @@ if (ord "A" == 193) { # EBCDIC
15e4c91ad67f5ff238033305376c9140 Changes
0565ec21b15c0f23f4c51fb327c8926d README
f0f77710cd8d5ba7d9faedec8d02dc2f MD5.pm
-f9848c0ee3b20a9177465eec19361e6c MD5.xs
+f6314d62d3aa97dcf4cba66b4c39b105 MD5.xs
276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
EOT
} elsif ("\n" eq "\015") { # MacOS
@@ -31,7 +31,7 @@ EOT
dea016b088ab4d88a5e7cbd9c15a9c88 Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
} else {
@@ -40,7 +40,7 @@ EOT
0f09886e2c129bdabf57674c6822bd4f Changes
6c950a0211a5a28f023bb482037698cd README
f057c88277ecee875cf6f0352468407a MD5.pm
-5bae62404829e6fd8ad0d4f8d5ccea54 MD5.xs
+a526b0218e43c702a6c994a82620686f MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 8476dad187..426d3a5a27 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -26,6 +26,10 @@ sub to_string {
#
# -- added by VKON, 03-10-2004 to separate $^O-specific between OSes
# (so that Win32 never checks for $^O eq 'VMS' for example)
+#
+# The $^O tests test both for $^O and for $Config{osname}.
+# The latter is better for some for cross-compilation setups.
+#
sub expand_os_specific {
my $s = shift;
for ($s) {
@@ -36,7 +40,7 @@ sub expand_os_specific {
if ($expr =~ m[^(.*?)<<\|\$\^O-$op-$os>>(.*?)$]s) {
# #if;#else;#endif
my ($if,$el) = ($1,$2);
- if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) {
+ if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) {
$if
}
else {
@@ -45,7 +49,7 @@ sub expand_os_specific {
}
else {
# #if;#endif
- if (($op eq 'eq' and $^O eq $os) || ($op eq 'ne' and $^O ne $os)) {
+ if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) {
$expr
}
else {
@@ -496,13 +500,22 @@ sub dl_findfile {
push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
push(@names, $_);
}
+ my $dirsep = '/';
+ <<$^O-eq-symbian>>
+ $dirsep = '\\';
+ if ($0 =~ /^([a-z]):/i) {
+ my $drive = $1;
+ @dirs = map { "$drive:$_" } @dirs;
+ @dl_library_path = map { "$drive:$_" } @dl_library_path;
+ }
+ <</$^O-eq-symbian>>
foreach $dir (@dirs, @dl_library_path) {
next unless -d $dir;
<<$^O-eq-VMS>>
chop($dir = VMS::Filespec::unixpath($dir));
<</$^O-eq-VMS>>
foreach $name (@names) {
- my($file) = "$dir/$name";
+ my($file) = "$dir$dirsep$name";
print STDERR " checking in $dir for $name\n" if $dl_debug;
$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
#$file = _check_file($file);
diff --git a/ext/DynaLoader/dl_symbian.xs b/ext/DynaLoader/dl_symbian.xs
new file mode 100644
index 0000000000..6cf1d1f658
--- /dev/null
+++ b/ext/DynaLoader/dl_symbian.xs
@@ -0,0 +1,223 @@
+/* dl_symbian.xs
+ *
+ * Platform: Symbian 7.0s
+ * Author: Jarkko Hietaniemi <jarkko.hietaniemi@nokia.com>
+ * Copyright: 2004, Nokia
+ * License: Artistic/GPL
+ *
+ */
+
+/*
+ * In Symbian DLLs there is no name information, one can only access
+ * the functions by their ordinals. Perl, however, very much would like
+ * to load functions by their names. We fake this by having a special
+ * setup function at the ordinal 1 (this is arranged by building the DLLs
+ * in a special way). The setup function builds a Perl hash mapping the
+ * names to the ordinals, and the hash is then used by dlsym().
+ *
+ */
+
+#include <e32base.h>
+#include <eikdll.h>
+#include <utf.h>
+
+/* This is a useful pattern: first include the Symbian headers,
+ * only after that the Perl ones. Otherwise you will get a lot
+ * trouble because of Symbian's New(), Copy(), etc definitions. */
+
+#define DL_SYMBIAN_XS
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+START_EXTERN_C
+
+void *dlopen(const char *filename, int flag);
+void *dlsym(void *handle, const char *symbol);
+int dlclose(void *handle);
+const char *dlerror(void);
+
+extern void* memset(void *s, int c, size_t n);
+extern size_t strlen(const char *s);
+
+END_EXTERN_C
+
+#include "dlutils.c"
+
+#define RTLD_LAZY 0x0001
+#define RTLD_NOW 0x0002
+#define RTLD_GLOBAL 0x0004
+
+#ifndef NULL
+# define NULL 0
+#endif
+
+/* No need to pull in symbian_dll.cpp for this. */
+#define symbian_get_vars() ((void*)Dll::Tls())
+
+const TInt KPerlDllSetupFunction = 1;
+
+typedef struct {
+ RLibrary handle;
+ TInt error;
+ HV* symbols;
+} PerlSymbianLibHandle;
+
+typedef void (*PerlSymbianLibInit)(void *);
+
+void* dlopen(const char *filename, int flags) {
+ TBuf16<KMaxFileName> utf16fn;
+ const TUint8* utf8fn = (const TUint8*)filename;
+ PerlSymbianLibHandle* h = NULL;
+ TInt error;
+
+ error =
+ CnvUtfConverter::ConvertToUnicodeFromUtf8(utf16fn, TPtrC8(utf8fn));
+ if (error == KErrNone) {
+ h = new PerlSymbianLibHandle;
+ if (h) {
+ h->error = KErrNone;
+ h->symbols = Nullhv;
+ } else
+ error = KErrNoMemory;
+ }
+
+ if (h && error == KErrNone) {
+ error = (h->handle).Load(utf16fn);
+ if (error == KErrNone) {
+ TLibraryFunction init = (h->handle).Lookup(KPerlDllSetupFunction);
+ ((PerlSymbianLibInit)init)(h);
+ } else {
+ free(h);
+ h = NULL;
+ }
+ }
+
+ if (h)
+ h->error = error;
+
+ return h;
+}
+
+void* dlsym(void *handle, const char *symbol) {
+ if (handle) {
+ dTHX;
+ PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+ HV* symbols = h->symbols;
+ if (symbols) {
+ SV** svp = hv_fetch(symbols, symbol, strlen(symbol), FALSE);
+ if (svp && *svp && SvIOK(*svp)) {
+ IV ord = SvIV(*svp);
+ if (ord > 0)
+ return (void*)((h->handle).Lookup(ord));
+ }
+ }
+ }
+ return NULL;
+}
+
+int dlclose(void *handle) {
+ PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
+ if (h) {
+ (h->handle).Close();
+ if (h->symbols) {
+ dTHX;
+ hv_undef(h->symbols);
+ h->symbols = NULL;
+ }
+ return 0;
+ } else
+ return 1;
+}
+
+const char* dlerror(void) {
+ return 0; /* Bad interface: assumes static data. */
+}
+
+static void
+dl_private_init(pTHX)
+{
+ (void)dl_generic_private_init(aTHX);
+}
+
+MODULE = DynaLoader PACKAGE = DynaLoader
+
+PROTOTYPES: ENABLE
+
+BOOT:
+ (void)dl_private_init(aTHX);
+
+
+void
+dl_load_file(filename, flags=0)
+ char * filename
+ int flags
+ PREINIT:
+ PerlSymbianLibHandle* h;
+ CODE:
+{
+ ST(0) = sv_newmortal();
+ h = (PerlSymbianLibHandle*)dlopen(filename, flags);
+ if (h && h->error == KErrNone)
+ sv_setiv(ST(0), PTR2IV(h));
+ else
+ PerlIO_printf(Perl_debug_log, "(dl_load_file %s %d)",
+ filename, h ? h->error : -1);
+}
+
+
+int
+dl_unload_file(libhandle)
+ void * libhandle
+ CODE:
+ RETVAL = (dlclose(libhandle) == 0 ? 1 : 0);
+ OUTPUT:
+ RETVAL
+
+
+void
+dl_find_symbol(libhandle, symbolname)
+ void * libhandle
+ char * symbolname
+ PREINIT:
+ void *sym;
+ CODE:
+ PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)libhandle;
+ sym = dlsym(libhandle, symbolname);
+ ST(0) = sv_newmortal();
+ if (sym)
+ sv_setiv(ST(0), PTR2IV(sym));
+ else
+ PerlIO_printf(Perl_debug_log, "(dl_find_symbol %s %d)",
+ symbolname, h ? h->error : -1);
+
+
+void
+dl_undef_symbols()
+ CODE:
+
+
+
+# These functions should not need changing on any platform:
+
+void
+dl_install_xsub(perl_name, symref, filename="$Package")
+ char * perl_name
+ void * symref
+ char * filename
+ CODE:
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
+
+
+char *
+dl_error()
+ CODE:
+ dMY_CXT;
+ RETVAL = dl_last_error;
+ OUTPUT:
+ RETVAL
+
+# end.
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 474c93d367..956848ad94 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -8,6 +8,12 @@
* files when the interpreter exits
*/
+#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
+# include "EXTERN.h"
+# include "perl.h"
+# include "XSUB.h"
+#endif
+
#ifndef XS_VERSION
# define XS_VERSION "0"
#endif
@@ -110,6 +116,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
}
+#ifndef SYMBIAN
/* SaveError() takes printf style args and saves the result in dl_last_error */
static void
SaveError(pTHX_ const char* pat, ...)
@@ -133,4 +140,5 @@ SaveError(pTHX_ const char* pat, ...)
sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
}
+#endif
diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
index 39e2c19230..5c76d89057 100644
--- a/ext/Errno/Errno_pm.PL
+++ b/ext/Errno/Errno_pm.PL
@@ -7,6 +7,11 @@ our $VERSION = "1.09_01";
my %err = ();
my %wsa = ();
+# Symbian cross-compiling environment.
+my $IsSymbian = exists $ENV{SDK} && -d "$ENV{SDK}\\epoc32";
+
+my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian;
+
unlink "Errno.pm" if -f "Errno.pm";
open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
select OUT;
@@ -27,7 +32,7 @@ sub process_file {
}
return unless defined $file and -f $file;
-# warn "Processing $file\n";
+# warn "Processing $file\n";
local *FH;
if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
@@ -53,7 +58,7 @@ sub process_file {
return;
}
}
-
+
if ($^O eq 'MacOS') {
while(<FH>) {
$err{$1} = $2
@@ -63,12 +68,13 @@ sub process_file {
while(<FH>) {
$err{$1} = 1
if /^\s*#\s*define\s+(E\w+)\s+/;
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
$wsa{$1} = 1
if /^\s*#\s*define\s+WSA(E\w+)\s+/;
}
}
}
+
close(FH);
}
@@ -130,6 +136,10 @@ sub get_files {
} elsif ($^O eq 'vos') {
# avoid problem where cpp returns non-POSIX pathnames
$file{'/system/include_library/errno.h'} = 1;
+ } elsif ($IsSymbian) {
+ my $SDK = $ENV{SDK};
+ $SDK =~ s!\\!/!g;
+ $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1;
} else {
open(CPPI,"> errno.c") or
die "Cannot open errno.c";
@@ -138,7 +148,7 @@ sub get_files {
print CPPI "#include <nwerrno.h>\n";
} else {
print CPPI "#include <errno.h>\n";
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
print CPPI "#define _WINSOCKAPI_\n"; # don't drag in everything
print CPPI "#include <winsock.h>\n";
}
@@ -147,7 +157,7 @@ sub get_files {
close(CPPI);
# invoke CPP and read the output
- if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+ if ($IsMSWin32 || $^O eq 'NetWare') {
open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
} else {
@@ -157,14 +167,14 @@ sub get_files {
}
my $pat;
- if (($^O eq 'MSWin32' || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
+ if (($IsMSWin32 || $^O eq 'NetWare') and $Config{cc} =~ /^bcc/i) {
$pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
}
else {
$pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"';
}
while(<CPPO>) {
- if ($^O eq 'os2' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
+ if ($^O eq 'os2' or $IsMSWin32 or $^O eq 'NetWare') {
if (/$pat/o) {
my $f = $1;
$f =~ s,\\\\,/,g;
@@ -198,7 +208,7 @@ sub write_errno_pm {
else {
print CPPI "#include <errno.h>\n";
}
- if ($^O eq 'MSWin32') {
+ if ($IsMSWin32) {
print CPPI "#include <winsock.h>\n";
foreach $err (keys %wsa) {
print CPPI "#ifndef $err\n";
@@ -222,10 +232,14 @@ sub write_errno_pm {
$cpp =~ s/sys\$input//i;
open(CPPO,"$cpp errno.c |") or
die "Cannot exec $Config{cppstdin}";
- } elsif ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+ } elsif ($IsMSWin32 || $^O eq 'NetWare') {
open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
- } else {
+ } elsif ($IsSymbian) {
+ my $cpp = "gcc -E -I$ENV{SDK}\\epoc32\\include\\libc -";
+ open(CPPO,"$cpp < errno.c |")
+ or die "Cannot exec $cpp";
+ } else {
my $cpp = default_cpp();
open(CPPO,"$cpp < errno.c |")
or die "Cannot exec $cpp";
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index e706894a75..353785a3ea 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -19,7 +19,7 @@ use Errno;
# legacy
require IO::Socket::INET;
-require IO::Socket::UNIX if ($^O ne 'epoc');
+require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
@ISA = qw(IO::Handle);
diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index 3a03488197..790a2b9af4 100644
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -103,6 +103,24 @@ sv_tainted(SV *sv)
# define PTR2UV(ptr) (UV)(ptr)
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
MODULE=List::Util PACKAGE=List::Util
void
@@ -206,6 +224,7 @@ reduce(block,...)
PROTOTYPE: &@
CODE:
{
+ dVAR;
SV *ret = sv_newmortal();
int index;
GV *agv,*bgv,*gv;
@@ -261,6 +280,7 @@ first(block,...)
PROTOTYPE: &@
CODE:
{
+ dVAR;
int index;
GV *gv;
HV *stash;
@@ -315,6 +335,7 @@ shuffle(...)
PROTOTYPE: @
CODE:
{
+ dVAR;
int index;
struct op dmy_op;
struct op *old_op = PL_op;
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index 8fd14cf355..99ff0e49a1 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -56,14 +56,14 @@ extern "C" {
#define MAX_LINE 76 /* size of encoded lines */
-static char basis_64[] =
+static const char basis_64[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
#define XX 255 /* illegal base64 char */
#define EQ 254 /* padding */
#define INVALID XX
-static unsigned char index_64[256] = {
+static const unsigned char index_64[256] = {
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 561dc3053c..9f76b47c86 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -85,6 +85,24 @@ char *tzname[] = { "" , "" };
#endif
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
#if defined(__VMS) && !defined(__POSIX_SOURCE)
# include <libdef.h> /* LIB$_INVARG constant */
# include <lib$routines.h> /* prototype for lib$ediv() */
@@ -189,7 +207,9 @@ char *tzname[] = { "" , "" };
# define ttyname(a) (char*)not_here("ttyname")
# define tzset() not_here("tzset")
# else
-# include <grp.h>
+# ifdef I_GRP
+# include <grp.h>
+# endif
# include <sys/times.h>
# ifdef HAS_UNAME
# include <sys/utsname.h>
@@ -602,7 +622,6 @@ sigismember(sigset, sig)
POSIX::SigSet sigset
int sig
-
MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
POSIX::Termios
@@ -1228,6 +1247,7 @@ sigaction(sig, optaction, oldaction = 0)
# interface look beautiful, which is hard.
{
+ dVAR;
POSIX__SigAction action;
GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 074da92631..55a5fd8057 100644
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -254,7 +254,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
return f;
}
-PerlIO_funcs PerlIO_scalar = {
+PERLIO_FUNCS_DECL(PerlIO_scalar) = {
sizeof(PerlIO_funcs),
"scalar",
sizeof(PerlIOScalar),
@@ -295,7 +295,7 @@ PROTOTYPES: ENABLE
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_scalar);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
#endif
}
diff --git a/ext/PerlIO/via/via.xs b/ext/PerlIO/via/via.xs
index d95d631190..ad27416b0f 100644
--- a/ext/PerlIO/via/via.xs
+++ b/ext/PerlIO/via/via.xs
@@ -590,7 +590,7 @@ PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
-PerlIO_funcs PerlIO_object = {
+PERLIO_FUNCS_DECL(PerlIO_object) = {
sizeof(PerlIO_funcs),
"via",
sizeof(PerlIOVia),
@@ -630,7 +630,7 @@ PROTOTYPES: ENABLE;
BOOT:
{
#ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_object);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
#endif
}
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index a3c4acfb3d..f705db58af 100644
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -62,7 +62,7 @@ static int makroom proto((DBM *, long, int));
#define OFF_PAG(off) (long) (off) * PBLKSIZ
#define OFF_DIR(off) (long) (off) * DBLKSIZ
-static long masks[] = {
+static const long masks[] = {
000000000000, 000000000001, 000000000003, 000000000007,
000000000017, 000000000037, 000000000077, 000000000177,
000000000377, 000000000777, 000000001777, 000000003777,
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 702644e5f6..7c6a755ec5 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -93,6 +93,24 @@ typedef double NV; /* Older perls lack the NV type */
#endif
#endif
+#ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#define dVAR dNOOP
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
@@ -1024,15 +1042,17 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv);
static int store_other(pTHX_ stcxt_t *cxt, SV *sv);
static int store_blessed(pTHX_ stcxt_t *cxt, SV *sv, int type, HV *pkg);
-static int (*sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
- store_ref, /* svis_REF */
- store_scalar, /* svis_SCALAR */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_array, /* svis_ARRAY */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_hash, /* svis_HASH */
- store_tied, /* svis_TIED */
- store_tied_item, /* svis_TIED_ITEM */
- (int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_code, /* svis_CODE */
- store_other, /* svis_OTHER */
+#define SV_STORE_TYPE (const int (* const)(pTHX_ stcxt_t *cxt, SV *sv))
+
+static const int (* const sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
+ SV_STORE_TYPE store_ref, /* svis_REF */
+ SV_STORE_TYPE store_scalar, /* svis_SCALAR */
+ SV_STORE_TYPE store_array, /* svis_ARRAY */
+ SV_STORE_TYPE store_hash, /* svis_HASH */
+ SV_STORE_TYPE store_tied, /* svis_TIED */
+ SV_STORE_TYPE store_tied_item, /* svis_TIED_ITEM */
+ SV_STORE_TYPE store_code, /* svis_CODE */
+ SV_STORE_TYPE store_other, /* svis_OTHER */
};
#define SV_STORE(x) (*sv_store[x])
@@ -1058,37 +1078,39 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname);
-static SV *(*sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
- 0, /* SX_OBJECT -- entry unused dynamically */
- retrieve_lscalar, /* SX_LSCALAR */
- old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
- old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
- retrieve_ref, /* SX_REF */
- retrieve_undef, /* SX_UNDEF */
- retrieve_integer, /* SX_INTEGER */
- retrieve_double, /* SX_DOUBLE */
- retrieve_byte, /* SX_BYTE */
- retrieve_netint, /* SX_NETINT */
- retrieve_scalar, /* SX_SCALAR */
- retrieve_tied_array, /* SX_ARRAY */
- retrieve_tied_hash, /* SX_HASH */
- retrieve_tied_scalar, /* SX_SCALAR */
- retrieve_other, /* SX_SV_UNDEF not supported */
- retrieve_other, /* SX_SV_YES not supported */
- retrieve_other, /* SX_SV_NO not supported */
- retrieve_other, /* SX_BLESS not supported */
- retrieve_other, /* SX_IX_BLESS not supported */
- retrieve_other, /* SX_HOOK not supported */
- retrieve_other, /* SX_OVERLOADED not supported */
- retrieve_other, /* SX_TIED_KEY not supported */
- retrieve_other, /* SX_TIED_IDX not supported */
- retrieve_other, /* SX_UTF8STR not supported */
- retrieve_other, /* SX_LUTF8STR not supported */
- retrieve_other, /* SX_FLAG_HASH not supported */
- retrieve_other, /* SX_CODE not supported */
- retrieve_other, /* SX_WEAKREF not supported */
- retrieve_other, /* SX_WEAKOVERLOAD not supported */
- retrieve_other, /* SX_ERROR */
+#define SV_RETRIEVE_TYPE (const SV* (* const)(pTHX_ stcxt_t *cxt, char *cname))
+
+static const SV *(* const sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+ 0, /* SX_OBJECT -- entry unused dynamically */
+ SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
+ SV_RETRIEVE_TYPE old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
+ SV_RETRIEVE_TYPE old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
+ SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
+ SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
+ SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
+ SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
+ SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
+ SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_UNDEF not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_YES not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_NO not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_BLESS not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_IX_BLESS not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_HOOK not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_OVERLOADED not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_KEY not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_IDX not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_UTF8STR not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_LUTF8STR not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_FLAG_HASH not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_CODE not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKREF not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKOVERLOAD not supported */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
};
static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
@@ -1107,37 +1129,37 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname);
-static SV *(*sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+static const SV *(* const sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
0, /* SX_OBJECT -- entry unused dynamically */
- retrieve_lscalar, /* SX_LSCALAR */
- retrieve_array, /* SX_ARRAY */
- retrieve_hash, /* SX_HASH */
- retrieve_ref, /* SX_REF */
- retrieve_undef, /* SX_UNDEF */
- retrieve_integer, /* SX_INTEGER */
- retrieve_double, /* SX_DOUBLE */
- retrieve_byte, /* SX_BYTE */
- retrieve_netint, /* SX_NETINT */
- retrieve_scalar, /* SX_SCALAR */
- retrieve_tied_array, /* SX_ARRAY */
- retrieve_tied_hash, /* SX_HASH */
- retrieve_tied_scalar, /* SX_SCALAR */
- retrieve_sv_undef, /* SX_SV_UNDEF */
- retrieve_sv_yes, /* SX_SV_YES */
- retrieve_sv_no, /* SX_SV_NO */
- retrieve_blessed, /* SX_BLESS */
- retrieve_idx_blessed, /* SX_IX_BLESS */
- retrieve_hook, /* SX_HOOK */
- retrieve_overloaded, /* SX_OVERLOAD */
- retrieve_tied_key, /* SX_TIED_KEY */
- retrieve_tied_idx, /* SX_TIED_IDX */
- retrieve_utf8str, /* SX_UTF8STR */
- retrieve_lutf8str, /* SX_LUTF8STR */
- retrieve_flag_hash, /* SX_HASH */
- retrieve_code, /* SX_CODE */
- retrieve_weakref, /* SX_WEAKREF */
- retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
- retrieve_other, /* SX_ERROR */
+ SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
+ SV_RETRIEVE_TYPE retrieve_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
+ SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
+ SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
+ SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
+ SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
+ SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
+ SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
+ SV_RETRIEVE_TYPE retrieve_sv_undef, /* SX_SV_UNDEF */
+ SV_RETRIEVE_TYPE retrieve_sv_yes, /* SX_SV_YES */
+ SV_RETRIEVE_TYPE retrieve_sv_no, /* SX_SV_NO */
+ SV_RETRIEVE_TYPE retrieve_blessed, /* SX_BLESS */
+ SV_RETRIEVE_TYPE retrieve_idx_blessed, /* SX_IX_BLESS */
+ SV_RETRIEVE_TYPE retrieve_hook, /* SX_HOOK */
+ SV_RETRIEVE_TYPE retrieve_overloaded, /* SX_OVERLOAD */
+ SV_RETRIEVE_TYPE retrieve_tied_key, /* SX_TIED_KEY */
+ SV_RETRIEVE_TYPE retrieve_tied_idx, /* SX_TIED_IDX */
+ SV_RETRIEVE_TYPE retrieve_utf8str, /* SX_UTF8STR */
+ SV_RETRIEVE_TYPE retrieve_lutf8str, /* SX_LUTF8STR */
+ SV_RETRIEVE_TYPE retrieve_flag_hash, /* SX_HASH */
+ SV_RETRIEVE_TYPE retrieve_code, /* SX_CODE */
+ SV_RETRIEVE_TYPE retrieve_weakref, /* SX_WEAKREF */
+ SV_RETRIEVE_TYPE retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
+ SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
};
#define RETRIEVE(c,x) (*(c)->retrieve_vtbl[(x) >= SX_ERROR ? SX_ERROR : (x)])
@@ -2161,6 +2183,7 @@ sortcmp(const void *a, const void *b)
*/
static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
{
+ dVAR;
I32 len =
#ifdef HAS_RESTRICTED_HASHES
HvTOTALKEYS(hv);
@@ -2250,7 +2273,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
for (i = 0; i < len; i++) {
#ifdef HAS_RESTRICTED_HASHES
- int placeholders = HvPLACEHOLDERS(hv);
+ int placeholders = (int)HvPLACEHOLDERS(hv);
#endif
unsigned char flags = 0;
char *keyval;
@@ -3235,7 +3258,7 @@ static int store_blessed(
static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
{
I32 len;
- static char buf[80];
+ char buf[80];
TRACEME(("store_other"));
@@ -5050,6 +5073,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
*/
static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
{
+ dVAR;
I32 len;
I32 size;
I32 i;
@@ -5373,7 +5397,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
HV *hv;
SV *sv = (SV *) 0;
int c;
- static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
+ SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
TRACEME(("old_retrieve_hash (#%d)", cxt->tagnum));
@@ -5524,7 +5548,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
*/
version_major = use_network_order >> 1;
- cxt->retrieve_vtbl = version_major ? sv_retrieve : sv_old_retrieve;
+ cxt->retrieve_vtbl = (SV*(**)()) (version_major ? sv_retrieve : sv_old_retrieve);
TRACEME(("magic_check: netorder = 0x%x", use_network_order));
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 3272748fa8..b9040eb0e2 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -31,6 +31,7 @@ extern "C" {
#ifdef HAS_PAUSE
# define Pause pause
#else
+# undef Pause /* In case perl.h did it already. */
# define Pause() sleep(~0) /* Zzz for a long time. */
#endif
View Lorry Controller Status