This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate cfgperl contents into mainline
authorGurusamy Sarathy <gsar@cpan.org>
Sun, 1 Aug 1999 21:23:18 +0000 (21:23 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Sun, 1 Aug 1999 21:23:18 +0000 (21:23 +0000)
p4raw-id: //depot/perl@3860

27 files changed:
Configure
Makefile.SH
Porting/Glossary
Porting/config.sh
Porting/config_H
README.threads
config_h.SH
embed.pl
ext/SDBM_File/Makefile.PL
hints/solaris_2.sh
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/MakeMaker.pm
os2/OS2/REXX/Makefile.PL
perl.h
pod/perldelta.pod
pod/perldiag.pod
pp.c
proto.h
regcomp.sym
regexec.c
regnodes.h
t/op/exec.t
t/op/oct.t
t/pragma/warn/6default
t/pragma/warn/util
toke.c
util.c

index 1f9e653..4df1da0 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Wed Jul 28 20:32:22 EET DST 1999 [metaconfig 3.0 PL70]
+# Generated on Sun Aug  1 00:18:49 EET DST 1999 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.com)
 
 cat >/tmp/c1$$ <<EOF
@@ -282,6 +282,8 @@ baserev=''
 bin=''
 binexp=''
 installbin=''
+bincompat5005=''
+d_bincompat5005=''
 byteorder=''
 cc=''
 gccversion=''
@@ -2570,24 +2572,16 @@ case "$usethreads" in
 : user has specified that a threading perl is to be built,
 : we may need to set or change some other defaults.
        if $test -f usethreads.cbu; then
+               echo "Your platform has some specific hints for threaded builds, using them..."
                . ./usethreads.cbu
-       fi
-       case "$osname" in
-       aix|dec_osf|dos_djgpp|freebsd|hpux|irix|linux|next|openbsd|os2|solaris|vmesa)
-               # Known thread-capable platforms.
-               ;;
-       *)
-               cat >&4 <<EOM
-$osname is not known to support threads.
-Please let perlbug@perl.com know how to do that.
-
-Cannot continue, aborting.
+       else
+               $cat <<EOM
+(Your platform doesn't have any specific hints for threaded builds.
+ Assuming POSIX threads, then.)
 EOM
-               exit 1
-       ;;
-       esac # $osname
+       fi
     ;;
-esac # $usethreads
+esac
 
 cat <<EOM
 
@@ -2611,6 +2605,350 @@ esac
 set usemultiplicity
 eval $setvar 
 
+: determine where manual pages are on this system
+echo " "
+case "$sysman" in
+'') 
+       syspath='/usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1'
+       syspath="$syspath /usr/man/u_man/man1 /usr/share/man/man1"
+       syspath="$syspath /usr/catman/u_man/man1 /usr/man/l_man/man1"
+       syspath="$syspath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1"
+       syspath="$syspath /usr/man/man.L /local/man/man1 /usr/local/man/man1"
+       sysman=`./loc . /usr/man/man1 $syspath`
+       ;;
+esac
+if $test -d "$sysman"; then
+       echo "System manual is in $sysman." >&4
+else
+       echo "Could not find manual pages in source form." >&4
+fi
+
+: see what memory models we can support
+case "$models" in
+'')
+       $cat >pdp11.c <<'EOP'
+int main() {
+#ifdef pdp11
+       exit(0);
+#else
+       exit(1);
+#endif
+}
+EOP
+       ( cc -o pdp11 pdp11.c ) >/dev/null 2>&1
+       if $test -f pdp11 && ./pdp11 2>/dev/null; then
+               dflt='unsplit split'
+       else
+               tans=`./loc . X /lib/small /lib/large /usr/lib/small /usr/lib/large /lib/medium /usr/lib/medium /lib/huge`
+               case "$tans" in
+               X) dflt='none';;
+               *) if $test -d /lib/small || $test -d /usr/lib/small; then
+                               dflt='small'
+                       else
+                               dflt=''
+                       fi
+                       if $test -d /lib/medium || $test -d /usr/lib/medium; then
+                               dflt="$dflt medium"
+                       fi
+                       if $test -d /lib/large || $test -d /usr/lib/large; then
+                               dflt="$dflt large"
+                       fi
+                       if $test -d /lib/huge || $test -d /usr/lib/huge; then
+                               dflt="$dflt huge"
+                       fi
+               esac
+       fi;;
+*) dflt="$models";;
+esac
+$cat <<EOM
+Some systems have different model sizes.  On most systems they are called
+small, medium, large, and huge.  On the PDP11 they are called unsplit and
+split.  If your system doesn't support different memory models, say "none".
+If you wish to force everything to one memory model, say "none" here and
+put the appropriate flags later when it asks you for other cc and ld flags.
+Venix systems may wish to put "none" and let the compiler figure things out.
+(In the following question multiple model names should be space separated.)
+
+The default for most systems is "none".
+
+EOM
+rp="Which memory models are supported?"
+. ./myread
+models="$ans"
+
+case "$models" in
+none)
+       small=''
+       medium=''
+       large=''
+       huge=''
+       unsplit=''
+       split=''
+       ;;
+*split)
+       case "$split" in
+       '') if $contains '\-i' $sysman/ld.1 >/dev/null 2>&1 || \
+                        $contains '\-i' $sysman/cc.1 >/dev/null 2>&1; then
+                       dflt='-i'
+               else
+                       dflt='none'
+               fi;;
+       *) dflt="$split";;
+       esac
+       rp="What flag indicates separate I and D space?"
+       . ./myread
+       tans="$ans"
+       case "$tans" in
+       none) tans='';;
+       esac
+       split="$tans"
+       unsplit='';;
+*large*|*small*|*medium*|*huge*)
+       case "$models" in
+       *large*)
+               case "$large" in
+               '') dflt='-Ml';;
+               *) dflt="$large";;
+               esac
+       rp="What flag indicates large model?"
+       . ./myread
+       tans="$ans"
+       case "$tans" in
+       none) tans='';
+       esac
+       large="$tans";;
+       *) large='';;
+       esac
+       case "$models" in
+       *huge*) case "$huge" in
+               '') dflt='-Mh';;
+               *) dflt="$huge";;
+               esac
+               rp="What flag indicates huge model?"
+               . ./myread
+               tans="$ans"
+               case "$tans" in
+               none) tans='';
+               esac
+               huge="$tans";;
+       *) huge="$large";;
+       esac
+       case "$models" in
+       *medium*) case "$medium" in
+               '') dflt='-Mm';;
+               *) dflt="$medium";;
+               esac
+               rp="What flag indicates medium model?"
+               . ./myread
+               tans="$ans"
+               case "$tans" in
+               none) tans='';
+               esac
+               medium="$tans";;
+       *) medium="$large";;
+       esac
+       case "$models" in
+       *small*) case "$small" in
+               '') dflt='none';;
+               *) dflt="$small";;
+               esac
+               rp="What flag indicates small model?"
+               . ./myread
+               tans="$ans"
+               case "$tans" in
+               none) tans='';
+               esac
+               small="$tans";;
+       *) small='';;
+       esac
+       ;;
+*)
+       echo "Unrecognized memory models--you may have to edit Makefile.SH" >&4
+       ;;
+esac
+$rm -f pdp11.* pdp11
+
+: make some quick guesses about what we are up against
+echo " "
+$echo $n "Hmm...  $c"
+echo exit 1 >bsd
+echo exit 1 >usg
+echo exit 1 >v7
+echo exit 1 >osf1
+echo exit 1 >eunice
+echo exit 1 >xenix
+echo exit 1 >venix
+echo exit 1 >os2
+d_bsd="$undef"
+$cat /usr/include/signal.h /usr/include/sys/signal.h >foo 2>/dev/null
+if test -f /osf_boot || $contains 'OSF/1' /usr/include/ctype.h >/dev/null 2>&1
+then
+       echo "Looks kind of like an OSF/1 system, but we'll see..."
+       echo exit 0 >osf1
+elif test `echo abc | tr a-z A-Z` = Abc ; then
+       xxx=`./loc addbib blurfl $pth`
+       if $test -f $xxx; then
+       echo "Looks kind of like a USG system with BSD features, but we'll see..."
+               echo exit 0 >bsd
+               echo exit 0 >usg
+       else
+               if $contains SIGTSTP foo >/dev/null 2>&1 ; then
+                       echo "Looks kind of like an extended USG system, but we'll see..."
+               else
+                       echo "Looks kind of like a USG system, but we'll see..."
+               fi
+               echo exit 0 >usg
+       fi
+elif $contains SIGTSTP foo >/dev/null 2>&1 ; then
+       echo "Looks kind of like a BSD system, but we'll see..."
+       d_bsd="$define"
+       echo exit 0 >bsd
+else
+       echo "Looks kind of like a Version 7 system, but we'll see..."
+       echo exit 0 >v7
+fi
+case "$eunicefix" in
+*unixtovms*)
+       $cat <<'EOI'
+There is, however, a strange, musty smell in the air that reminds me of
+something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit.
+EOI
+       echo exit 0 >eunice
+       d_eunice="$define"
+: it so happens the Eunice I know will not run shell scripts in Unix format
+       ;;
+*)
+       echo " "
+       echo "Congratulations.  You aren't running Eunice."
+       d_eunice="$undef"
+       ;;
+esac
+: Detect OS2.  The p_ variable is set above in the Head.U unit.
+case "$p_" in
+:) ;;
+*)
+       $cat <<'EOI'
+I have the feeling something is not exactly right, however...don't tell me...
+lemme think...does HAL ring a bell?...no, of course, you're only running OS/2!
+EOI
+       echo exit 0 >os2
+       ;;
+esac
+if test -f /xenix; then
+       echo "Actually, this looks more like a XENIX system..."
+       echo exit 0 >xenix
+       d_xenix="$define"
+else
+       echo " "
+       echo "It's not Xenix..."
+       d_xenix="$undef"
+fi
+chmod +x xenix
+$eunicefix xenix
+if test -f /venix; then
+       echo "Actually, this looks more like a VENIX system..."
+       echo exit 0 >venix
+else
+       echo " "
+       if ./xenix; then
+               : null
+       else
+               echo "Nor is it Venix..."
+       fi
+fi
+chmod +x bsd usg v7 osf1 eunice xenix venix os2
+$eunicefix bsd usg v7 osf1 eunice xenix venix os2
+$rm -f foo
+
+: see if we need a special compiler
+echo " "
+if ./usg; then
+       case "$cc" in
+       '') case "$Mcc" in
+               /*) dflt='Mcc';;
+               *) case "$large" in
+                       -M*) dflt='cc';;
+                       *)      if $contains '\-M' $sysman/cc.1 >/dev/null 2>&1 ; then
+                                       if $contains '\-M' $sysman/cpp.1 >/dev/null 2>&1; then
+                                               dflt='cc'
+                                       else
+                                               dflt='cc -M'
+                                       fi
+                               else
+                                       dflt='cc'
+                               fi;;
+                       esac;;
+               esac;;
+       *)  dflt="$cc";;
+       esac
+       case "$dflt" in
+       *M*)    $cat <<'EOM'
+On some older systems the default C compiler will not resolve multiple global
+references that happen to have the same name.  On some such systems the "Mcc"
+command may be used to force these to be resolved.  On other systems a "cc -M"
+command is required.  (Note that the -M flag on other systems indicates a
+memory model to use!) If you have the Gnu C compiler, you might wish to use
+that instead.
+
+EOM
+       ;;
+       esac
+       rp="Use which C compiler?"
+       . ./myread
+       cc="$ans"
+else
+       case "$cc" in
+       '') dflt=cc;;
+       *) dflt="$cc";;
+       esac
+       rp="Use which C compiler?"
+       . ./myread
+       cc="$ans"
+fi
+: Look for a hint-file generated 'call-back-unit'.  Now that the
+: user has specified the compiler, we may need to set or change some
+: other defaults.
+if $test -f cc.cbu; then
+    . ./cc.cbu
+fi
+echo " "
+echo "Checking for GNU cc in disguise and/or its version number..." >&4
+$cat >gccvers.c <<EOM
+#include <stdio.h>
+int main() {
+#ifdef __GNUC__
+#ifdef __VERSION__
+       printf("%s\n", __VERSION__);
+#else
+       printf("%s\n", "1");
+#endif
+#endif
+       exit(0);
+}
+EOM
+if $cc -o gccvers gccvers.c; then
+       gccversion=`./gccvers`
+       case "$gccversion" in
+       '') echo "You are not using GNU cc." ;;
+       *)  echo "You are using GNU cc $gccversion." ;;
+       esac
+else
+       echo " "
+       echo "*** WHOA THERE!!! ***" >&4
+       echo "    Your C compiler \"$cc\" doesn't seem to be working!" >&4
+       case "$knowitall" in
+       '')
+       echo "    You'd better start hunting for one and let me know about it." >&4
+               exit 1
+               ;;
+       esac
+fi
+$rm -f gccvers*
+case "$gccversion" in
+1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
+esac
+
 cat <<EOM
 
 Perl can be built to take advantage of explicit 64-bit interfaces,
@@ -2645,22 +2983,23 @@ case "$use64bits" in
 : user has specified that a 64 bit perl is to be built,
 : we may need to set or change some other defaults.
        if $test -f use64bits.cbu; then
+               echo "Your platform has some specific hints for 64-bit builds, using them..."
                . ./use64bits.cbu
-       fi
-       case "$osname" in
-       aix|dec_osf|hpux|irix|solaris|unicos)
-               # Known 64-bit capable platforms.
-               ;;
-       *)
-               cat >&4 <<EOM
-$osname is not known to support 64-bit interfaces.
-Please let perlbug@perl.com know how to do that.
-
-Cannot continue, aborting.
+       else
+               $cat <<EOM
+(Your platform doesn't have any specific hints for 64-bit builds.
+ This is probably okay, especially if your system is a true 64-bit system.)
 EOM
-               exit 1
-               ;;
-       esac
+               case "$gccversion" in
+               '')     ;;
+               *)      $cat <<EOM
+But since you seem to be using gcc,
+I will now add -DUSE_LONG_LONG to the compilation flags.
+EOM
+                       ccflags="$ccflags -DUSE_LONG_LONG"
+                       ;;
+               esac
+       fi
        ;;
 esac
 
@@ -3256,97 +3595,37 @@ else
        installarchlib="$archlibexp"
 fi
 
-: make some quick guesses about what we are up against
-echo " "
-$echo $n "Hmm...  $c"
-echo exit 1 >bsd
-echo exit 1 >usg
-echo exit 1 >v7
-echo exit 1 >osf1
-echo exit 1 >eunice
-echo exit 1 >xenix
-echo exit 1 >venix
-echo exit 1 >os2
-d_bsd="$undef"
-$cat /usr/include/signal.h /usr/include/sys/signal.h >foo 2>/dev/null
-if test -f /osf_boot || $contains 'OSF/1' /usr/include/ctype.h >/dev/null 2>&1
-then
-       echo "Looks kind of like an OSF/1 system, but we'll see..."
-       echo exit 0 >osf1
-elif test `echo abc | tr a-z A-Z` = Abc ; then
-       xxx=`./loc addbib blurfl $pth`
-       if $test -f $xxx; then
-       echo "Looks kind of like a USG system with BSD features, but we'll see..."
-               echo exit 0 >bsd
-               echo exit 0 >usg
-       else
-               if $contains SIGTSTP foo >/dev/null 2>&1 ; then
-                       echo "Looks kind of like an extended USG system, but we'll see..."
-               else
-                       echo "Looks kind of like a USG system, but we'll see..."
-               fi
-               echo exit 0 >usg
-       fi
-elif $contains SIGTSTP foo >/dev/null 2>&1 ; then
-       echo "Looks kind of like a BSD system, but we'll see..."
-       d_bsd="$define"
-       echo exit 0 >bsd
-else
-       echo "Looks kind of like a Version 7 system, but we'll see..."
-       echo exit 0 >v7
-fi
-case "$eunicefix" in
-*unixtovms*)
-       $cat <<'EOI'
-There is, however, a strange, musty smell in the air that reminds me of
-something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit.
-EOI
-       echo exit 0 >eunice
-       d_eunice="$define"
-: it so happens the Eunice I know will not run shell scripts in Unix format
-       ;;
-*)
-       echo " "
-       echo "Congratulations.  You aren't running Eunice."
-       d_eunice="$undef"
-       ;;
-esac
-: Detect OS2.  The p_ variable is set above in the Head.U unit.
-case "$p_" in
-:) ;;
-*)
-       $cat <<'EOI'
-I have the feeling something is not exactly right, however...don't tell me...
-lemme think...does HAL ring a bell?...no, of course, you're only running OS/2!
-EOI
-       echo exit 0 >os2
-       ;;
-esac
-if test -f /xenix; then
-       echo "Actually, this looks more like a XENIX system..."
-       echo exit 0 >xenix
-       d_xenix="$define"
-else
-       echo " "
-       echo "It's not Xenix..."
-       d_xenix="$undef"
-fi
-chmod +x xenix
-$eunicefix xenix
-if test -f /venix; then
-       echo "Actually, this looks more like a VENIX system..."
-       echo exit 0 >venix
-else
-       echo " "
-       if ./xenix; then
-               : null
-       else
-               echo "Nor is it Venix..."
-       fi
-fi
-chmod +x bsd usg v7 osf1 eunice xenix venix os2
-$eunicefix bsd usg v7 osf1 eunice xenix venix os2
-$rm -f foo
+
+: Binary compatibility with 5.005 is not possible for builds
+: with advanced features
+case "$usethreads$usemultiplicity" in
+*define*) bincompat5005="$undef" ;;
+*)     $cat <<EOM
+
+Perl 5.006 can be compiled for binary compatibility with 5.005.
+If you decide to do so, you will be able to continue using most
+of the extensions that were compiled for Perl 5.005.
+
+EOM
+       case "$bincompat5005$d_bincompat5005" in
+       *"$undef"*) dflt=n ;;
+       *) dflt=y ;;
+       esac
+       rp='Binary compatibility with Perl 5.005?'
+       . ./myread
+       case "$ans" in
+       y*) val="$define" ;;
+       *)  val="$undef" ;;
+       esac
+       set d_bincompat5005
+       eval $setvar
+       case "$d_bincompat5005" in
+       "$define") bincompat5005="$define" ;;
+       *) bincompat5005="$undef" ;;
+       esac
+       ;;
+esac
+
 
 : see if setuid scripts can be secure
 $cat <<EOM
@@ -3458,258 +3737,6 @@ esac
 set d_dosuid
 eval $setvar
 
-: determine where manual pages are on this system
-echo " "
-case "$sysman" in
-'') 
-       syspath='/usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1'
-       syspath="$syspath /usr/man/u_man/man1 /usr/share/man/man1"
-       syspath="$syspath /usr/catman/u_man/man1 /usr/man/l_man/man1"
-       syspath="$syspath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1"
-       syspath="$syspath /usr/man/man.L /local/man/man1 /usr/local/man/man1"
-       sysman=`./loc . /usr/man/man1 $syspath`
-       ;;
-esac
-if $test -d "$sysman"; then
-       echo "System manual is in $sysman." >&4
-else
-       echo "Could not find manual pages in source form." >&4
-fi
-
-: see what memory models we can support
-case "$models" in
-'')
-       $cat >pdp11.c <<'EOP'
-int main() {
-#ifdef pdp11
-       exit(0);
-#else
-       exit(1);
-#endif
-}
-EOP
-       ( cc -o pdp11 pdp11.c ) >/dev/null 2>&1
-       if $test -f pdp11 && ./pdp11 2>/dev/null; then
-               dflt='unsplit split'
-       else
-               tans=`./loc . X /lib/small /lib/large /usr/lib/small /usr/lib/large /lib/medium /usr/lib/medium /lib/huge`
-               case "$tans" in
-               X) dflt='none';;
-               *) if $test -d /lib/small || $test -d /usr/lib/small; then
-                               dflt='small'
-                       else
-                               dflt=''
-                       fi
-                       if $test -d /lib/medium || $test -d /usr/lib/medium; then
-                               dflt="$dflt medium"
-                       fi
-                       if $test -d /lib/large || $test -d /usr/lib/large; then
-                               dflt="$dflt large"
-                       fi
-                       if $test -d /lib/huge || $test -d /usr/lib/huge; then
-                               dflt="$dflt huge"
-                       fi
-               esac
-       fi;;
-*) dflt="$models";;
-esac
-$cat <<EOM
-Some systems have different model sizes.  On most systems they are called
-small, medium, large, and huge.  On the PDP11 they are called unsplit and
-split.  If your system doesn't support different memory models, say "none".
-If you wish to force everything to one memory model, say "none" here and
-put the appropriate flags later when it asks you for other cc and ld flags.
-Venix systems may wish to put "none" and let the compiler figure things out.
-(In the following question multiple model names should be space separated.)
-
-The default for most systems is "none".
-
-EOM
-rp="Which memory models are supported?"
-. ./myread
-models="$ans"
-
-case "$models" in
-none)
-       small=''
-       medium=''
-       large=''
-       huge=''
-       unsplit=''
-       split=''
-       ;;
-*split)
-       case "$split" in
-       '') if $contains '\-i' $sysman/ld.1 >/dev/null 2>&1 || \
-                        $contains '\-i' $sysman/cc.1 >/dev/null 2>&1; then
-                       dflt='-i'
-               else
-                       dflt='none'
-               fi;;
-       *) dflt="$split";;
-       esac
-       rp="What flag indicates separate I and D space?"
-       . ./myread
-       tans="$ans"
-       case "$tans" in
-       none) tans='';;
-       esac
-       split="$tans"
-       unsplit='';;
-*large*|*small*|*medium*|*huge*)
-       case "$models" in
-       *large*)
-               case "$large" in
-               '') dflt='-Ml';;
-               *) dflt="$large";;
-               esac
-       rp="What flag indicates large model?"
-       . ./myread
-       tans="$ans"
-       case "$tans" in
-       none) tans='';
-       esac
-       large="$tans";;
-       *) large='';;
-       esac
-       case "$models" in
-       *huge*) case "$huge" in
-               '') dflt='-Mh';;
-               *) dflt="$huge";;
-               esac
-               rp="What flag indicates huge model?"
-               . ./myread
-               tans="$ans"
-               case "$tans" in
-               none) tans='';
-               esac
-               huge="$tans";;
-       *) huge="$large";;
-       esac
-       case "$models" in
-       *medium*) case "$medium" in
-               '') dflt='-Mm';;
-               *) dflt="$medium";;
-               esac
-               rp="What flag indicates medium model?"
-               . ./myread
-               tans="$ans"
-               case "$tans" in
-               none) tans='';
-               esac
-               medium="$tans";;
-       *) medium="$large";;
-       esac
-       case "$models" in
-       *small*) case "$small" in
-               '') dflt='none';;
-               *) dflt="$small";;
-               esac
-               rp="What flag indicates small model?"
-               . ./myread
-               tans="$ans"
-               case "$tans" in
-               none) tans='';
-               esac
-               small="$tans";;
-       *) small='';;
-       esac
-       ;;
-*)
-       echo "Unrecognized memory models--you may have to edit Makefile.SH" >&4
-       ;;
-esac
-$rm -f pdp11.* pdp11
-
-: see if we need a special compiler
-echo " "
-if ./usg; then
-       case "$cc" in
-       '') case "$Mcc" in
-               /*) dflt='Mcc';;
-               *) case "$large" in
-                       -M*) dflt='cc';;
-                       *)      if $contains '\-M' $sysman/cc.1 >/dev/null 2>&1 ; then
-                                       if $contains '\-M' $sysman/cpp.1 >/dev/null 2>&1; then
-                                               dflt='cc'
-                                       else
-                                               dflt='cc -M'
-                                       fi
-                               else
-                                       dflt='cc'
-                               fi;;
-                       esac;;
-               esac;;
-       *)  dflt="$cc";;
-       esac
-       case "$dflt" in
-       *M*)    $cat <<'EOM'
-On some older systems the default C compiler will not resolve multiple global
-references that happen to have the same name.  On some such systems the "Mcc"
-command may be used to force these to be resolved.  On other systems a "cc -M"
-command is required.  (Note that the -M flag on other systems indicates a
-memory model to use!) If you have the Gnu C compiler, you might wish to use
-that instead.
-
-EOM
-       ;;
-       esac
-       rp="Use which C compiler?"
-       . ./myread
-       cc="$ans"
-else
-       case "$cc" in
-       '') dflt=cc;;
-       *) dflt="$cc";;
-       esac
-       rp="Use which C compiler?"
-       . ./myread
-       cc="$ans"
-fi
-: Look for a hint-file generated 'call-back-unit'.  Now that the
-: user has specified the compiler, we may need to set or change some
-: other defaults.
-if $test -f cc.cbu; then
-    . ./cc.cbu
-fi
-echo " "
-echo "Checking for GNU cc in disguise and/or its version number..." >&4
-$cat >gccvers.c <<EOM
-#include <stdio.h>
-int main() {
-#ifdef __GNUC__
-#ifdef __VERSION__
-       printf("%s\n", __VERSION__);
-#else
-       printf("%s\n", "1");
-#endif
-#endif
-       exit(0);
-}
-EOM
-if $cc -o gccvers gccvers.c; then
-       gccversion=`./gccvers`
-       case "$gccversion" in
-       '') echo "You are not using GNU cc." ;;
-       *)  echo "You are using GNU cc $gccversion." ;;
-       esac
-else
-       echo " "
-       echo "*** WHOA THERE!!! ***" >&4
-       echo "    Your C compiler \"$cc\" doesn't seem to be working!" >&4
-       case "$knowitall" in
-       '')
-       echo "    You'd better start hunting for one and let me know about it." >&4
-               exit 1
-               ;;
-       esac
-fi
-$rm -f gccvers*
-case "$gccversion" in
-1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
-esac
-
 : What should the include directory be ?
 echo " "
 $echo $n "Hmm...  $c"
@@ -13072,6 +13099,7 @@ awk='$awk'
 baserev='$baserev'
 bash='$bash'
 bin='$bin'
+bincompat5005='$bincompat5005'
 binexp='$binexp'
 bison='$bison'
 byacc='$byacc'
@@ -13116,6 +13144,7 @@ d_archlib='$d_archlib'
 d_attribut='$d_attribut'
 d_bcmp='$d_bcmp'
 d_bcopy='$d_bcopy'
+d_bincompat5005='$d_bincompat5005'
 d_bsd='$d_bsd'
 d_bsdgetpgrp='$d_bsdgetpgrp'
 d_bsdsetpgrp='$d_bsdsetpgrp'
index 0399902..cd7cd60 100644 (file)
@@ -332,7 +332,7 @@ $(LIBPERL_NONSHR): perl$(OBJ_EXT) $(obj)
        $(AR) rcu $(LIBPERL_NONSHR) perl$(OBJ_EXT) $(obj)
 
 $(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT)
-       $(CC) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS)
+       $(CC) $(LDFLAGS) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS)
 
 MINIPERLEXP            = $(MINIPERL_NONSHR)
 
index 25d6942..6a9bb48 100644 (file)
@@ -94,6 +94,10 @@ bin (bin.U):
        is most often a local directory such as /usr/local/bin. Programs using
        this variable must be prepared to deal with ~name substitution.
 
+bincompat5005 (bincompat5005.U):
+       This variable contains y if Perl 5.006 should be binary-compatible
+       with Perl 5.005.
+
 binexp (bin.U):
        This is the same as the bin variable, but is filename expanded at
        configuration time, for use in your makefiles.
@@ -305,6 +309,12 @@ d_bcopy (d_bcopy.U):
        This variable conditionally defines the HAS_BCOPY symbol if
        the bcopy() routine is available to copy strings.
 
+d_bincompat5005 (bincompat5005.U):
+       This variable conditionally defines BINCOMPAT5005 so that embed.h
+       can take special action if Perl 5.006 should be binary-compatible
+       with Perl 5.005.  This is impossible for builds that use features
+       like threads and multiplicity it is always $undef for those versions.
+
 d_bsd (Guess.U):
        This symbol conditionally defines the symbol BSD when running on a
        BSD system.
index 14d1ea2..6957d00 100644 (file)
@@ -8,7 +8,7 @@
 
 # Package name      : perl5
 # Source directory  : .
-# Configuration time: Wed Jul 28 20:34:48 EET DST 1999
+# Configuration time: Fri Jul 30 00:00:04 EET DST 1999
 # Configured by     : jhi
 # Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
 
@@ -41,6 +41,7 @@ awk='awk'
 baserev='5.0'
 bash=''
 bin='/opt/perl/bin'
+bincompat5005='undef'
 binexp='/opt/perl/bin'
 bison=''
 byacc='byacc'
@@ -55,7 +56,7 @@ ccflags='-pthread -std -DLANGUAGE_C'
 ccsymbols='__LANGUAGE_C__=1 _LONGLONG=1 LANGUAGE_C=1 SYSTYPE_BSD=1'
 cf_by='jhi'
 cf_email='yourname@yourhost.yourplace.com'
-cf_time='Wed Jul 28 20:34:48 EET DST 1999'
+cf_time='Fri Jul 30 00:00:04 EET DST 1999'
 chgrp=''
 chmod=''
 chown=''
@@ -85,6 +86,7 @@ d_archlib='define'
 d_attribut='undef'
 d_bcmp='define'
 d_bcopy='define'
+d_bincompat5005=''
 d_bsd='undef'
 d_bsdgetpgrp='undef'
 d_bsdsetpgrp='define'
index 740e7c7..78c1527 100644 (file)
@@ -17,7 +17,7 @@
 /*
  * Package name      : perl5
  * Source directory  : .
- * Configuration time: Wed Jul 28 20:34:48 EET DST 1999
+ * Configuration time: Fri Jul 30 00:00:04 EET DST 1999
  * Configured by     : jhi
  * Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
  */
 #define M_VOID                 /* Xenix strikes again */
 #endif
 
+/* PERL_BINCOMPAT_5005:
+ *     This symbol, if defined, indicates that Perl 5.006 should be
+ *     binary-compatible with Perl 5.005.  This is impossible for builds
+ *     that use features like threads and multiplicity it is always 
+ *     for those versions.
+ */
+# PERL_BINCOMPAT_5005                  /**/
+
 /* DLSYM_NEEDS_UNDERSCORE:
  *     This symbol, if defined, indicates that we need to prepend an
  *     underscore to the symbol name before calling dlsym().  This only
index 4ae2f37..b02e607 100644 (file)
@@ -55,27 +55,21 @@ you believe supports POSIX.1c threads then read on.  Additional
 information may be in a platform-specific "hints" file in the hints/
 subdirectory.
 
-First of all, because threads are such an experimentral feature
-there's a failsafe in Configure that stops unknown platforms
-from using threads.  Search for "is not known to support threads". 
-About five lines above that is a line that has a list of operating
-system names separated with |-signs.  Append your operating system
-(perl -le 'print $^O') to that list.
-
-On other platforms that use Configure to build perl, omit the -d
-from your ./Configure arguments. For example, use:
+On platforms that use Configure to build perl, omit the -d from your
+./Configure arguments. For example, use:
 
     ./Configure -Dusethreads
 
 When Configure prompts you for ccflags, insert any other arguments in
-there that your compiler needs to use POSIX threads. When Configure
-prompts you for linking flags, include any flags required for
-threading (usually nothing special is required here).  Finally, when
-Configure prompts you for libraries, include any necessary libraries
-(e.g. -lpthread).  Pay attention to the order of libraries.  It is
-probably necessary to specify your threading library *before* your
-standard C library, e.g.  it might be necessary to have -lpthread -lc,
-instead of -lc -lpthread.  You may also need to use -lc_r instead
+there that your compiler needs to use POSIX threads (-D_REENTRANT,
+-pthreads, -threads, -pthread, -thread, are good guesses). When
+Configure prompts you for linking flags, include any flags required
+for threading (usually nothing special is required here).  Finally,
+when Configure prompts you for libraries, include any necessary
+libraries (e.g. -lpthread).  Pay attention to the order of libraries.
+It is probably necessary to specify your threading library *before*
+your standard C library, e.g.  it might be necessary to have -lpthread
+-lc, instead of -lc -lpthread.  You may also need to use -lc_r instead
 of -lc.
 
 Once you have specified all your compiler flags, you can have Configure
index 405f896..5019560 100644 (file)
@@ -2143,6 +2143,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
 #define M_VOID                 /* Xenix strikes again */
 #endif
 
+/* PERL_BINCOMPAT_5005:
+ *     This symbol, if defined, indicates that Perl 5.006 should be
+ *     binary-compatible with Perl 5.005.  This is impossible for builds
+ *     that use features like threads and multiplicity it is always $undef
+ *     for those versions.
+ */
+#$d_bincompat5005 PERL_BINCOMPAT_5005                  /**/
+
 /* DLSYM_NEEDS_UNDERSCORE:
  *     This symbol, if defined, indicates that we need to prepend an
  *     underscore to the symbol name before calling dlsym().  This only
index 661a1ac..ec13498 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1572,10 +1572,10 @@ p       |OP*    |scalar         |OP* o
 p      |OP*    |scalarkids     |OP* o
 p      |OP*    |scalarseq      |OP* o
 p      |OP*    |scalarvoid     |OP* o
-p      |UV     |scan_bin       |char* start|I32 len|I32* retlen
-p      |UV     |scan_hex       |char* start|I32 len|I32* retlen
+p      |NV     |scan_bin       |char* start|I32 len|I32* retlen
+p      |NV     |scan_hex       |char* start|I32 len|I32* retlen
 p      |char*  |scan_num       |char* s
-p      |UV     |scan_oct       |char* start|I32 len|I32* retlen
+p      |NV     |scan_oct       |char* start|I32 len|I32* retlen
 p      |OP*    |scope          |OP* o
 p      |char*  |screaminstr    |SV* bigsv|SV* littlesv|I32 start_shift \
                                |I32 end_shift|I32 *state|I32 last
index afce3f1..7494785 100644 (file)
@@ -16,7 +16,6 @@ WriteMakefile(
               XSPROTOARG => '-noprototypes',           # XXX remove later?
               VERSION_FROM => 'SDBM_File.pm',
               DEFINE => $define,
-             PERL_MALLOC_OK => 1,
              );
 
 sub MY::postamble {
index 236db7d..9b4f5e2 100644 (file)
@@ -285,19 +285,6 @@ rm -f core
 # XXX
 EOSH
 
-# Damon.Atkins@nabaus.com.au 19-Mar-1999
-# Large Files Support
-if [ -x /usr/bin/getconf ] ; then
-    ccflags="$ccflags `/usr/bin/getconf LFS_CFLAGS`"
-    [ "X${ccflags}"    = "X " ]    && ccflags=''
-    ldflags="$ldflags `/usr/bin/getconf LFS_LDFLAGS`"
-    [ "X${ldflags}" = "X " ]       && ldflags=''
-    libswanted="$libswanted `/usr/bin/getconf LFS_LIBS`"
-    [ "X${libswanted}" = "X " ]    && libswanted=''
-    lintflags="$lintflags `/usr/bin/getconf LFS_LINTFLAGS`"
-    [ "X${lintflags}"  = "X " ]    && lintflags=''
-fi
-
 # This script UU/usethreads.cbu will get 'called-back' by Configure 
 # after it has prompted the user for whether to use threads.
 cat > UU/usethreads.cbu <<'EOCBU'
@@ -360,9 +347,10 @@ EOM
                exit 1
                ;;
            esac
-           ccflags="$ccflags `getconf LFS_CFLAGS` -DUSE_LONG_LONG"
+           ccflags="$ccflags `getconf LFS_CFLAGS`"
            ldflags="$ldflags `getconf LFS_LDFLAGS`"
            libswanted="$libswanted `getconf LFS_LIBS`"
+           ccflags="$ccflags -DUSE_LONG_LONG"
            # When a 64-bit cc becomes available $archname64
            # may need setting so that $archname gets it attached.
            ;;
index 855a703..b4bf41c 100644 (file)
@@ -388,18 +388,12 @@ sub cflags {
        $self->{CCFLAGS} .= ' -DPERL_POLLUTE ';
     }
 
-    my $pollute = '';
-    if ($Config{usemymalloc} and $self->{PERL_MALLOC_OK}) {
-       $pollute = '$(PERL_MALLOC_DEF)';
-    }
-
     return $self->{CFLAGS} = qq{
 CCFLAGS = $self->{CCFLAGS}
 OPTIMIZE = $self->{OPTIMIZE}
 PERLTYPE = $self->{PERLTYPE}
 LARGE = $self->{LARGE}
 SPLIT = $self->{SPLIT}
-MPOLLUTE = $pollute
 };
 
 }
@@ -456,7 +450,7 @@ sub const_cccmd {
     return '' unless $self->needs_linking();
     return $self->{CONST_CCCMD} =
        q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\
-       $(PERLTYPE) $(LARGE) $(SPLIT) $(MPOLLUTE) $(DEFINE_VERSION) \\
+       $(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \\
        $(XS_DEFINE_VERSION)};
 }
 
@@ -541,7 +535,6 @@ VERSION_MACRO = VERSION
 DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
 XS_VERSION_MACRO = XS_VERSION
 XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
-PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
 };
 
     push @m, qq{
index 6318d0e..ad1944c 100644 (file)
@@ -250,7 +250,6 @@ sub full_setup {
     INST_HTMLLIBDIR INST_HTMLSCRIPTDIR
     INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIB LIBPERL_A LIBS
     LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
-    PERL_MALLOC_OK
     NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC
     PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX
     PL_FILES PM PMLIBDIRS POLLUTE PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREFIX
@@ -1485,34 +1484,6 @@ Directory, where executable files should be installed during
 testing. make install will copy the files in INST_SCRIPT to
 INSTALLSCRIPT.
 
-=item PERL_MALLOC_OK
-
-defaults to 0.  Should be set to TRUE if the extension can work with
-the memory allocation routines substituted by the Perl malloc() subsystem.
-This should be applicable to most extensions with exceptions of those
-
-=over
-
-=item *
-
-with bugs in memory allocations which are caught by Perl's malloc();
-
-=item *
-
-which interact with the memory allocator in other ways than via
-malloc(), realloc(), free(), calloc(), sbrk() and brk();
-
-=item *
-
-which rely on special alignment which is not provided by Perl's malloc().
-
-=back
-
-B<NOTE.>  Negligence to set this flag in I<any one> of loaded extension
-nullifies many advantages of Perl's malloc(), such as better usage of
-system resources, error detection, memory usage reporting, catchable failure
-of memory allocations, etc.
-
 =item LDFROM
 
 defaults to "$(OBJECT)" and is used in the ld command to specify
index 5eda5a3..0b43a36 100644 (file)
@@ -5,5 +5,4 @@ WriteMakefile(
              VERSION => '0.21',
              MAN3PODS  => ' ',         # Pods will be built by installman.
              XSPROTOARG => '-noprototypes',
-             PERL_MALLOC_OK => 1,
 );
diff --git a/perl.h b/perl.h
index 6891b37..9972c7d 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -507,12 +507,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 
 #ifdef MYMALLOC
 #  ifdef PERL_POLLUTE_MALLOC
-#   ifndef PERL_EXTMALLOC_DEF
 #    define Perl_malloc                malloc
 #    define Perl_calloc                calloc
 #    define Perl_realloc       realloc
 #    define Perl_mfree         free
-#   endif
 #  else
 #    define EMBEDMYMALLOC      /* for compatibility */
 #  endif
@@ -1027,6 +1025,8 @@ Free_t   Perl_mfree (Malloc_t where);
 #    define UV_MAX PERL_UQUAD_MAX
 #    define UV_MIN PERL_UQUAD_MIN
 #  endif
+#  define IV_SIZEOF 8
+#  define UV_SIZEOF 8
 #else
    typedef          long               IV;
    typedef         unsigned long      UV;
@@ -1041,6 +1041,8 @@ Free_t   Perl_mfree (Malloc_t where);
 #    define UV_MAX PERL_ULONG_MAX
 #    define UV_MIN PERL_ULONG_MIN
 #  endif
+#  define UV_SIZEOF LONGSIZE
+#  define IV_SIZEOF LONGSIZE
 #endif
 
 #ifdef USE_LONG_DOUBLE
index 260d62a..ad0abcc 100644 (file)
@@ -141,13 +141,6 @@ C<oct()>:
     $answer = 0b101010;
     printf "The answer is: %b\n", oct("0b101010");
 
-=head2 Literal hexadecimal, octal, and binary numbers must fit within native sizes
-
-The warning that used to be produced when encountering hexadecimal, octal,
-and binary literals that are too large to be represented as native integers
-has now been promoted to a fatal error.  Literal decimal numbers are
-unaffected.
-
 =head2 syswrite() ease-of-use
 
 The length argument of C<syswrite()> is now optional.
index 7a7b129..47e16bf 100644 (file)
@@ -472,9 +472,9 @@ likely depends on its correct operation, Perl just gave up.
 
 =item Binary number > 0b11111111111111111111111111111111 non-portable
 
-(W) The binary number you specified is larger than 2**32-1 and therefore
-generally non-portable between systems.  See L<perlport> for more on
-portability concerns.
+(W) The binary number you specified is larger than 2**32-1
+(4294967295) and therefore non-portable between systems.  See
+L<perlport> for more on portability concerns.
 
 =item bind() on closed fd
 
@@ -1426,9 +1426,9 @@ is now heavily deprecated.
 
 =item Hexadecimal number > 0xffffffff non-portable
 
-(W) The hexadecimal number you specified is larger than 2**32-1 and
-therefore non-portable between systems.  See L<perlport> for more on
-portability concerns.
+(W) The hexadecimal number you specified is larger than 2**32-1
+(4294967295) and therefore non-portable between systems.  See
+L<perlport> for more on portability concerns.
 
 =item Identifier too long
 
@@ -1544,18 +1544,15 @@ known value, using trustworthy data.  See L<perlsec>.
 
 =item Integer overflow in %s number
 
-(F,X) The hexadecimal, octal or binary number you have specified
-either as a literal in your code or as a scalar is too big for your
-architecture. On a 32-bit architecture the largest literal hex, octal
-or binary number representable without overflow is 0xFFFFFFFF,
-037777777777, or 0b11111111111111111111111111111111 respectively.
-Note that Perl transparently promotes decimal literals to a floating
-point representation internally--subject to loss of precision errors
-in subsequent operations--so this limit usually doesn't apply to
-decimal literals.  If the overflow is in a literal of your code, the
-error is untrappable (there is no way the code could work safely in
-your system), if the overflow happens in hex() or oct() the error is
-trappable.
+(W) The hexadecimal, octal or binary number you have specified either
+as a literal in your code or as a scalar is too big for your
+architecture, and has been converted to a floating point number.  On a
+32-bit architecture the largest hexadecimal, octal or binary number
+representable without overflow is 0xFFFFFFFF, 037777777777, or
+0b11111111111111111111111111111111 respectively.  Note that Perl
+transparently promotes all numbers to a floating point representation
+internally--subject to loss of precision errors in subsequent
+operations.
 
 =item Internal inconsistency in tracking vforks
 
@@ -1982,9 +1979,9 @@ try using scientific notation (e.g. "1e6" instead of "1_000_000").
 
 =item Octal number > 037777777777 non-portable
 
-(W) The octal number you specified is larger than 2**32-1 and
-therefore non-portable between systems.  See L<perlport> for more on
-portability concerns.
+(W) The octal number you specified is larger than 2**32-1 (4294967295)
+and therefore non-portable between systems.  See L<perlport> for more
+on portability concerns.
 
 =item Odd number of elements in hash assignment
 
diff --git a/pp.c b/pp.c
index 770b07d..18c875b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1885,14 +1885,14 @@ PP(pp_hex)
     STRLEN n_a;
 
     tmps = POPpx;
-    XPUSHu(scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype));
+    XPUSHn(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
 
 PP(pp_oct)
 {
     djSP; dTARGET;
-    UV value;
+    NV value;
     I32 argtype;
     char *tmps;
     STRLEN n_a;
@@ -1900,15 +1900,15 @@ PP(pp_oct)
     tmps = POPpx;
     while (*tmps && isSPACE(*tmps))
        tmps++;
-    /* Do not eat the leading 0[bx] because we need them
-     * to detect malformed binary and hexadecimal numbers. */
-    if ((tmps[0] == '0' && tmps[1] == 'x') || tmps[0] == 'x')
-       value = scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype);
-    else if ((tmps[0] == '0' && tmps[1] == 'b') || tmps[0] == 'b')
-       value = scan_bin(tmps, sizeof(UV) * 8 + 1, &argtype);
+    if (*tmps == '0')
+       tmps++;
+    if (*tmps == 'x')
+       value = scan_hex(++tmps, 99, &argtype);
+    else if (*tmps == 'b')
+       value = scan_bin(++tmps, 99, &argtype);
     else
-       value = scan_oct(tmps, sizeof(UV) * 4 + 1, &argtype);
-    XPUSHu(value);
+       value = scan_oct(tmps, 99, &argtype);
+    XPUSHn(value);
     RETURN;
 }
 
diff --git a/proto.h b/proto.h
index 90b2500..bdb0ea0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -536,10 +536,10 @@ VIRTUAL OP*       Perl_scalar(pTHX_ OP* o);
 VIRTUAL OP*    Perl_scalarkids(pTHX_ OP* o);
 VIRTUAL OP*    Perl_scalarseq(pTHX_ OP* o);
 VIRTUAL OP*    Perl_scalarvoid(pTHX_ OP* o);
-VIRTUAL UV     Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen);
-VIRTUAL UV     Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen);
+VIRTUAL NV     Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen);
+VIRTUAL NV     Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen);
 VIRTUAL char*  Perl_scan_num(pTHX_ char* s);
-VIRTUAL UV     Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen);
+VIRTUAL NV     Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen);
 VIRTUAL OP*    Perl_scope(pTHX_ OP* o);
 VIRTUAL char*  Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last);
 #if !defined(VMS)
index 4e5c1c1..bb5f8f8 100644 (file)
@@ -33,97 +33,29 @@ SANYUTF8    REG_ANY,    no  Match any one Unicode character.
 ANYOF          ANYOF,  sv      Match character in (or not in) this class.
 ANYOFUTF8      ANYOF,  sv 1    Match character in (or not in) this class.
 ALNUM          ALNUM,  no      Match any alphanumeric character
-ALNUMUTF8      ALNUM,  no      Match any alphanumeric character
+ALNUMUTF8      ALNUM,  no      Match any alphanumeric character in utf8
 ALNUML         ALNUM,  no      Match any alphanumeric char in locale
-ALNUMLUTF8     ALNUM,  no      Match any alphanumeric char in locale
+ALNUMLUTF8     ALNUM,  no      Match any alphanumeric char in locale+utf8
 NALNUM         NALNUM, no      Match any non-alphanumeric character
-NALNUMUTF8     NALNUM, no      Match any non-alphanumeric character
+NALNUMUTF8     NALNUM, no      Match any non-alphanumeric character in utf8
 NALNUML                NALNUM, no      Match any non-alphanumeric char in locale
-NALNUMLUTF8    NALNUM, no      Match any non-alphanumeric char in locale
+NALNUMLUTF8    NALNUM, no      Match any non-alphanumeric char in locale+utf8
 SPACE          SPACE,  no      Match any whitespace character
-SPACEUTF8      SPACE,  no      Match any whitespace character
+SPACEUTF8      SPACE,  no      Match any whitespace character in utf8
 SPACEL         SPACE,  no      Match any whitespace char in locale
-SPACELUTF8     SPACE,  no      Match any whitespace char in locale
+SPACELUTF8     SPACE,  no      Match any whitespace char in locale+utf8
 NSPACE         NSPACE, no      Match any non-whitespace character
-NSPACEUTF8     NSPACE, no      Match any non-whitespace character
+NSPACEUTF8     NSPACE, no      Match any non-whitespace character in utf8
 NSPACEL                NSPACE, no      Match any non-whitespace char in locale
-NSPACELUTF8    NSPACE, no      Match any non-whitespace char in locale
+NSPACELUTF8    NSPACE, no      Match any non-whitespace char in locale+utf8
 DIGIT          DIGIT,  no      Match any numeric character
-DIGITUTF8      DIGIT,  no      Match any numeric character
+DIGITUTF8      DIGIT,  no      Match any numeric character in utf8
 DIGITL         DIGIT,  no      Match any numeric character in locale
-DIGITLUTF8     DIGIT,  no      Match any numeric character in locale
+DIGITLUTF8     DIGIT,  no      Match any numeric character in locale+utf8
 NDIGIT         NDIGIT, no      Match any non-numeric character
-NDIGITUTF8     NDIGIT, no      Match any non-numeric character
+NDIGITUTF8     NDIGIT, no      Match any non-numeric character in utf8
 NDIGITL                NDIGIT, no      Match any non-numeric character in locale
-NDIGITLUTF8    NDIGIT, no      Match any non-numeric character in locale
-ALNUMC         ALNUMC,  no     Match any alphanumeric character
-ALNUMCUTF8     ALNUMC,  no     Match any alphanumeric character
-ALNUMCL                ALNUMC,  no     Match any alphanumeric character in locale
-ALNUMCLUTF8    ALNUMC,  no     Match any alphanumeric character in locale
-NALNUMC                NALNUMC, no     Match any non-alphanumeric character
-NALNUMCUTF8    NALNUMC, no     Match any non-alphanumeric character
-NALNUMCL       NALNUMC, no     Match any non-alphanumeric character in locale
-NALNUMCLUTF8   NALNUMC, no     Match any non-alphanumeric character in locale
-ALPHA          ALPHA,  no      Match any alphabetic character
-ALPHAUTF8      ALPHA,  no      Match any alphabetic character
-ALPHAL         ALPHA,  no      Match any alphabetic character in locale
-ALPHALUTF8     ALPHA,  no      Match any alphabetic character in locale
-NALPHA         NALPHA, no      Match any non-alphabetic character
-NALPHAUTF8     NALPHA, no      Match any non-alphabetic character
-NALPHAL                NALPHA, no      Match any non-alphabetic character in locale
-NALPHALUTF8    NALPHA, no      Match any non-alphabetic character in locale
-ASCII          ASCII,  no      Match any ASCII character
-NASCII         NASCII, no      Match any non-ASCII character
-CNTRL          CNTRL,  no      Match any control character
-CNTRLUTF8      CNTRL,  no      Match any control character
-CNTRLL         CNTRL,  no      Match any control character in locale
-CNTRLLUTF8     CNTRL,  no      Match any control character in locale
-NCNTRL         NCNTRL, no      Match any non-control character
-NCNTRLUTF8     NCNTRL, no      Match any non-control character
-NCNTRLL                NCNTRL, no      Match any non-control character in locale
-NCNTRLLUTF8    NCNTRL, no      Match any non-control character in locale
-GRAPH          GRAPH,  no      Match any graphical character
-GRAPHUTF8      GRAPH,  no      Match any graphical character
-GRAPHL         GRAPH,  no      Match any graphical character in locale
-GRAPHLUTF8     GRAPH,  no      Match any graphical character in locale
-NGRAPH         NGRAPH, no      Match any non-graphical character
-NGRAPHUTF8     NGRAPH, no      Match any non-graphical character
-NGRAPHL                NGRAPH, no      Match any non-graphical character in locale
-NGRAPHLUTF8    NGRAPH, no      Match any non-graphical character in locale
-LOWER          LOWER,  no      Match any lowercase character
-LOWERUTF8      LOWER,  no      Match any lowercase character
-LOWERL         LOWER,  no      Match any lowercase character in locale
-LOWERLUTF8     LOWER,  no      Match any lowercase character in locale
-NLOWER         NLOWER, no      Match any non-lowercase character
-NLOWERUTF8     NLOWER, no      Match any non-lowercase character
-NLOWERL                NLOWER, no      Match any non-lowercase character in locale
-NLOWERLUTF8    NLOWER, no      Match any non-lowercase character in locale
-PRINT          PRINT,  no      Match any printable character
-PRINTUTF8      PRINT,  no      Match any printable character
-PRINTL         PRINT,  no      Match any printable character in locale
-PRINTLUTF8     PRINT,  no      Match any printable character in locale
-NPRINT         NPRINT, no      Match any non-printable character
-NPRINTUTF8     NPRINT, no      Match any non-printable character
-NPRINTL                NPRINT, no      Match any non-printable character in locale
-NPRINTLUTF8    NPRINT, no      Match any non-printable character in locale
-PUNCT          PUNCT,  no      Match any punctuation character
-PUNCTUTF8      PUNCT,  no      Match any punctuation character
-PUNCTL         PUNCT,  no      Match any punctuation character in locale
-PUNCTLUTF8     PUNCT,  no      Match any punctuation character in locale
-NPUNCT         NPUNCT, no      Match any non-punctuation character
-NPUNCTUTF8     NPUNCT, no      Match any non-punctuation character
-NPUNCTL                NPUNCT, no      Match any non-punctuation character in locale
-NPUNCTLUTF8    NPUNCT, no      Match any non-punctuation character in locale
-UPPER          UPPER,  no      Match any uppercase character
-UPPERUTF8      UPPER,  no      Match any uppercase character
-UPPERL         UPPER,  no      Match any uppercase character in locale
-UPPERLUTF8     UPPER,  no      Match any uppercase character in locale
-NUPPER         NUPPER, no      Match any non-uppercase character
-NUPPERUTF8     NUPPER, no      Match any non-uppercase character
-NUPPERL                NUPPER, no      Match any non-uppercase character in locale
-NUPPERLUTF8    NUPPER, no      Match any non-uppercase character in locale
-XDIGIT         XDIGIT,  no     Match any hexdigit character
-NXDIGIT                NXDIGIT, no     Match any non-hexdigit character
+NDIGITLUTF8    NDIGIT, no      Match any non-numeric character in locale+utf8
 CLUMP          CLUMP,  no      Match any combining character sequence
 
 # BRANCH       The set of branches constituting a single choice are hooked
index b464a40..9a7e91b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1322,1772 +1322,475 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                s += UTF8SKIP(s);
            }
            break;
-       case ALNUMC:
-           while (s < strend) {
-               if (isALNUMC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case ALNUMCUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_alnumc, (U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case ALNUMCL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isALNUMC_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case ALNUMCLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isALNUMC_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NALNUMC:
-           while (s < strend) {
-               if (!isALNUMC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
+       }
+    }
+    else {
+       dontbother = 0;
+       if (prog->float_substr != Nullsv) {     /* Trim the end. */
+           char *last;
+           I32 oldpos = scream_pos;
+
+           if (flags & REXEC_SCREAM) {
+               last = screaminstr(sv, prog->float_substr, s - strbeg,
+                                  end_shift, &scream_pos, 1); /* last one */
+               if (!last)
+                   last = scream_olds; /* Only one occurence. */
            }
-           break;
-       case NALNUMCUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_alnumc, (U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
+           else {
+               STRLEN len;
+               char *little = SvPV(prog->float_substr, len);
+
+               if (SvTAIL(prog->float_substr)) {
+                   if (memEQ(strend - len + 1, little, len - 1))
+                       last = strend - len + 1;
+                   else if (!PL_multiline)
+                       last = memEQ(strend - len, little, len) 
+                           ? strend - len : Nullch;
                    else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NALNUMCL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isALNUMC_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
+                       goto find_last;
+               } else {
+                 find_last:
+                   if (len) 
+                       last = rninstr(s, strend, little, little + len);
                    else
-                       tmp = doevery;
+                       last = strend;  /* matching `$' */
                }
-               else
-                   tmp = 1;
-               s++;
            }
-           break;
-       case NALNUMCLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isALNUMC_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
+           if (last == NULL) goto phooey; /* Should not happen! */
+           dontbother = strend - last + prog->float_min_offset;
+       }
+       if (minlen && (dontbother < minlen))
+           dontbother = minlen - 1;
+       strend -= dontbother;              /* this one's always in bytes! */
+       /* We don't know much -- general case. */
+       if (UTF) {
+           for (;;) {
+               if (regtry(prog, s))
+                   goto got_it;
+               if (s >= strend)
+                   break;
                s += UTF8SKIP(s);
+           };
+       }
+       else {
+           do {
+               if (regtry(prog, s))
+                   goto got_it;
+           } while (s++ < strend);
+       }
+    }
+
+    /* Failure. */
+    goto phooey;
+
+got_it:
+    RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
+
+    if (PL_reg_eval_set) {
+       /* Preserve the current value of $^R */
+       if (oreplsv != GvSV(PL_replgv))
+           sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
+                                                 restored, the value remains
+                                                 the same. */
+       restore_pos(aTHXo_ 0);
+    }
+
+    /* make sure $`, $&, $', and $digit will work later */
+    if ( !(flags & REXEC_NOT_FIRST) ) {
+       if (RX_MATCH_COPIED(prog)) {
+           Safefree(prog->subbeg);
+           RX_MATCH_COPIED_off(prog);
+       }
+       if (flags & REXEC_COPY_STR) {
+           I32 i = PL_regeol - startpos + (stringarg - strbeg);
+
+           s = savepvn(strbeg, i);
+           prog->subbeg = s;
+           prog->sublen = i;
+           RX_MATCH_COPIED_on(prog);
+       }
+       else {
+           prog->subbeg = strbeg;
+           prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
+       }
+    }
+    
+    return 1;
+
+phooey:
+    if (PL_reg_eval_set)
+       restore_pos(aTHXo_ 0);
+    return 0;
+}
+
+/*
+ - regtry - try match at specific point
+ */
+STATIC I32                     /* 0 failure, 1 success */
+S_regtry(pTHX_ regexp *prog, char *startpos)
+{
+    dTHR;
+    register I32 i;
+    register I32 *sp;
+    register I32 *ep;
+    CHECKPOINT lastcp;
+
+    if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
+       MAGIC *mg;
+
+       PL_reg_eval_set = RS_init;
+       DEBUG_r(DEBUG_s(
+           PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
+                         PL_stack_sp - PL_stack_base);
+           ));
+       SAVEINT(cxstack[cxstack_ix].blk_oldsp);
+       cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
+       /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
+       SAVETMPS;
+       /* Apparently this is not needed, judging by wantarray. */
+       /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
+          cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
+
+       if (PL_reg_sv) {
+           /* Make $_ available to executed code. */
+           if (PL_reg_sv != DEFSV) {
+               /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+               SAVESPTR(DEFSV);
+               DEFSV = PL_reg_sv;
            }
-           break;
-       case ASCII:
-           while (s < strend) {
-               if (isASCII(*(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NASCII:
-           while (s < strend) {
-               if (!isASCII(*(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case CNTRL:
-           while (s < strend) {
-               if (isCNTRL(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case CNTRLUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_cntrl,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case CNTRLL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isCNTRL_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case CNTRLLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isCNTRL_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NCNTRL:
-           while (s < strend) {
-               if (!isCNTRL(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NCNTRLUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_cntrl,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NCNTRLL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isCNTRL_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NCNTRLLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isCNTRL_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case GRAPH:
-           while (s < strend) {
-               if (isGRAPH(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case GRAPHUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_graph,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case GRAPHL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isGRAPH_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case GRAPHLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isGRAPH_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NGRAPH:
-           while (s < strend) {
-               if (!isGRAPH(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NGRAPHUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_graph,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NGRAPHL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isGRAPH_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NGRAPHLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isGRAPH_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case LOWER:
-           while (s < strend) {
-               if (isLOWER(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case LOWERUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_lower,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case LOWERL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isLOWER_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case LOWERLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isLOWER_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NLOWER:
-           while (s < strend) {
-               if (!isLOWER(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NLOWERUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_lower,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NLOWERL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isLOWER_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NLOWERLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isLOWER_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case PRINT:
-           while (s < strend) {
-               if (isPRINT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case PRINTUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_print,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case PRINTL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isPRINT_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case PRINTLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isPRINT_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NPRINT:
-           while (s < strend) {
-               if (!isPRINT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NPRINTUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_print,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NPRINTL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isPRINT_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NPRINTLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isPRINT_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case PUNCT:
-           while (s < strend) {
-               if (isPUNCT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case PUNCTUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_punct,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case PUNCTL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isPUNCT_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case PUNCTLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isPUNCT_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NPUNCT:
-           while (s < strend) {
-               if (!isPUNCT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NPUNCTUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_punct,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NPUNCTL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isPUNCT_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NPUNCTLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isPUNCT_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case UPPER:
-           while (s < strend) {
-               if (isUPPER(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case UPPERUTF8:
-           while (s < strend) {
-               if (swash_fetch(PL_utf8_upper,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case UPPERL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (isUPPER_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case UPPERLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (*s == ' ' || isUPPER_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NUPPER:
-           while (s < strend) {
-               if (!isUPPER(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NUPPERUTF8:
-           while (s < strend) {
-               if (!swash_fetch(PL_utf8_upper,(U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case NUPPERL:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isUPPER_LC(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NUPPERLUTF8:
-           PL_reg_flags |= RF_tainted;
-           while (s < strend) {
-               if (!isUPPER_LC_utf8((U8*)s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s += UTF8SKIP(s);
-           }
-           break;
-       case XDIGIT:
-           while (s < strend) {
-               if (isXDIGIT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       case NXDIGIT:
-           while (s < strend) {
-               if (!isXDIGIT(*s)) {
-                   if (tmp && regtry(prog, s))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else
-                   tmp = 1;
-               s++;
-           }
-           break;
-       }
-    }
-    else {
-       dontbother = 0;
-       if (prog->float_substr != Nullsv) {     /* Trim the end. */
-           char *last;
-           I32 oldpos = scream_pos;
-
-           if (flags & REXEC_SCREAM) {
-               last = screaminstr(sv, prog->float_substr, s - strbeg,
-                                  end_shift, &scream_pos, 1); /* last one */
-               if (!last)
-                   last = scream_olds; /* Only one occurence. */
-           }
-           else {
-               STRLEN len;
-               char *little = SvPV(prog->float_substr, len);
-
-               if (SvTAIL(prog->float_substr)) {
-                   if (memEQ(strend - len + 1, little, len - 1))
-                       last = strend - len + 1;
-                   else if (!PL_multiline)
-                       last = memEQ(strend - len, little, len) 
-                           ? strend - len : Nullch;
-                   else
-                       goto find_last;
-               } else {
-                 find_last:
-                   if (len) 
-                       last = rninstr(s, strend, little, little + len);
-                   else
-                       last = strend;  /* matching `$' */
-               }
-           }
-           if (last == NULL) goto phooey; /* Should not happen! */
-           dontbother = strend - last + prog->float_min_offset;
-       }
-       if (minlen && (dontbother < minlen))
-           dontbother = minlen - 1;
-       strend -= dontbother;              /* this one's always in bytes! */
-       /* We don't know much -- general case. */
-       if (UTF) {
-           for (;;) {
-               if (regtry(prog, s))
-                   goto got_it;
-               if (s >= strend)
-                   break;
-               s += UTF8SKIP(s);
-           };
-       }
-       else {
-           do {
-               if (regtry(prog, s))
-                   goto got_it;
-           } while (s++ < strend);
-       }
-    }
-
-    /* Failure. */
-    goto phooey;
-
-got_it:
-    RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
-
-    if (PL_reg_eval_set) {
-       /* Preserve the current value of $^R */
-       if (oreplsv != GvSV(PL_replgv))
-           sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
-                                                 restored, the value remains
-                                                 the same. */
-       restore_pos(aTHXo_ 0);
-    }
-
-    /* make sure $`, $&, $', and $digit will work later */
-    if ( !(flags & REXEC_NOT_FIRST) ) {
-       if (RX_MATCH_COPIED(prog)) {
-           Safefree(prog->subbeg);
-           RX_MATCH_COPIED_off(prog);
-       }
-       if (flags & REXEC_COPY_STR) {
-           I32 i = PL_regeol - startpos + (stringarg - strbeg);
-
-           s = savepvn(strbeg, i);
-           prog->subbeg = s;
-           prog->sublen = i;
-           RX_MATCH_COPIED_on(prog);
-       }
-       else {
-           prog->subbeg = strbeg;
-           prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
-       }
-    }
-    
-    return 1;
-
-phooey:
-    if (PL_reg_eval_set)
-       restore_pos(aTHXo_ 0);
-    return 0;
-}
-
-/*
- - regtry - try match at specific point
- */
-STATIC I32                     /* 0 failure, 1 success */
-S_regtry(pTHX_ regexp *prog, char *startpos)
-{
-    dTHR;
-    register I32 i;
-    register I32 *sp;
-    register I32 *ep;
-    CHECKPOINT lastcp;
-
-    if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
-       MAGIC *mg;
-
-       PL_reg_eval_set = RS_init;
-       DEBUG_r(DEBUG_s(
-           PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
-                         PL_stack_sp - PL_stack_base);
-           ));
-       SAVEINT(cxstack[cxstack_ix].blk_oldsp);
-       cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
-       /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
-       SAVETMPS;
-       /* Apparently this is not needed, judging by wantarray. */
-       /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
-          cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
-
-       if (PL_reg_sv) {
-           /* Make $_ available to executed code. */
-           if (PL_reg_sv != DEFSV) {
-               /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
-               SAVESPTR(DEFSV);
-               DEFSV = PL_reg_sv;
-           }
-       
-           if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) 
-                 && (mg = mg_find(PL_reg_sv, 'g')))) {
-               /* prepare for quick setting of pos */
-               sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0);
-               mg = mg_find(PL_reg_sv, 'g');
-               mg->mg_len = -1;
-           }
-           PL_reg_magic    = mg;
-           PL_reg_oldpos   = mg->mg_len;
-           SAVEDESTRUCTOR(restore_pos, 0);
-        }
-       if (!PL_reg_curpm)
-           New(22,PL_reg_curpm, 1, PMOP);
-       PL_reg_curpm->op_pmregexp = prog;
-       PL_reg_oldcurpm = PL_curpm;
-       PL_curpm = PL_reg_curpm;
-       if (RX_MATCH_COPIED(prog)) {
-           /*  Here is a serious problem: we cannot rewrite subbeg,
-               since it may be needed if this match fails.  Thus
-               $` inside (?{}) could fail... */
-           PL_reg_oldsaved = prog->subbeg;
-           PL_reg_oldsavedlen = prog->sublen;
-           RX_MATCH_COPIED_off(prog);
-       }
-       else
-           PL_reg_oldsaved = Nullch;
-       prog->subbeg = PL_bostr;
-       prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
-    }
-    prog->startp[0] = startpos - PL_bostr;
-    PL_reginput = startpos;
-    PL_regstartp = prog->startp;
-    PL_regendp = prog->endp;
-    PL_reglastparen = &prog->lastparen;
-    prog->lastparen = 0;
-    PL_regsize = 0;
-    DEBUG_r(PL_reg_starttry = startpos);
-    if (PL_reg_start_tmpl <= prog->nparens) {
-       PL_reg_start_tmpl = prog->nparens*3/2 + 3;
-        if(PL_reg_start_tmp)
-            Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
-        else
-            New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
-    }
-
-    /* XXXX What this code is doing here?!!!  There should be no need
-       to do this again and again, PL_reglastparen should take care of
-       this!  */
-    sp = prog->startp;
-    ep = prog->endp;
-    if (prog->nparens) {
-       for (i = prog->nparens; i >= 1; i--) {
-           *++sp = -1;
-           *++ep = -1;
-       }
-    }
-    REGCP_SET;
-    if (regmatch(prog->program + 1)) {
-       prog->endp[0] = PL_reginput - PL_bostr;
-       return 1;
-    }
-    REGCP_UNWIND;
-    return 0;
-}
-
-/*
- - regmatch - main matching routine
- *
- * Conceptually the strategy is simple:  check to see whether the current
- * node matches, call self recursively to see whether the rest matches,
- * and then act accordingly.  In practice we make some effort to avoid
- * recursion, in particular by going through "ordinary" nodes (that don't
- * need to know whether the rest of the match failed) by a loop instead of
- * by recursion.
- */
-/* [lwall] I've hoisted the register declarations to the outer block in order to
- * maybe save a little bit of pushing and popping on the stack.  It also takes
- * advantage of machines that use a register save mask on subroutine entry.
- */
-STATIC I32                     /* 0 failure, 1 success */
-S_regmatch(pTHX_ regnode *prog)
-{
-    dTHR;
-    register regnode *scan;    /* Current node. */
-    regnode *next;             /* Next node. */
-    regnode *inner;            /* Next node in internal branch. */
-    register I32 nextchr;      /* renamed nextchr - nextchar colides with
-                                  function of same name */
-    register I32 n;            /* no or next */
-    register I32 ln;           /* len or last */
-    register char *s;          /* operand or save */
-    register char *locinput = PL_reginput;
-    register I32 c1, c2, paren;        /* case fold search, parenth */
-    int minmod = 0, sw = 0, logical = 0;
-#ifdef DEBUGGING
-    PL_regindent++;
-#endif
-
-    /* Note that nextchr is a byte even in UTF */
-    nextchr = UCHARAT(locinput);
-    scan = prog;
-    while (scan != NULL) {
-#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
-#ifdef DEBUGGING
-#  define sayYES goto yes
-#  define sayNO goto no
-#  define saySAME(x) if (x) goto yes; else goto no
-#  define REPORT_CODE_OFF 24
-#else
-#  define sayYES return 1
-#  define sayNO return 0
-#  define saySAME(x) return x
-#endif
-       DEBUG_r( {
-           SV *prop = sv_newmortal();
-           int docolor = *PL_colors[0];
-           int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
-           int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
-           /* The part of the string before starttry has one color
-              (pref0_len chars), between starttry and current
-              position another one (pref_len - pref0_len chars),
-              after the current position the third one.
-              We assume that pref0_len <= pref_len, otherwise we
-              decrease pref0_len.  */
-           int pref_len = (locinput - PL_bostr > (5 + taill) - l 
-                           ? (5 + taill) - l : locinput - PL_bostr);
-           int pref0_len = pref_len  - (locinput - PL_reg_starttry);
-
-           if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
-               l = ( PL_regeol - locinput > (5 + taill) - pref_len 
-                     ? (5 + taill) - pref_len : PL_regeol - locinput);
-           if (pref0_len < 0)
-               pref0_len = 0;
-           if (pref0_len > pref_len)
-               pref0_len = pref_len;
-           regprop(prop, scan);
-           PerlIO_printf(Perl_debug_log, 
-                         "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
-                         locinput - PL_bostr, 
-                         PL_colors[4], pref0_len, 
-                         locinput - pref_len, PL_colors[5],
-                         PL_colors[2], pref_len - pref0_len, 
-                         locinput - pref_len + pref0_len, PL_colors[3],
-                         (docolor ? "" : "> <"),
-                         PL_colors[0], l, locinput, PL_colors[1],
-                         15 - l - pref_len + 1,
-                         "",
-                         scan - PL_regprogram, PL_regindent*2, "",
-                         SvPVX(prop));
-       } );
-
-       next = scan + NEXT_OFF(scan);
-       if (next == scan)
-           next = NULL;
-
-       switch (OP(scan)) {
-       case BOL:
-           if (locinput == PL_bostr
-               ? PL_regprev == '\n'
-               : (PL_multiline && 
-                  (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
-           {
-               /* regtill = regbol; */
-               break;
-           }
-           sayNO;
-       case MBOL:
-           if (locinput == PL_bostr
-               ? PL_regprev == '\n'
-               : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
-           {
-               break;
-           }
-           sayNO;
-       case SBOL:
-           if (locinput == PL_regbol && PL_regprev == '\n')
-               break;
-           sayNO;
-       case GPOS:
-           if (locinput == PL_reg_ganch)
-               break;
-           sayNO;
-       case EOL:
-           if (PL_multiline)
-               goto meol;
-           else
-               goto seol;
-       case MEOL:
-         meol:
-           if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
-               sayNO;
-           break;
-       case SEOL:
-         seol:
-           if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
-               sayNO;
-           if (PL_regeol - locinput > 1)
-               sayNO;
-           break;
-       case EOS:
-           if (PL_regeol != locinput)
-               sayNO;
-           break;
-       case SANYUTF8:
-           if (nextchr & 0x80) {
-               locinput += PL_utf8skip[nextchr];
-               if (locinput > PL_regeol)
-                   sayNO;
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case SANY:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ANYUTF8:
-           if (nextchr & 0x80) {
-               locinput += PL_utf8skip[nextchr];
-               if (locinput > PL_regeol)
-                   sayNO;
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case REG_ANY:
-           if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case EXACT:
-           s = (char *) OPERAND(scan);
-           ln = UCHARAT(s++);
-           /* Inline the first character, for speed. */
-           if (UCHARAT(s) != nextchr)
-               sayNO;
-           if (PL_regeol - locinput < ln)
-               sayNO;
-           if (ln > 1 && memNE(s, locinput, ln))
-               sayNO;
-           locinput += ln;
-           nextchr = UCHARAT(locinput);
-           break;
-       case EXACTFL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case EXACTF:
-           s = (char *) OPERAND(scan);
-           ln = UCHARAT(s++);
-
-           if (UTF) {
-               char *l = locinput;
-               char *e = s + ln;
-               c1 = OP(scan) == EXACTF;
-               while (s < e) {
-                   if (l >= PL_regeol)
-                       sayNO;
-                   if (utf8_to_uv((U8*)s, 0) != (c1 ?
-                                                 toLOWER_utf8((U8*)l) :
-                                                 toLOWER_LC_utf8((U8*)l)))
-                   {
-                       sayNO;
-                   }
-                   s += UTF8SKIP(s);
-                   l += UTF8SKIP(l);
-               }
-               locinput = l;
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-
-           /* Inline the first character, for speed. */
-           if (UCHARAT(s) != nextchr &&
-               UCHARAT(s) != ((OP(scan) == EXACTF)
-                              ? PL_fold : PL_fold_locale)[nextchr])
-               sayNO;
-           if (PL_regeol - locinput < ln)
-               sayNO;
-           if (ln > 1 && (OP(scan) == EXACTF
-                          ? ibcmp(s, locinput, ln)
-                          : ibcmp_locale(s, locinput, ln)))
-               sayNO;
-           locinput += ln;
-           nextchr = UCHARAT(locinput);
-           break;
-       case ANYOFUTF8:
-           s = (char *) OPERAND(scan);
-           if (!REGINCLASSUTF8(scan, (U8*)locinput))
-               sayNO;
-           if (locinput >= PL_regeol)
-               sayNO;
-           locinput += PL_utf8skip[nextchr];
-           nextchr = UCHARAT(locinput);
-           break;
-       case ANYOF:
-           s = (char *) OPERAND(scan);
-           if (nextchr < 0)
-               nextchr = UCHARAT(locinput);
-           if (!REGINCLASS(s, nextchr))
-               sayNO;
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALNUML:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALNUM:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == ALNUM
-                 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALNUMLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALNUMUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == ALNUMUTF8
-                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
-                     : isALNUM_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (!(OP(scan) == ALNUMUTF8
-                 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALNUML:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALNUM:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (OP(scan) == NALNUM
-               ? isALNUM(nextchr) : isALNUM_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALNUMLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALNUMUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (OP(scan) == NALNUMUTF8
-                   ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
-                   : isALNUM_LC_utf8((U8*)locinput))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (OP(scan) == NALNUMUTF8
-               ? isALNUM(nextchr) : isALNUM_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case BOUNDL:
-       case NBOUNDL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case BOUND:
-       case NBOUND:
-           /* was last char in word? */
-           ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
-           if (OP(scan) == BOUND || OP(scan) == NBOUND) {
-               ln = isALNUM(ln);
-               n = isALNUM(nextchr);
-           }
-           else {
-               ln = isALNUM_LC(ln);
-               n = isALNUM_LC(nextchr);
-           }
-           if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
-               sayNO;
-           break;
-       case BOUNDLUTF8:
-       case NBOUNDLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case BOUNDUTF8:
-       case NBOUNDUTF8:
-           /* was last char in word? */
-           ln = (locinput != PL_regbol)
-               ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
-           if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
-               ln = isALNUM_uni(ln);
-               n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
-           }
-           else {
-               ln = isALNUM_LC_uni(ln);
-               n = isALNUM_LC_utf8((U8*)locinput);
-           }
-           if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
-               sayNO;
-           break;
-       case SPACEL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case SPACE:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (!(OP(scan) == SPACE
-                 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case SPACELUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case SPACEUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == SPACEUTF8
-                     ? swash_fetch(PL_utf8_space,(U8*)locinput)
-                     : isSPACE_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (!(OP(scan) == SPACEUTF8
-                 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NSPACEL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NSPACE:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == SPACE
-               ? isSPACE(nextchr) : isSPACE_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NSPACELUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NSPACEUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (OP(scan) == NSPACEUTF8
-                   ? swash_fetch(PL_utf8_space,(U8*)locinput)
-                   : isSPACE_LC_utf8((U8*)locinput))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (OP(scan) == NSPACEUTF8
-               ? isSPACE(nextchr) : isSPACE_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case DIGITL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case DIGIT:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (!(OP(scan) == DIGIT
-                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case DIGITLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case DIGITUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (OP(scan) == NDIGITUTF8
-                   ? swash_fetch(PL_utf8_digit,(U8*)locinput)
-                   : isDIGIT_LC_utf8((U8*)locinput))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (!isDIGIT(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NDIGITL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NDIGIT:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == DIGIT
-               ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NDIGITLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NDIGITUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_digit,(U8*)locinput))
-                   sayNO;
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (isDIGIT(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALNUMCL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALNUMC:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == ALNUMC
-                 ? isALNUMC(nextchr) : isALNUMC_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALNUMCLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALNUMCUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == ALNUMCUTF8
-                     ? swash_fetch(PL_utf8_alnumc, (U8*)locinput)
-                     : isALNUMC_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
+       
+           if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) 
+                 && (mg = mg_find(PL_reg_sv, 'g')))) {
+               /* prepare for quick setting of pos */
+               sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0);
+               mg = mg_find(PL_reg_sv, 'g');
+               mg->mg_len = -1;
            }
-           if (!(OP(scan) == ALNUMCUTF8
-                 ? isALNUMC(nextchr) : isALNUMC_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALNUMCL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALNUMC:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == ALNUMC
-               ? isALNUMC(nextchr) : isALNUMC_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALNUMCLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALNUMCUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_alnumc,(U8*)locinput))
-                   sayNO;
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
+           PL_reg_magic    = mg;
+           PL_reg_oldpos   = mg->mg_len;
+           SAVEDESTRUCTOR(restore_pos, 0);
+        }
+       if (!PL_reg_curpm)
+           New(22,PL_reg_curpm, 1, PMOP);
+       PL_reg_curpm->op_pmregexp = prog;
+       PL_reg_oldcurpm = PL_curpm;
+       PL_curpm = PL_reg_curpm;
+       if (RX_MATCH_COPIED(prog)) {
+           /*  Here is a serious problem: we cannot rewrite subbeg,
+               since it may be needed if this match fails.  Thus
+               $` inside (?{}) could fail... */
+           PL_reg_oldsaved = prog->subbeg;
+           PL_reg_oldsavedlen = prog->sublen;
+           RX_MATCH_COPIED_off(prog);
+       }
+       else
+           PL_reg_oldsaved = Nullch;
+       prog->subbeg = PL_bostr;
+       prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
+    }
+    prog->startp[0] = startpos - PL_bostr;
+    PL_reginput = startpos;
+    PL_regstartp = prog->startp;
+    PL_regendp = prog->endp;
+    PL_reglastparen = &prog->lastparen;
+    prog->lastparen = 0;
+    PL_regsize = 0;
+    DEBUG_r(PL_reg_starttry = startpos);
+    if (PL_reg_start_tmpl <= prog->nparens) {
+       PL_reg_start_tmpl = prog->nparens*3/2 + 3;
+        if(PL_reg_start_tmp)
+            Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
+        else
+            New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
+    }
+
+    /* XXXX What this code is doing here?!!!  There should be no need
+       to do this again and again, PL_reglastparen should take care of
+       this!  */
+    sp = prog->startp;
+    ep = prog->endp;
+    if (prog->nparens) {
+       for (i = prog->nparens; i >= 1; i--) {
+           *++sp = -1;
+           *++ep = -1;
+       }
+    }
+    REGCP_SET;
+    if (regmatch(prog->program + 1)) {
+       prog->endp[0] = PL_reginput - PL_bostr;
+       return 1;
+    }
+    REGCP_UNWIND;
+    return 0;
+}
+
+/*
+ - regmatch - main matching routine
+ *
+ * Conceptually the strategy is simple:  check to see whether the current
+ * node matches, call self recursively to see whether the rest matches,
+ * and then act accordingly.  In practice we make some effort to avoid
+ * recursion, in particular by going through "ordinary" nodes (that don't
+ * need to know whether the rest of the match failed) by a loop instead of
+ * by recursion.
+ */
+/* [lwall] I've hoisted the register declarations to the outer block in order to
+ * maybe save a little bit of pushing and popping on the stack.  It also takes
+ * advantage of machines that use a register save mask on subroutine entry.
+ */
+STATIC I32                     /* 0 failure, 1 success */
+S_regmatch(pTHX_ regnode *prog)
+{
+    dTHR;
+    register regnode *scan;    /* Current node. */
+    regnode *next;             /* Next node. */
+    regnode *inner;            /* Next node in internal branch. */
+    register I32 nextchr;      /* renamed nextchr - nextchar colides with
+                                  function of same name */
+    register I32 n;            /* no or next */
+    register I32 ln;           /* len or last */
+    register char *s;          /* operand or save */
+    register char *locinput = PL_reginput;
+    register I32 c1, c2, paren;        /* case fold search, parenth */
+    int minmod = 0, sw = 0, logical = 0;
+#ifdef DEBUGGING
+    PL_regindent++;
+#endif
+
+    /* Note that nextchr is a byte even in UTF */
+    nextchr = UCHARAT(locinput);
+    scan = prog;
+    while (scan != NULL) {
+#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
+#ifdef DEBUGGING
+#  define sayYES goto yes
+#  define sayNO goto no
+#  define saySAME(x) if (x) goto yes; else goto no
+#  define REPORT_CODE_OFF 24
+#else
+#  define sayYES return 1
+#  define sayNO return 0
+#  define saySAME(x) return x
+#endif
+       DEBUG_r( {
+           SV *prop = sv_newmortal();
+           int docolor = *PL_colors[0];
+           int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
+           int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
+           /* The part of the string before starttry has one color
+              (pref0_len chars), between starttry and current
+              position another one (pref_len - pref0_len chars),
+              after the current position the third one.
+              We assume that pref0_len <= pref_len, otherwise we
+              decrease pref0_len.  */
+           int pref_len = (locinput - PL_bostr > (5 + taill) - l 
+                           ? (5 + taill) - l : locinput - PL_bostr);
+           int pref0_len = pref_len  - (locinput - PL_reg_starttry);
+
+           if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
+               l = ( PL_regeol - locinput > (5 + taill) - pref_len 
+                     ? (5 + taill) - pref_len : PL_regeol - locinput);
+           if (pref0_len < 0)
+               pref0_len = 0;
+           if (pref0_len > pref_len)
+               pref0_len = pref_len;
+           regprop(prop, scan);
+           PerlIO_printf(Perl_debug_log, 
+                         "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
+                         locinput - PL_bostr, 
+                         PL_colors[4], pref0_len, 
+                         locinput - pref_len, PL_colors[5],
+                         PL_colors[2], pref_len - pref0_len, 
+                         locinput - pref_len + pref0_len, PL_colors[3],
+                         (docolor ? "" : "> <"),
+                         PL_colors[0], l, locinput, PL_colors[1],
+                         15 - l - pref_len + 1,
+                         "",
+                         scan - PL_regprogram, PL_regindent*2, "",
+                         SvPVX(prop));
+       } );
+
+       next = scan + NEXT_OFF(scan);
+       if (next == scan)
+           next = NULL;
+
+       switch (OP(scan)) {
+       case BOL:
+           if (locinput == PL_bostr
+               ? PL_regprev == '\n'
+               : (PL_multiline && 
+                  (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
+           {
+               /* regtill = regbol; */
                break;
            }
-           if (isALNUMC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALPHAL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALPHA:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == ALPHA
-                 ? isALPHA(nextchr) : isALPHA_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ALPHALUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case ALPHAUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == ALPHAUTF8
-                     ? swash_fetch(PL_utf8_alpha, (U8*)locinput)
-                     : isALPHA_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
+           sayNO;
+       case MBOL:
+           if (locinput == PL_bostr
+               ? PL_regprev == '\n'
+               : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
+           {
                break;
            }
-           if (!(OP(scan) == ALPHAUTF8
-                 ? isALPHA(nextchr) : isALPHA_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALPHAL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALPHA:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == ALPHA
-               ? isALPHA(nextchr) : isALPHA_LC(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NALPHALUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NALPHAUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_alpha,(U8*)locinput))
-                   sayNO;
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
+           sayNO;
+       case SBOL:
+           if (locinput == PL_regbol && PL_regprev == '\n')
                break;
-           }
-           if (isALPHA(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case ASCII:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (!isASCII(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NASCII:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (isASCII(nextchr))
+           sayNO;
+       case GPOS:
+           if (locinput == PL_reg_ganch)
+               break;
+           sayNO;
+       case EOL:
+           if (PL_multiline)
+               goto meol;
+           else
+               goto seol;
+       case MEOL:
+         meol:
+           if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
                sayNO;
-           nextchr = UCHARAT(++locinput);
            break;
-       case CNTRLL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case CNTRL:
-           if (!nextchr)
+       case SEOL:
+         seol:
+           if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
                sayNO;
-           if (!(OP(scan) == CNTRL
-                 ? isCNTRL(nextchr) : isCNTRL_LC(nextchr)))
+           if (PL_regeol - locinput > 1)
                sayNO;
-           nextchr = UCHARAT(++locinput);
            break;
-       case CNTRLLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case CNTRLUTF8:
-           if (!nextchr)
+       case EOS:
+           if (PL_regeol != locinput)
                sayNO;
+           break;
+       case SANYUTF8:
            if (nextchr & 0x80) {
-               if (!(OP(scan) == CNTRLUTF8
-                     ? swash_fetch(PL_utf8_cntrl, (U8*)locinput)
-                     : isCNTRL_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
                locinput += PL_utf8skip[nextchr];
+               if (locinput > PL_regeol)
+                   sayNO;
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (!(OP(scan) == CNTRLUTF8
-                 ? isCNTRL(nextchr) : isCNTRL_LC(nextchr)))
+           if (!nextchr && locinput >= PL_regeol)
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NCNTRLL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NCNTRL:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == CNTRL
-               ? isCNTRL(nextchr) : isCNTRL_LC(nextchr))
+       case SANY:
+           if (!nextchr && locinput >= PL_regeol)
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NCNTRLLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NCNTRLUTF8:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
+       case ANYUTF8:
            if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_cntrl,(U8*)locinput))
-                   sayNO;
                locinput += PL_utf8skip[nextchr];
+               if (locinput > PL_regeol)
+                   sayNO;
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (isCNTRL(nextchr))
+           if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case GRAPHL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case GRAPH:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == GRAPH
-                 ? isGRAPH(nextchr) : isGRAPH_LC(nextchr)))
+       case REG_ANY:
+           if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case GRAPHLUTF8:
+       case EXACT:
+           s = (char *) OPERAND(scan);
+           ln = UCHARAT(s++);
+           /* Inline the first character, for speed. */
+           if (UCHARAT(s) != nextchr)
+               sayNO;
+           if (PL_regeol - locinput < ln)
+               sayNO;
+           if (ln > 1 && memNE(s, locinput, ln))
+               sayNO;
+           locinput += ln;
+           nextchr = UCHARAT(locinput);
+           break;
+       case EXACTFL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case GRAPHUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == GRAPHUTF8
-                     ? swash_fetch(PL_utf8_graph, (U8*)locinput)
-                     : isGRAPH_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
+       case EXACTF:
+           s = (char *) OPERAND(scan);
+           ln = UCHARAT(s++);
+
+           if (UTF) {
+               char *l = locinput;
+               char *e = s + ln;
+               c1 = OP(scan) == EXACTF;
+               while (s < e) {
+                   if (l >= PL_regeol)
+                       sayNO;
+                   if (utf8_to_uv((U8*)s, 0) != (c1 ?
+                                                 toLOWER_utf8((U8*)l) :
+                                                 toLOWER_LC_utf8((U8*)l)))
+                   {
+                       sayNO;
+                   }
+                   s += UTF8SKIP(s);
+                   l += UTF8SKIP(l);
                }
-               locinput += PL_utf8skip[nextchr];
+               locinput = l;
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (!(OP(scan) == GRAPHUTF8
-                 ? isGRAPH(nextchr) : isGRAPH_LC(nextchr)))
+
+           /* Inline the first character, for speed. */
+           if (UCHARAT(s) != nextchr &&
+               UCHARAT(s) != ((OP(scan) == EXACTF)
+                              ? PL_fold : PL_fold_locale)[nextchr])
                sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NGRAPHL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NGRAPH:
-           if (!nextchr)
+           if (PL_regeol - locinput < ln)
                sayNO;
-           if (OP(scan) == GRAPH
-               ? isGRAPH(nextchr) : isGRAPH_LC(nextchr))
+           if (ln > 1 && (OP(scan) == EXACTF
+                          ? ibcmp(s, locinput, ln)
+                          : ibcmp_locale(s, locinput, ln)))
                sayNO;
-           nextchr = UCHARAT(++locinput);
+           locinput += ln;
+           nextchr = UCHARAT(locinput);
            break;
-       case NGRAPHLUTF8:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NGRAPHUTF8:
-           if (!nextchr && locinput >= PL_regeol)
+       case ANYOFUTF8:
+           s = (char *) OPERAND(scan);
+           if (!REGINCLASSUTF8(scan, (U8*)locinput))
                sayNO;
-           if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_graph,(U8*)locinput))
-                   sayNO;
-               locinput += PL_utf8skip[nextchr];
+           if (locinput >= PL_regeol)
+               sayNO;
+           locinput += PL_utf8skip[nextchr];
+           nextchr = UCHARAT(locinput);
+           break;
+       case ANYOF:
+           s = (char *) OPERAND(scan);
+           if (nextchr < 0)
                nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (isGRAPH(nextchr))
+           if (!REGINCLASS(s, nextchr))
+               sayNO;
+           if (!nextchr && locinput >= PL_regeol)
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case LOWERL:
+       case ALNUML:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case LOWER:
+       case ALNUM:
            if (!nextchr)
                sayNO;
-           if (!(OP(scan) == LOWER
-                 ? isLOWER(nextchr) : isLOWER_LC(nextchr)))
+           if (!(OP(scan) == ALNUM
+                 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case LOWERLUTF8:
+       case ALNUMLUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case LOWERUTF8:
+       case ALNUMUTF8:
            if (!nextchr)
                sayNO;
            if (nextchr & 0x80) {
-               if (!(OP(scan) == LOWERUTF8
-                     ? swash_fetch(PL_utf8_lower, (U8*)locinput)
-                     : isLOWER_LC_utf8((U8*)locinput)))
+               if (!(OP(scan) == ALNUMUTF8
+                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
+                     : isALNUM_LC_utf8((U8*)locinput)))
                {
                    sayNO;
                }
@@ -3095,121 +1798,137 @@ S_regmatch(pTHX_ regnode *prog)
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (!(OP(scan) == LOWERUTF8
-                 ? isLOWER(nextchr) : isLOWER_LC(nextchr)))
+           if (!(OP(scan) == ALNUMUTF8
+                 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NLOWERL:
+       case NALNUML:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NLOWER:
-           if (!nextchr)
+       case NALNUM:
+           if (!nextchr && locinput >= PL_regeol)
                sayNO;
-           if (OP(scan) == LOWER
-               ? isLOWER(nextchr) : isLOWER_LC(nextchr))
+           if (OP(scan) == NALNUM
+               ? isALNUM(nextchr) : isALNUM_LC(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NLOWERLUTF8:
+       case NALNUMLUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NLOWERUTF8:
+       case NALNUMUTF8:
            if (!nextchr && locinput >= PL_regeol)
                sayNO;
            if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_lower,(U8*)locinput))
+               if (OP(scan) == NALNUMUTF8
+                   ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
+                   : isALNUM_LC_utf8((U8*)locinput))
+               {
                    sayNO;
+               }
                locinput += PL_utf8skip[nextchr];
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (isLOWER(nextchr))
+           if (OP(scan) == NALNUMUTF8
+               ? isALNUM(nextchr) : isALNUM_LC(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case PRINTL:
+       case BOUNDL:
+       case NBOUNDL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case PRINT:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == PRINT
-                 ? isPRINT(nextchr) : isPRINT_LC(nextchr)))
+       case BOUND:
+       case NBOUND:
+           /* was last char in word? */
+           ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
+           if (OP(scan) == BOUND || OP(scan) == NBOUND) {
+               ln = isALNUM(ln);
+               n = isALNUM(nextchr);
+           }
+           else {
+               ln = isALNUM_LC(ln);
+               n = isALNUM_LC(nextchr);
+           }
+           if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
                sayNO;
-           nextchr = UCHARAT(++locinput);
            break;
-       case PRINTLUTF8:
+       case BOUNDLUTF8:
+       case NBOUNDLUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case PRINTUTF8:
-           if (!nextchr)
-               sayNO;
-           if (nextchr & 0x80) {
-               if (!(OP(scan) == PRINTUTF8
-                     ? swash_fetch(PL_utf8_print, (U8*)locinput)
-                     : isPRINT_LC_utf8((U8*)locinput)))
-               {
-                   sayNO;
-               }
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
+       case BOUNDUTF8:
+       case NBOUNDUTF8:
+           /* was last char in word? */
+           ln = (locinput != PL_regbol)
+               ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
+           if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
+               ln = isALNUM_uni(ln);
+               n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
            }
-           if (!(OP(scan) == PRINTUTF8
-                 ? isPRINT(nextchr) : isPRINT_LC(nextchr)))
+           else {
+               ln = isALNUM_LC_uni(ln);
+               n = isALNUM_LC_utf8((U8*)locinput);
+           }
+           if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
                sayNO;
-           nextchr = UCHARAT(++locinput);
            break;
-       case NPRINTL:
+       case SPACEL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NPRINT:
-           if (!nextchr)
+       case SPACE:
+           if (!nextchr && locinput >= PL_regeol)
                sayNO;
-           if (OP(scan) == PRINT
-               ? isPRINT(nextchr) : isPRINT_LC(nextchr))
+           if (!(OP(scan) == SPACE
+                 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NPRINTLUTF8:
+       case SPACELUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NPRINTUTF8:
+       case SPACEUTF8:
            if (!nextchr && locinput >= PL_regeol)
                sayNO;
            if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_print,(U8*)locinput))
+               if (!(OP(scan) == SPACEUTF8
+                     ? swash_fetch(PL_utf8_space,(U8*)locinput)
+                     : isSPACE_LC_utf8((U8*)locinput)))
+               {
                    sayNO;
+               }
                locinput += PL_utf8skip[nextchr];
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (isPRINT(nextchr))
+           if (!(OP(scan) == SPACEUTF8
+                 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case PUNCTL:
+       case NSPACEL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case PUNCT:
+       case NSPACE:
            if (!nextchr)
                sayNO;
-           if (!(OP(scan) == PUNCT
-                 ? isPUNCT(nextchr) : isPUNCT_LC(nextchr)))
+           if (OP(scan) == SPACE
+               ? isSPACE(nextchr) : isSPACE_LC(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case PUNCTLUTF8:
+       case NSPACELUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case PUNCTUTF8:
+       case NSPACEUTF8:
            if (!nextchr)
                sayNO;
            if (nextchr & 0x80) {
-               if (!(OP(scan) == PUNCTUTF8
-                     ? swash_fetch(PL_utf8_punct, (U8*)locinput)
-                     : isPUNCT_LC_utf8((U8*)locinput)))
+               if (OP(scan) == NSPACEUTF8
+                   ? swash_fetch(PL_utf8_space,(U8*)locinput)
+                   : isSPACE_LC_utf8((U8*)locinput))
                {
                    sayNO;
                }
@@ -3217,60 +1936,32 @@ S_regmatch(pTHX_ regnode *prog)
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (!(OP(scan) == PUNCTUTF8
-                 ? isPUNCT(nextchr) : isPUNCT_LC(nextchr)))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NPUNCTL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case NPUNCT:
-           if (!nextchr)
-               sayNO;
-           if (OP(scan) == PUNCT
-               ? isPUNCT(nextchr) : isPUNCT_LC(nextchr))
+           if (OP(scan) == NSPACEUTF8
+               ? isSPACE(nextchr) : isSPACE_LC(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NPUNCTLUTF8:
+       case DIGITL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NPUNCTUTF8:
+       case DIGIT:
            if (!nextchr && locinput >= PL_regeol)
                sayNO;
-           if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_punct,(U8*)locinput))
-                   sayNO;
-               locinput += PL_utf8skip[nextchr];
-               nextchr = UCHARAT(locinput);
-               break;
-           }
-           if (isPUNCT(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case UPPERL:
-           PL_reg_flags |= RF_tainted;
-           /* FALL THROUGH */
-       case UPPER:
-           if (!nextchr)
-               sayNO;
-           if (!(OP(scan) == UPPER
-                 ? isUPPER(nextchr) : isUPPER_LC(nextchr)))
+           if (!(OP(scan) == DIGIT
+                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case UPPERLUTF8:
+       case DIGITLUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case UPPERUTF8:
+       case DIGITUTF8:
            if (!nextchr)
                sayNO;
            if (nextchr & 0x80) {
-               if (!(OP(scan) == UPPERUTF8
-                     ? swash_fetch(PL_utf8_upper, (U8*)locinput)
-                     : isUPPER_LC_utf8((U8*)locinput)))
+               if (OP(scan) == NDIGITUTF8
+                   ? swash_fetch(PL_utf8_digit,(U8*)locinput)
+                   : isDIGIT_LC_utf8((U8*)locinput))
                {
                    sayNO;
                }
@@ -3278,50 +1969,35 @@ S_regmatch(pTHX_ regnode *prog)
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (!(OP(scan) == UPPERUTF8
-                 ? isUPPER(nextchr) : isUPPER_LC(nextchr)))
+           if (!isDIGIT(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NUPPERL:
+       case NDIGITL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NUPPER:
+       case NDIGIT:
            if (!nextchr)
                sayNO;
-           if (OP(scan) == UPPER
-               ? isUPPER(nextchr) : isUPPER_LC(nextchr))
+           if (OP(scan) == DIGIT
+               ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
-       case NUPPERLUTF8:
+       case NDIGITLUTF8:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
-       case NUPPERUTF8:
+       case NDIGITUTF8:
            if (!nextchr && locinput >= PL_regeol)
                sayNO;
            if (nextchr & 0x80) {
-               if (swash_fetch(PL_utf8_upper,(U8*)locinput))
+               if (swash_fetch(PL_utf8_digit,(U8*)locinput))
                    sayNO;
                locinput += PL_utf8skip[nextchr];
                nextchr = UCHARAT(locinput);
                break;
            }
-           if (isUPPER(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case XDIGIT:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (!isXDIGIT(nextchr))
-               sayNO;
-           nextchr = UCHARAT(++locinput);
-           break;
-       case NXDIGIT:
-           if (!nextchr && locinput >= PL_regeol)
-               sayNO;
-           if (isXDIGIT(nextchr))
+           if (isDIGIT(nextchr))
                sayNO;
            nextchr = UCHARAT(++locinput);
            break;
index cdc6dd4..c5725cd 100644 (file)
 #define        ANYOF   22      /* 0x16 Match character in (or not in) this class. */
 #define        ANYOFUTF8       23      /* 0x17 Match character in (or not in) this class. */
 #define        ALNUM   24      /* 0x18 Match any alphanumeric character */
-#define        ALNUMUTF8       25      /* 0x19 Match any alphanumeric character */
+#define        ALNUMUTF8       25      /* 0x19 Match any alphanumeric character in utf8 */
 #define        ALNUML  26      /* 0x1a Match any alphanumeric char in locale */
-#define        ALNUMLUTF8      27      /* 0x1b Match any alphanumeric char in locale */
+#define        ALNUMLUTF8      27      /* 0x1b Match any alphanumeric char in locale+utf8 */
 #define        NALNUM  28      /* 0x1c Match any non-alphanumeric character */
-#define        NALNUMUTF8      29      /* 0x1d Match any non-alphanumeric character */
+#define        NALNUMUTF8      29      /* 0x1d Match any non-alphanumeric character in utf8 */
 #define        NALNUML 30      /* 0x1e Match any non-alphanumeric char in locale */
-#define        NALNUMLUTF8     31      /* 0x1f Match any non-alphanumeric char in locale */
+#define        NALNUMLUTF8     31      /* 0x1f Match any non-alphanumeric char in locale+utf8 */
 #define        SPACE   32      /* 0x20 Match any whitespace character */
-#define        SPACEUTF8       33      /* 0x21 Match any whitespace character */
+#define        SPACEUTF8       33      /* 0x21 Match any whitespace character in utf8 */
 #define        SPACEL  34      /* 0x22 Match any whitespace char in locale */
-#define        SPACELUTF8      35      /* 0x23 Match any whitespace char in locale */
+#define        SPACELUTF8      35      /* 0x23 Match any whitespace char in locale+utf8 */
 #define        NSPACE  36      /* 0x24 Match any non-whitespace character */
-#define        NSPACEUTF8      37      /* 0x25 Match any non-whitespace character */
+#define        NSPACEUTF8      37      /* 0x25 Match any non-whitespace character in utf8 */
 #define        NSPACEL 38      /* 0x26 Match any non-whitespace char in locale */
-#define        NSPACELUTF8     39      /* 0x27 Match any non-whitespace char in locale */
+#define        NSPACELUTF8     39      /* 0x27 Match any non-whitespace char in locale+utf8 */
 #define        DIGIT   40      /* 0x28 Match any numeric character */
-#define        DIGITUTF8       41      /* 0x29 Match any numeric character */
+#define        DIGITUTF8       41      /* 0x29 Match any numeric character in utf8 */
 #define        DIGITL  42      /* 0x2a Match any numeric character in locale */
-#define        DIGITLUTF8      43      /* 0x2b Match any numeric character in locale */
+#define        DIGITLUTF8      43      /* 0x2b Match any numeric character in locale+utf8 */
 #define        NDIGIT  44      /* 0x2c Match any non-numeric character */
-#define        NDIGITUTF8      45      /* 0x2d Match any non-numeric character */
+#define        NDIGITUTF8      45      /* 0x2d Match any non-numeric character in utf8 */
 #define        NDIGITL 46      /* 0x2e Match any non-numeric character in locale */
-#define        NDIGITLUTF8     47      /* 0x2f Match any non-numeric character in locale */
-#define        ALNUMC  48      /* 0x30 Match any alphanumeric character */
-#define        ALNUMCUTF8      49      /* 0x31 Match any alphanumeric character */
-#define        ALNUMCL 50      /* 0x32 Match any alphanumeric character in locale */
-#define        ALNUMCLUTF8     51      /* 0x33 Match any alphanumeric character in locale */
-#define        NALNUMC 52      /* 0x34 Match any non-alphanumeric character */
-#define        NALNUMCUTF8     53      /* 0x35 Match any non-alphanumeric character */
-#define        NALNUMCL        54      /* 0x36 Match any non-alphanumeric character in locale */
-#define        NALNUMCLUTF8    55      /* 0x37 Match any non-alphanumeric character in locale */
-#define        ALPHA   56      /* 0x38 Match any alphabetic character */
-#define        ALPHAUTF8       57      /* 0x39 Match any alphabetic character */
-#define        ALPHAL  58      /* 0x3a Match any alphabetic character in locale */
-#define        ALPHALUTF8      59      /* 0x3b Match any alphabetic character in locale */
-#define        NALPHA  60      /* 0x3c Match any non-alphabetic character */
-#define        NALPHAUTF8      61      /* 0x3d Match any non-alphabetic character */
-#define        NALPHAL 62      /* 0x3e Match any non-alphabetic character in locale */
-#define        NALPHALUTF8     63      /* 0x3f Match any non-alphabetic character in locale */
-#define        ASCII   64      /* 0x40 Match any ASCII character */
-#define        NASCII  65      /* 0x41 Match any non-ASCII character */
-#define        CNTRL   66      /* 0x42 Match any control character */
-#define        CNTRLUTF8       67      /* 0x43 Match any control character */
-#define        CNTRLL  68      /* 0x44 Match any control character in locale */
-#define        CNTRLLUTF8      69      /* 0x45 Match any control character in locale */
-#define        NCNTRL  70      /* 0x46 Match any non-control character */
-#define        NCNTRLUTF8      71      /* 0x47 Match any non-control character */
-#define        NCNTRLL 72      /* 0x48 Match any non-control character in locale */
-#define        NCNTRLLUTF8     73      /* 0x49 Match any non-control character in locale */
-#define        GRAPH   74      /* 0x4a Match any graphical character */
-#define        GRAPHUTF8       75      /* 0x4b Match any graphical character */
-#define        GRAPHL  76      /* 0x4c Match any graphical character in locale */
-#define        GRAPHLUTF8      77      /* 0x4d Match any graphical character in locale */
-#define        NGRAPH  78      /* 0x4e Match any non-graphical character */
-#define        NGRAPHUTF8      79      /* 0x4f Match any non-graphical character */
-#define        NGRAPHL 80      /* 0x50 Match any non-graphical character in locale */
-#define        NGRAPHLUTF8     81      /* 0x51 Match any non-graphical character in locale */
-#define        LOWER   82      /* 0x52 Match any lowercase character */
-#define        LOWERUTF8       83      /* 0x53 Match any lowercase character */
-#define        LOWERL  84      /* 0x54 Match any lowercase character in locale */
-#define        LOWERLUTF8      85      /* 0x55 Match any lowercase character in locale */
-#define        NLOWER  86      /* 0x56 Match any non-lowercase character */
-#define        NLOWERUTF8      87      /* 0x57 Match any non-lowercase character */
-#define        NLOWERL 88      /* 0x58 Match any non-lowercase character in locale */
-#define        NLOWERLUTF8     89      /* 0x59 Match any non-lowercase character in locale */
-#define        PRINT   90      /* 0x5a Match any printable character */
-#define        PRINTUTF8       91      /* 0x5b Match any printable character */
-#define        PRINTL  92      /* 0x5c Match any printable character in locale */
-#define        PRINTLUTF8      93      /* 0x5d Match any printable character in locale */
-#define        NPRINT  94      /* 0x5e Match any non-printable character */
-#define        NPRINTUTF8      95      /* 0x5f Match any non-printable character */
-#define        NPRINTL 96      /* 0x60 Match any non-printable character in locale */
-#define        NPRINTLUTF8     97      /* 0x61 Match any non-printable character in locale */
-#define        PUNCT   98      /* 0x62 Match any punctuation character */
-#define        PUNCTUTF8       99      /* 0x63 Match any punctuation character */
-#define        PUNCTL  100     /* 0x64 Match any punctuation character in locale */
-#define        PUNCTLUTF8      101     /* 0x65 Match any punctuation character in locale */
-#define        NPUNCT  102     /* 0x66 Match any non-punctuation character */
-#define        NPUNCTUTF8      103     /* 0x67 Match any non-punctuation character */
-#define        NPUNCTL 104     /* 0x68 Match any non-punctuation character in locale */
-#define        NPUNCTLUTF8     105     /* 0x69 Match any non-punctuation character in locale */
-#define        UPPER   106     /* 0x6a Match any uppercase character */
-#define        UPPERUTF8       107     /* 0x6b Match any uppercase character */
-#define        UPPERL  108     /* 0x6c Match any uppercase character in locale */
-#define        UPPERLUTF8      109     /* 0x6d Match any uppercase character in locale */
-#define        NUPPER  110     /* 0x6e Match any non-uppercase character */
-#define        NUPPERUTF8      111     /* 0x6f Match any non-uppercase character */
-#define        NUPPERL 112     /* 0x70 Match any non-uppercase character in locale */
-#define        NUPPERLUTF8     113     /* 0x71 Match any non-uppercase character in locale */
-#define        XDIGIT  114     /* 0x72 Match any hexdigit character */
-#define        NXDIGIT 115     /* 0x73 Match any non-hexdigit character */
-#define        CLUMP   116     /* 0x74 Match any combining character sequence */
-#define        BRANCH  117     /* 0x75 Match this alternative, or the next... */
-#define        BACK    118     /* 0x76 Match "", "next" ptr points backward. */
-#define        EXACT   119     /* 0x77 Match this string (preceded by length). */
-#define        EXACTF  120     /* 0x78 Match this string, folded (prec. by length). */
-#define        EXACTFL 121     /* 0x79 Match this string, folded in locale (w/len). */
-#define        NOTHING 122     /* 0x7a Match empty string. */
-#define        TAIL    123     /* 0x7b Match empty string. Can jump here from outside. */
-#define        STAR    124     /* 0x7c Match this (simple) thing 0 or more times. */
-#define        PLUS    125     /* 0x7d Match this (simple) thing 1 or more times. */
-#define        CURLY   126     /* 0x7e Match this simple thing {n,m} times. */
-#define        CURLYN  127     /* 0x7f Match next-after-this simple thing  */
-#define        CURLYM  128     /* 0x80 Match this medium-complex thing {n,m} times. */
-#define        CURLYX  129     /* 0x81 Match this complex thing {n,m} times. */
-#define        WHILEM  130     /* 0x82 Do curly processing and see if rest matches. */
-#define        OPEN    131     /* 0x83 Mark this point in input as start of #n. */
-#define        CLOSE   132     /* 0x84 Analogous to OPEN. */
-#define        REF     133     /* 0x85 Match some already matched string */
-#define        REFF    134     /* 0x86 Match already matched string, folded */
-#define        REFFL   135     /* 0x87 Match already matched string, folded in loc. */
-#define        IFMATCH 136     /* 0x88 Succeeds if the following matches. */
-#define        UNLESSM 137     /* 0x89 Fails if the following matches. */
-#define        SUSPEND 138     /* 0x8a "Independent" sub-RE. */
-#define        IFTHEN  139     /* 0x8b Switch, should be preceeded by switcher . */
-#define        GROUPP  140     /* 0x8c Whether the group matched. */
-#define        LONGJMP 141     /* 0x8d Jump far away. */
-#define        BRANCHJ 142     /* 0x8e BRANCH with long offset. */
-#define        EVAL    143     /* 0x8f Execute some Perl code. */
-#define        MINMOD  144     /* 0x90 Next operator is not greedy. */
-#define        LOGICAL 145     /* 0x91 Next opcode should set the flag only. */
-#define        RENUM   146     /* 0x92 Group with independently numbered parens. */
-#define        OPTIMIZED       147     /* 0x93 Placeholder for dump. */
+#define        NDIGITLUTF8     47      /* 0x2f Match any non-numeric character in locale+utf8 */
+#define        CLUMP   48      /* 0x30 Match any combining character sequence */
+#define        BRANCH  49      /* 0x31 Match this alternative, or the next... */
+#define        BACK    50      /* 0x32 Match "", "next" ptr points backward. */
+#define        EXACT   51      /* 0x33 Match this string (preceded by length). */
+#define        EXACTF  52      /* 0x34 Match this string, folded (prec. by length). */
+#define        EXACTFL 53      /* 0x35 Match this string, folded in locale (w/len). */
+#define        NOTHING 54      /* 0x36 Match empty string. */
+#define        TAIL    55      /* 0x37 Match empty string. Can jump here from outside. */
+#define        STAR    56      /* 0x38 Match this (simple) thing 0 or more times. */
+#define        PLUS    57      /* 0x39 Match this (simple) thing 1 or more times. */
+#define        CURLY   58      /* 0x3a Match this simple thing {n,m} times. */
+#define        CURLYN  59      /* 0x3b Match next-after-this simple thing  */
+#define        CURLYM  60      /* 0x3c Match this medium-complex thing {n,m} times. */
+#define        CURLYX  61      /* 0x3d Match this complex thing {n,m} times. */
+#define        WHILEM  62      /* 0x3e Do curly processing and see if rest matches. */
+#define        OPEN    63      /* 0x3f Mark this point in input as start of #n. */
+#define        CLOSE   64      /* 0x40 Analogous to OPEN. */
+#define        REF     65      /* 0x41 Match some already matched string */
+#define        REFF    66      /* 0x42 Match already matched string, folded */
+#define        REFFL   67      /* 0x43 Match already matched string, folded in loc. */
+#define        IFMATCH 68      /* 0x44 Succeeds if the following matches. */
+#define        UNLESSM 69      /* 0x45 Fails if the following matches. */
+#define        SUSPEND 70      /* 0x46 "Independent" sub-RE. */
+#define        IFTHEN  71      /* 0x47 Switch, should be preceeded by switcher . */
+#define        GROUPP  72      /* 0x48 Whether the group matched. */
+#define        LONGJMP 73      /* 0x49 Jump far away. */
+#define        BRANCHJ 74      /* 0x4a BRANCH with long offset. */
+#define        EVAL    75      /* 0x4b Execute some Perl code. */
+#define        MINMOD  76      /* 0x4c Next operator is not greedy. */
+#define        LOGICAL 77      /* 0x4d Next opcode should set the flag only. */
+#define        RENUM   78      /* 0x4e Group with independently numbered parens. */
+#define        OPTIMIZED       79      /* 0x4f Placeholder for dump. */
 
 #ifndef DOINIT
 EXTCONST U8 PL_regkind[];
@@ -204,74 +136,6 @@ EXTCONST U8 PL_regkind[] = {
        NDIGIT,         /* NDIGITUTF8 */
        NDIGIT,         /* NDIGITL */
        NDIGIT,         /* NDIGITLUTF8 */
-       ALNUMC,         /* ALNUMC */
-       ALNUMC,         /* ALNUMCUTF8 */
-       ALNUMC,         /* ALNUMCL */
-       ALNUMC,         /* ALNUMCLUTF8 */
-       NALNUMC,                /* NALNUMC */
-       NALNUMC,                /* NALNUMCUTF8 */
-       NALNUMC,                /* NALNUMCL */
-       NALNUMC,                /* NALNUMCLUTF8 */
-       ALPHA,          /* ALPHA */
-       ALPHA,          /* ALPHAUTF8 */
-       ALPHA,          /* ALPHAL */
-       ALPHA,          /* ALPHALUTF8 */
-       NALPHA,         /* NALPHA */
-       NALPHA,         /* NALPHAUTF8 */
-       NALPHA,         /* NALPHAL */
-       NALPHA,         /* NALPHALUTF8 */
-       ASCII,          /* ASCII */
-       NASCII,         /* NASCII */
-       CNTRL,          /* CNTRL */
-       CNTRL,          /* CNTRLUTF8 */
-       CNTRL,          /* CNTRLL */
-       CNTRL,          /* CNTRLLUTF8 */
-       NCNTRL,         /* NCNTRL */
-       NCNTRL,         /* NCNTRLUTF8 */
-       NCNTRL,         /* NCNTRLL */
-       NCNTRL,         /* NCNTRLLUTF8 */
-       GRAPH,          /* GRAPH */
-       GRAPH,          /* GRAPHUTF8 */
-       GRAPH,          /* GRAPHL */
-       GRAPH,          /* GRAPHLUTF8 */
-       NGRAPH,         /* NGRAPH */
-       NGRAPH,         /* NGRAPHUTF8 */
-       NGRAPH,         /* NGRAPHL */
-       NGRAPH,         /* NGRAPHLUTF8 */
-       LOWER,          /* LOWER */
-       LOWER,          /* LOWERUTF8 */
-       LOWER,          /* LOWERL */
-       LOWER,          /* LOWERLUTF8 */
-       NLOWER,         /* NLOWER */
-       NLOWER,         /* NLOWERUTF8 */
-       NLOWER,         /* NLOWERL */
-       NLOWER,         /* NLOWERLUTF8 */
-       PRINT,          /* PRINT */
-       PRINT,          /* PRINTUTF8 */
-       PRINT,          /* PRINTL */
-       PRINT,          /* PRINTLUTF8 */
-       NPRINT,         /* NPRINT */
-       NPRINT,         /* NPRINTUTF8 */
-       NPRINT,         /* NPRINTL */
-       NPRINT,         /* NPRINTLUTF8 */
-       PUNCT,          /* PUNCT */
-       PUNCT,          /* PUNCTUTF8 */
-       PUNCT,          /* PUNCTL */
-       PUNCT,          /* PUNCTLUTF8 */
-       NPUNCT,         /* NPUNCT */
-       NPUNCT,         /* NPUNCTUTF8 */
-       NPUNCT,         /* NPUNCTL */
-       NPUNCT,         /* NPUNCTLUTF8 */
-       UPPER,          /* UPPER */
-       UPPER,          /* UPPERUTF8 */
-       UPPER,          /* UPPERL */
-       UPPER,          /* UPPERLUTF8 */
-       NUPPER,         /* NUPPER */
-       NUPPER,         /* NUPPERUTF8 */
-       NUPPER,         /* NUPPERL */
-       NUPPER,         /* NUPPERLUTF8 */
-       XDIGIT,         /* XDIGIT */
-       NXDIGIT,                /* NXDIGIT */
        CLUMP,          /* CLUMP */
        BRANCH,         /* BRANCH */
        BACK,           /* BACK */
@@ -358,74 +222,6 @@ const static U8 regarglen[] = {
        0,              /* NDIGITUTF8 */
        0,              /* NDIGITL */
        0,              /* NDIGITLUTF8 */
-       0,              /* ALNUMC */
-       0,              /* ALNUMCUTF8 */
-       0,              /* ALNUMCL */
-       0,              /* ALNUMCLUTF8 */
-       0,              /* NALNUMC */
-       0,              /* NALNUMCUTF8 */
-       0,              /* NALNUMCL */
-       0,              /* NALNUMCLUTF8 */
-       0,              /* ALPHA */
-       0,              /* ALPHAUTF8 */
-       0,              /* ALPHAL */
-       0,              /* ALPHALUTF8 */
-       0,              /* NALPHA */
-       0,              /* NALPHAUTF8 */
-       0,              /* NALPHAL */
-       0,              /* NALPHALUTF8 */
-       0,              /* ASCII */
-       0,              /* NASCII */
-       0,              /* CNTRL */
-       0,              /* CNTRLUTF8 */
-       0,              /* CNTRLL */
-       0,              /* CNTRLLUTF8 */
-       0,              /* NCNTRL */
-       0,              /* NCNTRLUTF8 */
-       0,              /* NCNTRLL */
-       0,              /* NCNTRLLUTF8 */
-       0,              /* GRAPH */
-       0,              /* GRAPHUTF8 */
-       0,              /* GRAPHL */
-       0,              /* GRAPHLUTF8 */
-       0,              /* NGRAPH */
-       0,              /* NGRAPHUTF8 */
-       0,              /* NGRAPHL */
-       0,              /* NGRAPHLUTF8 */
-       0,              /* LOWER */
-       0,              /* LOWERUTF8 */
-       0,              /* LOWERL */
-       0,              /* LOWERLUTF8 */
-       0,              /* NLOWER */
-       0,              /* NLOWERUTF8 */
-       0,              /* NLOWERL */
-       0,              /* NLOWERLUTF8 */
-       0,              /* PRINT */
-       0,              /* PRINTUTF8 */
-       0,              /* PRINTL */
-       0,              /* PRINTLUTF8 */
-       0,              /* NPRINT */
-       0,              /* NPRINTUTF8 */
-       0,              /* NPRINTL */
-       0,              /* NPRINTLUTF8 */
-       0,              /* PUNCT */
-       0,              /* PUNCTUTF8 */
-       0,              /* PUNCTL */
-       0,              /* PUNCTLUTF8 */
-       0,              /* NPUNCT */
-       0,              /* NPUNCTUTF8 */
-       0,              /* NPUNCTL */
-       0,              /* NPUNCTLUTF8 */
-       0,              /* UPPER */
-       0,              /* UPPERUTF8 */
-       0,              /* UPPERL */
-       0,              /* UPPERLUTF8 */
-       0,              /* NUPPER */
-       0,              /* NUPPERUTF8 */
-       0,              /* NUPPERL */
-       0,              /* NUPPERLUTF8 */
-       0,              /* XDIGIT */
-       0,              /* NXDIGIT */
        0,              /* CLUMP */
        0,              /* BRANCH */
        0,              /* BACK */
@@ -509,74 +305,6 @@ const static char reg_off_by_arg[] = {
        0,              /* NDIGITUTF8 */
        0,              /* NDIGITL */
        0,              /* NDIGITLUTF8 */
-       0,              /* ALNUMC */
-       0,              /* ALNUMCUTF8 */
-       0,              /* ALNUMCL */
-       0,              /* ALNUMCLUTF8 */
-       0,              /* NALNUMC */
-       0,              /* NALNUMCUTF8 */
-       0,              /* NALNUMCL */
-       0,              /* NALNUMCLUTF8 */
-       0,              /* ALPHA */
-       0,              /* ALPHAUTF8 */
-       0,              /* ALPHAL */
-       0,              /* ALPHALUTF8 */
-       0,              /* NALPHA */
-       0,              /* NALPHAUTF8 */
-       0,              /* NALPHAL */
-       0,              /* NALPHALUTF8 */
-       0,              /* ASCII */
-       0,              /* NASCII */
-       0,              /* CNTRL */
-       0,              /* CNTRLUTF8 */
-       0,              /* CNTRLL */
-       0,              /* CNTRLLUTF8 */
-       0,              /* NCNTRL */
-       0,              /* NCNTRLUTF8 */
-       0,              /* NCNTRLL */
-       0,              /* NCNTRLLUTF8 */
-       0,              /* GRAPH */
-       0,              /* GRAPHUTF8 */
-       0,              /* GRAPHL */
-       0,              /* GRAPHLUTF8 */
-       0,              /* NGRAPH */
-       0,              /* NGRAPHUTF8 */
-       0,              /* NGRAPHL */
-       0,              /* NGRAPHLUTF8 */
-       0,              /* LOWER */
-       0,              /* LOWERUTF8 */
-       0,              /* LOWERL */
-       0,              /* LOWERLUTF8 */
-       0,              /* NLOWER */
-       0,              /* NLOWERUTF8 */
-       0,              /* NLOWERL */
-       0,              /* NLOWERLUTF8 */
-       0,              /* PRINT */
-       0,              /* PRINTUTF8 */
-       0,              /* PRINTL */
-       0,              /* PRINTLUTF8 */
-       0,              /* NPRINT */
-       0,              /* NPRINTUTF8 */
-       0,              /* NPRINTL */
-       0,              /* NPRINTLUTF8 */
-       0,              /* PUNCT */
-       0,              /* PUNCTUTF8 */
-       0,              /* PUNCTL */
-       0,              /* PUNCTLUTF8 */
-       0,              /* NPUNCT */
-       0,              /* NPUNCTUTF8 */
-       0,              /* NPUNCTL */
-       0,              /* NPUNCTLUTF8 */
-       0,              /* UPPER */
-       0,              /* UPPERUTF8 */
-       0,              /* UPPERL */
-       0,              /* UPPERLUTF8 */
-       0,              /* NUPPER */
-       0,              /* NUPPERUTF8 */
-       0,              /* NUPPERL */
-       0,              /* NUPPERLUTF8 */
-       0,              /* XDIGIT */
-       0,              /* NXDIGIT */
        0,              /* CLUMP */
        0,              /* BRANCH */
        0,              /* BACK */
@@ -661,109 +389,41 @@ const static char * const reg_name[] = {
        "NDIGITUTF8",           /* 0x2d */
        "NDIGITL",              /* 0x2e */
        "NDIGITLUTF8",          /* 0x2f */
-       "ALNUMC",               /* 0x30 */
-       "ALNUMCUTF8",           /* 0x31 */
-       "ALNUMCL",              /* 0x32 */
-       "ALNUMCLUTF8",          /* 0x33 */
-       "NALNUMC",              /* 0x34 */
-       "NALNUMCUTF8",          /* 0x35 */
-       "NALNUMCL",             /* 0x36 */
-       "NALNUMCLUTF8",         /* 0x37 */
-       "ALPHA",                /* 0x38 */
-       "ALPHAUTF8",            /* 0x39 */
-       "ALPHAL",               /* 0x3a */
-       "ALPHALUTF8",           /* 0x3b */
-       "NALPHA",               /* 0x3c */
-       "NALPHAUTF8",           /* 0x3d */
-       "NALPHAL",              /* 0x3e */
-       "NALPHALUTF8",          /* 0x3f */
-       "ASCII",                /* 0x40 */
-       "NASCII",               /* 0x41 */
-       "CNTRL",                /* 0x42 */
-       "CNTRLUTF8",            /* 0x43 */
-       "CNTRLL",               /* 0x44 */
-       "CNTRLLUTF8",           /* 0x45 */
-       "NCNTRL",               /* 0x46 */
-       "NCNTRLUTF8",           /* 0x47 */
-       "NCNTRLL",              /* 0x48 */
-       "NCNTRLLUTF8",          /* 0x49 */
-       "GRAPH",                /* 0x4a */
-       "GRAPHUTF8",            /* 0x4b */
-       "GRAPHL",               /* 0x4c */
-       "GRAPHLUTF8",           /* 0x4d */
-       "NGRAPH",               /* 0x4e */
-       "NGRAPHUTF8",           /* 0x4f */
-       "NGRAPHL",              /* 0x50 */
-       "NGRAPHLUTF8",          /* 0x51 */
-       "LOWER",                /* 0x52 */
-       "LOWERUTF8",            /* 0x53 */
-       "LOWERL",               /* 0x54 */
-       "LOWERLUTF8",           /* 0x55 */
-       "NLOWER",               /* 0x56 */
-       "NLOWERUTF8",           /* 0x57 */
-       "NLOWERL",              /* 0x58 */
-       "NLOWERLUTF8",          /* 0x59 */
-       "PRINT",                /* 0x5a */
-       "PRINTUTF8",            /* 0x5b */
-       "PRINTL",               /* 0x5c */
-       "PRINTLUTF8",           /* 0x5d */
-       "NPRINT",               /* 0x5e */
-       "NPRINTUTF8",           /* 0x5f */
-       "NPRINTL",              /* 0x60 */
-       "NPRINTLUTF8",          /* 0x61 */
-       "PUNCT",                /* 0x62 */
-       "PUNCTUTF8",            /* 0x63 */
-       "PUNCTL",               /* 0x64 */
-       "PUNCTLUTF8",           /* 0x65 */
-       "NPUNCT",               /* 0x66 */
-       "NPUNCTUTF8",           /* 0x67 */
-       "NPUNCTL",              /* 0x68 */
-       "NPUNCTLUTF8",          /* 0x69 */
-       "UPPER",                /* 0x6a */
-       "UPPERUTF8",            /* 0x6b */
-       "UPPERL",               /* 0x6c */
-       "UPPERLUTF8",           /* 0x6d */
-       "NUPPER",               /* 0x6e */
-       "NUPPERUTF8",           /* 0x6f */
-       "NUPPERL",              /* 0x70 */
-       "NUPPERLUTF8",          /* 0x71 */
-       "XDIGIT",               /* 0x72 */
-       "NXDIGIT",              /* 0x73 */
-       "CLUMP",                /* 0x74 */
-       "BRANCH",               /* 0x75 */
-       "BACK",         /* 0x76 */
-       "EXACT",                /* 0x77 */
-       "EXACTF",               /* 0x78 */
-       "EXACTFL",              /* 0x79 */
-       "NOTHING",              /* 0x7a */
-       "TAIL",         /* 0x7b */
-       "STAR",         /* 0x7c */
-       "PLUS",         /* 0x7d */
-       "CURLY",                /* 0x7e */
-       "CURLYN",               /* 0x7f */
-       "CURLYM",               /* 0x80 */
-       "CURLYX",               /* 0x81 */
-       "WHILEM",               /* 0x82 */
-       "OPEN",         /* 0x83 */
-       "CLOSE",                /* 0x84 */
-       "REF",          /* 0x85 */
-       "REFF",         /* 0x86 */
-       "REFFL",                /* 0x87 */
-       "IFMATCH",              /* 0x88 */
-       "UNLESSM",              /* 0x89 */
-       "SUSPEND",              /* 0x8a */
-       "IFTHEN",               /* 0x8b */
-       "GROUPP",               /* 0x8c */
-       "LONGJMP",              /* 0x8d */
-       "BRANCHJ",              /* 0x8e */
-       "EVAL",         /* 0x8f */
-       "MINMOD",               /* 0x90 */
-       "LOGICAL",              /* 0x91 */
-       "RENUM",                /* 0x92 */
-       "OPTIMIZED",            /* 0x93 */
+       "CLUMP",                /* 0x30 */
+       "BRANCH",               /* 0x31 */
+       "BACK",         /* 0x32 */
+       "EXACT",                /* 0x33 */
+       "EXACTF",               /* 0x34 */
+       "EXACTFL",              /* 0x35 */
+       "NOTHING",              /* 0x36 */
+       "TAIL",         /* 0x37 */
+       "STAR",         /* 0x38 */
+       "PLUS",         /* 0x39 */
+       "CURLY",                /* 0x3a */
+       "CURLYN",               /* 0x3b */
+       "CURLYM",               /* 0x3c */
+       "CURLYX",               /* 0x3d */
+       "WHILEM",               /* 0x3e */
+       "OPEN",         /* 0x3f */
+       "CLOSE",                /* 0x40 */
+       "REF",          /* 0x41 */
+       "REFF",         /* 0x42 */
+       "REFFL",                /* 0x43 */
+       "IFMATCH",              /* 0x44 */
+       "UNLESSM",              /* 0x45 */
+       "SUSPEND",              /* 0x46 */
+       "IFTHEN",               /* 0x47 */
+       "GROUPP",               /* 0x48 */
+       "LONGJMP",              /* 0x49 */
+       "BRANCHJ",              /* 0x4a */
+       "EVAL",         /* 0x4b */
+       "MINMOD",               /* 0x4c */
+       "LOGICAL",              /* 0x4d */
+       "RENUM",                /* 0x4e */
+       "OPTIMIZED",            /* 0x4f */
 };
 
-const static int reg_num = 148;
+const static int reg_num = 80;
 
 #endif /* DEBUGGING */
 #endif /* REG_COMP_C */
index 99af53b..5d01436 100755 (executable)
@@ -2,6 +2,9 @@
 
 $| = 1;                                # flush stdout
 
+$ENV{LC_ALL}   = 'C';          # Forge English error messages.
+$ENV{LANGUAGE} = 'C';          # Ditto in GNU.
+
 if ($^O eq 'MSWin32') {
     # XXX the system tests could be written to use ./perl and so work on Win32
     print "1..0 # Skip: shh, win32\n";
@@ -26,7 +29,14 @@ if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
 print "ok 5\n";
 
 $rc = system "lskdfj";
-if ($rc == 255 << 8 or $rc == -1 and ($! == 2 or $! =~ /\bno\b.*\bfile/i))
+if ($rc == 255 << 8 or $rc == -1 and
+     (
+      $! == 2 or
+      $! =~ /\bno\b.*\bfile/i or
+      $! == 13 or
+      $! =~ /permission denied/i
+     )
+   )
  {print "ok 6\n";} else {print "not ok 6\n";}
 
 unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
index 1dbb941..27ac5aa 100755 (executable)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..28\n";
+print "1..36\n";
 
 print +(oct('0b10101') ==          0b10101) ? "ok" : "not ok", " 1\n";
 print +(oct('0b10101') ==              025) ? "ok" : "not ok", " 2\n";
@@ -22,17 +22,32 @@ print +(oct('0x1234')  ==           011064) ? "ok" : "not ok", " 14\n";
 print +(oct('0x1234')  ==             4660) ? "ok" : "not ok", " 15\n";
 print +(oct('0x1234')  ==           0x1234) ? "ok" : "not ok", " 16\n";
 
-print +(hex('01234')   ==  0b1001000110100) ? "ok" : "not ok", " 17\n";
-print +(hex('01234')   ==           011064) ? "ok" : "not ok", " 18\n";
-print +(hex('01234')   ==             4660) ? "ok" : "not ok", " 19\n";
-print +(hex('01234')   ==           0x1234) ? "ok" : "not ok", " 20\n";
-
-print +(hex('0x1234')  ==  0b1001000110100) ? "ok" : "not ok", " 21\n";
-print +(hex('0x1234')  ==           011064) ? "ok" : "not ok", " 22\n";
-print +(hex('0x1234')  ==             4660) ? "ok" : "not ok", " 23\n";
-print +(hex('0x1234')  ==           0x1234) ? "ok" : "not ok", " 24\n";
-
-print +(hex('x1234')   ==  0b1001000110100) ? "ok" : "not ok", " 25\n";
-print +(hex('x1234')   ==           011064) ? "ok" : "not ok", " 26\n";
-print +(hex('x1234')   ==             4660) ? "ok" : "not ok", " 27\n";
-print +(hex('x1234')   ==           0x1234) ? "ok" : "not ok", " 28\n";
+print +(oct('x1234')   ==  0b1001000110100) ? "ok" : "not ok", " 17\n";
+print +(oct('x1234')   ==           011064) ? "ok" : "not ok", " 18\n";
+print +(oct('x1234')   ==             4660) ? "ok" : "not ok", " 19\n";
+print +(oct('x1234')   ==           0x1234) ? "ok" : "not ok", " 20\n";
+
+print +(hex('01234')   ==  0b1001000110100) ? "ok" : "not ok", " 21\n";
+print +(hex('01234')   ==           011064) ? "ok" : "not ok", " 22\n";
+print +(hex('01234')   ==             4660) ? "ok" : "not ok", " 23\n";
+print +(hex('01234')   ==           0x1234) ? "ok" : "not ok", " 24\n";
+
+print +(hex('0x1234')  ==  0b1001000110100) ? "ok" : "not ok", " 25\n";
+print +(hex('0x1234')  ==           011064) ? "ok" : "not ok", " 26\n";
+print +(hex('0x1234')  ==             4660) ? "ok" : "not ok", " 27\n";
+print +(hex('0x1234')  ==           0x1234) ? "ok" : "not ok", " 28\n";
+
+print +(hex('x1234')   ==  0b1001000110100) ? "ok" : "not ok", " 29\n";
+print +(hex('x1234')   ==           011064) ? "ok" : "not ok", " 30\n";
+print +(hex('x1234')   ==             4660) ? "ok" : "not ok", " 31\n";
+print +(hex('x1234')   ==           0x1234) ? "ok" : "not ok", " 32\n";
+
+print +(oct('0b11111111111111111111111111111111') == 4294967295) ?
+    "ok" : "not ok", " 33\n";
+print +(oct('037777777777')                       == 4294967295) ?
+    "ok" : "not ok", " 34\n";
+print +(oct('0xffffffff')                         == 4294967295) ?
+    "ok" : "not ok", " 35\n";
+
+print +(hex('0xffffffff')                         == 4294967295) ?
+    "ok" : "not ok", " 36\n";
index be45c77..5be4112 100644 (file)
@@ -9,25 +9,45 @@ Integer overflow in octal number at - line 3.
 ########
 # no warning should be displayed 
 no warning ;
-my $a = oct "7777777777777777777777777777777777779" ;
+my $a = oct "7777777777777777777777777777777777778" ;
 EXPECT
-Integer overflow in octal number at - line 3.
 ########
 # all warning should be displayed 
 use warning ;
-my $a = oct "77777777797";
+my $a = oct "7777777777777777777777777777777777778" ;
 EXPECT
-Illegal octal digit '9' ignored at - line 3.
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
 ########
 # check scope
 use warning ;
-my $a = oct "77777777797";
+my $a = oct "7777777777777777777777777777777777778" ;
 {
     no warning ;
-    my $b = oct "77777777797";
+    my $a = oct "7777777777777777777777777777777777778" ;
 }    
-my $c = oct "7777777777777777777777777777777777779" ;
+my $c = oct "7777777777777777777777777777777777778" ;
 EXPECT
-Illegal octal digit '9' ignored at - line 3.
-Octal number > 037777777777 non-portable at - line 8.
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
 Integer overflow in octal number at - line 8.
+Illegal octal digit '8' ignored at - line 8.
+Octal number > 037777777777 non-portable at - line 8.
+########
+# all warning should be displayed 
+use warning ;
+my $a = oct "0xfffffffffffffffffg" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+Illegal hexadecimal digit 'g' ignored at - line 3.
+Hexadecimal number > 0xffffffff non-portable at - line 3.
+########
+# all warning should be displayed 
+use warning ;
+my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
+EXPECT
+Integer overflow in binary number at - line 3.
+Illegal binary digit '2' ignored at - line 3.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
index 87d43e8..605b42a 100644 (file)
@@ -3,25 +3,18 @@
      Illegal octal digit ignored 
        my $a = oct "029" ;
 
-     Illegal hexadecimal digit ignored 
+     Illegal hex digit ignored 
        my $a = hex "0xv9" ;
 
      Illegal binary digit ignored
       my $a = oct "0b9" ;
 
-     
-     Mandatory Warnings
-     ------------------
-     Integer overflow in binary number
-     Integer overflow in octal number
-     Integer overflow in hex number
-
 __END__
 # util.c
 use warning 'octal' ;
 my $a = oct "029" ;
 no warning 'octal' ;
-my $b = oct "029" ;
+my $a = oct "029" ;
 EXPECT
 Illegal octal digit '9' ignored at - line 3.
 ########
@@ -40,49 +33,3 @@ no warning 'unsafe' ;
 *a =  oct "0b9" ;
 EXPECT
 Illegal binary digit '9' ignored at - line 3.
-########
-# util.c
-$^W = 1 ;
-sub make_bin { "1" x $_[0] }
-$n = make_bin(33);
-{
-  use warning 'unsafe' ;
-  my $a = oct "0b$n" ;
-  no warning 'unsafe' ;
-  my $b = oct "0b$n" ;
-}
-my $c = oct "0b$n" ;
-EXPECT
-Binary number > 0b11111111111111111111111111111111 non-portable at - line 7.
-Binary number > 0b11111111111111111111111111111111 non-portable at - line 11.
-########
-# util.c
-$^W = 1 ;
-sub make_oct { ("","1","3")[$_[0]%3] . "7" x int($_[0]/3) }
-$n = make_oct(33);
-{
-  use warning 'unsafe' ;
-  my $a = oct "$n" ;
-  no warning 'unsafe' ;
-  my $b = oct "$n" ;
-}
-my $c = oct "$n" ;
-EXPECT
-Octal number > 037777777777 non-portable at - line 7.
-Octal number > 037777777777 non-portable at - line 11.
-########
-# util.c
-$^W = 1 ;
-sub make_hex { ("","1","3","7")[$_[0]%4] . "f" x int($_[0]/4) }
-$n = make_hex(33);
-{
-  use warning 'unsafe' ;
-  my $a = hex "$n" ;
-  no warning 'unsafe' ;
-  my $b = hex "$n" ;
-}
-my $c = hex "$n" ;
-EXPECT
-Hexadecimal number > 0xffffffff non-portable at - line 7.
-Hexadecimal number > 0xffffffff non-portable at - line 11.
-
diff --git a/toke.c b/toke.c
index 9394391..c4521c5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6257,10 +6257,10 @@ Perl_scan_num(pTHX_ char *start)
     register char *s = start;          /* current position in buffer */
     register char *d;                  /* destination in temp buffer */
     register char *e;                  /* end of temp buffer */
-    I32 tryiv;                         /* used to see if it can be an int */
+    IV tryiv;                          /* used to see if it can be an IV */
     NV value;                          /* number read, as a double */
     SV *sv;                            /* place to put the converted number */
-    I32 floatit;                       /* boolean: int or float? */
+    bool floatit;                      /* boolean: int or float? */
     char *lastub = 0;                  /* position of last underbar */
     static char number_too_long[] = "Number too long";
 
@@ -6286,8 +6286,21 @@ Perl_scan_num(pTHX_ char *start)
             when in octal mode.
           */
            dTHR;
-           UV u;
+           NV n = 0.0;
+           UV u = 0;
            I32 shift;
+           bool overflowed = FALSE;
+           static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
+           static char* bases[5] = { "", "binary", "", "octal",
+                                     "hexadecimal" };
+           static char* Bases[5] = { "", "Binary", "", "Octal",
+                                     "Hexadecimal" };
+           static char *maxima[5] = { "",
+                                      "0b11111111111111111111111111111111",
+                                      "",
+                                      "037777777777",
+                                      "0xffffffff" };
+           char *base, *Base, *max;
 
            /* check for hex */
            if (s[1] == 'x') {
@@ -6303,11 +6316,16 @@ Perl_scan_num(pTHX_ char *start)
            /* so it must be octal */
            else
                shift = 3;
-           u = 0;
+
+           base = bases[shift];
+           Base = Bases[shift];
+           max  = maxima[shift];
 
            /* read the rest of the number */
            for (;;) {
-               UV n, b;        /* n is used in the overflow test, b is the digit we're adding on */
+               /* x is used in the overflow test,
+                  b is the digit we're adding on. */
+               UV x, b;
 
                switch (*s) {
 
@@ -6353,16 +6371,34 @@ Perl_scan_num(pTHX_ char *start)
                    */
 
                  digit:
-                   n = u << shift;     /* make room for the digit */
-                   if ((n >> shift) != u
-                       && !(PL_hints & HINT_NEW_BINARY))
-                   {
-                       Perl_croak(aTHX_
-                                  "Integer overflow in %s number",
-                                  (shift == 4) ? "hexadecimal"
-                                  : ((shift == 3) ? "octal" : "binary"));
+                   if (!overflowed) {
+                       x = u << shift; /* make room for the digit */
+
+                       if ((x >> shift) != u
+                           && !(PL_hints & HINT_NEW_BINARY)) {
+                           dTHR;
+                           overflowed = TRUE;
+                           n = (NV) u;
+                           if (ckWARN_d(WARN_UNSAFE))
+                               Perl_warner(aTHX_ ((shift == 3) ?
+                                                  WARN_OCTAL : WARN_UNSAFE),
+                                           "Integer overflow in %s number",
+                                           base);
+                       } else
+                           u = x | b;          /* add the digit to the end */
+                   }
+                   if (overflowed) {
+                       n *= nvshift[shift];
+                       /* If an NV has not enough bits in its
+                        * mantissa to represent an UV this summing of
+                        * small low-order numbers is a waste of time
+                        * (because the NV cannot preserve the
+                        * low-order bits anyway): we could just
+                        * remember when did we overflow and in the
+                        * end just multiply n by the right
+                        * amount. */
+                       n += (NV) b;
                    }
-                   u = n | b;          /* add the digit to the end */
                    break;
                }
            }
@@ -6372,8 +6408,25 @@ Perl_scan_num(pTHX_ char *start)
          */
          out:
            sv = NEWSV(92,0);
-           sv_setuv(sv, u);
-           if ( PL_hints & HINT_NEW_BINARY)
+           if (overflowed) {
+               dTHR;
+               if (ckWARN(WARN_UNSAFE) && n > 4294967295.0)
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "%s number > %s non-portable",
+                               Base, max);
+               sv_setnv(sv, n);
+           }
+           else {
+#if UV_SIZEOF > 4
+               dTHR;
+               if (ckWARN(WARN_UNSAFE) && u > 0xffffffff)
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "%s number > %s non-portable",
+                               Base, max);
+#endif
+               sv_setuv(sv, u);
+           }
+           if (PL_hints & HINT_NEW_BINARY)
                sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
        }
        break;
@@ -6479,9 +6532,11 @@ Perl_scan_num(pTHX_ char *start)
            sv_setiv(sv, tryiv);
        else
            sv_setnv(sv, value);
-       if ( floatit ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) )
+       if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
+                      (PL_hints & HINT_NEW_INTEGER) )
            sv = new_constant(PL_tokenbuf, d - PL_tokenbuf, 
-                             (floatit ? "float" : "integer"), sv, Nullsv, NULL);
+                             (floatit ? "float" : "integer"),
+                             sv, Nullsv, NULL);
        break;
     }
 
diff --git a/util.c b/util.c
index f9d0559..c2d05ae 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2776,24 +2776,22 @@ Perl_same_dirent(pTHX_ char *a, char *b)
 }
 #endif /* !HAS_RENAME */
 
-UV
+NV
 Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
-    register UV retval = 0;
-    register UV n;
-    register I32 d = 0;
+    register NV rnv = 0.0;
+    register UV ruv = 0;
     register bool seenb = FALSE;
-    register bool overflow = FALSE;
+    register bool overflowed = FALSE;
 
     for (; len-- && *s; s++) {
        if (!(*s == '0' || *s == '1')) {
            if (*s == '_')
-               continue;
-           if (seenb == FALSE && *s == 'b' && retval == 0) {
+               continue; /* Note: does not check for __ and the like. */
+           if (seenb == FALSE && *s == 'b' && ruv == 0) {
                /* Disallow 0bbb0b0bbb... */
                seenb = TRUE;
-               d = 0; /* Forget any leading zeros before the 'b'. */
                continue;
            }
            else {
@@ -2804,35 +2802,58 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
                break;
            }
        }
-       n = retval << 1;
-       overflow |= (n >> 1) != retval;
-       retval = n | (*s - '0');
-       d++;
+       if (!overflowed) {
+           register UV xuv = ruv << 1;
+
+           if ((xuv >> 1) != ruv) {
+               dTHR;
+               overflowed = TRUE;
+               rnv = (NV) ruv;
+               if (ckWARN_d(WARN_UNSAFE))
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "Integer overflow in binary number");
+           } else
+               ruv = xuv | (*s - '0');
+       }
+       if (overflowed) {
+           rnv *= 2;
+           /* If an NV has not enough bits in its mantissa to
+            * represent an UV this summing of small low-order numbers
+            * is a waste of time (because the NV cannot preserve
+            * the low-order bits anyway): we could just remember when
+            * did we overflow and in the end just multiply rnv by the
+            * right amount. */
+           rnv += (*s - '0');
+       }
     }
-    if (sizeof(UV) > 4 && d > 32) {
+    if (!overflowed)
+       rnv = (NV) ruv;
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) { 
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
                        "Binary number > 0b11111111111111111111111111111111 non-portable");
     }
-    if (overflow)
-       Perl_croak(aTHX_ "Integer overflow in binary number");
     *retlen = s - start;
-    return retval;
+    return rnv;
 }
-UV
+
+NV
 Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
-    register UV retval = 0;
-    register UV n;
-    register I32 d = 0;
-    register bool overflow = FALSE;
+    register NV rnv = 0.0;
+    register UV ruv = 0;
+    register bool overflowed = FALSE;
 
     for (; len-- && *s; s++) {
        if (!(*s >= '0' && *s <= '7')) {
            if (*s == '_')
-               continue;
+               continue; /* Note: does not check for __ and the like. */
            else {
                /* Allow \octal to work the DWIM way (that is, stop scanning
                 * as soon as non-octal characters are seen, complain only iff
@@ -2846,69 +2867,112 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
                break;
            }
        }
-       n = retval << 3;
-       overflow |= (n >> 3) != retval;
-       retval = n | (*s - '0');
-       d++;
+       if (!overflowed) {
+           register UV xuv = ruv << 3;
+
+           if ((xuv >> 3) != ruv) {
+               dTHR;
+               overflowed = TRUE;
+               rnv = (NV) ruv;
+               if (ckWARN_d(WARN_UNSAFE))
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "Integer overflow in octal number");
+           } else
+               ruv = xuv | (*s - '0');
+       }
+       if (overflowed) {
+           rnv *= 8.0;
+           /* If an NV has not enough bits in its mantissa to
+            * represent an UV this summing of small low-order numbers
+            * is a waste of time (because the NV cannot preserve
+            * the low-order bits anyway): we could just remember when
+            * did we overflow and in the end just multiply rnv by the
+            * right amount of 8-tuples. */
+           rnv += (NV)(*s - '0');
+       }
     }
-    if (sizeof(UV) > 4 && d > 10 && (retval >> 30) > 3) {
+    if (!overflowed)
+       rnv = (NV) ruv;
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) {
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
                        "Octal number > 037777777777 non-portable");
     }
-    if (overflow)
-       Perl_croak(aTHX_ "Integer overflow in octal number");
     *retlen = s - start;
-    return retval;
+    return rnv;
 }
 
-UV
+NV
 Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
-    register UV retval = 0;
-    char *tmp = s;
-    register UV n;
-    register I32 d = 0;
+    register NV rnv = 0.0;
+    register UV ruv = 0;
     register bool seenx = FALSE;
-    register bool overflow = FALSE;
+    register bool overflowed = FALSE;
+    char *hexdigit;
 
-    while (len-- && *s) {
-       tmp = strchr((char *) PL_hexdigit, *s++);
-       if (!tmp) {
-           if (*(s-1) == '_')
-               continue;
-           if (seenx == FALSE && *(s-1) == 'x' && retval == 0) {
+    for (; len-- && *s; s++) {
+       hexdigit = strchr((char *) PL_hexdigit, *s);
+       if (!hexdigit) {
+           if (*s == '_')
+               continue; /* Note: does not check for __ and the like. */
+           if (seenx == FALSE && *s == 'x' && ruv == 0) {
                /* Disallow 0xxx0x0xxx... */
                seenx = TRUE;
-               d = 0; /* Forget any leading zeros before the 'x'. */
                continue;
            }
            else {
                dTHR;
-               --s;
                if (ckWARN(WARN_UNSAFE))
                    Perl_warner(aTHX_ WARN_UNSAFE,
                                "Illegal hexadecimal digit '%c' ignored", *s);
                break;
            }
        }
-       d++;
-       n = retval << 4;
-       overflow |= (n >> 4) != retval;
-       retval = n | ((tmp - PL_hexdigit) & 15);
+       if (!overflowed) {
+           register UV xuv = ruv << 4;
+
+           if ((xuv >> 4) != ruv) {
+               dTHR;
+               overflowed = TRUE;
+               rnv = (NV) ruv;
+               if (ckWARN_d(WARN_UNSAFE))
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "Integer overflow in hexadecimal number");
+           } else
+               ruv = xuv | ((hexdigit - PL_hexdigit) & 15);
+       }
+       if (overflowed) {
+           rnv *= 16.0;
+           /* If an NV has not enough bits in its mantissa to
+            * represent an UV this summing of small low-order numbers
+            * is a waste of time (because the NV cannot preserve
+            * the low-order bits anyway): we could just remember when
+            * did we overflow and in the end just multiply rnv by the
+            * right amount of 16-tuples. */
+           rnv += (NV)((hexdigit - PL_hexdigit) & 15);
+       }
     }
-    if (sizeof(UV) > 4 && d > 8) {
+    if (!overflowed)
+       rnv = (NV) ruv;
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) { 
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
                        "Hexadecimal number > 0xffffffff non-portable");
     }
-    if (overflow)
-       Perl_croak(aTHX_ "Integer overflow in hexadecimal number");
     *retlen = s - start;
-    return retval;
+    return rnv;
 }
 
 char*