summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>1999-10-01 12:05:56 +0000
committerJarkko Hietaniemi <jhi@iki.fi>1999-10-01 12:05:56 +0000
commitb3c0bf3602cfb95d459cdd04ae7ddfd23779e14e (patch)
tree68089685c059116b52d4330c912a24ccf7cbc94f
parentb2f5ed49123019744d7a7be15208a7e98e095dd0 (diff)
parenta80b8354f5981907f826ef236ecd80cb746b2ace (diff)
downloadperl-b3c0bf3602cfb95d459cdd04ae7ddfd23779e14e.tar.gz
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@4270
-rw-r--r--ext/B/B/C.pm9
-rw-r--r--lib/ExtUtils/typemap2
-rwxr-xr-xlib/ExtUtils/xsubpp2
-rw-r--r--pod/perldiag.pod6
-rw-r--r--util.c45
5 files changed, 39 insertions, 25 deletions
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index b9e005bf41..b57d1ad2b3 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -595,8 +595,11 @@ sub B::CV::save {
}
# Reserve a place in svsect and xpvcvsect and record indices
my $gv = $cv->GV;
- my $cvstashname = $gv->STASH->NAME;
- my $cvname = $gv->NAME;
+ my ($cvname, $cvstashname);
+ if ($$gv){
+ $cvname = $gv->NAME;
+ $cvstashname = $gv->STASH->NAME;
+ }
my $root = $cv->ROOT;
my $cvxsub = $cv->XSUB;
#INIT is removed from the symbol table, so this call must come
@@ -1243,7 +1246,7 @@ sub mark_package
{
no strict 'refs';
$unused_sub_packages{$package} = 1;
- if (@{$package.'::ISA'})
+ if (defined @{$package.'::ISA'})
{
foreach my $isa (@{$package.'::ISA'})
{
diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index d84435e50f..a34cd4f9ea 100644
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -251,7 +251,7 @@ T_REFOBJ
T_OPAQUE
sv_setpvn($arg, (char *)&$var, sizeof($var));
T_OPAQUEPTR
- sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+ sv_setpvn($arg, (char *)$var, sizeof(*$var));
T_PACKED
XS_pack_$ntype($arg, $var);
T_PACKEDARRAY
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index a8508b38c3..6db993c521 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -1436,7 +1436,7 @@ sub generate_output {
$type = TidyType($type) ;
if ($type =~ /^array\(([^,]*),(.*)\)/) {
- print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
+ print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
} else {
blurt("Error: '$type' not in typemap"), return
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 454bfc5df1..d224a54bd7 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2141,6 +2141,12 @@ to use an operator, but this is highly likely to be incorrect.
For example, if you say "*foo *foo" it will be interpreted as
if you said "*foo * 'foo'".
+=item Out of memory!
+
+(X) The malloc() function returned 0, indicating there was insufficient
+remaining memory (or virtual memory) to satisfy the request. Perl
+has no option but to exit immediately.
+
=item Out of memory for yacc stack
(F) The yacc parser wanted to grow its stack so it could continue parsing,
diff --git a/util.c b/util.c
index a92c4dba2b..97401ab9df 100644
--- a/util.c
+++ b/util.c
@@ -912,7 +912,7 @@ Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
If FBMcf_TAIL, the table is created as if the string has a trailing \n. */
void
-Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */)
+Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
{
register U8 *s;
register U8 *table;
@@ -928,23 +928,23 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */)
if (len == 0) /* TAIL might be on on a zero-length string. */
return;
if (len > 2) {
- I32 mlen = len;
+ U8 mlen;
unsigned char *sb;
- if (mlen > 255)
+ if (len > 255)
mlen = 255;
- Sv_Grow(sv,len + 256 + FBM_TABLE_OFFSET);
+ else
+ mlen = (U8)len;
+ Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
table = (unsigned char*)(SvPVX(sv) + len + FBM_TABLE_OFFSET);
- s = table - 1 - FBM_TABLE_OFFSET; /* Last char */
- for (i = 0; i < 256; i++) {
- table[i] = mlen;
- }
- table[-1] = flags; /* Not used yet */
+ s = table - 1 - FBM_TABLE_OFFSET; /* last char */
+ memset((void*)table, mlen, 256);
+ table[-1] = (U8)flags;
i = 0;
- sb = s - mlen;
+ sb = s - mlen + 1; /* first char (maybe) */
while (s >= sb) {
if (table[*s] == mlen)
- table[*s] = i;
+ table[*s] = (U8)i;
s--, i++;
}
}
@@ -963,7 +963,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */)
BmUSEFUL(sv) = 100; /* Initial value */
if (flags & FBMcf_TAIL)
SvTAIL_on(sv);
- DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %d\n",
+ BmRARE(sv),BmPREVIOUS(sv)));
}
/* If SvTAIL(littlestr), it has a fake '\n' at end. */
@@ -1075,15 +1076,17 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
}
if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */
s = bigend - littlelen;
- if (s >= big
- && bigend[-1] == '\n'
- && *s == *little
+ if (s >= big && bigend[-1] == '\n' && *s == *little
/* Automatically of length > 2 */
&& memEQ((char*)s + 1, (char*)little + 1, littlelen - 2))
+ {
return (char*)s; /* how sweet it is */
- if (s[1] == *little && memEQ((char*)s + 2,(char*)little + 1,
- littlelen - 2))
+ }
+ if (s[1] == *little
+ && memEQ((char*)s + 2, (char*)little + 1, littlelen - 2))
+ {
return (char*)s + 1; /* how sweet it is */
+ }
return Nullch;
}
if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
@@ -1093,9 +1096,11 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
if (!b && SvTAIL(littlestr)) { /* Automatically multiline! */
/* Chop \n from littlestr: */
s = bigend - littlelen + 1;
- if (*s == *little && memEQ((char*)s + 1, (char*)little + 1,
- littlelen - 2))
+ if (*s == *little
+ && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2))
+ {
return (char*)s;
+ }
return Nullch;
}
return b;
@@ -1117,7 +1122,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
top2:
/*SUPPRESS 560*/
- if (tmp = table[*s]) {
+ if ((tmp = table[*s])) {
#ifdef POINTERRIGOR
if (bigend - s > tmp) {
s += tmp;