[inseparable changes from patch from perl5.003_07 to perl5.003_08]

diff --git a/Changes b/Changes

index 39e860e..7ed1eed 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,157 @@ or in the .../src/5/0/unsupported directory for sub-version
 releases.)
 
 ----------------
+Version 5.003_08
+----------------
+
+This patch was a compendium of various fixes and enhancements from
+many people.  Here are some of the more significant changes.
+
+
+ CORE LANGUAGE CHANGES
+
+  Title:  "Make C<no FOO> fail if C<unimport FOO> fails"
+   From:  Tim Bunce <Tim.Bunce@ig.co.uk>
+  Files:  gv.c
+
+  Title:  "Bitwise op sign rationalization"
+          (Make bitwise ops result in unsigned values, unless C<use
+          integer> is in effect.  Includes initial support for UVs.)
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  op.c opcode.pl pod/perlop.pod pod/perltoc.pod pp.c pp.h
+          pp_hot.c proto.h sv.c t/op/bop.t
+
+  Title:  "Defined scoping for C<my> in control structures"
+          (Finally defines semantics of "my" in control expressions,
+          like the condition of "if" and "while".  In all cases, scope
+          of a "my" var extends to the end of the entire control
+          structure.  Also adds new construct "for my", which
+          automatically declares the control variable "my" and limits
+          its scope to the loop.)
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  op.c perly.c perly.c.diff perly.h perly.y proto.h toke.c
+
+  Title:  "Fix ++/-- after int conversion (e.g. 'printf "%d"')"
+          (This patch makes Perl correctly ignore SvIVX() if either
+          NOK or POK is true, since SvIVX() may be a truncated or
+          overflowed version of the real value.)
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  pp.c pp_hot.c sv.c
+
+  Title:  "Make code match Camel II re: functions that use $_"
+   From:  pmarquess@bfsec.bt.co.uk (Paul Marquess)
+  Files:  opcode.pl
+
+  Title:  "Provide scalar context on left side of "->""
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  perly.c perly.y
+
+  Title:  "Quote bearword package/handle FOO in "funcname FOO => 'bar'""
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  toke.c
+
+
+ OTHER CORE CHANGES
+
+  Title:  "Warn on overflow of octal and hex integers"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  proto.h toke.c util.c
+
+  Title:  "If -w active, warn for commas and hashes ('#') in qw()"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  toke.c
+
+  Title:  "Fixes for pack('w')"
+   From:  Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
+  Files:  pp.c t/op/pack.t
+
+  Title:  "More complete output from sv_dump()"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+  Files:  sv.c
+
+  Title:  "Major '..' and debugger patches"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+  Files:  lib/perl5db.pl op.c pp_ctl.c scope.c scope.h
+
+  Title:  "Fix for formline()"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+  Files:  global.sym mg.c perl.h pod/perldiag.pod pp_ctl.c proto.h sv.c
+          t/op/write.t
+
+  Title:  "Fix stack botch in untie and binmode"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+  Files:  pp_sys.c
+
+  Title:  "Complete EMBED, including symbols from interp.sym"
+          (New define EMBEDMYMALLOC makes embedding total by
+          avoiding "Mymalloc" etc.)
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  MANIFEST embed.pl ext/DynaLoader/dlutils.c
+          ext/SDBM_File/sdbm/sdbm.h global.sym handy.h malloc.c
+          perl.h pp_sys.c proto.h regexec.c toke.c util.c
+          x2p/Makefile.SH x2p/a2p.h x2p/handy.h x2p/util.h
+
+  Title:  "Support old embedding for people who want it"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  MANIFEST Makefile.SH old_embed.pl old_global.sym
+
+
+ PORTABILITY
+
+  Title:  "Miscellaneous VMS fixes"
+   From:  Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+  Files:  lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm
+          lib/Math/Complex.pm lib/Time/Local.pm lib/timelocal.pl
+          perl.h perl_exp.SH proto.h t/TEST t/io/read.t
+          t/lib/findbin.t t/lib/getopt.t util.c utils/h2xs.PL
+          vms/Makefile vms/config.vms vms/descrip.mms
+          vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs
+          vms/perlvms.pod vms/test.com vms/vms.c
+
+  Title:  "DJGPP patches (MS-DOS)"
+   From:  "Douglas E. Wegscheid" <wegscd@whirlpool.com>
+  Files:  doio.c dosish.h ext/SDBM_File/sdbm/sdbm.c handy.h
+          lib/AutoSplit.pm lib/Cwd.pm lib/File/Find.pm malloc.c perl.c
+          perl.h pp_sys.c proto.h sv.c util.c
+
+  Title:  "Plan 9 update"
+   From:  Luther Huffman <lutherh@infinet.com>
+  Files:  plan9/buildinfo plan9/config.plan9 plan9/exclude
+          plan9/genconfig.pl plan9/mkfile plan9/setup.rc
+
+  Title:  "Patch to make Perl work under AmigaOS"
+   From:  "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
+  Files:  MANIFEST hints/amigaos.sh installman lib/File/Basename.pm
+          lib/File/Find.pm pod/pod2man.PL pp_sys.c util.c
+
+ LIBRARY AND EXTENSIONS
+
+  Title:  "DB_File 1.05"
+   From:  Paul Marquess (pmarquess@bfsec.bt.co.uk)
+  Files:  ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-hash.t
+
+  Title:  "Getopts::Std patch for hash support"
+   From:  Stephen Zander <stephen.zander@interlock.mckesson.com>
+  Files:  lib/Getopt/Std.pm
+
+  Title:  "Kludge for bareword handles"
+          (Add 'require IO::Handle' at beginning of FileHandle.pm)
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  ext/FileHandle/FileHandle.pm
+
+  Title:  "Re: strtod / strtol patch for POSIX module"
+   From:  hammen@gothamcity.jsc.nasa.gov (David Hammen)
+  Files:  Configure config_h.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod
+          ext/POSIX/POSIX.xs t/lib/posix.t
+
+ BUNDLED UTILITIES
+
+  Title:  "Fix a2p translation of '{print "a" "b" "c"}'"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  x2p/a2p.c x2p/a2p.y
+
+
+----------------
 Version 5.003_07
 ----------------
 
diff --git a/MANIFEST b/MANIFEST

index 801ffeb..c2c8609 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -202,6 +202,7 @@ hints/README.NeXT   Notes about NeXT hints.
 hints/README.hints     Notes about hints.
 hints/aix.sh           Hints for named architecture
 hints/altos486.sh      Hints for named architecture
+hints/amigaos.sh       Hints for named architecture
 hints/apollo.sh                Hints for named architecture
 hints/aux.sh           Hints for named architecture
 hints/bsdos.sh         Hints for named architecture
@@ -386,6 +387,8 @@ miniperlmain.c              Basic perl w/o dynamic loading or extensions
 mv-if-diff             Script to mv a file if it changed
 myconfig               Prints summary of the current configuration
 nostdio.h              Cause compile error on stdio calls
+old_embed.pl           Produces embed.h using old_global.sym
+old_global.sym         Old list of symbols to hide when embedded
 op.c                   Opcode syntax tree code
 op.h                   Opcode syntax tree header
 opcode.h               Automatically generated opcode header
@@ -708,7 +711,6 @@ x2p/a2p.y           A yacc grammer for awk
 x2p/a2py.c             Awk compiler, sort of
 x2p/cflags.SH          A script that emits C compilation flags per file
 x2p/find2perl.PL       A find to perl translator
-x2p/handy.h            Handy definitions
 x2p/hash.c             Associative arrays again
 x2p/hash.h             Public declarations for the above
 x2p/s2p.PL             Sed to perl translator
diff --git a/Makefile.SH b/Makefile.SH

index e3ee814..9052a4d 100755 (executable)
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -342,9 +342,10 @@ run_byacc: FORCE
        @ echo 'Expect' 130 shift/reduce and 1 reduce/reduce conflict
        $(BYACC) -d perly.y
        sh $(shellflags) ./perly.fixer y.tab.c perly.c
-       sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' perly.c >perly.tmp && mv perly.tmp perly.c
-       mv y.tab.h perly.h
-       echo 'extern YYSTYPE yylval;' >>perly.h
+       sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
+           -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c
+       echo 'extern YYSTYPE yylval;' >>y.tab.h
+       cmp -s y.tab.h perly.h && rm -f y.tab.h || mv y.tab.h perly.h
        - perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
 
 # We don't want to regenerate perly.c and perly.h, but they might
diff --git a/README.os2 b/README.os2

index f5bf87d..bbadbf6 100644 (file)
--- a/README.os2
+++ b/README.os2
@@ -144,9 +144,12 @@ Cf. L<Prerequisites>.
 
 =item B<EMX>
 
-B<EMX> runtime is required. Note that it is possible to make F<perl_.exe>
-to run under DOS without any external support by binding F<emx.exe> to
-it, see L<emxbind>.
+B<EMX> runtime is required (may be substituted by B<RSX>). Note that
+it is possible to make F<perl_.exe> to run under DOS without any
+external support by binding F<emx.exe> to it, see L<emxbind>. Note
+that under DOS for best results one should use B<RSX> runtime, which
+has much more functions working (like C<fork>, C<popen> and so on). In
+fact B<RSX> is required if there is no C<VCPI> present.
 
 Only the latest runtime is supported, currently C<0.9c>.
 
@@ -161,7 +164,13 @@ The runtime component should have the name F<emxrt.zip>.
 
 To run Perl on C<DPMS> platforms one needs B<RSX> runtime. This is
 needed under DOS-inside-OS/2, Win0.31, Win0.95 and WinNT (see 
-L<"Other OSes">).
+L<"Other OSes">). I do not know whether B<RSX> would work with C<VCPI>
+only, as B<EMX> would.
+
+Having B<RSX> and the latest F<sh.exe> one gets a fully functional
+B<*nix>-ish environment under DOS, say, C<fork>, C<``> and
+pipe-C<open> work. In fact, MakeMaker works (for static build), so one
+can have Perl development environment under DOS. 
 
 One can get B<RSX> from, say
 
@@ -170,6 +179,10 @@ One can get B<RSX> from, say
 
 Contact the author on C<rainer@mathematik.uni-bielefeld.de>.
 
+The latest F<sh.exe> with DOS hooks is available at
+
+  ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2/sh_dos.exe
+
 =item B<HPFS>
 
 Perl does not care about file systems, but to install the whole perl
@@ -254,9 +267,22 @@ meta-characters.
 
 =head2 I cannot run extenal programs
 
+=over 4
+
+=item
+
 Did you run your programs with C<-w> switch? See 
 L<Starting OS/2 programs under Perl>.
 
+=item
+
+Do you try to run I<internal> shell commands, like C<`copy a b`>
+(internal for F<cmd.exe>), or C<`glob a*b`> (internal for ksh)? You
+need to specify your shell explicitely, like C<`cmd /c copy a b`>,
+since Perl cannot deduce which commands are internal to your shell.
+
+=back
+
 =head2 I cannot embed perl into my program, or use F<perl.dll> from my
 program. 
 
@@ -273,6 +299,16 @@ I had reports it does not work. Somebody would need to fix it.
 
 =back
 
+=head2 C<``> and pipe-C<open> do not work under DOS.
+
+This may a variant of just L<"I cannot run extenal programs">, or a
+deeper problem. Basically: you I<need> B<RSX> (see L<"Prerequisites">)
+for these commands to work, and you need a port of F<sh.exe> which
+understands command arguments. One of such ports is listed in
+L<"Prerequisites"> under B<RSX>.
+
+I do not know whether C<DPMI> is required.
+
 =head1 INSTALLATION
 
 =head2 Automatic binary installation
@@ -674,7 +710,7 @@ Now run
 
   make test
 
-Some tests (4..6) should fail. Some perl invocations should end in a
+Some tests (5..7) should fail. Some perl invocations should end in a
 segfault (system error C<SYS3175>). To get finer error reports, 
 
   cd t
@@ -692,7 +728,8 @@ The report you get may look like
 
 Note that using `make test' target two more tests may fail: C<op/exec:1>
 because of (mis)feature of C<pdksh>, and C<lib/posix:15>, which checks
-that the buffers are not flushed on C<_exit>.
+that the buffers are not flushed on C<_exit> (this is a bug in the test
+which assumes that tty output is buffered).
 
 The reasons for failed tests are:
 
@@ -961,8 +998,22 @@ eventually).
 
 =item
 
-Since <lockf> is present in B<EMX>, but is not functional, the same is
-true for perl.
+Since <flock> is present in B<EMX>, but is not functional, the same is
+true for perl. Here is the list of things which may be "broken" on
+EMX (from EMX docs):
+
+  - The functions recvmsg(), sendmsg(), and socketpair() are not
+    implemented.
+  - sock_init() is not required and not implemented.
+  - flock() is not yet implemented (dummy function).
+  - kill:
+      Special treatment of PID=0, PID=1 and PID=-1 is not implemented.
+  - waitpid:
+      WUNTRACED
+             Not implemented.
+      waitpid() is not implemented for negative values of PID.
+
+Note that C<kill -9> does not work with the current version of EMX.
 
 =item
 
@@ -974,6 +1025,36 @@ the current C<pdksh>.
 
 =back
 
+=head2 Modifications
+
+Perl modifies some standard C library calls in the following ways:
+
+=over 9
+
+=item C<popen>
+
+C<my_popen> always uses F<sh.exe>, cf. L<"PERL_SH_DIR">.
+
+=item C<tmpnam>
+
+is created using C<TMP> or C<TEMP> environment variable, via
+C<tempnam>.
+
+=item C<tmpfile>
+
+If the current directory is not writable, it is created using modified
+C<tmpnam>, so there may be a race condition.
+
+=item C<ctermid>
+
+a dummy implementation.
+
+=item C<stat>
+
+C<os2_stat> special-cases F</dev/tty> and F</dev/con>.
+
+=back
+
 =head1 Perl flavors
 
 Because of ideosyncrasies of OS/2 one cannot have all the eggs in the
diff --git a/config_H b/config_H

index 498a238..dec1e75 100644 (file)
--- a/config_H
+++ b/config_H
@@ -786,6 +786,24 @@
 #define HAS_SYS_ERRLIST        /**/
 #define Strerror(e) strerror(e)
 
+/* HAS_STRTOD:
+ *     This symbol, if defined, indicates that the strtod routine is
+ *     available to translate strings to doubles.
+ */
+#define HAS_STRTOD     /**/
+
+/* HAS_STRTOL:
+ *     This symbol, if defined, indicates that the strtol routine is
+ *     available to translate strings to integers.
+ */
+#define HAS_STRTOL     /**/
+
+/* HAS_STRTOUL:
+ *     This symbol, if defined, indicates that the strtoul routine is
+ *     available to translate strings to integers.
+ */
+#define HAS_STRTOUL    /**/
+
 /* HAS_STRXFRM:
  *     This symbol, if defined, indicates that the strxfrm() routine is
  *     available to transform strings.
diff --git a/configure b/configure

index 5316745..868e454 100755 (executable)
--- a/configure
+++ b/configure
@@ -21,12 +21,18 @@
 #
 
 (exit $?0) || exec sh $0 $argv:q
-if test $0 -ef `echo $0 | sed -e s/configure/Configure/`; then
-       echo "You're configure and Configure scripts seem to be identical."
+
+case "$0" in
+*configure)
+    if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
+       echo "Your configure and Configure scripts seem to be identical."
        echo "This can happen on filesystems that aren't fully case sensitive."
        echo "You'll have to explicitely extract Configure and run that."
        exit 1
-fi
+    fi
+    ;;
+esac
+
 opts=''
 verbose=''
 create='-e'
diff --git a/doio.c b/doio.c

index c1de1e0..6bb3fa5 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -418,7 +418,7 @@ register GV *gv;
                    (void)unlink(SvPVX(sv));
                    (void)rename(oldname,SvPVX(sv));
                    do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
-#endif /* MSDOS */
+#endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX(sv));
                    if (link(oldname,SvPVX(sv)) < 0) {
@@ -1057,7 +1057,7 @@ char *cmd;
     return FALSE;
 }
 
-#endif 
+#endif /* OS2 */
 
 I32
 apply(type,mark,sp)
@@ -1108,6 +1108,8 @@ register SV **sp;
 #ifdef HAS_KILL
     case OP_KILL:
        TAINT_PROPER("kill");
+       if (mark == sp)
+           break;
        s = SvPVx(*++mark, na);
        tot = sp - mark;
        if (isUPPER(*s)) {
@@ -1258,7 +1260,7 @@ register struct stat *statbufp;
       */
      return (bit & statbufp->st_mode) ? TRUE : FALSE;
 
-#else /* ! MSDOS */
+#else /* ! DOSISH */
     if ((effective ? euid : uid) == 0) {       /* root is special */
        if (bit == S_IXUSR) {
            if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
@@ -1279,7 +1281,7 @@ register struct stat *statbufp;
     else if (statbufp->st_mode & bit >> 6)
        return TRUE;    /* ok as "other" */
     return FALSE;
-#endif /* ! MSDOS */
+#endif /* ! DOSISH */
 }
 #endif /* ! VMS */
 
diff --git a/dosish.h b/dosish.h

index 7a8b431..ff7e245 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -1,11 +1,39 @@
 #define ABORT() abort();
 
-#define BIT_BUCKET "\dev\nul"
+#define SH_PATH "/bin/sh"
+
+#ifdef DJGPP
+#define BIT_BUCKET "nul"
+#define OP_BINARY O_BINARY
+void Perl_DJGPP_init();
+#define PERL_SYS_INIT(argcp, argvp) STMT_START {        \
+    Perl_DJGPP_init();    } STMT_END
+#else
 #define PERL_SYS_INIT(c,v)
+#define BIT_BUCKET "\dev\nul"
+#endif
+
 #define PERL_SYS_TERM()
 #define dXSUB_SYS int dummy
 #define TMPPATH "plXXXXXX"
 
+/*
+ * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were 
+ * running on DOS, *and* if we had to cope with 16 bit memory addressing 
+ * constraints, *and* we need to have memory allocated as unsigned long.
+ *
+ * with the advent of *real* compilers for DOS, they are not locked together.
+ * MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have 
+ * 16 bit memory addressing constraints".
+ *
+ * if you need the last, try #DEFINE MEM_SIZE unsigned long.
+ */
+#ifdef MSDOS
+ #ifndef DJGPP
+  #define HAS_64K_LIMIT
+ #endif
+#endif
+
 /* USEMYBINMODE
  *     This symbol, if defined, indicates that the program should
  *     use the routine my_binmode(FILE *fp, char iotype) to insure
diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el

index c78a148..ba4a863 100644 (file)
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -10,7 +10,7 @@
 
 ;; This file is not (yet) part of GNU Emacs. It may be distributed
 ;; either under the same terms as GNU Emacs, or under the same terms
-;; as Perl. You should have recieved a copy of Perl Artistic license
+;; as Perl. You should have received a copy of Perl Artistic license
 ;; along with the Perl distribution.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -24,13 +24,15 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
 
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.25 1996/09/06 09:51:41 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.29 1996/11/18 23:10:26 ilya Exp ilya $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -53,7 +55,7 @@
 
 ;;; The mode information (on C-h m) provides customization help.
 ;;; If you use font-lock feature of this mode, it is advisable to use
-;;; eather lazy-lock-mode or fast-lock-mode (available on ELisp
+;;; either lazy-lock-mode or fast-lock-mode (available on ELisp
 ;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
 
 ;;; Faces used now: three faces for first-class and second-class keywords
@@ -63,12 +65,12 @@
 ;;; not define them, so you need to define them manually. Maybe you have 
 ;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
 
-;;; If you have grayscale monitor, and do not have the variable
+;;; If you have a grayscale monitor, and do not have the variable
 ;;; font-lock-display-type bound to 'grayscale, insert 
 
 ;;; (setq font-lock-display-type 'grayscale)
 
-;;; to your .emacs file.
+;;; into your .emacs file.
 
 ;;;; This mode supports font-lock, imenu and mode-compile. In the
 ;;;; hairy version font-lock is on, but you should activate imenu
@@ -289,7 +291,7 @@
 ;;;  Electric-; should work better.
 ;;;  Minor bugs with POD marking.
 
-;;;; After 1.25
+;;;; After 1.25 (probably not...)
 ;;;  `cperl-info-page' introduced.  
 ;;;  To make `uncomment-region' working, `comment-region' would
 ;;;  not insert extra space.
@@ -302,10 +304,30 @@
 ;;;  are not treated.
 ;;;  POD/friends scan merged in one pass.
 ;;;  Syntax class is not used for analyzing the code, only char-syntax
-;;;  may be cecked against _ or'ed with w.
+;;;  may be checked against _ or'ed with w.
 ;;;  Syntax class of `:' changed to be _.
 ;;;  `cperl-find-bad-style' added.
 
+;;;; After 1.25
+;;;  When search for here-documents, we ignore commented << in simplest cases.
+;;;  `cperl-get-help' added, available on C-h v and from menu.
+;;;  Auto-help added. Default with `cperl-hairy', switchable on/off
+;;;   with startup variable `cperl-lazy-help-time' and from
+;;;   menu. Requires `run-with-idle-timer'.
+;;;  Highlighting of @abc{@efg} was wrong - interchanged two regexps.
+
+;;;; After 1.27
+;;;  Indentation: At toplevel after a label - fixed.
+;;;  1.27 was put to archives in binary mode ===> DOSish :-(
+
+;;;; After 1.28
+;;;  Thanks to Martin Buchholz <mrb@Eng.Sun.COM>: misprints in
+;;;  comments and docstrings corrected, XEmacs support cleaned up.
+;;;  The closing parenths would enclose the region into matching
+;;;  parens under the same conditions as the opening ones.
+;;;  Minor updates to `cperl-short-docs'.
+;;;  Will not consider <<= as start of here-doc.
+
 (defvar cperl-extra-newline-before-brace nil
   "*Non-nil means that if, elsif, while, until, else, for, foreach
 and do constructs look like:
@@ -409,6 +431,9 @@ Can be overwritten by `cperl-hairy' if nil.")
 The opposite behaviour is always available if prefixed with C-c.
 Can be overwritten by `cperl-hairy' if nil.")
 
+(defvar cperl-lazy-help-time nil
+  "*Not-nil (and non-null) means to show lazy help after given idle time.")
+
 (defvar cperl-pod-face 'font-lock-comment-face
   "*The result of evaluation of this expression is used for pod highlighting.")
 
@@ -431,7 +456,7 @@ You can always make lookup from menu or using \\[cperl-find-pods-heres].")
 May require patched `imenu' and `imenu-go'.")
 
 (defvar cperl-info-page "perl"
-  "Name of the info page containging perl docs.
+  "Name of the info page containing perl docs.
 Older version of this page was called `perl5', newer `perl'.")
 
 \f
@@ -469,6 +494,8 @@ CPerl/Tools/Tags menu beforehand.
 
 Run CPerl/Tools/Insert-spaces-if-needed to fix your lazy typing.
 
+Switch auto-help on/off with CPerl/Tools/Auto-help.
+
 Before reporting (non-)problems look in the problem section on what I
 know about them.")
 
@@ -479,26 +506,26 @@ It may be corrected on the level of C code, please look in the
 `non-problems' section if you want to volunteer.
 
 CPerl mode tries to corrects some Emacs misunderstandings, however,
-for effeciency reasons the degree of correction is different for
+for efficiency reasons the degree of correction is different for
 different operations. The partially corrected problems are: POD
 sections, here-documents, regexps. The operations are: highlighting,
 indentation, electric keywords, electric braces. 
 
 This may be confusing, since the regexp s#//#/#\; may be highlighted
-as a comment, but it will recognized as a regexp by the indentation
+as a comment, but it will be recognized as a regexp by the indentation
 code. Or the opposite case, when a pod section is highlighted, but
 breaks the indentation of the following code.
 
 The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think out is
+${aaa} look like unbalanced braces. The only trick I can think of is
 to insert it as $ {aaa} (legal in perl5, not in perl4). 
 
 Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transpositinon is not always possible
+as /($|\\s)/. Note that such a transposition is not always possible
 :-(.  " )
 
 (defvar cperl-non-problems 'please-ignore-this-line
-"As you know from `problems' section, Perl syntax too hard for CPerl.
+"As you know from `problems' section, Perl syntax is too hard for CPerl.
 
 Most the time, if you write your own code, you may find an equivalent
 \(and almost as readable) expression.
@@ -530,7 +557,7 @@ b) Supply the code to me (IZ).
 Pods are treated _very_ rudimentally. Here-documents are not treated
 at all (except highlighting and inhibiting indentation). (This may
 change some time. RMS approved making syntax lookup recognize text
-attributes, but volonteers are needed to change Emacs C code.)
+attributes, but volunteers are needed to change Emacs C code.)
 
 To speed up coloring the following compromises exist:
    a) sub in $mypackage::sub may be highlighted.
@@ -546,8 +573,13 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 
 ;;; Portability stuff:
 
-(defsubst cperl-xemacs-p ()
-  (string-match "XEmacs\\|Lucid" emacs-version))
+(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
+(defmacro cperl-define-key (fsf-key definition &optional xemacs-key)
+  `(define-key cperl-mode-map
+     ,(if xemacs-key
+         `(if cperl-xemacs-p ,xemacs-key ,fsf-key)
+       fsf-key)
+     ,definition))
 
 (defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
                                 (where-is-internal 'backward-delete-char-untabify)))
@@ -556,7 +588,7 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 (and (vectorp del-back-ch) (= (length del-back-ch) 1) 
      (setq del-back-ch (aref del-back-ch 0)))
 
-(if (cperl-xemacs-p)
+(if cperl-xemacs-p
     (progn
       ;; "Active regions" are on: use region only if active
       ;; "Active regions" are off: use region unconditionally
@@ -568,10 +600,10 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
   (defun cperl-mark-active () mark-active))
 
 (defsubst cperl-enable-font-lock ()
-  (or (cperl-xemacs-p) window-system))
+  (or cperl-xemacs-p window-system))
 
 (if (boundp 'unread-command-events)
-    (if (cperl-xemacs-p)
+    (if cperl-xemacs-p
        (defun cperl-putback-char (c)   ; XEmacs >= 19.12
          (setq unread-command-events (list (character-to-event c))))
       (defun cperl-putback-char (c)    ; Emacs 19
@@ -628,39 +660,37 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
 
 (if cperl-mode-map nil
   (setq cperl-mode-map (make-sparse-keymap))
-  (define-key cperl-mode-map "{" 'cperl-electric-lbrace)
-  (define-key cperl-mode-map "[" 'cperl-electric-paren)
-  (define-key cperl-mode-map "(" 'cperl-electric-paren)
-  (define-key cperl-mode-map "<" 'cperl-electric-paren)
-  (define-key cperl-mode-map "}" 'cperl-electric-brace)
-  (define-key cperl-mode-map ";" 'cperl-electric-semi)
-  (define-key cperl-mode-map ":" 'cperl-electric-terminator)
-  (define-key cperl-mode-map "\C-j" 'newline-and-indent)
-  (define-key cperl-mode-map "\C-c\C-j" 'cperl-linefeed)
-  (define-key cperl-mode-map "\C-c\C-a" 'cperl-toggle-auto-newline)
-  (define-key cperl-mode-map "\C-c\C-k" 'cperl-toggle-abbrev)
-  (define-key cperl-mode-map "\C-c\C-e" 'cperl-toggle-electric)
-  (define-key cperl-mode-map "\e\C-q" 'cperl-indent-exp) ; Usually not bound
-  ;;(define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
-  ;;(define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
-  (define-key cperl-mode-map "\177" 'cperl-electric-backspace)
-  (define-key cperl-mode-map "\t" 'cperl-indent-command)
-  (if (cperl-xemacs-p)
-      ;; don't clobber the backspace binding:
-      (define-key cperl-mode-map [(control h) f] 'cperl-info-on-command)
-    (define-key cperl-mode-map "\C-hf" 'cperl-info-on-command))
-  (if (cperl-xemacs-p)
-      ;; don't clobber the backspace binding:
-      (define-key cperl-mode-map [(control c) (control h) f]
-       'cperl-info-on-current-command)
-    (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-current-command))
-  (if (and (cperl-xemacs-p) 
+  (cperl-define-key "{" 'cperl-electric-lbrace)
+  (cperl-define-key "[" 'cperl-electric-paren)
+  (cperl-define-key "(" 'cperl-electric-paren)
+  (cperl-define-key "<" 'cperl-electric-paren)
+  (cperl-define-key "}" 'cperl-electric-brace)
+  (cperl-define-key "]" 'cperl-electric-rparen)
+  (cperl-define-key ")" 'cperl-electric-rparen)
+  (cperl-define-key ";" 'cperl-electric-semi)
+  (cperl-define-key ":" 'cperl-electric-terminator)
+  (cperl-define-key "\C-j" 'newline-and-indent)
+  (cperl-define-key "\C-c\C-j" 'cperl-linefeed)
+  (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
+  (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
+  (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
+  (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+  ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
+  ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
+  (cperl-define-key "\177" 'cperl-electric-backspace)
+  (cperl-define-key "\t" 'cperl-indent-command)
+  ;; don't clobber the backspace binding:
+  (cperl-define-key "\C-hf" 'cperl-info-on-command [(control h) f])
+  (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
+                   [(control c) (control h) f])
+  (cperl-define-key "\C-hv" 'cperl-get-help [(control h) v])
+  (if (and cperl-xemacs-p 
           (<= emacs-minor-version 11) (<= emacs-major-version 19))
       (progn
        ;; substitute-key-definition is usefulness-deenhanced...
-       (define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
-       (define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
-       (define-key cperl-mode-map "\e\C-\\" 'cperl-indent-region))
+       (cperl-define-key "\M-q" 'cperl-fill-paragraph)
+       (cperl-define-key "\e;" 'cperl-indent-for-comment)
+       (cperl-define-key "\e\C-\\" 'cperl-indent-region))
     (substitute-key-definition
      'indent-sexp 'cperl-indent-exp
      cperl-mode-map global-map)
@@ -728,7 +758,11 @@ Imenu in 19.31 is broken. Set `imenu-use-keymap-menu' to t, and remove
            ["Define word at point" imenu-go-find-at-position 
             (fboundp 'imenu-go-find-at-position)]
            ["Help on function" cperl-info-on-command t]
-           ["Help on function at point" cperl-info-on-current-command t])
+           ["Help on function at point" cperl-info-on-current-command t]
+           ["Help on symbol at point" cperl-get-help t]
+           ["Auto-help on" cperl-lazy-install (fboundp 'run-with-idle-timer)]
+           ["Auto-help off" cperl-lazy-unstall 
+            (fboundp 'run-with-idle-timer)])
           ("Toggle..."
            ["Auto newline" cperl-toggle-auto-newline t]
            ["Electric parens" cperl-toggle-electric t]
@@ -830,13 +864,13 @@ between the braces. If CPerl decides that you want to insert
 it will not do any expansion. See also help on variable 
 `cperl-extra-newline-before-brace'.
 
-\\[cperl-linefeed] is a convinience replacement for typing carriage
+\\[cperl-linefeed] is a convenience replacement for typing carriage
 return. It places you in the next line with proper indentation, or if
 you type it inside the inline block of control construct, like
             foreach (@lines) {print; print}
 and you are on a boundary of a statement inside braces, it will
 transform the construct into a multiline and will place you into an
-apporpriately indented blank line. If you need a usual 
+appropriately indented blank line. If you need a usual 
 `newline-and-indent' behaviour, it is on \\[newline-and-indent], 
 see documentation on `cperl-electric-linefeed'.
 
@@ -862,6 +896,15 @@ These keys run commands `cperl-info-on-current-command' and
 `cperl-info-on-command', which one is which is controlled by variable
 `cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy').
 
+Even if you have no info-format documentation, short one-liner-style
+help is available on \\[cperl-get-help]. 
+
+It is possible to show this help automatically after some idle
+time. This is regulated by variable `cperl-lazy-help-time'.  Default
+with `cperl-hairy' is 5 secs idle time if the value of this variable
+is nil.  It is also possible to switch this on/off from the
+menu. Requires `run-with-idle-timer'.
+
 Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
 `cperl-pod-face', `cperl-pod-head-face' control processing of pod and
 here-docs sections. In a future version results of scan may be used
@@ -926,15 +969,10 @@ with no args."
        (local-set-key "\C-C\C-J" 'newline-and-indent)))
   (if (cperl-val 'cperl-info-on-command-no-prompt)
       (progn
-       (if (cperl-xemacs-p)
-           ;; don't clobber the backspace binding:
-           (local-set-key [(control h) f] 'cperl-info-on-current-command)
-         (local-set-key "\C-hf" 'cperl-info-on-current-command))
-       (if (cperl-xemacs-p)
-           ;; don't clobber the backspace binding:
-           (local-set-key [(control c) (control h) f]
-                          'cperl-info-on-command)
-         (local-set-key "\C-c\C-hf" 'cperl-info-on-command))))
+       ;; don't clobber the backspace binding:
+       (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
+       (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
+                         [(control c) (control h) f])))
   (setq major-mode 'perl-mode)
   (setq mode-name "CPerl")
   (if (not cperl-mode-abbrev-table)
@@ -1009,6 +1047,8 @@ with no args."
   (and (boundp 'msb-menu-cond)
        (not cperl-msb-fixed)
        (cperl-msb-fix))
+  (if (featurep 'easymenu)
+      (easy-menu-add cperl-menu))      ; A NOP under FSF Emacs.
   (run-hooks 'cperl-mode-hook)
   ;; After hooks since fontification will break this
   (if cperl-pod-here-scan (cperl-find-pods-heres)))
@@ -1089,7 +1129,7 @@ with no args."
 ;;;      (setq prevc (current-column)))))))
 
 (defun cperl-indent-for-comment ()
-  "Substite for `indent-for-comment' in CPerl."
+  "Substitute for `indent-for-comment' in CPerl."
   (interactive)
   (let (cperl-wrong-comment)
     (indent-for-comment)
@@ -1111,6 +1151,8 @@ See `comment-region'."
   (let ((comment-start "#"))
     (comment-region b e (- arg))))
 
+(defvar cperl-brace-recursing nil)
+
 (defun cperl-electric-brace (arg &optional only-before)
   "Insert character and correct line's indentation.
 If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
@@ -1118,55 +1160,74 @@ place (even in empty line), but not after. If after \")\" and the inserted
 char is \"{\", insert extra newline before only if 
 `cperl-extra-newline-before-brace'."
   (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)                 ; No args, end (of empty line or auto)
-            (eolp)
-            (or (and (null only-before)
-                     (save-excursion
-                       (skip-chars-backward " \t")
-                       (bolp)))
-                (and (eq last-command-char ?\{) ; Do not insert newline
-                     ;; if after ")" and `cperl-extra-newline-before-brace'
-                     ;; is nil, do not insert extra newline.
-                     (not cperl-extra-newline-before-brace)
-                     (save-excursion
-                       (skip-chars-backward " \t")
-                       (eq (preceding-char) ?\))))
-                (if cperl-auto-newline 
-                    (progn (cperl-indent-line) (newline) t) nil)))
+  (let (insertpos
+       (other-end (if (and cperl-electric-parens-mark
+                           (cperl-mark-active) 
+                           (< (mark) (point)))
+                      (mark) 
+                    nil)))
+    (if (and other-end
+            (not cperl-brace-recursing)
+            (cperl-val 'cperl-electric-parens)
+            (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)))
+       ;; Need to insert a matching pair
        (progn
-         (if cperl-auto-newline
-             (setq insertpos (point)))
-         (insert last-command-char)
-         (cperl-indent-line)
-         (if (and cperl-auto-newline (null only-before))
-             (progn
-               (newline)
-               (cperl-indent-line)))
          (save-excursion
-           (if insertpos (progn (goto-char insertpos)
-                                (search-forward (make-string 
-                                                 1 last-command-char))
-                                (setq insertpos (1- (point)))))
-           (delete-char -1))))
-    (if insertpos
-       (save-excursion
-         (goto-char insertpos)
-         (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
+           (setq insertpos (point-marker))
+           (goto-char other-end)
+           (setq last-command-char ?\{)
+           (cperl-electric-lbrace arg insertpos))
+         (forward-char 1))
+      (if (and (not arg)               ; No args, end (of empty line or auto)
+              (eolp)
+              (or (and (null only-before)
+                       (save-excursion
+                         (skip-chars-backward " \t")
+                         (bolp)))
+                  (and (eq last-command-char ?\{) ; Do not insert newline
+                       ;; if after ")" and `cperl-extra-newline-before-brace'
+                       ;; is nil, do not insert extra newline.
+                       (not cperl-extra-newline-before-brace)
+                       (save-excursion
+                         (skip-chars-backward " \t")
+                         (eq (preceding-char) ?\))))
+                  (if cperl-auto-newline 
+                      (progn (cperl-indent-line) (newline) t) nil)))
+         (progn
+           (if cperl-auto-newline
+               (setq insertpos (point)))
+           (insert last-command-char)
+           (cperl-indent-line)
+           (if (and cperl-auto-newline (null only-before))
+               (progn
+                 (newline)
+                 (cperl-indent-line)))
+           (save-excursion
+             (if insertpos (progn (goto-char insertpos)
+                                  (search-forward (make-string 
+                                                   1 last-command-char))
+                                  (setq insertpos (1- (point)))))
+             (delete-char -1))))
+      (if insertpos
+         (save-excursion
+           (goto-char insertpos)
+           (self-insert-command (prefix-numeric-value arg)))
+       (self-insert-command (prefix-numeric-value arg))))))
 
-(defun cperl-electric-lbrace (arg)
+(defun cperl-electric-lbrace (arg &optional end)
   "Insert character, correct line's indentation, correct quoting by space."
   (interactive "P")
   (let (pos after 
+           (cperl-brace-recursing t)
            (cperl-auto-newline cperl-auto-newline)
-           (other-end (if (and cperl-electric-parens-mark
-                               (cperl-mark-active)
-                               (> (mark) (point)))
-                          (save-excursion
-                            (goto-char (mark))
-                            (point-marker)) 
-                        nil)))
+           (other-end (or end
+                          (if (and cperl-electric-parens-mark
+                                   (cperl-mark-active)
+                                   (> (mark) (point)))
+                              (save-excursion
+                                (goto-char (mark))
+                                (point-marker)) 
+                            nil))))
     (and (cperl-val 'cperl-electric-lbrace-space)
         (eq (preceding-char) ?$)
         (save-excursion
@@ -1215,10 +1276,39 @@ char is \"{\", insert extra newline before only if
       (insert last-command-char)
       )))
 
+(defun cperl-electric-rparen (arg)
+  "Insert a matching pair of parentheses if marking is active.
+If not, or if we are not at the end of marking range, would self-insert."
+  (interactive "P")
+  (let ((beg (save-excursion (beginning-of-line) (point)))
+       (other-end (if (and cperl-electric-parens-mark
+                           (cperl-mark-active) 
+                           (< (mark) (point)))
+                      (mark) 
+                    nil))
+       p)
+    (if (and other-end
+            (cperl-val 'cperl-electric-parens)
+            (memq last-command-char '( ?\) ?\] ?\} ?\> ))
+            (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
+            ;;(not (save-excursion (search-backward "#" beg t)))
+            )
+       (progn
+         (insert last-command-char)
+         (setq p (point))
+         (if other-end (goto-char other-end))
+         (insert (cdr (assoc last-command-char '((?\} . ?\{)
+                                                 (?\] . ?\[)
+                                                 (?\) . ?\()
+                                                 (?\> . ?\<)))))
+         (goto-char (1+ p)))
+      (call-interactively 'self-insert-command)
+      )))
+
 (defun cperl-electric-keyword ()
   "Insert a construction appropriate after a keyword."
   (let ((beg (save-excursion (beginning-of-line) (point))) 
-       (dollar (eq (preceding-char) ?$)))
+       (dollar (eq last-command-char ?$)))
     (and (save-excursion
           (backward-sexp 1)
           (cperl-after-expr-p nil "{};:"))
@@ -1659,7 +1749,12 @@ Returns nil if line starts inside a string, t if in a comment."
                    ;; Now add a little if this is a continuation line.
                    (if (or (bobp)
                            (memq (preceding-char) (append " ;}" nil)) ; Was ?\)
-                           (memq char-after (append ")]}" nil))) 
+                           (memq char-after (append ")]}" nil))
+                           (and (eq (preceding-char) ?\:) ; label
+                                (progn
+                                  (forward-sexp -1)
+                                  (skip-chars-backward " \t")
+                                  (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) 
                        0
                      cperl-continued-statement-offset))))
              ((/= (char-after containing-sexp) ?{)
@@ -1721,7 +1816,7 @@ Returns nil if line starts inside a string, t if in a comment."
                 (or
                  ;; If no, find that first statement and indent like
                  ;; it.  If the first statement begins with label, do
-                 ;; not belive when the indentation of the label is too
+                 ;; not believe when the indentation of the label is too
                  ;; small.
                  (save-excursion
                    (forward-char 1)
@@ -1744,7 +1839,7 @@ Returns nil if line starts inside a string, t if in a comment."
                               (if (> (current-indentation) 
                                      cperl-min-label-indent)
                                   (- (current-indentation) cperl-label-offset)
-                                ;; Do not belive: `max' is involved
+                                ;; Do not believe: `max' is involved
                                 (+ old-indent cperl-indent-level))
                             (current-column)))))
                  ;; If no previous statement,
@@ -1894,7 +1989,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
               (or
                ;; If no, find that first statement and indent like
                ;; it.  If the first statement begins with label, do
-               ;; not belive when the indentation of the label is too
+               ;; not believe when the indentation of the label is too
                ;; small.
                (save-excursion
                  (forward-char 1)
@@ -1920,7 +2015,7 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
                             (if (> (current-indentation) 
                                    cperl-min-label-indent)
                                 (list (list 'label-in-block (point)))
-                              ;; Do not belive: `max' is involved
+                              ;; Do not believe: `max' is involved
                               (list
                                (list 'label-in-block-min-indent (point))))
                           ;; Before statement
@@ -2042,7 +2137,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
               "\\(\\`\n?\\|\n\n\\)=" 
               "\\|"
               ;; One extra () before this:
-              "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
+              "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)[^=]\\)" ; [^=] to avoid <<=.
               "\\|"
               ;; 1+5 extra () before this:
               "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
@@ -2105,74 +2200,82 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                (match-beginning 1) (match-end 1)
                                'face head-face))))
                  (goto-char e)))
-             ;; 1 () ahead
-             ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
-             ((match-beginning 2)      ; 1 + 1
-              (if (match-beginning 5)  ;4 + 1
-                 (setq b1 (match-beginning 5) ; 4 + 1
-                       e1 (match-end 5)) ; 4 + 1
-               (setq b1 (match-beginning 4) ; 3 + 1
-                     e1 (match-end 4))) ; 3 + 1
-             (setq tag (buffer-substring b1 e1)
-                   qtag (regexp-quote tag))
-             (cond (cperl-pod-here-fontify 
-                    (put-text-property b1 e1 'face font-lock-reference-face)
-                    (cperl-put-do-not-fontify b1 e1)))
-             (forward-line)
-             (setq b (point))
-             (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
-                    (if cperl-pod-here-fontify 
-                        (progn
-                          (put-text-property (match-beginning 0) (match-end 0) 
-                                             'face font-lock-reference-face)
-                          (cperl-put-do-not-fontify b (match-end 0))
-                          ;;(put-text-property (max (point-min) (1- b))
-                          ;;                 (min (point-max)
-                          ;;                      (1+ (match-end 0)))
-                          ;;                 cperl-do-not-fontify t)
-                          (put-text-property b (match-beginning 0) 
-                                             'face here-face)))
-                    (put-text-property b (match-beginning 0) 
-                                       'syntax-type 'here-doc)
-                    (cperl-put-do-not-fontify b (match-beginning 0)))
-                   (t (message "End of here-document `%s' not found." tag))))
-             (t
-              ;; 1+5=6 extra () before this:
-              ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
-              (setq b (point)
-                    name (if (match-beginning 7) ; 6 + 1
-                             (buffer-substring (match-beginning 7) ; 6 + 1
-                                               (match-end 7)) ; 6 + 1
-                           ""))
-              (setq argument nil)
-              (if cperl-pod-here-fontify 
-                  (while (and (eq (forward-line) 0)
-                              (not (looking-at "^[.;]$")))
-                    (cond
-                     ((looking-at "^#")) ; Skip comments
-                     ((and argument    ; Skip argument multi-lines
-                           (looking-at "^[ \t]*{")) 
-                      (forward-sexp 1)
-                      (setq argument nil))
-                     (argument         ; Skip argument lines
-                      (setq argument nil))
-                     (t                ; Format line
-                      (setq b1 (point))
-                      (setq argument (looking-at "^[^\n]*[@^]"))
-                      (end-of-line)
-                      (put-text-property b1 (point) 
-                                         'face font-lock-string-face)
-                      (cperl-put-do-not-fontify b1 (point)))))
-                (re-search-forward (concat "^[.;]$") max 'toend))
-              (beginning-of-line)
-              (if (looking-at "^[.;]$")
-                  (progn
-                    (put-text-property (point) (+ (point) 2)
-                                       'face font-lock-string-face)
-                    (cperl-put-do-not-fontify (point) (+ (point) 2)))
-                (message "End of format `%s' not found." name))
-              (forward-line)
-              (put-text-property b (point) 'syntax-type 'format)
+              ;; Here document
+              ;; 1 () ahead
+              ;; "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)\\)"
+              ((match-beginning 2)     ; 1 + 1
+               ;; Abort in comment (_extremely_ simplified):
+               (setq b (point))
+               (if (save-excursion
+                     (beginning-of-line)
+                     (search-forward "#" b t))
+                   nil
+                 (if (match-beginning 5) ;4 + 1
+                     (setq b1 (match-beginning 5) ; 4 + 1
+                           e1 (match-end 5)) ; 4 + 1
+                   (setq b1 (match-beginning 4) ; 3 + 1
+                         e1 (match-end 4))) ; 3 + 1
+                 (setq tag (buffer-substring b1 e1)
+                       qtag (regexp-quote tag))
+                 (cond (cperl-pod-here-fontify 
+                        (put-text-property b1 e1 'face font-lock-reference-face)
+                        (cperl-put-do-not-fontify b1 e1)))
+                 (forward-line)
+                 (setq b (point))
+                 (cond ((re-search-forward (concat "^" qtag "$") max 'toend)
+                        (if cperl-pod-here-fontify 
+                            (progn
+                              (put-text-property (match-beginning 0) (match-end 0) 
+                                                 'face font-lock-reference-face)
+                              (cperl-put-do-not-fontify b (match-end 0))
+                              ;;(put-text-property (max (point-min) (1- b))
+                              ;;                     (min (point-max)
+                              ;;                          (1+ (match-end 0)))
+                              ;;                     cperl-do-not-fontify t)
+                              (put-text-property b (match-beginning 0) 
+                                                 'face here-face)))
+                        (put-text-property b (match-beginning 0) 
+                                           'syntax-type 'here-doc)
+                        (cperl-put-do-not-fontify b (match-beginning 0)))
+                       (t (message "End of here-document `%s' not found." tag)))))
+              ;; format
+              (t
+               ;; 1+5=6 extra () before this:
+               ;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
+               (setq b (point)
+                     name (if (match-beginning 7) ; 6 + 1
+                              (buffer-substring (match-beginning 7) ; 6 + 1
+                                                (match-end 7)) ; 6 + 1
+                            ""))
+               (setq argument nil)
+               (if cperl-pod-here-fontify 
+                   (while (and (eq (forward-line) 0)
+                               (not (looking-at "^[.;]$")))
+                     (cond
+                      ((looking-at "^#")) ; Skip comments
+                      ((and argument   ; Skip argument multi-lines
+                            (looking-at "^[ \t]*{")) 
+                       (forward-sexp 1)
+                       (setq argument nil))
+                      (argument        ; Skip argument lines
+                       (setq argument nil))
+                      (t               ; Format line
+                       (setq b1 (point))
+                       (setq argument (looking-at "^[^\n]*[@^]"))
+                       (end-of-line)
+                       (put-text-property b1 (point) 
+                                          'face font-lock-string-face)
+                       (cperl-put-do-not-fontify b1 (point)))))
+                 (re-search-forward (concat "^[.;]$") max 'toend))
+               (beginning-of-line)
+               (if (looking-at "^[.;]$")
+                   (progn
+                     (put-text-property (point) (+ (point) 2)
+                                        'face font-lock-string-face)
+                     (cperl-put-do-not-fontify (point) (+ (point) 2)))
+                 (message "End of format `%s' not found." name))
+               (forward-line)
+               (put-text-property b (point) 'syntax-type 'format)
 ;;;           (cond ((re-search-forward (concat "^[.;]$") max 'toend)
 ;;;                  (if cperl-pod-here-fontify 
 ;;;                      (progn
@@ -2183,7 +2286,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 ;;;                                     'syntax-type 'format)
 ;;;                  (cperl-put-do-not-fontify b (match-beginning 0)))
 ;;;                 (t (message "End of format `%s' not found." name)))
-              )))
+               )))
 ;;;        (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
 ;;;          (if (looking-at "\n*cut\\>")
 ;;;              (progn
@@ -2734,36 +2837,43 @@ indentation and initial hashes. Behaves usually outside of comment."
               "\\|")                   ; Flow control
              "\\)\\>") 2)              ; was "\\)[ \n\t;():,\|&]"
                                        ; In what follows we use `type' style
-                                       ; for overwritable buildins
+                                       ; for overwritable builtins
            (list
             (concat
              "\\(^\\|[^$@%&\\]\\)\\<\\("
-             ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2"
-             ;; "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr"
-             ;; "chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
-             ;; "crypt" "dbmclose" "dbmopen" "die" "dump" "endgrent" "endhostent"
-             ;; "endnetent" "endprotoent" "endpwent" "endservent" "eof" "eq" "exec"
-             ;; "exit" "exp" "fcntl" "fileno" "flock" "fork" "formline" "ge" "getc"
-             ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" "gethostbyname"
-             ;; "gethostent" "getlogin" "getnetbyaddr" "getnetbyname" "getnetent"
-             ;; "getpeername" "getpgrp" "getppid" "getpriority" "getprotobyname"
-             ;; "getprotobynumber" "getprotoent" "getpwent" "getpwnam" "getpwuid"
-             ;; "getservbyname" "getservbyport" "getservent" "getsockname"
-             ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" "ioctl"
-             ;; "join" "kill" "lc" "lcfirst" "le" "length" "link" "listen"
-             ;; "localtime" "log" "lstat" "lt" "mkdir" "msgctl" "msgget" "msgrcv"
-             ;; "msgsnd" "ne" "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
-             ;; "quotemeta" "rand" "read" "readdir" "readline" "readlink"
-             ;; "readpipe" "recv" "ref" "rename" "require" "reset" "reverse"
-             ;; "rewinddir" "rindex" "rmdir" "seek" "seekdir" "select" "semctl"
-             ;; "semget" "semop" "send" "setgrent" "sethostent" "setnetent"
-             ;; "setpgrp" "setpriority" "setprotoent" "setpwent" "setservent"
-             ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" "shutdown"
-             ;; "sin" "sleep" "socket" "socketpair" "sprintf" "sqrt" "srand" "stat"
-             ;; "substr" "symlink" "syscall" "sysread" "system" "syswrite" "tell"
-             ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" "umask" "unlink"
-             ;; "unpack" "utime" "values" "vec" "wait" "waitpid" "wantarray" "warn"
-             ;; "write" "x" "xor"
+             ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm"
+             ;; "and" "atan2" "bind" "binmode" "bless" "caller"
+             ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
+             ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
+             ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
+             ;; "endhostent" "endnetent" "endprotoent" "endpwent"
+             ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fcntl"
+             ;; "fileno" "flock" "fork" "formline" "ge" "getc"
+             ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
+             ;; "gethostbyname" "gethostent" "getlogin"
+             ;; "getnetbyaddr" "getnetbyname" "getnetent"
+             ;; "getpeername" "getpgrp" "getppid" "getpriority"
+             ;; "getprotobyname" "getprotobynumber" "getprotoent"
+             ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
+             ;; "getservbyport" "getservent" "getsockname"
+             ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
+             ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
+             ;; "link" "listen" "localtime" "log" "lstat" "lt"
+             ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
+             ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
+             ;; "quotemeta" "rand" "read" "readdir" "readline"
+             ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
+             ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
+             ;; "seekdir" "select" "semctl" "semget" "semop" "send"
+             ;; "setgrent" "sethostent" "setnetent" "setpgrp"
+             ;; "setpriority" "setprotoent" "setpwent" "setservent"
+             ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
+             ;; "shutdown" "sin" "sleep" "socket" "socketpair"
+             ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
+             ;; "syscall" "sysread" "system" "syswrite" "tell"
+             ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
+             ;; "umask" "unlink" "unpack" "utime" "values" "vec"
+             ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
              "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|" 
              "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
              "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
@@ -2797,18 +2907,20 @@ indentation and initial hashes. Behaves usually outside of comment."
              "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
              "\\)\\>") 2 'font-lock-type-face)
            ;; In what follows we use `other' style
-           ;; for nonoverwritable buildins
-           ;; Somehow 's', 'm' are not autogenerated???
+           ;; for nonoverwritable builtins
+           ;; Somehow 's', 'm' are not auto-generated???
            (list
             (concat
              "\\(^\\|[^$@%&\\]\\)\\<\\("
-             ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp" "chop"
-             ;; "defined" "delete" "do" "each" "else" "elsif" "eval" "exists" "for"
-             ;; "foreach" "format" "goto" "grep" "if" "keys" "last" "local" "map"
-             ;; "my" "next" "no" "package" "pop" "pos" "print" "printf" "push" "q"
-             ;; "qq" "qw" "qx" "redo" "return" "scalar" "shift" "sort" "splice"
-             ;; "split" "study" "sub" "tie" "tr" "undef" "unless" "unshift" "untie"
-             ;; "until" "use" "while" "y"
+             ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp"
+             ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
+             ;; "eval" "exists" "for" "foreach" "format" "goto"
+             ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
+             ;; "no" "package" "pop" "pos" "print" "printf" "push"
+             ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift"
+             ;; "sort" "splice" "split" "study" "sub" "tie" "tr"
+             ;; "undef" "unless" "unshift" "untie" "until" "use"
+             ;; "while" "y"
              "AUTOLOAD\\|BEGIN\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
              "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
              "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|"
@@ -2825,7 +2937,7 @@ indentation and initial hashes. Behaves usually outside of comment."
            ;;                       "#include" "#define" "#undef")
            ;;                     "\\|")
            '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
-             font-lock-function-name-face) ; Not very good, triggers at "[a-z]"
+             font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
            '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
              font-lock-function-name-face)
            '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
@@ -2871,8 +2983,14 @@ indentation and initial hashes. Behaves usually outside of comment."
          (setq 
           t-font-lock-keywords-1
           (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
-               (not (cperl-xemacs-p)) ; not yet as of XEmacs 19.12
-               '(("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
+               (not cperl-xemacs-p) ; not yet as of XEmacs 19.12
+               '(
+                 ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
+                  (if (eq (char-after (match-beginning 2)) ?%)
+                      font-lock-other-emphasized-face
+                    font-lock-emphasized-face)
+                  t)                   ; arrays and hashes
+                 ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
                   1
                   (if (= (- (match-end 2) (match-beginning 2)) 1) 
                       (if (eq (char-after (match-beginning 3)) ?{)
@@ -2880,11 +2998,6 @@ indentation and initial hashes. Behaves usually outside of comment."
                         font-lock-emphasized-face) ; arrays and hashes
                     font-lock-variable-name-face) ; Just to put something
                   t)
-                 ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
-                  (if (eq (char-after (match-beginning 2)) ?%)
-                      font-lock-other-emphasized-face
-                    font-lock-emphasized-face)
-                  t)                   ; arrays and hashes
                  ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
                       ;;; Too much noise from \s* @s[ and friends
                  ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" 
@@ -2996,7 +3109,7 @@ indentation and initial hashes. Behaves usually outside of comment."
                'font-lock-other-type-face
                "Face to use for data types from another group.")
              )
-         (if (not (cperl-xemacs-p)) nil
+         (if (not cperl-xemacs-p) nil
            (or (boundp 'font-lock-comment-face)
                (defconst font-lock-comment-face
                  'font-lock-comment-face
@@ -3183,7 +3296,7 @@ Available styles are GNU, K&R, BSD and Whitesmith."
     (mode-compile)))
 
 (defun cperl-info-buffer ()
-  ;; Returns buffer with documentation. Creats if missing
+  ;; Returns buffer with documentation. Creates if missing
   (let ((info (get-buffer "*info-perl*")))
     (if info info
       (save-window-excursion
@@ -3283,7 +3396,7 @@ Available styles are GNU, K&R, BSD and Whitesmith."
 (defun cperl-lineup (beg end &optional step minshift)
   "Lineup construction in a region.
 Beginning of region should be at the start of a construction.
-All first occurences of this construction in the lines that are
+All first occurrences of this construction in the lines that are
 partially contained in the region are lined up at the same column.
 
 MINSHIFT is the minimal amount of space to insert before the construction.
@@ -3324,7 +3437,7 @@ Will not move the position at the start to the left."
        (setq tcol (current-column) seen t)
        (if (> tcol col) (setq col tcol)))
       (or seen
-         (error "The construction to line up occured only once"))
+         (error "The construction to line up occurred only once"))
       (goto-char beg)
       (setq col (+ col minshift))
       (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
@@ -3596,7 +3709,7 @@ in subdirectories too."
                ;; Name known
                (setcdr cons1 (cons (cons fileind (vector file info))
                                    (cdr cons1)))
-             ;; First occurence of the name, start alist
+             ;; First occurrence of the name, start alist
              (setq cons1 (cons name (list (cons fileind (vector file info)))))
              (if pack 
                  (setcar (cdr cperl-hierarchy)
@@ -3852,3 +3965,564 @@ Currently it is tuned to C and Perl syntax."
              found-bad found)))
     (not not-found)))
 
+\ 6
+;;; Getting help
+(defvar cperl-have-help-regexp 
+  ;;(concat "\\("
+  (mapconcat
+   'identity
+   '("[$@%*&][0-9a-zA-Z_:]+"           ; Usual variable
+     "[$@]\\^[a-zA-Z]"                 ; Special variable
+     "[$@][^ \n\t]"                    ; Special variable
+     "-[a-zA-Z]"                       ; File test
+     "\\\\[a-zA-Z0]"                   ; Special chars
+     "[-!&*+,-./<=>?\\\\^|~]+"         ; Operator
+     "[a-zA-Z_0-9:]+"                  ; symbol or number
+     "x="
+     "#!"
+     )
+   ;;"\\)\\|\\("
+   "\\|"
+   )
+         ;;"\\)"
+         ;;)
+  "Matches places in the buffer we can find help for.")
+
+(defvar cperl-message-on-help-error t)
+
+(defun cperl-get-help ()
+  "Get one-line docs on the symbol at the point.
+The data for these docs is a little bit obsolete and may be in fact longer
+than a line. Your contribution to update/shorten it is appreciated."
+  (interactive)
+  (save-excursion
+    ;; Get to the something meaningful
+    (or (eobp) (eolp) (forward-char 1))
+    (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" 
+                       (save-excursion (beginning-of-line) (point))
+                       'to-beg)
+    ;;  (cond
+    ;;   ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
+    ;;    (skip-chars-backward " \n\t\r({[]});,")
+    ;;    (or (bobp) (backward-char 1))))
+    ;; Try to backtrace
+    (cond
+     ((looking-at "[a-zA-Z0-9_:]")     ; symbol
+      (skip-chars-backward "[a-zA-Z0-9_:]")
+      (cond 
+       ((and (eq (preceding-char) ?^)  ; $^I
+            (eq (char-after (- (point) 2)) ?\$))
+       (forward-char -2))
+       ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob
+       (forward-char -1)))
+      (if (and (eq (preceding-char) ?\<)
+              (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH>
+         (forward-char -1)))
+     ((and (looking-at "=") (eq (preceding-char) ?x)) ; x=
+      (forward-char -1))
+     ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
+      (forward-char -1))
+     ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
+      (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
+      (cond
+       ((and (eq (preceding-char) ?\$)
+              (not (eq (char-after (- (point) 2)) ?\$))) ; $-
+         (forward-char -1))
+       ((and (eq (following-char) ?\>)
+            (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char)))
+            (save-excursion
+              (forward-sexp -1)
+              (and (eq (preceding-char) ?\<)
+                   (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH>
+       (search-backward "<"))))
+     ((and (eq (following-char) ?\$)
+          (eq (preceding-char) ?\<)
+          (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh>
+      (forward-char -1)))
+    ;;(or (eobp) (forward-char 1))
+    (if (looking-at cperl-have-help-regexp)
+       (cperl-describe-perl-symbol 
+        (buffer-substring (match-beginning 0) (match-end 0)))
+      (if cperl-message-on-help-error
+         (message "Nothing found for %s..." 
+                  (buffer-substring (point) (+ 5 (point))))))))
+
+;;; Stolen from perl-descr.el by Johan Vromans:
+
+(defvar cperl-doc-buffer " *perl-doc*"
+  "Where the documentation can be found.")
+
+(defun cperl-describe-perl-symbol (val)
+  "Display the documentation of symbol at point, a Perl operator."
+  ;; We suppose that the current position is at the start of the symbol
+  ;; when we convert $_[5] to @_
+  (let (;;(fn (perl-symbol-at-point))
+       (enable-recursive-minibuffers t)
+       ;;val 
+       args-file regexp)
+    ;;  (interactive
+    ;;    (let ((fn (perl-symbol-at-point))
+    ;;   (enable-recursive-minibuffers t)
+    ;;   val args-file regexp)
+    ;;      (setq val (read-from-minibuffer
+    ;;           (if fn
+    ;;               (format "Symbol (default %s): " fn)
+    ;;             "Symbol: ")))
+    ;;      (if (string= val "")
+    ;;   (setq val fn))
+    (cond
+       ((string-match "^[&*][a-zA-Z_]" val)
+        (setq val (concat (substring val 0 1) "NAME")))
+       ((looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+        (if (= ?\[ (char-after (match-beginning 1)))
+             (setq val (concat "@" (substring val 1)))
+           (setq val (concat "%" (substring val 1)))))
+       ((and (string= val "x") (looking-at "x="))
+        (setq val "x="))
+       ((string-match "^\\$[\C-a-\C-z]" val)
+        (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))
+       ((and (string= "<" val) (looking-at "<\\$?[a-zA-Z0-9_:]+>"))
+        (setq val "<NAME>")))
+;;;    (if (string-match "^[&*][a-zA-Z_]" val)
+;;;    (setq val (concat (substring val 0 1) "NAME"))
+;;;      (if (looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+;;;      (if (= ?\[ (char-after (match-beginning 1)))
+;;;          (setq val (concat "@" (substring val 1)))
+;;;        (setq val (concat "%" (substring val 1))))
+;;;    (if (and (string= val "x") (looking-at "x="))
+;;;        (setq val "x=")
+;;;      (if (looking-at "[$@][a-zA-Z_:0-9]")
+;;;          ))))
+    (setq regexp (concat "^" "\\([^a-zA-Z0-9_:]+[ \t]\\)?"
+                        (regexp-quote val) 
+                        "\\([ \t([/]\\|$\\)"))
+
+    ;; get the buffer with the documentation text
+    (cperl-switch-to-doc-buffer)
+
+    ;; lookup in the doc
+    (goto-char (point-min))
+    (let ((case-fold-search nil))
+      (list 
+       (if (re-search-forward regexp (point-max) t)
+          (save-excursion
+            (beginning-of-line 1)
+            (let ((lnstart (point)))
+              (end-of-line)
+              (message "%s" (buffer-substring lnstart (point)))))
+        (if cperl-message-on-help-error
+            (message "No definition for %s" val)))))))
+
+(defvar cperl-short-docs "Ignore my value"
+  "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
+!      Logical negation.       
+!=     Numeric inequality.
+!~     Search pattern, substitution, or translation (negated).
+$!     In numeric context: errno. In a string context: error string.
+$\"    The separator which joins elements of arrays interpolated in strings.
+$#     The output format for printed numbers. Initial value is %.20g.
+$$     The process number of the perl running this script. Altered (in the child process) by fork().
+$%     The current page number of the currently selected output channel.
+
+       The following variables are always local to the current block:
+
+$1     Match of the 1st set of parentheses in the last match (auto-local).
+$2     Match of the 2nd set of parentheses in the last match (auto-local).
+$3     Match of the 3rd set of parentheses in the last match (auto-local).
+$4     Match of the 4th set of parentheses in the last match (auto-local).
+$5     Match of the 5th set of parentheses in the last match (auto-local).
+$6     Match of the 6th set of parentheses in the last match (auto-local).
+$7     Match of the 7th set of parentheses in the last match (auto-local).
+$8     Match of the 8th set of parentheses in the last match (auto-local).
+$9     Match of the 9th set of parentheses in the last match (auto-local).
+$&     The string matched by the last pattern match (auto-local).
+$'     The string after what was matched by the last match (auto-local).
+$`     The string before what was matched by the last match (auto-local).
+
+$(     The real gid of this process.
+$)     The effective gid of this process.
+$*     Deprecated: Set to 1 to do multiline matching within a string.
+$+     The last bracket matched by the last search pattern.
+$,     The output field separator for the print operator.
+$-     The number of lines left on the page.
+$.     The current input line number of the last filehandle that was read.
+$/     The input record separator, newline by default.
+$0     The name of the file containing the perl script being executed. May be set
+$:     The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
+$;     The subscript separator for multi-dimensional array emulation. Default is \"\\034\".
+$<     The real uid of this process.
+$=     The page length of the current output channel. Default is 60 lines.
+$>     The effective uid of this process.
+$?     The status returned by the last ``, pipe close or `system'.
+$@     The perl error message from the last eval or do @var{EXPR} command.
+$ARGV  The name of the current file used with <> .
+$[     Deprecated: The index of the first element/char in an array/string.
+$\\    The output record separator for the print operator.
+$]     The perl version string as displayed with perl -v.
+$^     The name of the current top-of-page format.
+$^A     The current value of the write() accumulator for format() lines.
+$^D    The value of the perl debug (-D) flags.
+$^E     Information about the last system error other than that provided by $!.
+$^F    The highest system file descriptor, ordinarily 2.
+$^H     The current set of syntax checks enabled by `use strict'.
+$^I    The value of the in-place edit extension (perl -i option).
+$^L     What formats output to perform a formfeed. Default is \f.
+$^O     The operating system name under which this copy of Perl was built.
+$^P    Internal debugging flag.
+$^T    The time the script was started. Used by -A/-M/-C file tests.
+$^W    True if warnings are requested (perl -w flag).
+$^X    The name under which perl was invoked (argv[0] in C-speech).
+$_     The default input and pattern-searching space.
+$|     Flag for auto-flush after write/print on the currently selected output channel. Default is 0. 
+$~     The name of the current report format.
+%      Modulo division.
+%=     Modulo division assignment.
+%ENV   Contains the current environment.
+%INC   List of files that have been require-d or do-ne.
+%SIG   Used to set signal handlers for various signals.
+&      Bitwise and.
+&&     Logical and.
+&&=    Logical and assignment.
+&=     Bitwise and assignment.
+*      Multiplication.
+**     Exponentiation.
+*NAME  Refers to all objects represented by NAME. *NAM1 = *NAM2 makes NAM1 a reference to NAM2.
+&NAME(arg0, ...)       Subroutine call. Arguments go to @_.
++      Addition.
+++     Auto-increment (magical on strings).
++=     Addition assignment.
+,      Comma operator.
+-      Subtraction.
+--     Auto-decrement.
+-=     Subtraction assignment.
+-A     Access time in days since script started.
+-B     File is a non-text (binary) file.
+-C     Inode change time in days since script started.
+-M     Age in days since script started.
+-O     File is owned by real uid.
+-R     File is readable by real uid.
+-S     File is a socket .
+-T     File is a text file.
+-W     File is writable by real uid.
+-X     File is executable by real uid.
+-b     File is a block special file.
+-c     File is a character special file.
+-d     File is a directory.
+-e     File exists .
+-f     File is a plain file.
+-g     File has setgid bit set.
+-k     File has sticky bit set.
+-l     File is a symbolic link.
+-o     File is owned by effective uid.
+-p     File is a named pipe (FIFO).
+-r     File is readable by effective uid.
+-s     File has non-zero size.
+-t     Tests if filehandle (STDIN by default) is opened to a tty.
+-u     File has setuid bit set.
+-w     File is writable by effective uid.
+-x     File is executable by effective uid.
+-z     File has zero size.
+.      Concatenate strings.
+..     Alternation, also range operator.
+.=     Concatenate assignment strings
+/      Division.       /PATTERN/ioxsmg Pattern match
+/=     Division assignment.
+/PATTERN/ioxsmg        Pattern match.
+<      Numeric less than.      <pattern>       Glob.   See <NAME>, <> as well.
+<NAME> Reads line from filehandle NAME. NAME must be bareword/dollar-bareword.
+<pattern>      Glob. (Unless pattern is bareword/dollar-bareword - see <NAME>)
+<>     Reads line from union of files in @ARGV (= command line) and STDIN.
+<<     Bitwise shift left.     <<      start of HERE-DOCUMENT.
+<=     Numeric less than or equal to.
+<=>    Numeric compare.
+=      Assignment.
+==     Numeric equality.
+=~     Search pattern, substitution, or translation
+>      Numeric greater than.
+>=     Numeric greater than or equal to.
+>>     Bitwise shift right.
+>>=    Bitwise shift right assignment.
+? :    Alternation (if-then-else) operator.    ?PAT? Backwards pattern match.
+?PATTERN?      Backwards pattern match.
+@ARGV  Command line arguments (not including the command name - see $0).
+@INC   List of places to look for perl scripts during do/include/use.
+@_     Parameter array for subroutines. Also used by split unless in array context.
+\\     Creates a reference to whatever follows, like \$var.
+\\0    Octal char, e.g. \\033.
+\\E    Case modification terminator. See \\Q, \\L, and \\U.
+\\L    Lowercase until \\E .
+\\U    Upcase until \\E .
+\\Q    Quote metacharacters until \\E .
+\\a    Alarm character (octal 007).
+\\b    Backspace character (octal 010).
+\\c    Control character, e.g. \\c[ .
+\\e    Escape character (octal 033).
+\\f    Formfeed character (octal 014).
+\\l    Lowercase of next character. See also \\L and \\u,
+\\n    Newline character (octal 012).
+\\r    Return character (octal 015).
+\\t    Tab character (octal 011).
+\\u    Upcase  of next character. See also \\U and \\l,
+\\x    Hex character, e.g. \\x1b.
+^      Bitwise exclusive or.
+__END__        End of program source.
+__DATA__       End of program source.
+__FILE__       Current (source) filename.
+__LINE__       Current line in current source.
+ARGV   Default multi-file input filehandle. <ARGV> is a synonym for <>.
+ARGVOUT        Output filehandle with -i flag.
+BEGIN { block }        Immediately executed (during compilation) piece of code.
+END { block }  Pseudo-subroutine executed after the script finishes.
+DATA   Input filehandle for what follows after __END__ or __DATA__.
+accept(NEWSOCKET,GENERICSOCKET)
+alarm(SECONDS)
+atan2(X,Y)
+bind(SOCKET,NAME)
+binmode(FILEHANDLE)
+caller[(LEVEL)]
+chdir(EXPR)
+chmod(LIST)
+chop[(LIST|VAR)]
+chown(LIST)
+chroot(FILENAME)
+close(FILEHANDLE)
+closedir(DIRHANDLE)
+cmp    String compare.
+connect(SOCKET,NAME)
+continue of { block } continue { block }. Is executed after `next' or at end.
+cos(EXPR)
+crypt(PLAINTEXT,SALT)
+dbmclose(ASSOC_ARRAY)
+dbmopen(ASSOC,DBNAME,MODE)
+defined(EXPR)
+delete($ASSOC{KEY})
+die(LIST)
+do { ... }|SUBR while|until EXPR       executes at least once
+do(EXPR|SUBR([LIST]))
+dump LABEL
+each(ASSOC_ARRAY)
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof[([FILEHANDLE])]
+eq     String equality.
+eval(EXPR) or eval { BLOCK }
+exec(LIST)
+exit(EXPR)
+exp(EXPR)
+fcntl(FILEHANDLE,FUNCTION,SCALAR)
+fileno(FILEHANDLE)
+flock(FILEHANDLE,OPERATION)
+for (EXPR;EXPR;EXPR) { ... }
+foreach [VAR] (@ARRAY) { ... }
+fork
+ge     String greater than or equal.
+getc[(FILEHANDLE)]
+getgrent
+getgrgid(GID)
+getgrnam(NAME)
+gethostbyaddr(ADDR,ADDRTYPE)
+gethostbyname(NAME)
+gethostent
+getlogin
+getnetbyaddr(ADDR,ADDRTYPE)
+getnetbyname(NAME)
+getnetent
+getpeername(SOCKET)
+getpgrp(PID)
+getppid
+getpriority(WHICH,WHO)
+getprotobyname(NAME)
+getprotobynumber(NUMBER)
+getprotoent
+getpwent
+getpwnam(NAME)
+getpwuid(UID)
+getservbyname(NAME,PROTO)
+getservbyport(PORT,PROTO)
+getservent
+getsockname(SOCKET)
+getsockopt(SOCKET,LEVEL,OPTNAME)
+gmtime(EXPR)
+goto LABEL
+grep(EXPR,LIST)
+gt     String greater than.
+hex(EXPR)
+if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
+index(STR,SUBSTR[,OFFSET])
+int(EXPR)
+ioctl(FILEHANDLE,FUNCTION,SCALAR)
+join(EXPR,LIST)
+keys(ASSOC_ARRAY)
+kill(LIST)
+last [LABEL]
+le     String less than or equal.
+length(EXPR)
+link(OLDFILE,NEWFILE)
+listen(SOCKET,QUEUESIZE)
+local(LIST)
+localtime(EXPR)
+log(EXPR)
+lstat(EXPR|FILEHANDLE|VAR)
+lt     String less than.
+m/PATTERN/iogsmx
+mkdir(FILENAME,MODE)
+msgctl(ID,CMD,ARG)
+msgget(KEY,FLAGS)
+msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
+msgsnd(ID,MSG,FLAGS)
+my VAR or my (VAR1,...)        Introduces a lexical variable ($VAR, @ARR, or %HASH).
+ne     String inequality.
+next [LABEL]
+oct(EXPR)
+open(FILEHANDLE[,EXPR])
+opendir(DIRHANDLE,EXPR)
+ord(EXPR)
+pack(TEMPLATE,LIST)
+package        Introduces package context.
+pipe(READHANDLE,WRITEHANDLE)
+pop(ARRAY)
+print [FILEHANDLE] [(LIST)]
+printf [FILEHANDLE] (FORMAT,LIST)
+push(ARRAY,LIST)
+q/STRING/      Synonym for 'STRING'
+qq/STRING/     Synonym for \"STRING\"
+qx/STRING/     Synonym for `STRING`
+rand[(EXPR)]
+read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+readdir(DIRHANDLE)
+readlink(EXPR)
+recv(SOCKET,SCALAR,LEN,FLAGS)
+redo [LABEL]
+rename(OLDNAME,NEWNAME)
+require [FILENAME | PERL_VERSION]
+reset[(EXPR)]
+return(LIST)
+reverse(LIST)
+rewinddir(DIRHANDLE)
+rindex(STR,SUBSTR[,OFFSET])
+rmdir(FILENAME)
+s/PATTERN/REPLACEMENT/gieoxsm
+scalar(EXPR)
+seek(FILEHANDLE,POSITION,WHENCE)
+seekdir(DIRHANDLE,POS)
+select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT)
+semctl(ID,SEMNUM,CMD,ARG)
+semget(KEY,NSEMS,SIZE,FLAGS)
+semop(KEY,...)
+send(SOCKET,MSG,FLAGS[,TO])
+setgrent
+sethostent(STAYOPEN)
+setnetent(STAYOPEN)
+setpgrp(PID,PGRP)
+setpriority(WHICH,WHO,PRIORITY)
+setprotoent(STAYOPEN)
+setpwent
+setservent(STAYOPEN)
+setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)
+shift[(ARRAY)]
+shmctl(ID,CMD,ARG)
+shmget(KEY,SIZE,FLAGS)
+shmread(ID,VAR,POS,SIZE)
+shmwrite(ID,STRING,POS,SIZE)
+shutdown(SOCKET,HOW)
+sin(EXPR)
+sleep[(EXPR)]
+socket(SOCKET,DOMAIN,TYPE,PROTOCOL)
+socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)
+sort [SUBROUTINE] (LIST)
+splice(ARRAY,OFFSET[,LENGTH[,LIST]])
+split[(/PATTERN/[,EXPR[,LIMIT]])]
+sprintf(FORMAT,LIST)
+sqrt(EXPR)
+srand(EXPR)
+stat(EXPR|FILEHANDLE|VAR)
+study[(SCALAR)]
+sub [NAME [(format)]] { BODY } or      sub [NAME [(format)]];
+substr(EXPR,OFFSET[,LEN])
+symlink(OLDFILE,NEWFILE)
+syscall(LIST)
+sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+system(LIST)
+syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
+tell[(FILEHANDLE)]
+telldir(DIRHANDLE)
+time
+times
+tr/SEARCHLIST/REPLACEMENTLIST/cds
+truncate(FILE|EXPR,LENGTH)
+umask[(EXPR)]
+undef[(EXPR)]
+unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
+unlink(LIST)
+unpack(TEMPLATE,EXPR)
+unshift(ARRAY,LIST)
+until (EXPR) { ... } or EXPR until EXPR
+utime(LIST)
+values(ASSOC_ARRAY)
+vec(EXPR,OFFSET,BITS)
+wait
+waitpid(PID,FLAGS)
+wantarray
+warn(LIST)
+while  (EXPR) { ... } or EXPR while EXPR
+write[(EXPR|FILEHANDLE)]
+x      Repeat string or array.
+x=     Repetition assignment.
+y/SEARCHLIST/REPLACEMENTLIST/
+|      Bitwise or.
+||     Logical or.
+~      Unary bitwise complement.
+#!     OS interpreter indicator. If contains `perl', used for options, and -x.
+")
+
+(defun cperl-switch-to-doc-buffer ()
+  "Go to the perl documentation buffer and insert the documentation."
+  (interactive)
+  (let ((buf (get-buffer-create cperl-doc-buffer)))
+    (if (interactive-p)
+       (switch-to-buffer-other-window buf)
+      (set-buffer buf))
+    (if (= (buffer-size) 0)
+       (progn
+         (insert (documentation-property 'cperl-short-docs
+                                         'variable-documentation))
+         (setq buffer-read-only t)))))
+
+(if (fboundp 'run-with-idle-timer)
+    (progn
+      (defvar cperl-help-shown nil
+       "Non-nil means that the help was already shown now.")
+
+      (defvar cperl-help-timer nil
+       "Non-nil means that the help was already shown now.")
+
+      (defun cperl-lazy-install ()
+       (interactive)
+       (make-variable-buffer-local 'cperl-help-shown)
+       (if (cperl-val cperl-lazy-help-time)
+           (progn
+             (add-hook 'post-command-hook 'cperl-lazy-hook)
+             (setq cperl-help-timer 
+                   (run-with-idle-timer 
+                    (cperl-val cperl-lazy-help-time 1000000 5) 
+                    t 
+                    'cperl-get-help-defer)))))
+
+      (defun cperl-lazy-unstall ()
+       (interactive)
+       (remove-hook 'post-command-hook 'cperl-lazy-hook)
+       (cancel-timer cperl-help-timer))
+
+      (defun cperl-lazy-hook ()
+       (setq cperl-help-shown nil))
+
+      (defun cperl-get-help-defer ()
+       (if (not (eq major-mode 'perl-mode)) nil
+         (let ((cperl-message-on-help-error nil))
+           (cperl-get-help)
+           (setq cperl-help-shown t))))
+      (cperl-lazy-install)))
diff --git a/embed.h b/embed.h

index 4d5009d..edad009 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -19,9 +19,10 @@
 
 /* globals we need to hide from the world */
 #define AMG_names      Perl_AMG_names
+#define Error          Perl_Error
+#define He             Perl_He
 #define No             Perl_No
 #define Sv             Perl_Sv
-#define He             Perl_He
 #define Xpv            Perl_Xpv
 #define Yes            Perl_Yes
 #define abs_amg                Perl_abs_amg
@@ -32,6 +33,7 @@
 #define an             Perl_an
 #define atan2_amg      Perl_atan2_amg
 #define band_amg       Perl_band_amg
+#define block_type     Perl_block_type
 #define bool__amg      Perl_bool__amg
 #define bor_amg                Perl_bor_amg
 #define buf            Perl_buf
@@ -39,9 +41,9 @@
 #define bufptr         Perl_bufptr
 #define bxor_amg       Perl_bxor_amg
 #define check          Perl_check
+#define compcv         Perl_compcv
 #define compiling      Perl_compiling
 #define compl_amg      Perl_compl_amg
-#define compcv         Perl_compcv
 #define comppad                Perl_comppad
 #define comppad_name   Perl_comppad_name
 #define comppad_name_fill      Perl_comppad_name_fill
@@ -53,8 +55,6 @@
 #define cryptseen      Perl_cryptseen
 #define cshlen         Perl_cshlen
 #define cshname                Perl_cshname
-#define curcop         Perl_curcop
-#define curcopdb       Perl_curcopdb
 #define curinterp      Perl_curinterp
 #define curpad         Perl_curpad
 #define cv_const_sv    Perl_cv_const_sv
@@ -67,7 +67,6 @@
 #define do_undump      Perl_do_undump
 #define ds             Perl_ds
 #define egid           Perl_egid
-#define envgv          Perl_envgv
 #define eq_amg         Perl_eq_amg
 #define error_count    Perl_error_count
 #define euid           Perl_euid
@@ -93,23 +92,24 @@
 #define last_lop       Perl_last_lop
 #define last_lop_op    Perl_last_lop_op
 #define last_uni       Perl_last_uni
+#define lc_collate_active      Perl_lc_collate_active
 #define le_amg         Perl_le_amg
-#define lex_state      Perl_lex_state
-#define lex_defer      Perl_lex_defer
-#define lex_expect     Perl_lex_expect
 #define lex_brackets   Perl_lex_brackets
-#define lex_formbrack  Perl_lex_formbrack
-#define lex_fakebrack  Perl_lex_fakebrack
+#define lex_brackstack Perl_lex_brackstack
 #define lex_casemods   Perl_lex_casemods
+#define lex_casestack  Perl_lex_casestack
+#define lex_defer      Perl_lex_defer
 #define lex_dojoin     Perl_lex_dojoin
-#define lex_starts     Perl_lex_starts
-#define lex_stuff      Perl_lex_stuff
-#define lex_repl       Perl_lex_repl
-#define lex_op         Perl_lex_op
+#define lex_expect     Perl_lex_expect
+#define lex_fakebrack  Perl_lex_fakebrack
+#define lex_formbrack  Perl_lex_formbrack
 #define lex_inpat      Perl_lex_inpat
 #define lex_inwhat     Perl_lex_inwhat
-#define lex_brackstack Perl_lex_brackstack
-#define lex_casestack  Perl_lex_casestack
+#define lex_op         Perl_lex_op
+#define lex_repl       Perl_lex_repl
+#define lex_starts     Perl_lex_starts
+#define lex_state      Perl_lex_state
+#define lex_stuff      Perl_lex_stuff
 #define linestr                Perl_linestr
 #define log_amg                Perl_log_amg
 #define lshift_amg     Perl_lshift_amg
@@ -118,8 +118,8 @@
 #define markstack      Perl_markstack
 #define markstack_max  Perl_markstack_max
 #define markstack_ptr  Perl_markstack_ptr
-#define maxo           Perl_maxo
 #define max_intro_pending      Perl_max_intro_pending
+#define maxo           Perl_maxo
 #define min_intro_pending      Perl_min_intro_pending
 #define mod_amg                Perl_mod_amg
 #define mod_ass_amg    Perl_mod_ass_amg
@@ -131,22 +131,27 @@
 #define multi_start    Perl_multi_start
 #define na             Perl_na
 #define ncmp_amg       Perl_ncmp_amg
-#define nextval                Perl_nextval
-#define nexttype       Perl_nexttype
-#define nexttoke       Perl_nexttoke
 #define ne_amg         Perl_ne_amg
 #define neg_amg                Perl_neg_amg
+#define nexttoke       Perl_nexttoke
+#define nexttype       Perl_nexttype
 #define nexttype       Perl_nexttype
 #define nextval                Perl_nextval
+#define nextval                Perl_nextval
+#define nice_chunk     Perl_nice_chunk
+#define nice_chunk_size        Perl_nice_chunk_size
 #define no_aelem       Perl_no_aelem
 #define no_dir_func    Perl_no_dir_func
 #define no_func                Perl_no_func
 #define no_helem       Perl_no_helem
 #define no_mem         Perl_no_mem
 #define no_modify      Perl_no_modify
+#define no_myglob      Perl_no_myglob
 #define no_security    Perl_no_security
 #define no_sock_func   Perl_no_sock_func
+#define no_symref      Perl_no_symref
 #define no_usym                Perl_no_usym
+#define no_wrongref    Perl_no_wrongref
 #define nointrp                Perl_nointrp
 #define nomem          Perl_nomem
 #define nomemok                Perl_nomemok
@@ -163,15 +168,17 @@
 #define origalen       Perl_origalen
 #define origenviron    Perl_origenviron
 #define osname         Perl_osname
+#define pad_reset_pending      Perl_pad_reset_pending
 #define padix          Perl_padix
+#define padix_floor    Perl_padix_floor
 #define patleave       Perl_patleave
 #define pow_amg                Perl_pow_amg
 #define pow_ass_amg    Perl_pow_ass_amg
 #define ppaddr         Perl_ppaddr
 #define profiledata    Perl_profiledata
 #define provide_ref    Perl_provide_ref
-#define psig_ptr       Perl_psig_ptr
 #define psig_name      Perl_psig_name
+#define psig_ptr       Perl_psig_ptr
 #define qrt_amg                Perl_qrt_amg
 #define rcsid          Perl_rcsid
 #define reall_srchlen  Perl_reall_srchlen
@@ -181,6 +188,7 @@
 #define regdummy       Perl_regdummy
 #define regendp                Perl_regendp
 #define regeol         Perl_regeol
+#define regflags       Perl_regflags
 #define regfold                Perl_regfold
 #define reginput       Perl_reginput
 #define regkind                Perl_regkind
@@ -208,6 +216,7 @@
 #define rsfp_filters   Perl_rsfp_filters
 #define rshift_amg     Perl_rshift_amg
 #define rshift_ass_amg Perl_rshift_ass_amg
+#define save_iv                Perl_save_iv
 #define save_pptr      Perl_save_pptr
 #define savestack      Perl_savestack
 #define savestack_ix   Perl_savestack_ix
@@ -223,7 +232,6 @@
 #define sgt_amg                Perl_sgt_amg
 #define sig_name       Perl_sig_name
 #define sig_num                Perl_sig_num
-#define siggv          Perl_siggv
 #define sighandler     Perl_sighandler
 #define simple         Perl_simple
 #define sin_amg                Perl_sin_amg
@@ -243,7 +251,6 @@
 #define sv_no          Perl_sv_no
 #define sv_undef       Perl_sv_undef
 #define sv_yes         Perl_sv_yes
-#define tainting       Perl_tainting
 #define thisexpr       Perl_thisexpr
 #define timesbuf       Perl_timesbuf
 #define tokenbuf       Perl_tokenbuf
@@ -257,6 +264,7 @@
 #define vtbl_dbline    Perl_vtbl_dbline
 #define vtbl_env       Perl_vtbl_env
 #define vtbl_envelem   Perl_vtbl_envelem
+#define vtbl_fm                Perl_vtbl_fm
 #define vtbl_glob      Perl_vtbl_glob
 #define vtbl_isa       Perl_vtbl_isa
 #define vtbl_isaelem   Perl_vtbl_isaelem
@@ -275,6 +283,7 @@
 #define warn_nl                Perl_warn_nl
 #define warn_nosemi    Perl_warn_nosemi
 #define warn_reserved  Perl_warn_reserved
+#define warn_uninit    Perl_warn_uninit
 #define watchaddr      Perl_watchaddr
 #define watchok                Perl_watchok
 #define yychar         Perl_yychar
@@ -316,12 +325,14 @@
 #define bind_match     Perl_bind_match
 #define block_end      Perl_block_end
 #define block_start    Perl_block_start
+#define boot_core_UNIVERSAL    Perl_boot_core_UNIVERSAL
 #define calllist       Perl_calllist
 #define cando          Perl_cando
 #define cast_ulong     Perl_cast_ulong
 #define check_uni      Perl_check_uni
 #define checkcomma     Perl_checkcomma
 #define ck_aelem       Perl_ck_aelem
+#define ck_bitop       Perl_ck_bitop
 #define ck_concat      Perl_ck_concat
 #define ck_delete      Perl_ck_delete
 #define ck_eof         Perl_ck_eof
@@ -498,6 +509,7 @@
 #define magic_setbm    Perl_magic_setbm
 #define magic_setdbline        Perl_magic_setdbline
 #define magic_setenv   Perl_magic_setenv
+#define magic_setfm    Perl_magic_setfm
 #define magic_setglob  Perl_magic_setglob
 #define magic_setisa   Perl_magic_setisa
 #define magic_setmglob Perl_magic_setmglob
@@ -512,6 +524,7 @@
 #define magic_wipepack Perl_magic_wipepack
 #define magicname      Perl_magicname
 #define markstack_grow Perl_markstack_grow
+#define mem_collxfrm   Perl_mem_collxfrm
 #define mess           Perl_mess
 #define mg_clear       Perl_mg_clear
 #define mg_copy                Perl_mg_copy
@@ -968,7 +981,16 @@
 #define repeatcpy      Perl_repeatcpy
 #define rninstr                Perl_rninstr
 #define runops         Perl_runops
+#define safecalloc     Perl_safecalloc
+#define safemalloc     Perl_safemalloc
+#define safefree       Perl_safefree
+#define saferealloc    Perl_saferealloc
+#define safexcalloc    Perl_safexcalloc
+#define safexmalloc    Perl_safexmalloc
+#define safexfree      Perl_safexfree
+#define safexrealloc   Perl_safexrealloc
 #define same_dirent    Perl_same_dirent
+#define save_I16       Perl_save_I16
 #define save_I32       Perl_save_I32
 #define save_aptr      Perl_save_aptr
 #define save_ary       Perl_save_ary
@@ -1041,6 +1063,7 @@
 #define sv_clear       Perl_sv_clear
 #define sv_cmp         Perl_sv_cmp
 #define sv_dec         Perl_sv_dec
+#define sv_derived_from        Perl_sv_derived_from
 #define sv_dump                Perl_sv_dump
 #define sv_eq          Perl_sv_eq
 #define sv_free                Perl_sv_free
@@ -1073,6 +1096,7 @@
 #define sv_setref_pv   Perl_sv_setref_pv
 #define sv_setref_pvn  Perl_sv_setref_pvn
 #define sv_setsv       Perl_sv_setsv
+#define sv_setuv       Perl_sv_setuv
 #define sv_unmagic     Perl_sv_unmagic
 #define sv_unref       Perl_sv_unref
 #define sv_upgrade     Perl_sv_upgrade
@@ -1095,6 +1119,7 @@
 #define xpv_root       Perl_xpv_root
 #define xrv_root       Perl_xrv_root
 #define yyerror                Perl_yyerror
+#define yydestruct     Perl_yydestruct
 #define yylex          Perl_yylex
 #define yyparse                Perl_yyparse
 #define yywarn         Perl_yywarn
@@ -1105,14 +1130,6 @@
 
 #ifdef MULTIPLICITY
 
-/* Undefine symbols that were defined by EMBED. Somewhat ugly */
-
-#undef curcop
-#undef curcopdb
-#undef envgv
-#undef siggv
-#undef tainting
-
 #define Argv           (curinterp->IArgv)
 #define Cmd            (curinterp->ICmd)
 #define DBgv           (curinterp->IDBgv)
@@ -1417,4 +1434,155 @@
 #define Iunsafe                unsafe
 #define Iwarnhook      warnhook
 
+#define Argv           Perl_Argv
+#define Cmd            Perl_Cmd
+#define DBgv           Perl_DBgv
+#define DBline         Perl_DBline
+#define DBsignal       Perl_DBsignal
+#define DBsingle       Perl_DBsingle
+#define DBsub          Perl_DBsub
+#define DBtrace                Perl_DBtrace
+#define allgvs         Perl_allgvs
+#define ampergv                Perl_ampergv
+#define argvgv         Perl_argvgv
+#define argvoutgv      Perl_argvoutgv
+#define basetime       Perl_basetime
+#define beginav                Perl_beginav
+#define bodytarget     Perl_bodytarget
+#define cddir          Perl_cddir
+#define chopset                Perl_chopset
+#define copline                Perl_copline
+#define curblock       Perl_curblock
+#define curcop         Perl_curcop
+#define curcopdb       Perl_curcopdb
+#define curcsv         Perl_curcsv
+#define curpm          Perl_curpm
+#define curstack       Perl_curstack
+#define curstash       Perl_curstash
+#define curstname      Perl_curstname
+#define cxstack                Perl_cxstack
+#define cxstack_ix     Perl_cxstack_ix
+#define cxstack_max    Perl_cxstack_max
+#define dbargs         Perl_dbargs
+#define debdelim       Perl_debdelim
+#define debname                Perl_debname
+#define debstash       Perl_debstash
+#define defgv          Perl_defgv
+#define defoutgv       Perl_defoutgv
+#define defstash       Perl_defstash
+#define delaymagic     Perl_delaymagic
+#define diehook                Perl_diehook
+#define dirty          Perl_dirty
+#define dlevel         Perl_dlevel
+#define dlmax          Perl_dlmax
+#define doextract      Perl_doextract
+#define doswitches     Perl_doswitches
+#define dowarn         Perl_dowarn
+#define dumplvl                Perl_dumplvl
+#define e_fp           Perl_e_fp
+#define e_tmpname      Perl_e_tmpname
+#define endav          Perl_endav
+#define envgv          Perl_envgv
+#define errgv          Perl_errgv
+#define eval_root      Perl_eval_root
+#define eval_start     Perl_eval_start
+#define fdpid          Perl_fdpid
+#define filemode       Perl_filemode
+#define firstgv                Perl_firstgv
+#define forkprocess    Perl_forkprocess
+#define formfeed       Perl_formfeed
+#define formtarget     Perl_formtarget
+#define gensym         Perl_gensym
+#define in_eval                Perl_in_eval
+#define incgv          Perl_incgv
+#define inplace                Perl_inplace
+#define last_in_gv     Perl_last_in_gv
+#define lastfd         Perl_lastfd
+#define lastretstr     Perl_lastretstr
+#define lastscream     Perl_lastscream
+#define lastsize       Perl_lastsize
+#define lastspbase     Perl_lastspbase
+#define laststatval    Perl_laststatval
+#define laststype      Perl_laststype
+#define leftgv         Perl_leftgv
+#define lineary                Perl_lineary
+#define localizing     Perl_localizing
+#define localpatches   Perl_localpatches
+#define main_cv                Perl_main_cv
+#define main_root      Perl_main_root
+#define main_start     Perl_main_start
+#define mainstack      Perl_mainstack
+#define maxscream      Perl_maxscream
+#define maxsysfd       Perl_maxsysfd
+#define minus_F                Perl_minus_F
+#define minus_a                Perl_minus_a
+#define minus_c                Perl_minus_c
+#define minus_l                Perl_minus_l
+#define minus_n                Perl_minus_n
+#define minus_p                Perl_minus_p
+#define multiline      Perl_multiline
+#define mystack_base   Perl_mystack_base
+#define mystack_mark   Perl_mystack_mark
+#define mystack_max    Perl_mystack_max
+#define mystack_sp     Perl_mystack_sp
+#define mystrk         Perl_mystrk
+#define nrs            Perl_nrs
+#define ofmt           Perl_ofmt
+#define ofs            Perl_ofs
+#define ofslen         Perl_ofslen
+#define oldlastpm      Perl_oldlastpm
+#define oldname                Perl_oldname
+#define op_mask                Perl_op_mask
+#define origargc       Perl_origargc
+#define origargv       Perl_origargv
+#define origfilename   Perl_origfilename
+#define ors            Perl_ors
+#define orslen         Perl_orslen
+#define parsehook      Perl_parsehook
+#define patchlevel     Perl_patchlevel
+#define perldb         Perl_perldb
+#define perl_destruct_level    Perl_perl_destruct_level
+#define pidstatus      Perl_pidstatus
+#define preambled      Perl_preambled
+#define preambleav     Perl_preambleav
+#define preprocess     Perl_preprocess
+#define restartop      Perl_restartop
+#define rightgv                Perl_rightgv
+#define rs             Perl_rs
+#define runlevel       Perl_runlevel
+#define sawampersand   Perl_sawampersand
+#define sawi           Perl_sawi
+#define sawstudy       Perl_sawstudy
+#define sawvec         Perl_sawvec
+#define screamfirst    Perl_screamfirst
+#define screamnext     Perl_screamnext
+#define secondgv       Perl_secondgv
+#define siggv          Perl_siggv
+#define signalstack    Perl_signalstack
+#define sortcop                Perl_sortcop
+#define sortstack      Perl_sortstack
+#define sortstash      Perl_sortstash
+#define splitstr       Perl_splitstr
+#define statcache      Perl_statcache
+#define statgv         Perl_statgv
+#define statname       Perl_statname
+#define statusvalue    Perl_statusvalue
+#define stdingv                Perl_stdingv
+#define strchop                Perl_strchop
+#define strtab         Perl_strtab
+#define sv_count       Perl_sv_count
+#define sv_objcount    Perl_sv_objcount
+#define sv_root                Perl_sv_root
+#define sv_arenaroot   Perl_sv_arenaroot
+#define tainted                Perl_tainted
+#define tainting       Perl_tainting
+#define tmps_floor     Perl_tmps_floor
+#define tmps_ix                Perl_tmps_ix
+#define tmps_max       Perl_tmps_max
+#define tmps_stack     Perl_tmps_stack
+#define top_env                Perl_top_env
+#define toptarget      Perl_toptarget
+#define unsafe         Perl_unsafe
+#define warnhook       Perl_warnhook
+
 #endif /* MULTIPLICITY */
diff --git a/embed.pl b/embed.pl

index 5ade24a..6bbcd01 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -46,43 +46,41 @@ print EM <<'END';
 
 #ifdef MULTIPLICITY
 
-/* Undefine symbols that were defined by EMBED. Somewhat ugly */
-
 END
 
-
 open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
 while (<INT>) {
        s/[ \t]*#.*//;          # Delete comments.
        next unless /\S/;
-       s/^\s*(\S*).*$/#undef $1/;
-       print EM $_ if (exists $global{$1});
+       s/^\s*(\S+).*$/#define $1\t\t(curinterp->I$1)/;
+       s/(................\t)\t/$1/;
+       print EM $_;
 }
 close(INT) || warn "Can't close interp.sym: $!\n";
 
-print EM "\n";
+print EM <<'END';
+
+#else  /* not multiple, so translate interpreter symbols the other way... */
+
+END
 
 open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
 while (<INT>) {
        s/[ \t]*#.*//;          # Delete comments.
        next unless /\S/;
-       s/^\s*(\S+).*$/#define $1\t\t(curinterp->I$1)/;
+       s/^\s*(\S+).*$/#define I$1\t\t$1/;
        s/(................\t)\t/$1/;
        print EM $_;
 }
 close(INT) || warn "Can't close interp.sym: $!\n";
 
-print EM <<'END';
-
-#else  /* not multiple, so translate interpreter symbols the other way... */
-
-END
+print EM "\n";
 
 open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
 while (<INT>) {
        s/[ \t]*#.*//;          # Delete comments.
        next unless /\S/;
-       s/^\s*(\S+).*$/#define I$1\t\t$1/;
+       s/^\s*(\S+).*$/#define $1\t\tPerl_$1/;
        s/(................\t)\t/$1/;
        print EM $_;
 }
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c

index 599dd37..e13427a 100644 (file)
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -84,7 +84,7 @@ SaveError(pat, va_alist)
 
 
 /* prepend underscore to s. write into buf. return buf. */
-char *
+static char *
 dl_add_underscore(s, buf)
 char *s;
 char *buf;
diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm

index ef9d510..9b3025f 100644 (file)
--- a/ext/IO/lib/IO/File.pm
+++ b/ext/IO/lib/IO/File.pm
@@ -43,7 +43,7 @@ IO::File - supply object methods for filehandles
 
 =head1 DESCRIPTION
 
-C<IO::File> is inherits from C<IO::Handle> ans C<IO::Seekable>. It extends
+C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
 these classes with methods that are specific to file handles.
 
 =head1 CONSTRUCTOR
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm

index e4abdd2..4b0b93c 100644 (file)
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -169,7 +169,7 @@ module keeps a C<timeout> variable in 'io_socket_timeout'.
 
 L<perlfunc>, 
 L<perlop/"I/O Operators">,
-L<POSIX/"FileHandle">
+L<FileHandle>
 
 =head1 BUGS
 
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c

index d4836be..a62334c 100644 (file)
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -135,7 +135,7 @@ int mode;
  * open the files in sequence, and stat the dirfile.
  * If we fail anywhere, undo everything, return NULL.
  */
-#      ifdef OS2
+#if defined(OS2) || defined(MSDOS)
        flags |= O_BINARY;
 #      endif
        if ((db->pagf = open(pagname, flags, mode)) > -1) {
diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h

index 8fcdda0..c05f0d0 100644 (file)
--- a/ext/SDBM_File/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -108,19 +108,6 @@ extern long sdbm_hash proto((char *, int));
 #   endif
 #endif
 
-#ifdef MYMALLOC
-#   ifdef HIDEMYMALLOC
-#      define malloc Mymalloc
-#      define realloc Myremalloc
-#      define free Myfree
-#      define calloc Mycalloc
-#   endif
-#   define safemalloc malloc
-#   define saferealloc realloc
-#   define safefree free
-#   define safecalloc calloc
-#endif
-
 #if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
 # define STANDARD_C 1
 #endif
@@ -163,6 +150,31 @@ extern long sdbm_hash proto((char *, int));
 
 #define MEM_SIZE Size_t
 
+/* This comes after <stdlib.h> so we don't try to change the standard
+ * library prototypes; we'll use our own instead. */
+
+#if defined(MYMALLOC) && (defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC))
+
+#   ifdef HIDEMYMALLOC
+#      define malloc  Mymalloc
+#      define calloc  Mycalloc
+#      define realloc Myremalloc
+#      define free    Myfree
+#   endif
+#   ifdef EMBEDMYMALLOC
+#      define malloc  Perl_malloc
+#      define calloc  Perl_calloc
+#      define realloc Perl_realloc
+#      define free    Perl_free
+#   endif
+
+    Malloc_t malloc _((MEM_SIZE nbytes));
+    Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size));
+    Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
+    Free_t   free _((Malloc_t where));
+
+#endif /* MYMALLOC && (HIDEMYMALLOC || EMBEDMYMALLOC) */
+
 #ifdef I_STRING
 #include <string.h>
 #else
diff --git a/global.sym b/global.sym

index 62f7064..c2d8992 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -3,9 +3,10 @@
 # Variables
 
 AMG_names
+Error
+He
 No
 Sv
-He
 Xpv
 Yes
 abs_amg
@@ -16,6 +17,7 @@ amagic_generation
 an
 atan2_amg
 band_amg
+block_type
 bool__amg
 bor_amg
 buf
@@ -23,9 +25,9 @@ bufend
 bufptr
 bxor_amg
 check
+compcv
 compiling
 compl_amg
-compcv
 comppad
 comppad_name
 comppad_name_fill
@@ -37,8 +39,6 @@ cos_amg
 cryptseen
 cshlen
 cshname
-curcop
-curcopdb
 curinterp
 curpad
 cv_const_sv
@@ -51,7 +51,6 @@ div_ass_amg
 do_undump
 ds
 egid
-envgv
 eq_amg
 error_count
 euid
@@ -79,22 +78,22 @@ last_lop_op
 last_uni
 lc_collate_active
 le_amg
-lex_state
-lex_defer
-lex_expect
 lex_brackets
-lex_formbrack
-lex_fakebrack
+lex_brackstack
 lex_casemods
+lex_casestack
+lex_defer
 lex_dojoin
-lex_starts
-lex_stuff
-lex_repl
-lex_op
+lex_expect
+lex_fakebrack
+lex_formbrack
 lex_inpat
 lex_inwhat
-lex_brackstack
-lex_casestack
+lex_op
+lex_repl
+lex_starts
+lex_state
+lex_stuff
 linestr
 log_amg
 lshift_amg
@@ -103,8 +102,8 @@ lt_amg
 markstack
 markstack_max
 markstack_ptr
-maxo
 max_intro_pending
+maxo
 min_intro_pending
 mod_amg
 mod_ass_amg
@@ -116,22 +115,27 @@ multi_open
 multi_start
 na
 ncmp_amg
-nextval
-nexttype
-nexttoke
 ne_amg
 neg_amg
+nexttoke
 nexttype
+nexttype
+nextval
 nextval
+nice_chunk
+nice_chunk_size
 no_aelem
 no_dir_func
 no_func
 no_helem
 no_mem
 no_modify
+no_myglob
 no_security
 no_sock_func
+no_symref
 no_usym
+no_wrongref
 nointrp
 nomem
 nomemok
@@ -148,15 +152,17 @@ opargs
 origalen
 origenviron
 osname
+pad_reset_pending
 padix
+padix_floor
 patleave
 pow_amg
 pow_ass_amg
 ppaddr
 profiledata
 provide_ref
-psig_ptr
 psig_name
+psig_ptr
 qrt_amg
 rcsid
 reall_srchlen
@@ -166,6 +172,7 @@ regcode
 regdummy
 regendp
 regeol
+regflags
 regfold
 reginput
 regkind
@@ -193,6 +200,7 @@ rsfp
 rsfp_filters
 rshift_amg
 rshift_ass_amg
+save_iv
 save_pptr
 savestack
 savestack_ix
@@ -208,7 +216,6 @@ sge_amg
 sgt_amg
 sig_name
 sig_num
-siggv
 sighandler
 simple
 sin_amg
@@ -228,7 +235,6 @@ subtr_ass_amg
 sv_no
 sv_undef
 sv_yes
-tainting
 thisexpr
 timesbuf
 tokenbuf
@@ -242,6 +248,7 @@ vtbl_bm
 vtbl_dbline
 vtbl_env
 vtbl_envelem
+vtbl_fm
 vtbl_glob
 vtbl_isa
 vtbl_isaelem
@@ -260,6 +267,7 @@ vtbl_vec
 warn_nl
 warn_nosemi
 warn_reserved
+warn_uninit
 watchaddr
 watchok
 yychar
@@ -304,12 +312,14 @@ av_unshift
 bind_match
 block_end
 block_start
+boot_core_UNIVERSAL
 calllist
 cando
 cast_ulong
 check_uni
 checkcomma
 ck_aelem
+ck_bitop
 ck_concat
 ck_delete
 ck_eof
@@ -486,6 +496,7 @@ magic_setarylen
 magic_setbm
 magic_setdbline
 magic_setenv
+magic_setfm
 magic_setglob
 magic_setisa
 magic_setmglob
@@ -957,7 +968,16 @@ regprop
 repeatcpy
 rninstr
 runops
+safecalloc
+safemalloc
+safefree
+saferealloc
+safexcalloc
+safexmalloc
+safexfree
+safexrealloc
 same_dirent
+save_I16
 save_I32
 save_aptr
 save_ary
@@ -1030,6 +1050,7 @@ sv_clean_objs
 sv_clear
 sv_cmp
 sv_dec
+sv_derived_from
 sv_dump
 sv_eq
 sv_free
@@ -1062,6 +1083,7 @@ sv_setref_nv
 sv_setref_pv
 sv_setref_pvn
 sv_setsv
+sv_setuv
 sv_unmagic
 sv_unref
 sv_upgrade
@@ -1084,6 +1106,7 @@ xnv_root
 xpv_root
 xrv_root
 yyerror
+yydestruct
 yylex
 yyparse
 yywarn
diff --git a/handy.h b/handy.h

index 27eebd7..99d07f0 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -181,43 +181,21 @@ typedef U16 line_t;
    Renew macros.
        --Andy Dougherty                August 1996
 */
+
 #ifndef lint
 #ifndef LEAKTEST
-#ifndef safemalloc
 
-#  ifdef __cplusplus
-    extern "C" {
-#  endif
-Malloc_t safemalloc _((MEM_SIZE));
-Malloc_t saferealloc _((Malloc_t, MEM_SIZE));
-Free_t safefree _((Malloc_t));
-Malloc_t safecalloc _((MEM_SIZE, MEM_SIZE));
-#  ifdef __cplusplus
-    }
-#  endif
-#endif
-#ifndef MSDOS
 #define New(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
 #define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
     memzero((char*)(v), (n) * sizeof(t))
 #define Renew(v,n,t) (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
 #define Renewc(v,n,t,c) (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#else
-#define New(x,v,n,t)  (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
-#define Newc(x,v,n,t,c)  (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
-    memzero((char*)(v), (n) * sizeof(t))
-#define Renew(v,n,t) (v = (t*)saferealloc((Malloc_t)(v),((unsigned long)(n)*sizeof(t))))
-#define Renewc(v,n,t,c) (v = (c*)saferealloc((Malloc_t)(v),((unsigned long)(n)*sizeof(t))))
-#endif /* MSDOS */
 #define Safefree(d) safefree((Malloc_t)(d))
 #define NEWSV(x,len) newSV(len)
+
 #else /* LEAKTEST */
-Malloc_t safexmalloc();
-Malloc_t safexrealloc();
-Free_t safexfree();
-Malloc_t safexcalloc();
+
 #define New(x,v,n,t)  (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
 #define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
@@ -229,11 +207,15 @@ Malloc_t safexcalloc();
 #define MAXXCOUNT 1200
 long xcount[MAXXCOUNT];
 long lastxcount[MAXXCOUNT];
+
 #endif /* LEAKTEST */
+
 #define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
 #define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
 #define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+
 #else /* lint */
+
 #define New(x,v,n,s) (v = Null(s *))
 #define Newc(x,v,n,s,c) (v = Null(s *))
 #define Newz(x,v,n,s) (v = Null(s *))
@@ -242,6 +224,7 @@ long lastxcount[MAXXCOUNT];
 #define Copy(s,d,n,t)
 #define Zero(d,n,t)
 #define Safefree(d) d = d
+
 #endif /* lint */
 
 #ifdef USE_STRUCT_COPY
diff --git a/hints/amigaos.sh b/hints/amigaos.sh

new file mode 100644 (file)

index 0000000..8328c8a
--- /dev/null
+++ b/hints/amigaos.sh
@@ -0,0 +1,43 @@
+# hints/amigaos.sh
+#
+# talk to pueschel@imsdd.meb.uni-bonn.de if you want to change this file.
+#
+# misc stuff
+archname='m68k-amigaos'
+cc='gcc'
+firstmakefile='GNUmakefile'
+ccflags='-DAMIGAOS -mstackextend'
+optimize='-O2 -fomit-frame-pointer'
+
+cppminus=' '
+cpprun='cpp'
+cppstdin='cpp'
+
+usenm='y'
+usemymalloc='n'
+usevfork='true'
+useperlio='true'
+d_eofnblk='define'
+d_fork='undef'
+d_vfork='define'
+groupstype='int'
+
+# libs
+
+libpth="/local/lib $prefix/lib"
+glibpth="$libpth"
+xlibpth="$libpth"
+
+libswanted='dld m c gdbm'
+so=' '
+
+# dynamic loading
+
+dlext='o'
+cccdlflags='none'
+ccdlflags='none'
+lddlflags='-oformat a.out-amiga -r'
+
+# Avoid telldir prototype conflict in pp_sys.c  (AmigaOS uses const DIR *)
+# Configure should test for this.  Volunteers?
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
diff --git a/hints/freebsd.sh b/hints/freebsd.sh

index 1e92053..e8bee39 100644 (file)
--- a/hints/freebsd.sh
+++ b/hints/freebsd.sh
@@ -14,6 +14,10 @@
 # Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net>
 # Date: Fri, 12 May 1995 14:30:38 +0200 (MET DST)
 #
+# Additional 2.2 defines from
+# Mark Murray <mark@grondar.za>
+# Date: Wed, 6 Nov 1996 09:44:58 +0200 (MET)
+# 
 # The two flags "-fpic -DPIC" are used to indicate a
 # will-be-shared object.  Configure will guess the -fpic, (and the
 # -DPIC is not used by perl proper) but the full define is included to 
@@ -43,16 +47,38 @@ case "$osvers" in
        d_setruid='undef'
        ;;
 #
-# Trying to cover 2.0.5, 2.1-current and future 2.1
+# Trying to cover 2.0.5, 2.1-current and future 2.1/2.2
 # It does not covert all 2.1-current versions as the output of uname
 # changed a few times.
 #
+# Even though seteuid/setegid are available, they've been turned off
+# because perl isn't coded with saved set[ug]id variables in mind.
+# In addition, a small patch is requried to suidperl to avoid a security
+# problem with FreeBSD.
+#
 2.0.5*|2.0-built*|2.1*)
        usevfork='true'
+       d_dosuid='define'
+       d_setregid='define'
+       d_setreuid='define'
+       d_setegid='undef'
+       d_seteuid='undef'
+       ;;
+#
+# 2.2 and above have phkmalloc(3).
+2.2*)
+       usevfork='true'
+       usemymalloc='n'
+       d_dosuid='define'
+       d_setregid='define'
+       d_setreuid='define'
+       d_setegid='undef'
+       d_seteuid='undef'
        ;;
 #
-# Guesses at what will be needed after 2.1
+# Guesses at what will be needed after 2.2
 *)     usevfork='true'
+       usemymalloc='n'
        ;;
 esac
 
diff --git a/hints/machten.sh b/hints/machten.sh

index 321a80a..f6f75d6 100644 (file)
--- a/hints/machten.sh
+++ b/hints/machten.sh
@@ -13,8 +13,9 @@
 #      Martijn Koster <m.koster@webcrawler.com>
 #      Richard Yeh <rcyeh@cco.caltech.edu>
 #
-# File::Find's use of link count disabled by Dominic Dunlop 950528
-# Perl's use of sigsetjmp etc. disabled by Dominic Dunlop 950521
+# Do not use perl's malloc; SysV IPC OK -- Neil Cutcliffe, Tenon 961030
+# File::Find's use of link count disabled by Dominic Dunlop 960528
+# Perl's use of sigsetjmp etc. disabled by Dominic Dunlop 960521
 #
 # Comments, questions, and improvements welcome!
 #
@@ -22,11 +23,20 @@
 # know how to use it yet.
 #
 #  Updated by Dominic Dunlop <domo@tcp.ip.lu>
-#  Tue May 28 11:20:08 WET DST 1996
+#  Wed Nov 13 11:47:09 WET 1996
+
+
+# Power MachTen is a real memory system and its standard malloc
+# has been optimized for this. Using this malloc instead of Perl's
+# malloc may result in significant memory savings.
+usemymalloc='false'
 
 # Configure doesn't know how to parse the nm output.
 usenm=undef
 
+# Install in /usr/local by default
+prefix='/usr/local'
+
 # At least on PowerMac, doubles must be aligned on 8 byte boundaries.
 # I don't know if this is true for all MachTen systems, or how to
 # determine this automatically.
@@ -60,16 +70,3 @@ Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
 Read the File::Find documentation for more information.
 
 EOM
-
-# Date: Wed, 18 Sep 1996 11:29:40 +0200
-# From: Dominic Dunlop <domo@tcp.ip.lu>
-# Subject: Re: Perl 5.003 from ftp.tenon.com requires MT 4.0.3
-
-# MachTen 4.0.2 and earlier do not implement System V interprocess
-# communication (message queues, semaphores and shered memory); 4.0.3 has a
-# half-baked implementation which provides the corresponding library
-# functions but does not implement the system calls or provide the header
-# files (or documentation).  The perl installation process correctly divines
-# that System V IPC is not usable in either case.  Do not attempt to persuade
-# it otherwise, or the resulting perl will crash (rather than producing an
-# error message) if you attempt to use the functions.
diff --git a/installman b/installman

index d57cdb1..c5663dd 100755 (executable)
--- a/installman
+++ b/installman
@@ -126,7 +126,7 @@ sub runpod2man {
        # Convert name from  File/Basename.pm to File::Basename.3 format,
        # if necessary.
        $manpage =~ s#\.p(m|od)$##;
-       if ($^O eq 'os2') {
+       if ($^O eq 'os2' || $^O eq 'amigaos') {
          $manpage =~ s#/#.#g;
        } else {
          $manpage =~ s#/#::#g;
diff --git a/installperl b/installperl

index 8f8f7e7..a9082df 100755 (executable)
--- a/installperl
+++ b/installperl
@@ -167,27 +167,30 @@ foreach $file (@corefiles) {
 $mainperl_is_instperl = 0;
 
 if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) {
-    # First make sure $mainperldir/perl is not already the same as
-    # the perl we just installed
-    if (-x "$mainperldir/perl$exe_ext") {
+    local($usrbinperl) = "$mainperldir/perl$exe_ext";
+    local($instperl)   = "$installbin/perl$exe_ext";
+    local($expinstperl)        = "$binexp/perl$exe_ext";
+
+    # First make sure $usrbinperl is not already the same as the perl we
+    # just installed.
+    if (-x $usrbinperl) {
        # Try to be clever about mainperl being a symbolic link
        # to binexp/perl if binexp and installbin are different.
        $mainperl_is_instperl =
-           &samepath("$mainperldir/perl$exe_ext", "$installbin/perl$exe_ext") ||
+           &samepath($usrbinperl, $instperl) ||
             (($binexp ne $installbin) &&
-             (-l "$mainperldir/perl$exe_ext") &&
-             ((readlink "$mainperldir/perl$exe_ext") eq "$binexp/perl$exe_ext"));
+             (-l $usrbinperl) &&
+             ((readlink $usrbinperl) eq $expinstperl));
     }
     if ((! $mainperl_is_instperl) &&
-       (&yn("Many scripts expect perl to be installed as " .
-            "$mainperldir/perl.\n" . 
-            "Do you wish to have $mainperldir/perl be the same as\n" .
-            "$binexp/perl? [y] ")))
+       (&yn("Many scripts expect perl to be installed as $usrbinperl.\n" . 
+            "Do you wish to have $usrbinperl be the same as\n" .
+            "$expinstperl? [y] ")))
     {  
-       unlink("$mainperldir/perl$exe_ext");
-       CORE::link("$installbin/perl$exe_ext", "$mainperldir/perl$exe_ext") ||
-           symlink("$binexp/perl$exe_ext", "$mainperldir/perl$exe_ext") ||
-               cmd("cp $installbin/perl$exe_ext $mainperldir$exe_ext");
+       unlink($usrbinperl);
+       eval { CORE::link $instperl, $usrbinperl } ||
+           eval { symlink $expinstperl, $usrbinperl } ||
+               cmd("cp $instperl $usrbinperl");
        $mainperl_is_instperl = 1;
     }
 }
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm

index 7d781d1..fa9a322 100644 (file)
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -95,10 +95,6 @@ subroutine may have a shorter name that the routine itself. This can lead to
 conflicting file names. The I<AutoSplit> package warns of these potential
 conflicts when used to split a module.
 
-Calling foo($1) for the autoloaded function foo() might not work as
-expected, because the AUTOLOAD function of B<AutoLoader> clobbers the
-regexp variables.  Invoking it as foo("$1") avoids this problem.
-
 =cut
 
 AUTOLOAD {
diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm

index b582f78..d9bd17a 100644 (file)
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -195,6 +195,7 @@ sub autosplit_file{
 
     die "Package $package does not match filename $filename"
            unless ($filename =~ m/$modpname.pm$/ or
+                   ($^O eq "msdos") or
                    $Is_VMS && $filename =~ m/$modpname.pm/i);
 
     if ($check_mod_time){
diff --git a/lib/Carp.pm b/lib/Carp.pm

index 5de8f83..1a1b79e 100644 (file)
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -29,6 +29,8 @@ not where carp() was called.
 
 $CarpLevel = 0;                # How many extra package levels to skip on carp.
 $MaxEvalLen = 0;       # How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64;        # How much of each argument to print. 0 = all.
+$MaxArgNums = 8;        # How many arguments to print. 0 = all.
 
 require Exporter;
 @ISA = Exporter;
@@ -38,8 +40,10 @@ sub longmess {
     my $error = shift;
     my $mess = "";
     my $i = 1 + $CarpLevel;
-    my ($pack,$file,$line,$sub,$eval,$require);
-    while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
+    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+    my (@a);
+    while (do { { package DB; @a = caller($i++) } } ) {
+      ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
        if ($error =~ m/\n$/) {
            $mess .= $error;
        } else {
@@ -56,6 +60,21 @@ sub longmess {
            } elsif ($sub eq '(eval)') {
                $sub = 'eval {...}';
            }
+           if ($hargs) {
+             @a = @DB::args;   # must get local copy of args
+             if ($MaxArgNums and @a > $MaxArgNums) {
+               $#a = $MaxArgNums;
+               $a[$#a] = "...";
+             }
+             for (@a) {
+               s/'/\\'/g;
+               substr($_,$MaxArgLen) = '...' if $MaxArgLen and $MaxArgLen < length;
+               s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+               s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+               s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+             }
+             $sub .= '(' . join(', ', @a) . ')';
+           }
            $mess .= "\t$sub " if $error eq "called";
            $mess .= "$error at $file line $line\n";
        }
diff --git a/lib/Cwd.pm b/lib/Cwd.pm

index 83b472c..d7a4875 100644 (file)
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -38,7 +38,7 @@ the trailing line terminator). It is recommended that cwd (or another
 
 If you ask to override your chdir() built-in function, then your PWD
 environment variable will be kept up to date.  (See
-L<perlsub/Overriding builtin functions>.) Note that it will only be
+L<perlsub/Overriding Builtin Functions>.) Note that it will only be
 kept up to date if all packages which use chdir import it from Cwd.
 
 =cut
@@ -108,7 +108,7 @@ sub getcwd
                }
                unless (@tst = lstat("$dotdots/$dir"))
                {
-                   warn "lstat($dotdots/$dir): $!";
+                   # warn "lstat($dotdots/$dir): $!";
                    # Just because you can't lstat this directory
                    # doesn't mean you'll never find the right one.
                    # closedir(PARENT);
@@ -172,7 +172,7 @@ sub fastcwd {
 my $chdir_init = 0;
 
 sub chdir_init {
-    if ($ENV{'PWD'} and $^O ne 'os2') {
+    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
        my($dd,$di) = stat('.');
        my($pd,$pi) = stat($ENV{'PWD'});
        if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
@@ -237,6 +237,13 @@ sub _os2_cwd {
     return $ENV{'PWD'};
 }
 
+sub _msdos_cwd {
+    $ENV{'PWD'} = `command /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
 my($oldw) = $^W;
 $^W = 0;  # assignments trigger 'subroutine redefined' warning
 if ($^O eq 'VMS') {
@@ -259,7 +266,13 @@ elsif ($^O eq 'os2') {
     *getcwd     = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
     *fastgetcwd         = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
     *fastcwd    = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
-  }
+}
+elsif ($^O eq 'msdos') {
+    *cwd     = \&_msdos_cwd;
+    *getcwd     = \&_msdos_cwd;
+    *fastgetcwd = \&_msdos_cwd;
+    *fastcwd = \&_msdos_cwd;
+}
 $^W = $oldw;
 
 # package main; eval join('',<DATA>) || die $@;        # quick test
diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm

index dc8b943..eac7c13 100644 (file)
--- a/lib/ExtUtils/Liblist.pm
+++ b/lib/ExtUtils/Liblist.pm
@@ -8,9 +8,12 @@ use Config;
 use Cwd 'cwd';
 use File::Basename;
 
-my $Config_libext = $Config{lib_ext} || ".a";
-
 sub ext {
+  if   ($^O eq 'VMS') { return &_vms_ext;      }
+  else                { return &_unix_os2_ext; }
+}
+
+sub _unix_os2_ext {
     my($self,$potential_libs, $Verbose) = @_;
     if ($^O =~ 'os2' and $Config{libs}) { 
        # Dynamic libraries are not transitive, so we may need including
@@ -24,6 +27,8 @@ sub ext {
 
     my($so)   = $Config{'so'};
     my($libs) = $Config{'libs'};
+    my $Config_libext = $Config{lib_ext} || ".a";
+
 
     # compute $extralibs, $bsloadlibs and $ldloadlibs from
     # $potential_libs
@@ -174,6 +179,136 @@ sub ext {
     ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
 }
 
+
+sub _vms_ext {
+  my($self, $potential_libs,$verbose) = @_;
+  return ('', '', '', '') unless $potential_libs;
+
+  my(@dirs,@libs,$dir,$lib,%sh,%olb,%obj);
+  my $cwd = cwd();
+  my($so,$lib_ext,$obj_ext) = @Config{'so','lib_ext','obj_ext'};
+  # List of common Unix library names and there VMS equivalents
+  # (VMS equivalent of '' indicates that the library is automatially
+  # searched by the linker, and should be skipped here.)
+  my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
+                 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
+                 'socket' => '', 'X11' => 'DECW$XLIBSHR',
+                 'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
+                 'Xmu' => 'DECW$XMULIBSHR');
+  if ($Config{'vms_cc_type'} ne 'decc') { $libmap{'curses'} = 'VAXCCURSE'; }
+
+  print STDOUT "Potential libraries are '$potential_libs'\n" if $verbose;
+
+  # First, sort out directories and library names in the input
+  foreach $lib (split ' ',$potential_libs) {
+    push(@dirs,$1),   next if $lib =~ /^-L(.*)/;
+    push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
+    push(@dirs,$lib), next if -d $lib;
+    push(@libs,$1),   next if $lib =~ /^-l(.*)/;
+    push(@libs,$lib);
+  }
+  push(@dirs,split(' ',$Config{'libpth'}));
+
+  # Now make sure we've got VMS-syntax absolute directory specs
+  # (We don't, however, check whether someone's hidden a relative
+  # path in a logical name.)
+  foreach $dir (@dirs) {
+    unless (-d $dir) {
+      print STDOUT "Skipping nonexistent Directory $dir\n" if $verbose > 1;
+      $dir = '';
+      next;
+    }
+    print STDOUT "Resolving directory $dir\n" if $verbose;
+    if ($self->file_name_is_absolute($dir)) { $dir = $self->fixpath($dir,1); }
+    else                                    { $dir = $self->catdir($cwd,$dir); }
+  }
+  @dirs = grep { length($_) } @dirs;
+  unshift(@dirs,''); # Check each $lib without additions first
+
+  LIB: foreach $lib (@libs) {
+    if (exists $libmap{$lib}) {
+      next unless length $libmap{$lib};
+      $lib = $libmap{$lib};
+    }
+
+    my(@variants,$variant,$name,$test,$cand);
+    my($ctype) = '';
+
+    # If we don't have a file type, consider it a possibly abbreviated name and
+    # check for common variants.  We try these first to grab libraries before
+    # a like-named executable image (e.g. -lperl resolves to perlshr.exe
+    # before perl.exe).
+    if ($lib !~ /\.[^:>\]]*$/) {
+      push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
+      push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
+    }
+    push(@variants,$lib);
+    print STDOUT "Looking for $lib\n" if $verbose;
+    foreach $variant (@variants) {
+      foreach $dir (@dirs) {
+        my($type);
+
+        $name = "$dir$variant";
+        print "\tChecking $name\n" if $verbose > 2;
+        if (-f ($test = VMS::Filespec::rmsexpand($name))) {
+          # It's got its own suffix, so we'll have to figure out the type
+          if    ($test =~ /(?:$so|exe)$/i)      { $type = 'sh'; }
+          elsif ($test =~ /(?:$lib_ext|olb)$/i) { $type = 'olb'; }
+          elsif ($test =~ /(?:$obj_ext|obj)$/i) {
+            print STDOUT "Warning (will try anyway): Plain object file $test found in library list\n";
+            $type = 'obj';
+          }
+          else {
+            print STDOUT "Warning (will try anyway): Unknown library type for $test; assuming shared\n";
+            $type = 'sh';
+          }
+        }
+        elsif (-f ($test = VMS::Filespec::rmsexpand($name,$so))      or
+               -f ($test = VMS::Filespec::rmsexpand($name,'.exe')))     {
+          $type = 'sh';
+          $name = $test unless $test =~ /exe;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$lib_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.olb'))))  {
+          $type = 'olb';
+          $name = $test unless $test =~ /olb;?\d*$/i;
+        }
+        elsif (not length($ctype) and  # If we've got a lib already, don't bother
+               ( -f ($test = VMS::Filespec::rmsexpand($name,$obj_ext)) or
+                 -f ($test = VMS::Filespec::rmsexpand($name,'.obj'))))  {
+          print STDOUT "Warning (will try anyway): Plain object file $test found in library list\n";
+          $type = 'obj';
+          $name = $test unless $test =~ /obj;?\d*$/i;
+        }
+        if (defined $type) {
+          $ctype = $type; $cand = $name;
+          last if $ctype eq 'sh';
+        }
+      }
+      if ($ctype) { 
+        eval '$' . $ctype . "{'$cand'}++";
+        die "Error recording library: $@" if $@;
+        print STDOUT "\tFound as $name (really $test), type $type\n" if $verbose > 1;
+        next LIB;
+      }
+    }
+    print STDOUT "Warning (will try anyway): No library found for $lib\n";
+  }
+
+  @libs = sort keys %obj;
+  # This has to precede any other CRTLs, so just make it first
+  if ($olb{VAXCCURSE}) {
+    push(@libs,"$olb{VAXCCURSE}/Library");
+    delete $olb{VAXCCURSE};
+  }
+  push(@libs, map { "$_/Library" } sort keys %olb);
+  push(@libs, map { "$_/Share"   } sort keys %sh);
+  $lib = join(' ',@libs);
+  print "Result: $lib\n" if $verbose;
+  wantarray ? ($lib, '', $lib, '') : $lib;
+}
+
 1;
 
 __END__
@@ -247,11 +382,55 @@ object file.  This list is used to create a .bs (bootstrap) file.
 This module deals with a lot of system dependencies and has quite a
 few architecture specific B<if>s in the code.
 
+=head2 VMS implementation
+
+The version of ext() which is executed under VMS differs from the
+Unix-OS/2 version in several respects:
+
+=over 2
+
+=item *
+
+Input library and path specifications are accepted with or without the
+C<-l> and C<-L> prefices used by Unix linkers.  If neither prefix is
+present, a token is considered a directory to search if it is in fact
+a directory, and a library to search for otherwise.  Authors who wish
+their extensions to be portable to Unix or OS/2 should use the Unix
+prefixes, since the Unix-OS/2 version of ext() requires them.
+
+=item *
+
+Wherever possible, shareable images are preferred to object libraries,
+and object libraries to plain object files.  In accordance with VMS
+naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
+it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
+used in some ported software.
+
+=item *
+
+For each library that is found, an appropriate directive for a linker options
+file is generated.  The return values are space-separated strings of
+these directives, rather than elements used on the linker command line.
+
+=item *
+
+LDLOADLIBS and EXTRALIBS are always identical under VMS, and BSLOADLIBS
+and LD_RIN_PATH are always empty.
+
+=back
+
+In addition, an attempt is made to recognize several common Unix library
+names, and filter them out or convert them to their VMS equivalents, as
+appropriate.
+
+In general, the VMS version of ext() should properly handle input from
+extensions originally designed for a Unix or VMS environment.  If you
+encounter problems, or discover cases where the search could be improved,
+please let us know.
+
 =head1 SEE ALSO
 
 L<ExtUtils::MakeMaker>
 
 =cut
 
-
-
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm

index ca2bf65..5d97956 100644 (file)
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -1701,7 +1701,7 @@ sub init_others { # --- Initialize Other Attributes
     };
 
     # These get overridden for VMS and maybe some other systems
-    $self->{NOOP}  ||= "sh -c true";
+    $self->{NOOP}  ||= '$(SHELL) -c true';
     $self->{FIRST_MAKEFILE} ||= "Makefile";
     $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
     $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
@@ -1923,6 +1923,10 @@ sub macro {
 Called by staticmake. Defines how to write the Makefile to produce a
 static new perl.
 
+By default the Makefile produced includes all the static extensions in
+the perl library. (Purified versions of library files, e.g.,
+DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.)
+
 =cut
 
 sub makeaperl {
@@ -1987,6 +1991,8 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
     File::Find::find(sub {
        return unless m/\Q$self->{LIB_EXT}\E$/;
        return if m/^libperl/;
+       # Skip purified versions of libraries (e.g., DynaLoader_pure_p1_c0_032.a)
+       return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
 
        if( exists $self->{INCLUDE_EXT} ){
                my $found = 0;
@@ -2107,7 +2113,7 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
 $tmp/perlmain.c: $makefilename}, q{
        }.$self->{NOECHO}.q{echo Writing $@
        }.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
-               writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@.tmp && mv $@.tmp $@
+               writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@t && mv $@t $@
 
 };
 
@@ -2451,7 +2457,7 @@ $(OBJECT) : $(PERL_HDRS)
 =item pm_to_blib
 
 Defines target that copies all files in the hash PM to their
-destination and autosplits them. See L<ExtUtils::Install/pm_to_blib>
+destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
 
 =cut
 
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm

index d05ddac..1a63f21 100644 (file)
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -6,7 +6,7 @@
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
 
 package ExtUtils::MM_VMS;
-$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.38 (02-Oct-1996)';
+$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.38 (22-Oct-1996)';
 unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
 use Config;
@@ -194,6 +194,7 @@ sub updir {
 
 package ExtUtils::MM_VMS;
 
+sub ExtUtils::MM_VMS::ext;
 sub ExtUtils::MM_VMS::guess_name;
 sub ExtUtils::MM_VMS::find_perl;
 sub ExtUtils::MM_VMS::path;
@@ -204,7 +205,6 @@ sub ExtUtils::MM_VMS::file_name_is_absolute;
 sub ExtUtils::MM_VMS::replace_manpage_separator;
 sub ExtUtils::MM_VMS::init_others;
 sub ExtUtils::MM_VMS::constants;
-sub ExtUtils::MM_VMS::const_loadlibs;
 sub ExtUtils::MM_VMS::cflags;
 sub ExtUtils::MM_VMS::const_cccmd;
 sub ExtUtils::MM_VMS::pm_to_blib;
@@ -268,6 +268,16 @@ sub AUTOLOAD {
 
 #__DATA__
 
+
+# This isn't really an override.  It's just here because ExtUtils::MM_VMS
+# appears in @MM::ISA before ExtUtils::Liblist, so if there isn't an ext()
+# in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
+# mimic inheritance here and hand off to ExtUtils::Liblist.
+sub ext {
+  ExtUtils::Liblist::ext(@_);
+}
+
+
 =head2 SelfLoaded methods
 
 Those methods which override default MM_Unix methods are marked
@@ -289,12 +299,24 @@ package name.
 
 sub guess_name {
     my($self) = @_;
-    my($defname,$defpm);
+    my($defname,$defpm,@pm,%xs,$pm);
     local *PM;
 
     $defname = basename(fileify($ENV{'DEFAULT'}));
     $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
     $defpm = $defname;
+    # Fallback in case for some reason a user has copied the files for an
+    # extension into a working directory whose name doesn't reflect the
+    # extension's name.  We'll use the name of a unique .pm file, or the
+    # first .pm file with a matching .xs file.
+    if (not -e "${defpm}.pm") {
+      @pm = map { s/.pm$//; $_ } glob('*.pm');
+      if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
+      elsif (@pm) {
+        %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
+        if (%xs) { foreach $pm (@pm) { $defpm = $pm, last if exists $xs{$pm}; } }
+      }
+    }
     if (open(PM,"${defpm}.pm")){
         while (<PM>) {
             if (/^\s*package\s+([^;]+)/i) {
@@ -700,57 +722,6 @@ PM_TO_BLIB = ',join(', ',@{$self->{PM_TO_BLIB}}),'
     join('',@m);
 }
 
-=item const_loadlibs (override)
-
-Basically a stub which passes through library specfications provided
-by the caller.  Will be updated or removed when VMS support is added
-to ExtUtils::Liblist.
-
-=cut
-
-sub const_loadlibs {
-    my($self) = @_;
-    my (@m);
-    push @m, "
-# $self->{NAME} might depend on some other libraries.
-# (These comments may need revising:)
-#
-# Dependent libraries can be linked in one of three ways:
-#
-#  1.  (For static extensions) by the ld command when the perl binary
-#      is linked with the extension library. See EXTRALIBS below.
-#
-#  2.  (For dynamic extensions) by the ld command when the shared
-#      object is built/linked. See LDLOADLIBS below.
-#
-#  3.  (For dynamic extensions) by the DynaLoader when the shared
-#      object is loaded. See BSLOADLIBS below.
-#
-# EXTRALIBS =  List of libraries that need to be linked with when
-#              linking a perl binary which includes this extension
-#              Only those libraries that actually exist are included.
-#              These are written to a file and used when linking perl.
-#
-# LDLOADLIBS = List of those libraries which can or must be linked into
-#              the shared library when created using ld. These may be
-#              static or dynamic libraries.
-#              LD_RUN_PATH is a colon separated list of the directories
-#              in LDLOADLIBS. It is passed as an environment variable to
-#              the process that links the shared library.
-#
-# BSLOADLIBS = List of those libraries that are needed but can be
-#              linked in dynamically at run time on this platform.
-#              SunOS/Solaris does not need this because ld records
-#              the information (from LDLOADLIBS) into the object file.
-#              This list is used to create a .bs (bootstrap) file.
-#
-EXTRALIBS  = ",map($self->fixpath($_) . ' ',$self->{'EXTRALIBS'}),"
-BSLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'BSLOADLIBS'}),"
-LDLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'LDLOADLIBS'}),"\n";
-
-    join('',@m);
-}
-
 =item cflags (override)
 
 Bypass shell script and produce qualifiers for CC directly (but warn
@@ -1271,7 +1242,21 @@ $(BASEEXT).opt : Makefile.PL
        $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
 ');
 
+    if (length $self->{LDLOADLIBS}) {
+       my($lib); my($line) = '';
+       foreach $lib (split ' ', $self->{LDLOADLIBS}) {
+           $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
+           if (length($line) + length($lib) > 160) {
+               push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n";
+               $line = $lib . '\n';
+           }
+           else { $line .= $lib . '\n'; }
+       }
+       push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n" if $line;
+    }
+
     join('',@m);
+
 }
 
 =item dynamic_lib (override)
@@ -1414,8 +1399,7 @@ sub manifypods {
     } else {
        $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
     }
-    if ($pod2man_exe = $self->perl_script($pod2man_exe)) { $found_pod2man = 1; }
-    else {
+    if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
        # No pod2man but some MAN3PODS to be installed
        print <<END;
 
@@ -2255,18 +2239,6 @@ map_clean :
     join '', @m;
 }
   
-=item ext (specific)
-
-Stub routine standing in for C<ExtUtils::LibList::ext> until VMS
-support is added to that package.
-
-=cut
-
-sub ext {
-    my($self) = @_;
-    '','','';
-}
-
 # --- Output postprocessing section ---
 
 =item nicetext (override)
diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap

index 14d1222..c65b1cf 100644 (file)
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -127,7 +127,7 @@ T_REF_IV_PTR
        else
            croak(\"$var is not of type ${ntype}\")
 T_PTROBJ
-       if (sv_isa($arg, \"${ntype}\")) {
+       if (sv_derived_from($arg, \"${ntype}\")) {
            IV tmp = SvIV((SV*)SvRV($arg));
            $var = ($type) tmp;
        }
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp

index eaf5bd4..6823955 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -76,7 +76,7 @@ perl(1), perlxs(1), perlxstut(1), perlxs(1)
 =cut
 
 # Global Constants
-$XSUBPP_version = "1.938";
+$XSUBPP_version = "1.939";
 require 5.002;
 use vars '$cplusplus';
 
@@ -741,7 +741,9 @@ while (fetch_para()) {
        $XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
     }
 
-    death ("Code is not inside a function")
+    death ("Code is not inside a function"
+          ." (maybe last function was ended by a blank line "
+          ." followed by a a statement on column one?)")
        if $line[0] =~ /^\s/;
 
     # initialize info arrays
diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm

index 2602f0d..ad44c5d 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -2,8 +2,6 @@ package File::Basename;
 
 =head1 NAME
 
-Basename - parse file specifications
-
 fileparse - split a pathname into pieces
 
 basename - extract just the filename from a path
@@ -35,10 +33,10 @@ pieces using the syntax of different operating systems.
 
 You select the syntax via the routine fileparse_set_fstype().
 If the argument passed to it contains one of the substrings
-"VMS", "MSDOS", or "MacOS", the file specification syntax of that
-operating system is used in future calls to fileparse(),
-basename(), and dirname().  If it contains none of these
-substrings, UNIX syntax is used.  This pattern matching is
+"VMS", "MSDOS", "MacOS" or "AmigaOS", the file specification 
+syntax of that operating system is used in future calls to 
+fileparse(), basename(), and dirname().  If it contains none of
+these substrings, UNIX syntax is used.  This pattern matching is
 case-insensitive.  If you've selected VMS syntax, and the file
 specification you pass to one of these routines contains a "/",
 they assume you are using UNIX emulation and apply the UNIX syntax
@@ -156,6 +154,9 @@ sub fileparse {
   elsif ($fstype =~ /^MacOS/i) {
     ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
   }
+  elsif ($fstype =~ /^AmigaOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
+  }
   elsif ($fstype !~ /^VMS/i) {  # default to Unix
     ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
     $dirpath = './' unless $dirpath;
@@ -206,6 +207,11 @@ sub dirname {
         $dirname =~ s:[^\\]+$:: unless length($basename);
         $dirname = '.' unless length($dirname);
     }
+    elsif ($fstype =~ /AmigaOS/i) {
+        if ( $dirname =~ /:$/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s#[^:/]+$## unless length($basename);
+    }
     else { 
         if ( $dirname =~ m:^/+$:) { return '/'; }
         chop $dirname;
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm

index 5cea310..2e55559 100644 (file)
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -7,6 +7,7 @@ package File::Copy;
 
 require Exporter;
 use Carp;
+use UNIVERSAL qw(isa);
 
 @ISA=qw(Exporter);
 @EXPORT=qw(copy);
@@ -24,10 +25,11 @@ sub copy {
     croak("Usage: copy( file1, file2 [, buffersize]) ")
       unless(@_ == 2 || @_ == 3);
 
-    if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$_[1]) ne 'GLOB' &&
-        !(defined ref $_[1] and (ref($_[1]) eq 'GLOB' ||
-          ref($_[1]) eq 'FileHandle' || ref($_[1]) eq 'VMS::Stdio')))
-        { return File::Copy::syscopy($_[0],$_[1]) }
+    if (defined &File::Copy::syscopy &&
+       \&File::Copy::syscopy != \&File::Copy::copy &&
+       ref(\$_[1]) ne 'GLOB' &&
+        !(defined ref $_[1] and isa($_[1], 'GLOB')))
+           { return File::Copy::syscopy($_[0],$_[1]) }
 
     my $from = shift;
     my $to = shift;
@@ -158,10 +160,10 @@ C<copy> routine.  For VMS systems, this calls the C<rmscopy>
 routine (see below).  For OS/2 systems, this calls the C<syscopy>
 XSUB directly.
 
-=head2 Special behavior under VMS
+=head2 Special behavior if C<syscopy> is defined (VMS and OS/2)
 
 If the second argument to C<copy> is not a file handle for an
-already opened file, then C<copy> will perform an RMS copy of
+already opened file, then C<copy> will perform an "system copy" of
 the input file to a new output file, in order to preserve file
 attributes, indexed file structure, I<etc.>  The buffer size
 parameter is ignored.  If the second argument to C<copy> is a
@@ -169,10 +171,12 @@ Perl handle to an opened file, then data is copied using Perl
 operators, and no effort is made to preserve file attributes
 or record structure.
 
-The RMS copy routine may also be called directly under VMS
-as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
+The system copy routine may also be called directly under VMS and OS/2
+as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
 is just an alias for this routine).
 
+=over
+
 =item rmscopy($from,$to[,$date_flag])
 
 The first and second arguments may be strings, typeglobs, or
@@ -207,6 +211,8 @@ it defaults to 0.
 Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
 it sets C<$!>, deletes the output file, and returns 0.
 
+=back
+
 =head1 RETURN
 
 Returns 1 on success, 0 on failure. $! will be set if an error was
diff --git a/lib/File/Find.pm b/lib/File/Find.pm

index b0312be..c5ce68c 100644 (file)
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -259,7 +259,8 @@ if ($^O =~ m:^mswin32:i) {
   $dont_use_nlink = 1;
 }
 
-$dont_use_nlink = 1 if $^O eq 'os2';
+$dont_use_nlink = 1
+    if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
 
 1;
 
diff --git a/lib/FindBin.pm b/lib/FindBin.pm

index 45d9e33..bbd72a2 100644 (file)
--- a/lib/FindBin.pm
+++ b/lib/FindBin.pm
@@ -96,7 +96,7 @@ $VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
 # $realpath;
 #}
 
-sub abs_path
+sub my_abs_path
 {
     my $start = shift || '.';
     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
@@ -154,6 +154,8 @@ BEGIN
 {
  *Dir = \$Bin;
  *RealDir = \$RealBin;
+ if (defined &Cwd::sys_abspath) { *abs_path = \&Cwd::sys_abspath}
+ else { *abs_path = \&my_abs_path}
 
  if($0 eq '-e' || $0 eq '-')
   {
diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm

index 11d10f8..d684577 100644 (file)
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -80,7 +80,7 @@ linkage specified in the HASH.
 The command line options are taken from array @ARGV. Upon completion
 of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
 the command line.
- 
+
 Each option specifier designates the name of the option, optionally
 followed by an argument specifier. Values for argument specifiers are:
 
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm

index a4d8b6b..f76f261 100644 (file)
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -171,11 +171,11 @@ sub add { #(int_num_array, int_num_array) return int_num_array
     $car = 0;
     for $x (@x) {
        last unless @y || $car;
-       $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+       $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
     }
     for $y (@y) {
        last unless $car;
-       $y -= 1e5 if $car = (($y += $car) >= 1e5);
+       $y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
     }
     (@x, @y, $car);
 }
diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm

index 5ec4a56..aec0776 100644 (file)
--- a/lib/Math/Complex.pm
+++ b/lib/Math/Complex.pm
@@ -699,6 +699,11 @@ sub stringify_cartesian {
        my ($x, $y) = @{$z->cartesian};
        my ($re, $im);
 
+       $x = int($x + ($x < 0 ? -1 : 1) * 1e-14)
+               if int(abs($x)) != int(abs($x) + 1e-14);
+       $y = int($y + ($y < 0 ? -1 : 1) * 1e-14)
+               if int(abs($y)) != int(abs($y) + 1e-14);
+
        $re = "$x" if abs($x) >= 1e-14;
        if ($y == 1)                            { $im = 'i' }
        elsif ($y == -1)                        { $im = '-i' }
@@ -734,7 +739,13 @@ sub stringify_polar {
        if (abs($nt) <= 1e-14)                  { $theta = 0 }
        elsif (abs(pi-$nt) <= 1e-14)    { $theta = 'pi' }
 
-       return "\[$r,$theta\]" if defined $theta;
+       if (defined $theta) {
+               $r = int($r + ($r < 0 ? -1 : 1) * 1e-14)
+                       if int(abs($r)) != int(abs($r) + 1e-14);
+               $theta = int($theta + ($theta < 0 ? -1 : 1) * 1e-14)
+                       if int(abs($theta)) != int(abs($theta) + 1e-14);
+               return "\[$r,$theta\]";
+       }
 
        #
        # Okay, number is not a real. Try to identify pi/n and friends...
@@ -753,6 +764,11 @@ sub stringify_polar {
 
        $theta = $nt unless defined $theta;
 
+       $r = int($r + ($r < 0 ? -1 : 1) * 1e-14)
+               if int(abs($r)) != int(abs($r) + 1e-14);
+       $theta = int($theta + ($theta < 0 ? -1 : 1) * 1e-14)
+               if int(abs($theta)) != int(abs($theta) + 1e-14);
+
        return "\[$r,$theta\]";
 }
 
diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm

index 4faed49..9998c48 100644 (file)
--- a/lib/Pod/Text.pm
+++ b/lib/Pod/Text.pm
@@ -1,6 +1,6 @@
 package Pod::Text;
 
-# Version 1.01
+# Version 1.02
 
 =head1 NAME
 
@@ -116,14 +116,14 @@ sub prepare_for_output {
     $maxnest = 10;
     while ($maxnest-- && /[A-Z]</) {
        unless ($FANCY) {
-           s/C<(.*?)>/`$1'/g;
+           s/C<(.*?)>/`$1'/sg;
        } else {
-           s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/ge;
+           s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/sge;
        }
         # s/[IF]<(.*?)>/italic($1)/ge;
-        s/I<(.*?)>/*$1*/g;
+        s/I<(.*?)>/*$1*/sg;
         # s/[CB]<(.*?)>/bold($1)/ge;
-       s/X<.*?>//g;
+       s/X<.*?>//sg;
        # LREF: a manpage(3f)
        s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
        # LREF: an =item on another manpage
@@ -167,9 +167,9 @@ sub prepare_for_output {
                    ?  "the section on \"$2\" in the $1 manpage"
                    :  "the section on \"$2\""
            }
-       }gex;
+       }sgex;
 
-        s/[A-Z]<(.*?)>/$1/g;
+        s/[A-Z]<(.*?)>/$1/sg;
     }
     clear_noremap(1);
 }
diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm

index 9df3161..c524170 100644 (file)
--- a/lib/Sys/Syslog.pm
+++ b/lib/Sys/Syslog.pm
@@ -7,6 +7,7 @@ use Carp;
 @EXPORT = qw(openlog closelog setlogmask syslog);
 
 use Socket;
+use Sys::Hostname;
 
 # adapted from syslog.pl
 #
@@ -85,7 +86,7 @@ L<syslog(3)>
 
 =head1 AUTHOR
 
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<lwall@sems.com>E<gt>
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>
 
 =cut
 
@@ -190,7 +191,7 @@ sub syslog {
 
 sub xlate {
     local($name) = @_;
-    $name =~ y/a-z/A-Z/;
+    $name = uc $name;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "Sys::Syslog::$name";
     eval(&$name) || -1;
diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm

index d4d91c6..5a73ecf 100644 (file)
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -195,11 +195,8 @@ sub Tgetent { ## public -- static method
                last;
            }
        }
-        if (defined $entry) {
-          $entry .= $_;
-        } else {
-          $entry = $_;
-        }
+       defined $entry or $entry = '';
+       $entry .= $_;
     };
 
     while ($state != 0) {
diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm

index 884f83f..bdab2ad 100644 (file)
--- a/lib/Term/Complete.pm
+++ b/lib/Term/Complete.pm
@@ -71,6 +71,8 @@ CONFIG: {
 }
 
 sub Complete {
+    my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
+
     $prompt = shift;
     if (ref $_[0] || $_[0] =~ /^\*/) {
        @cmp_lst = sort @{$_[0]};
diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm

index 33b6835..f86c8c2 100644 (file)
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -115,7 +115,7 @@ sub quotewords {
                last;
            }
            else {
-                while ($_ && !(/^$delim/ || /^['"\\]/)) {
+                while ($_ ne '' && !(/^$delim/ || /^['"\\]/)) {
                   $snippet .=  substr($_, 0, 1);
                    substr($_, 0, 1) = '';
                 }
diff --git a/lib/Text/Soundex.pm b/lib/Text/Soundex.pm

index a334404..ddc758c 100644 (file)
--- a/lib/Text/Soundex.pm
+++ b/lib/Text/Soundex.pm
@@ -48,7 +48,7 @@ sub soundex
 
   foreach (@s)
   {
-    tr/a-z/A-Z/;
+    $_ = uc $_;
     tr/A-Z//cd;
 
     if ($_ eq '')
diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm

index 1fab298..2bdf23c 100644 (file)
--- a/lib/Time/Local.pm
+++ b/lib/Time/Local.pm
@@ -40,12 +40,12 @@ after the 1st of January, 2038 on most machines.
 =cut
 
 BEGIN {
-    @epoch = localtime(0);
-
     $SEC  = 1;
     $MIN  = 60 * $SEC;
     $HR   = 60 * $MIN;
     $DAY  = 24 * $HR;
+    $epoch = (localtime(2*$DAY))[5];   # Allow for bugs near localtime == 0.
+
     $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
 
     my $t = time;
@@ -71,13 +71,13 @@ BEGIN {
 sub timegm {
     $ym = pack(C2, @_[5,4]);
     $cheat = $cheat{$ym} || &cheat;
-    return -1 if $cheat<0;
+    return -1 if $cheat<0 and $^O ne 'VMS';
     $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY;
 }
 
 sub timelocal {
     $time = &timegm + $tzsec;
-    return -1 if $cheat<0;
+    return -1 if $cheat<0 and $^O ne 'VMS';
     @test = localtime($time);
     $time -= $HR if $test[2] != $_[2];
     $time;
@@ -100,7 +100,7 @@ sub cheat {
        if $_[0] > 59 || $_[0] < 0;
     $guess = $^T;
     @g = gmtime($guess);
-    $year += $YearFix if $year < $epoch[5];
+    $year += $YearFix if $year < $epoch;
     $lastguess = "";
     while ($diff = $year - $g[5]) {
        $guess += $diff * (363 * $DAY);
diff --git a/lib/abbrev.pl b/lib/abbrev.pl

index c233d4a..62975e6 100644 (file)
--- a/lib/abbrev.pl
+++ b/lib/abbrev.pl
@@ -17,7 +17,7 @@ sub main'abbrev {
        $len = 1;
        foreach $cmp (@cmp) {
            next if $cmp eq $name;
-           while (substr($cmp,0,$len) eq $abbrev) {
+           while (@extra && substr($cmp,0,$len) eq $abbrev) {
                $abbrev .= shift(@extra);
                ++$len;
            }
diff --git a/lib/bigint.pl b/lib/bigint.pl

index a274736..bfd2efa 100644 (file)
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -168,11 +168,11 @@ sub add { #(int_num_array, int_num_array) return int_num_array
     $car = 0;
     for $x (@x) {
        last unless @y || $car;
-       $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+       $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5) ? 1 : 0;
     }
     for $y (@y) {
        last unless $car;
-       $y -= 1e5 if $car = (($y += $car) >= 1e5);
+       $y -= 1e5 if $car = (($y += $car) >= 1e5) ? 1 : 0;
     }
     (@x, @y, $car);
 }
diff --git a/lib/complete.pl b/lib/complete.pl

index 1e08f91..3352452 100644 (file)
--- a/lib/complete.pl
+++ b/lib/complete.pl
@@ -35,7 +35,7 @@ CONFIG: {
 sub Complete {
     package Complete;
 
-    local($[,$return) = 0;
+    local($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
     if ($_[1] =~ /^StB\0/) {
         ($prompt, *_) = @_;
     }
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm

index a8af08f..02fae7a 100755 (executable)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -415,10 +415,27 @@ sub warn_trap {
 
 sub death_trap {
     my $exception = $_[0];
-    splainthis($exception);
+
+    # See if we are coming from anywhere within an eval. If so we don't
+    # want to explain the exception because it's going to get caught.
+    my $in_eval = 0;
+    my $i = 0;
+    while (1) {
+      my $caller = (caller($i++))[3] or last;
+      if ($caller eq '(eval)') {
+       $in_eval = 1;
+       last;
+      }
+    }
+
+    splainthis($exception) unless $in_eval;
     if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
     &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
-    $SIG{__DIE__} = $SIG{__WARN__} = '';
+
+    # We don't want to unset these if we're coming from an eval because
+    # then we've turned off diagnostics. (Actually what does this next
+    # line do?  -PSeibel)
+    $SIG{__DIE__} = $SIG{__WARN__} = '' unless $in_eval;
     local($Carp::CarpLevel) = 1;
     confess "Uncaught exception from user code:\n\t$exception";
        # up we go; where we stop, nobody knows, but i think we die now
diff --git a/lib/getcwd.pl b/lib/getcwd.pl

index d886018..9dd6945 100644 (file)
--- a/lib/getcwd.pl
+++ b/lib/getcwd.pl
@@ -44,9 +44,9 @@ sub getcwd
                }
                unless (@tst = lstat("$dotdots/$dir"))
                {
-                   warn "lstat($dotdots/$dir): $!";
-                   closedir(getcwd'PARENT);                            #');
-                   return '';
+                   # warn "lstat($dotdots/$dir): $!";
+                   # closedir(getcwd'PARENT);                          #');
+                   # return '';
                }
            }
            while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
diff --git a/lib/getopts.pl b/lib/getopts.pl

index a0818d1..852aae8 100644 (file)
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -8,23 +8,22 @@ sub Getopts {
     local($argumentative) = @_;
     local(@args,$_,$first,$rest);
     local($errs) = 0;
-    local($[) = 0;
 
     @args = split( / */, $argumentative );
     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        $pos = index($argumentative,$first);
-       if($pos >= $[) {
-           if($args[$pos+1] eq ':') {
+       if($pos >= 0) {
+           if($pos < $#args && $args[$pos+1] eq ':') {
                shift(@ARGV);
                if($rest eq '') {
                    ++$errs unless @ARGV;
                    $rest = shift(@ARGV);
                }
-               eval "\$opt_$first = \$rest;";
+               ${"opt_$first"} = $rest;
            }
            else {
-               eval "\$opt_$first = 1";
+               ${"opt_$first"} = 1;
                if($rest eq '') {
                    shift(@ARGV);
                }
diff --git a/lib/look.pl b/lib/look.pl

index 4c14e64..e8dc8aa 100644 (file)
--- a/lib/look.pl
+++ b/lib/look.pl
@@ -10,7 +10,7 @@ sub look {
        $blksize,$blocks) = stat(FH);
     $blksize = 8192 unless $blksize;
     $key =~ s/[^\w\s]//g if $dict;
-    $key =~ y/A-Z/a-z/ if $fold;
+    $key = lc $key if $fold;
     $max = int($size / $blksize);
     while ($max - $min > 1) {
        $mid = int(($max + $min) / 2);
@@ -19,7 +19,7 @@ sub look {
        $_ = <FH>;
        chop;
        s/[^\w\s]//g if $dict;
-       y/A-Z/a-z/ if $fold;
+       $_ = lc $_ if $fold;
        if ($_ lt $key) {
            $min = $mid;
        }
@@ -33,7 +33,7 @@ sub look {
     while (<FH>) {
        chop;
        s/[^\w\s]//g if $dict;
-       y/A-Z/a-z/ if $fold;
+       $_ = lc $_ if $fold;
        last if $_ ge $key;
        $min = tell(FH);
     }
diff --git a/lib/perl5db.pl b/lib/perl5db.pl

index a57475c..3f3a4c2 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 0.95;
+$VERSION = 0.96;
 $header = "perl5db.pl patch level $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -23,6 +23,27 @@ $header = "perl5db.pl patch level $VERSION";
 # $DB::sub being the called subroutine. It also inserts a BEGIN
 # {require 'perl5db.pl'} before the first line.
 #
+# After each `require'd file is compiled, but before it is executed, a
+# call to DB::postponed(*{"_<$filename"}) is emulated. Here the
+# $filename is the expanded name of the `require'd file (as found as
+# value of %INC).
+#
+# Additional services from Perl interpreter:
+#
+# if caller() is called from the package DB, it provides some
+# additional data.
+#
+# The array @{"_<$filename"} is the line-by-line contents of
+# $filename.
+#
+# The hash %{"_<$filename"} contains breakpoints and action (it is
+# keyed by line number), and individual entries are settable (as
+# opposed to the whole hash). Only true/false is important to the
+# interpreter, though the values used by perl5db.pl have the form
+# "$break_condition\0$action". Values are magical in numeric context.
+#
+# The scalar ${"_<$filename"} contains "_<$filename".
+#
 # Note that no subroutine call is possible until &DB::sub is defined
 # (for subroutines defined outside this file). In fact the same is
 # true if $deep is not defined.
@@ -64,8 +85,6 @@ $header = "perl5db.pl patch level $VERSION";
 # information into db.out.  (If you interrupt it, you would better
 # reset LineInfo to something "interactive"!)
 #
-# Changes: 0.95: v command shows versions.
-
 ##################################################################
 # Changelog:
 
@@ -82,6 +101,26 @@ $header = "perl5db.pl patch level $VERSION";
 # the deletion of data may be postponed until the next function call,
 # due to the need to examine the return value.
 
+# Changes: 0.95: `v' command shows versions.
+# Changes: 0.96: `v' command shows version of readline.
+#      primitive completion works (dynamic variables, subs for `b' and `l',
+#              options). Can `p %var'
+#      Better help (`h <' now works). New commands <<, >>, {, {{.
+#      {dump|print}_trace() coded (to be able to do it from <<cmd).
+#      `c sub' documented.
+#      At last enough magic combined to stop after the end of debuggee.
+#      !! should work now (thanks to Emacs bracket matching an extra
+#      `]' in a regexp is caught).
+#      `L', `D' and `A' span files now (as documented).
+#      Breakpoints in `require'd code are possible (used in `R').
+#      Some additional words on internal work of debugger.
+#      `b load filename' implemented.
+#      `b postpone subr' implemented.
+#      now only `q' exits debugger (overwriteable on $inhibit_exit).
+#      When restarting debugger breakpoints/actions persist.
+#     Buglet: When restarting debugger only one breakpoint/action per 
+#              autoloaded function persists.
+
 ####################################################################
 
 # Needed for the statement after exec():
@@ -111,11 +150,7 @@ warn (                     # Do not ;-)
 
 $trace = $signal = $single = 0;        # Uninitialized warning suppression
                                 # (local $^W cannot help - other packages!).
-$doret = -2;
-$frame = 0;
-@stack = (0);
-
-$option{PrintRet} = 1;
+$inhibit_exit = $option{PrintRet} = 1;
 
 @options     = qw(hashDepth arrayDepth DumpDBFiles DumpPackages 
                  compactDump veryCompact quote HighBit undefPrint
@@ -165,6 +200,9 @@ $rl = 1 unless defined $rl;
 $warnLevel = 1 unless defined $warnLevel;
 $dieLevel = 1 unless defined $dieLevel;
 $signalLevel = 1 unless defined $signalLevel;
+$pre = [] unless defined $pre;
+$post = [] unless defined $post;
+$pretype = [] unless defined $pretype;
 warnLevel($warnLevel);
 dieLevel($dieLevel);
 signalLevel($signalLevel);
@@ -194,9 +232,11 @@ if (exists $ENV{PERLDB_RESTART}) {
   delete $ENV{PERLDB_RESTART};
   # $restart = 1;
   @hist = get_list('PERLDB_HIST');
-  my @visited = get_list("PERLDB_VISITED");
-  for (0 .. $#visited) {
-    %{$postponed{$visited[$_]}} = get_list("PERLDB_FILE_$_");
+  %break_on_load = get_list("PERLDB_ON_LOAD");
+  %postponed = get_list("PERLDB_POSTPONE");
+  my @had_breakpoints= get_list("PERLDB_VISITED");
+  for (0 .. $#had_breakpoints) {
+    %{$postponed_file{$had_breakpoints[$_]}} = get_list("PERLDB_FILE_$_");
   }
   my %opt = get_list("PERLDB_OPT");
   my ($opt,$val);
@@ -285,14 +325,6 @@ sub DB {
        $single = 0;
        return;
       }
-      # Define a subroutine in which we will stop
-#       eval <<'EOE';
-# sub at_end::db {"Debuggee terminating";}
-# END {
-#   $DB::step = 1; 
-#   print $OUT "Debuggee terminating.\n"; 
-#   &at_end::db;}
-# EOE
     }
     &save;
     ($package, $filename, $line) = caller;
@@ -300,7 +332,6 @@ sub DB {
     $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
       "package $package;";     # this won't let them modify, alas
     local(*dbline) = "::_<$filename";
-    install_breakpoints($filename) unless $visited{$filename}++;
     $max = $#dbline;
     if (($stop,$action) = split(/\0/,$dbline{$line})) {
        if ($stop eq '1') {
@@ -342,23 +373,23 @@ sub DB {
     $evalarg = $action, &eval if $action;
     if ($single || $signal) {
        local $level = $level + 1;
-       $evalarg = $pre, &eval if $pre;
+       map {$evalarg = $_, &eval} @$pre;
        print $OUT $#stack . " levels deep in subroutine calls!\n"
          if $single & 4;
        $start = $line;
+       @typeahead = @$pretype, @typeahead;
       CMD:
        while (($term || &setterm),
               defined ($cmd=&readline("  DB" . ('<' x $level) .
                                       ($#hist+1) . ('>' x $level) .
                                       " "))) {
-           #{                  # <-- Do we know what this brace is for?
                $single = 0;
                $signal = 0;
                $cmd =~ s/\\$/\n/ && do {
                    $cmd .= &readline("  cont: ");
                    redo CMD;
                };
-               $cmd =~ /^q$/ && exit 0;
+               $cmd =~ /^q$/ && ($exiting = 1) && exit 0;
                $cmd =~ /^$/ && ($cmd = $laststep);
                push(@hist,$cmd) if length($cmd) > 1;
              PIPE: {
@@ -372,8 +403,10 @@ sub DB {
                        next CMD; };
                    $cmd =~ /^h\s+(\S)$/ && do {
                        my $asked = "\Q$1";
-                       if ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/m) {
+                       if ($help =~ /^$asked/m) {
+                         while ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/mg) {
                            print $OUT $1;
+                         }
                        } else {
                            print $OUT "`$asked' is not a debugger command.\n";
                        }
@@ -429,7 +462,6 @@ sub DB {
                            next CMD;
                        } elsif ($file ne $filename) {
                            *dbline = "::_<$file";
-                           $visited{$file}++;
                            $max = $#dbline;
                            $filename = $file;
                            $start = 1;
@@ -445,7 +477,6 @@ sub DB {
                        $file = join(':', @pieces);
                        if ($file ne $filename) {
                            *dbline = "::_<$file";
-                           $visited{$file}++;
                            $max = $#dbline;
                            $filename = $file;
                        }
@@ -508,7 +539,13 @@ sub DB {
                        $start = $max if $start > $max;
                        next CMD; };
                    $cmd =~ /^D$/ && do {
-                       print $OUT "Deleting all breakpoints...\n";
+                     print $OUT "Deleting all breakpoints...\n";
+                     my $file;
+                     for $file (keys %had_breakpoints) {
+                       local *dbline = "::_<$file";
+                       my $max = $#dbline;
+                       my $was;
+                       
                        for ($i = 1; $i <= $max ; $i++) {
                            if (defined $dbline{$i}) {
                                $dbline{$i} =~ s/^[^\0]+//;
@@ -517,19 +554,89 @@ sub DB {
                                }
                            }
                        }
-                       next CMD; };
+                     }
+                     undef %postponed;
+                     undef %postponed_file;
+                     undef %break_on_load;
+                     undef %had_breakpoints;
+                     next CMD; };
                    $cmd =~ /^L$/ && do {
+                     my $file;
+                     for $file (keys %had_breakpoints) {
+                       local *dbline = "::_<$file";
+                       my $max = $#dbline;
+                       my $was;
+                       
                        for ($i = 1; $i <= $max; $i++) {
                            if (defined $dbline{$i}) {
-                               print $OUT "$i:\t", $dbline[$i];
+                               print "$file:\n" unless $was++;
+                               print $OUT " $i:\t", $dbline[$i];
                                ($stop,$action) = split(/\0/, $dbline{$i});
-                               print $OUT "  break if (", $stop, ")\n"
+                               print $OUT "   break if (", $stop, ")\n"
                                  if $stop;
-                               print $OUT "  action:  ", $action, "\n"
+                               print $OUT "   action:  ", $action, "\n"
                                  if $action;
                                last if $signal;
                            }
                        }
+                     }
+                     if (%postponed) {
+                       print $OUT "Postponed breakpoints in subroutines:\n";
+                       my $subname;
+                       for $subname (keys %postponed) {
+                         print $OUT " $subname\t$postponed{$subname}\n";
+                         last if $signal;
+                       }
+                     }
+                     my @have = map { # Combined keys
+                       keys %{$postponed_file{$_}}
+                     } keys %postponed_file;
+                     if (@have) {
+                       print $OUT "Postponed breakpoints in files:\n";
+                       my ($file, $line);
+                       for $file (keys %postponed_file) {
+                         my %db = %{$postponed_file{$file}};
+                         next unless keys %db;
+                         print $OUT " $file:\n";
+                         for $line (sort {$a <=> $b} keys %db) {
+                               print $OUT "  $i:\n";
+                               my ($stop,$action) = split(/\0/, $db{$line});
+                               print $OUT "    break if (", $stop, ")\n"
+                                 if $stop;
+                               print $OUT "    action:  ", $action, "\n"
+                                 if $action;
+                               last if $signal;
+                         }
+                         last if $signal;
+                       }
+                     }
+                     if (%break_on_load) {
+                       print $OUT "Breakpoints on load:\n";
+                       my $file;
+                       for $file (keys %break_on_load) {
+                         print $OUT " $file\n";
+                         last if $signal;
+                       }
+                     }
+                     next CMD; };
+                   $cmd =~ /^b\b\s*load\b\s*(.*)/ && do {
+                       my $file = $1;
+                       {
+                         $break_on_load{$file} = 1;
+                         $break_on_load{$::INC{$file}} = 1 if $::INC{$file};
+                         $file .= '.pm', redo unless $file =~ /\./;
+                       }
+                       $had_breakpoints{$file} = 1;
+                       print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
+                       next CMD; };
+                   $cmd =~ /^b\b\s*postpone\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+                       my $cond = $2 || '1';
+                       my $subname = $1;
+                       $subname =~ s/\'/::/;
+                       $subname = "${'package'}::" . $subname
+                         unless $subname =~ /::/;
+                       $subname = "main".$subname if substr($subname,0,2) eq "::";
+                       $postponed{$subname} = "break +0 if $cond";
                        next CMD; };
                    $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
                        $subname = $1;
@@ -544,7 +651,7 @@ sub DB {
                        if ($i) {
                            $filename = $file;
                            *dbline = "::_<$filename";
-                           $visited{$filename}++;
+                           $had_breakpoints{$filename} = 1;
                            $max = $#dbline;
                            ++$i while $dbline[$i] == 0 && $i < $max;
                            $dbline{$i} =~ s/^[^\0]*/$cond/;
@@ -558,6 +665,7 @@ sub DB {
                        if ($dbline[$i] == 0) {
                            print $OUT "Line $i not breakable.\n";
                        } else {
+                           $had_breakpoints{$filename} = 1;
                            $dbline{$i} =~ s/^[^\0]*/$cond/;
                        }
                        next CMD; };
@@ -567,13 +675,20 @@ sub DB {
                        delete $dbline{$i} if $dbline{$i} eq '';
                        next CMD; };
                    $cmd =~ /^A$/ && do {
+                     my $file;
+                     for $file (keys %had_breakpoints) {
+                       local *dbline = "::_<$file";
+                       my $max = $#dbline;
+                       my $was;
+                       
                        for ($i = 1; $i <= $max ; $i++) {
                            if (defined $dbline{$i}) {
                                $dbline{$i} =~ s/\0[^\0]*//;
                                delete $dbline{$i} if $dbline{$i} eq '';
                            }
                        }
-                       next CMD; };
+                     }
+                     next CMD; };
                    $cmd =~ /^O\s*$/ && do {
                        for (@options) {
                            &dump_option($_);
@@ -582,11 +697,26 @@ sub DB {
                    $cmd =~ /^O\s*(\S.*)/ && do {
                        parse_options($1);
                        next CMD; };
+                   $cmd =~ /^\<\<\s*(.*)/ && do { # \<\< for CPerl sake: not HERE
+                       push @$pre, action($1);
+                       next CMD; };
+                   $cmd =~ /^>>\s*(.*)/ && do {
+                       push @$post, action($1);
+                       next CMD; };
                    $cmd =~ /^<\s*(.*)/ && do {
-                       $pre = action($1);
+                       $pre = [], next CMD unless $1;
+                       $pre = [action($1)];
                        next CMD; };
                    $cmd =~ /^>\s*(.*)/ && do {
-                       $post = action($1);
+                       $post = [], next CMD unless $1;
+                       $post = [action($1)];
+                       next CMD; };
+                   $cmd =~ /^\{\{\s*(.*)/ && do {
+                       push @$pretype, $1;
+                       next CMD; };
+                   $cmd =~ /^\{\s*(.*)/ && do {
+                       $pretype = [], next CMD unless $1;
+                       $pretype = [$1];
                        next CMD; };
                    $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
                        $i = $1; $j = $3;
@@ -598,14 +728,17 @@ sub DB {
                        }
                        next CMD; };
                    $cmd =~ /^n$/ && do {
+                       next CMD if $finished and $level <= 1;
                        $single = 2;
                        $laststep = $cmd;
                        last CMD; };
                    $cmd =~ /^s$/ && do {
+                       next CMD if $finished and $level <= 1;
                        $single = 1;
                        $laststep = $cmd;
                        last CMD; };
                    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+                       next CMD if $finished and $level <= 1;
                        $i = $1;
                        if ($i =~ /\D/) { # subroutine name
                            ($file,$i) = ($sub{$i} =~ /^(.*):(.*)$/);
@@ -613,7 +746,7 @@ sub DB {
                            if ($i) {
                                $filename = $file;
                                *dbline = "::_<$filename";
-                               $visited{$filename}++;
+                               $had_breakpoints{$filename}++;
                                $max = $#dbline;
                                ++$i while $dbline[$i] == 0 && $i < $max;
                            } else {
@@ -633,11 +766,12 @@ sub DB {
                        }
                        last CMD; };
                    $cmd =~ /^r$/ && do {
+                       next CMD if $finished and $level <= 1;
                        $stack[$#stack] |= 1;
                        $doret = $option{PrintRet} ? $#stack - 1 : -2;
                        last CMD; };
                    $cmd =~ /^R$/ && do {
-                       print $OUT "Warning: a lot of settings and command-line options may be lost!\n";
+                       print $OUT "Warning: some settings and command-line options may be lost!\n";
                        my (@script, @flags, $cl);
                        push @flags, '-w' if $ini_warn;
                        # Put all the old includes at the start to get
@@ -658,52 +792,63 @@ sub DB {
                        set_list("PERLDB_HIST", 
                                 $term->Features->{getHistory} 
                                 ? $term->GetHistory : @hist);
-                       my @visited = keys %visited;
-                       set_list("PERLDB_VISITED", @visited);
+                       my @had_breakpoints = keys %had_breakpoints;
+                       set_list("PERLDB_VISITED", @had_breakpoints);
                        set_list("PERLDB_OPT", %option);
-                       for (0 .. $#visited) {
-                         *dbline = "::_<$visited[$_]";
-                         set_list("PERLDB_FILE_$_", %dbline);
+                       set_list("PERLDB_ON_LOAD", %break_on_load);
+                       my @hard;
+                       for (0 .. $#had_breakpoints) {
+                         my $file = $had_breakpoints[$_];
+                         *dbline = "::_<$file";
+                         next unless %dbline or %{$postponed_file{$file}};
+                         (push @hard, $file), next 
+                           if $file =~ /^\(eval \d+\)$/;
+                         my @add;
+                         @add = %{$postponed_file{$file}}
+                           if %{$postponed_file{$file}};
+                         set_list("PERLDB_FILE_$_", %dbline, @add);
+                       }
+                       for (@hard) { # Yes, really-really...
+                         # Find the subroutines in this eval
+                         *dbline = "::_<$_";
+                         my ($quoted, $sub, %subs, $line) = quotemeta $_;
+                         for $sub (keys %sub) {
+                           next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
+                           $subs{$sub} = [$1, $2];
+                         }
+                         unless (%subs) {
+                           print $OUT
+                             "No subroutines in $_, ignoring breakpoints.\n";
+                           next;
+                         }
+                       LINES: for $line (keys %dbline) {
+                           # One breakpoint per sub only:
+                           my ($offset, $sub, $found);
+                         SUBS: for $sub (keys %subs) {
+                             if ($subs{$sub}->[1] >= $line # Not after the subroutine
+                                 and (not defined $offset # Not caught
+                                      or $offset < 0 )) { # or badly caught
+                               $found = $sub;
+                               $offset = $line - $subs{$sub}->[0];
+                               $offset = "+$offset", last SUBS if $offset >= 0;
+                             }
+                           }
+                           if (defined $offset) {
+                             $postponed{$found} =
+                               "break $offset if $dbline{$line}";
+                           } else {
+                             print $OUT "Breakpoint in $_:$line ignored: after all the subroutines.\n";
+                           }
+                         }
                        }
+                       set_list("PERLDB_POSTPONE", %postponed);
                        $ENV{PERLDB_RESTART} = 1;
                        #print "$^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS";
                        exec $^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS;
                        print $OUT "exec failed: $!\n";
                        last CMD; };
                    $cmd =~ /^T$/ && do {
-                       local($p,$f,$l,$s,$h,$a,$e,$r,@a,@sub);
-                       for ($i = 1; 
-                            ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); 
-                            $i++) {
-                           @a = ();
-                           for $arg (@args) {
-                               $_ = "$arg";
-                               s/([\'\\])/\\$1/g;
-                               s/([^\0]*)/'$1'/
-                                 unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
-                               s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-                               s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
-                               push(@a, $_);
-                           }
-                           $w = $w ? '@ = ' : '$ = ';
-                           $a = $h ? '(' . join(', ', @a) . ')' : '';
-                           $e =~ s/\n\s*\;\s*\Z// if $e;
-                           $e =~ s/[\\\']/\\$1/g if $e;
-                           if ($r) {
-                             $s = "require '$e'";
-                           } elsif (defined $r) {
-                             $s = "eval '$e'";
-                           } elsif ($s eq '(eval)') {
-                             $s = "eval {...}";
-                           }
-                           $f = "file `$f'" unless $f eq '-e';
-                           push(@sub, "$w$s$a called from $f line $l\n");
-                           last if $signal;
-                       }
-                       for ($i=0; $i <= $#sub; $i++) {
-                           last if $signal;
-                           print $OUT $sub[$i];
-                       }
+                       print_trace($OUT, 3); # skip DB print_trace dump_trace
                        next CMD; };
                    $cmd =~ /^\/(.*)$/ && do {
                        $inpat = $1;
@@ -767,7 +912,7 @@ sub DB {
                        $cmd = $hist[$i] . "\n";
                        print $OUT $cmd;
                        redo CMD; };
-                   $cmd =~ /^$sh$sh\s*([\x00-\xff]]*)/ && do {
+                   $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
                        &system($1);
                        next CMD; };
                    $cmd =~ /^$rc([^$rc].*)$/ && do {
@@ -844,7 +989,6 @@ sub DB {
                    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
                    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
                }               # PIPE:
-           #}                  # <-- Do we know what this brace is for?
            $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
            if ($onetimeDump) {
                $onetimeDump = undef;
@@ -872,9 +1016,7 @@ sub DB {
                $piped= "";
            }
        }                       # CMD:
-       if ($post) {
-           $evalarg = $post; &eval;
-       }
+        map {$evalarg = $_; &eval} @$post;
     }                          # if ($single || $signal)
     ($@, $!, $,, $/, $\, $^W) = @saved;
     ();
@@ -937,16 +1079,44 @@ sub eval {
     }
 }
 
-sub install_breakpoints {
-  my $filename = shift;
-  return unless exists $postponed{$filename};
-  my %break = %{$postponed{$filename}};
-  for (keys %break) {
-    my $i = $_;
-    #if (/\D/) {                       # Subroutine name
-    #} 
-    $dbline{$i} = $break{$_};  # Cannot be done before the file is around
+sub postponed_sub {
+  my $subname = shift;
+  if ($postponed{$subname} =~ s/break\s([+-]?\d+)\s+if\s//) {
+    my $offset = $1 || 0;
+    # Filename below can contain ':'
+    my ($file,$i) = ($sub{$subname} =~ /^(.*):(\d+)-.*$/);
+    $i += $offset;
+    if ($i) {
+      local *dbline = "::_<$file";
+      local $^W = 0;           # != 0 is magical below
+      $had_breakpoints{$file}++;
+      my $max = $#dbline;
+      ++$i until $dbline[$i] != 0 or $i >= $max;
+      $dbline{$i} = delete $postponed{$subname};
+    } else {
+      print $OUT "Subroutine $subname not found.\n";
+    }
+    return;
+  }
+  print $OUT "In postponed_sub for `$subname'.\n";
+}
+
+sub postponed {
+  return &postponed_sub
+    unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
+  # Cannot be done before the file is compiled
+  local *dbline = shift;
+  my $filename = $dbline;
+  $filename =~ s/^_<//;
+  $signal = 1, print $OUT "'$filename' loaded...\n" if $break_on_load{$filename};
+  return unless %{$postponed_file{$filename}};
+  $had_breakpoints{$filename}++;
+  #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
+  my $key;
+  for $key (keys %{$postponed_file{$filename}}) {
+    $dbline{$key} = $ {$postponed_file{$filename}}{$key};
   }
+  undef %{$postponed_file{$filename}};
 }
 
 sub dumpit {
@@ -969,6 +1139,57 @@ sub dumpit {
     select ($savout);    
 }
 
+sub print_trace {
+  my $fh = shift;
+  my @sub = dump_trace(@_);
+  for ($i=0; $i <= $#sub; $i++) {
+    last if $signal;
+    local $" = ', ';
+    my $args = defined $sub[$i]{args} 
+    ? "(@{ $sub[$i]{args} })"
+      : '' ;
+    $file = $sub[$i]{file} eq '-e' ? $sub[$i]{file} :
+      "file `$sub[$i]{file}'";
+    print $fh "$sub[$i]{context}$sub[$i]{sub}$args" .
+      " called from $file" . 
+       " line $sub[$i]{line}\n";
+  }
+}
+
+sub dump_trace {
+  my $skip = shift;
+  my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context);
+  for ($i = $skip; 
+       ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); 
+       $i++) {
+    @a = ();
+    for $arg (@args) {
+      $_ = "$arg";
+      s/([\'\\])/\\$1/g;
+      s/([^\0]*)/'$1'/
+       unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+      s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+      s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+      push(@a, $_);
+    }
+    $context = $context ? '@ = ' : '$ = ';
+    $args = $h ? [@a] : undef;
+    $e =~ s/\n\s*\;\s*\Z// if $e;
+    $e =~ s/[\\\']/\\$1/g if $e;
+    if ($r) {
+      $sub = "require '$e'";
+    } elsif (defined $r) {
+      $sub = "eval '$e'";
+    } elsif ($sub eq '(eval)') {
+      $sub = "eval {...}";
+    }
+    push(@sub, {context => $context, sub => $sub, args => $args,
+               file => $file, line => $line});
+    last if $signal;
+  }
+  @sub;
+}
+
 sub action {
     my $action = shift;
     while ($action =~ s/\\$//) {
@@ -1032,6 +1253,12 @@ sub setterm {
        $readline::rl_basic_word_break_characters .= "[:" 
          if defined $readline::rl_basic_word_break_characters 
            and index($readline::rl_basic_word_break_characters, ":") == -1;
+       $readline::rl_special_prefixes = 
+         $readline::rl_special_prefixes = '$@&%';
+       $readline::rl_completer_word_break_characters =
+         $readline::rl_completer_word_break_characters . '$@&%';
+       $readline::rl_completion_function = 
+         $readline::rl_completion_function = \&db_complete; 
     }
     $LINEINFO = $OUT unless defined $LINEINFO;
     $lineinfo = $console unless defined $lineinfo;
@@ -1057,6 +1284,14 @@ sub readline {
 
 sub dump_option {
     my ($opt, $val)= @_;
+    $val = option_val($opt,'N/A');
+    $val =~ s/([\\\'])/\\$1/g;
+    printf $OUT "%20s = '%s'\n", $opt, $val;
+}
+
+sub option_val {
+    my ($opt, $default)= @_;
+    my $val;
     if (defined $optionVars{$opt}
        and defined $ {$optionVars{$opt}}) {
        $val = $ {$optionVars{$opt}};
@@ -1067,12 +1302,11 @@ sub dump_option {
             and not defined $option{$opt}
             or defined $optionVars{$opt}
             and not defined $ {$optionVars{$opt}}) {
-       $val = 'N/A';
+       $val = $default;
     } else {
        $val = $option{$opt};
     }
-    $val =~ s/([\\\'])/\\$1/g;
-    printf $OUT "%20s = '%s'\n", $opt, $val;
+    $val
 }
 
 sub parse_options {
@@ -1244,6 +1478,7 @@ sub list_versions {
     s,\.p[lm]$,,i ;
     s,/,::,g ;
     s/^perl5db$/DB/;
+    s/^Term::ReadLine::readline$/readline/;
     if (defined $ { $_ . '::VERSION' }) {
       $version{$file} = "$ { $_ . '::VERSION' } from ";
     } 
@@ -1265,8 +1500,8 @@ s [expr]  Single step [in expr].
 n [expr]       Next, steps over subroutine calls [in expr].
 <CR>           Repeat last n or s command.
 r              Return from current subroutine.
-c [line]       Continue; optionally inserts a one-time-only breakpoint
-               at the specified line.
+c [line|sub]   Continue; optionally inserts a one-time-only breakpoint
+               at the specified position.
 l min+incr     List incr+1 lines starting at min.
 l min-max      List lines min through max.
 l line         List single line.
@@ -1287,6 +1522,10 @@ b [line] [condition]
                condition breaks if it evaluates to true, defaults to '1'.
 b subname [condition]
                Set breakpoint at first line of subroutine.
+b load filename Set breakpoint on `require'ing the given file.
+b postpone subname [condition]
+               Set breakpoint at first line of subroutine after 
+               it is compiled.
 d [line]       Delete the breakpoint for line.
 D              Delete all breakpoints.
 a [line] command
@@ -1317,8 +1556,12 @@ O [opt[=val]] [opt\"val\"] [opt?]...
                During startup options are initialized from \$ENV{PERLDB_OPTS}.
                You can put additional initialization options TTY, noTTY,
                ReadLine, and NonStop there.
-< command      Define command to run before each prompt.
-> command      Define command to run after each prompt.
+< command      Define Perl command to run before each prompt.
+<< command     Add to the list of Perl commands to run before each prompt.
+> command      Define Perl command to run after each prompt.
+>> command     Add to the list of Perl commands to run after each prompt.
+\{ commandline Define debugger command to run before each prompt.
+\{{ commandline        Add to the list of debugger commands to run before each prompt.
 $prc number    Redo a previous command (default previous command).
 $prc -number   Redo number'th-to-last command.
 $prc pattern   Redo last command that started with pattern.
@@ -1334,8 +1577,8 @@ p expr            Same as \"print {DB::OUT} expr\" in current package.
 \= [alias value]       Define a command alias, or list current aliases.
 command                Execute as a perl statement in current package.
 v              Show versions of loaded modules.
-R              Pure-man-restart of debugger, debugger state and command-line
-               options are lost.
+R              Pure-man-restart of debugger, some of debugger state
+               and command-line options may be lost.
 h [db_command] Get help [on a specific debugger command], enter |h to page.
 h h            Summary of debugger commands.
 q or ^D                Quit.
@@ -1348,11 +1591,11 @@ List/search source lines:               Control script execution:
   w [line]    List around line            n [expr]    Next, steps over subs
   f filename  View source in file         <CR>        Repeat last n or s
   /pattern/ ?patt?   Search forw/backw    r           Return from subroutine
-  v          Show versions of modules    c [line]    Continue until line
+  v          Show versions of modules    c [ln|sub]  Continue until position
 Debugger controls:                        L           List break pts & actions
   O [...]     Set debugger options        t [expr]    Toggle trace [trace expr]
-  < command   Command for before prompt   b [ln] [c]  Set breakpoint
-  > command   Command for after prompt    b sub [c]   Set breakpoint for sub
+  <[<] or {[{] [cmd]   Do before prompt   b [ln/event] [c]     Set breakpoint
+  >[>] [cmd]  Do after prompt             b sub [c]   Set breakpoint for sub
   $prc [N|pat]   Redo a previous command     d [line]    Delete a breakpoint
   H [-num]    Display last num commands   D           Delete all breakpoints
   = [a val]   Define/list an alias        a [ln] cmd  Do cmd before line
@@ -1360,13 +1603,13 @@ Debugger controls:                        L           List break pts & actions
   |[|]dbcmd   Send output to pager        $psh\[$psh\] syscmd Run cmd in a subprocess
   q or ^D     Quit                       R           Attempt a restart
 Data Examination:            expr     Execute perl code, also see: s,n,t expr
+  x expr       Evals expression in array context, dumps the result.
+  p expr       Print expression (uses script's current package).
   S [[!]pat]   List subroutine names [not] matching pattern
   V [Pk [Vars]]        List Variables in Package.  Vars can be ~pattern or !pattern.
   X [Vars]     Same as \"V current_package [Vars]\".
-  x expr       Evals expression in array context, dumps the result.
-  p expr       Print expression (uses script's current package).
 END_SUM
-                               # '); # Fix balance of Emacs parsing
+                               # ')}}; # Fix balance of Emacs parsing
 }
 
 sub diesignal {
@@ -1500,10 +1743,86 @@ BEGIN {                 # This does not compile, alas.
   $db_stop = 0;                        # Compiler warning
   $db_stop = 1 << 30;
   $level = 0;                  # Level of recursive debugging
+  # @stack and $doret are needed in sub sub, which is called for DB::postponed.
+  # Triggers bug (?) in perl is we postpone this until runtime:
+  @postponed = @stack = (0);
+  $doret = -2;
+  $frame = 0;
 }
 
 BEGIN {$^W = $ini_warn;}       # Switch warnings back
 
 #use Carp;                     # This did break, left for debuggin
 
+sub db_complete {
+  my($text, $line, $start) = @_;
+  my ($itext, $prefix, $pack) = $text;
+  
+  if ((substr $text, 0, 1) eq '&') { # subroutines
+    $text = substr $text, 1;
+    $prefix = "&";
+    return map "$prefix$_", grep /^\Q$text/, keys %sub;
+  }
+  if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
+    $pack = ($1 eq 'main' ? '' : $1) . '::';
+    $prefix = (substr $text, 0, 1) . $1 . '::';
+    $text = $2;
+    my @out 
+      = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/, keys %$pack ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return @out;
+  }
+  if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
+    $pack = ($package eq 'main' ? '' : $package) . '::';
+    $prefix = substr $text, 0, 1;
+    $text = substr $text, 1;
+    my @out = map "$prefix$_", grep /^\Q$text/, 
+       (grep /^_?[a-zA-Z]/, keys %$pack), 
+       ( $pack eq '::' ? () : (grep /::$/, keys %::) ) ;
+    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
+      return db_complete($out[0], $line, $start);
+    }
+    return @out;
+  }
+  return grep /^\Q$text/, (keys %sub), qw(postpone load) # subroutines
+    if (substr $line, 0, $start) =~ /^[bl]\s+(postpone\s+)?$/;
+  return grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : ()} keys %:: # packages
+    if (substr $line, 0, $start) =~ /^V\s+$/;
+  if ((substr $line, 0, $start) =~ /^O\b.*\s$/) { # Options after a space
+    my @out = grep /^\Q$text/, @options;
+    my $val = option_val($out[0], undef);
+    my $out = '? ';
+    if (not defined $val or $val =~ /[\n\r]/) {
+      # Can do nothing better
+    } elsif ($val =~ /\s/) {
+      my $found;
+      foreach $l (split //, qq/\"\'\#\|/) {
+       $out = "$l$val$l ", last if (index $val, $l) == -1;
+      }
+    } else {
+      $out = "=$val ";
+    }
+    # Default to value if one completion, to question if many
+    $readline::rl_completer_terminator_character 
+      = $readline::rl_completer_terminator_character
+       = (@out == 1 ? $out : '? ');
+    return @out;
+  }
+  return &readline::rl_filename_list($text); # filenames
+}
+
+END {
+  $finished = $inhibit_exit;   # So that some keys may be disabled.
+  $DB::single = 1; 
+  DB::fake::at_exit() unless $exiting;
+}
+
+package DB::fake;
+
+sub at_exit {
+  "Debuggee terminated. Use `q' to quit and `R' to restart.";
+}
+
 1;
diff --git a/lib/sigtrap.pm b/lib/sigtrap.pm

index 378ca89..ed5925b 100644 (file)
--- a/lib/sigtrap.pm
+++ b/lib/sigtrap.pm
@@ -8,7 +8,7 @@ sigtrap - Perl pragma to enable simple signal handling
 
 use Carp;
 
-$VERSION = 1.01;
+$VERSION = 1.02;
 $Verbose ||= 0;
 
 sub import {
@@ -29,13 +29,16 @@ sub import {
            }
        }
        elsif ($_ eq 'normal-signals') {
-           unshift @_, qw(HUP INT PIPE TERM);
+           unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
        }
        elsif ($_ eq 'error-signals') {
-           unshift @_, qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP);
+           unshift @_, grep(exists $SIG{$_},
+                            qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
        }
        elsif ($_ eq 'old-interface-signals') {
-           unshift @_, qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP);
+           unshift @_,
+           grep(exists $SIG{$_},
+                qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
        }
        elsif ($_ eq 'stack-trace') {
            $handler = \&handler_traceback;
@@ -204,10 +207,15 @@ QUIT, SEGV, SYS and TRAP.
 These are the signals which were trapped by default by the old
 B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
 SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
-B<sigtrap> this list is used.
+B<sigtrap>, this list is used.
 
 =back
 
+For each of these three lists, the collection of signals set to be
+trapped is checked before trapping; if your architecture does not
+implement a particular signal, it will not be trapped but rather
+silently ignored.
+
 =head2 OTHER
 
 =over 4
diff --git a/lib/strict.pm b/lib/strict.pm

index 4aa55eb..e261e92 100644 (file)
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -11,7 +11,6 @@ strict - Perl pragma to restrict unsafe constructs
     use strict "vars";
     use strict "refs";
     use strict "subs";
-    use strict "untie";
 
     use strict;
     no strict "vars";
@@ -20,8 +19,8 @@ strict - Perl pragma to restrict unsafe constructs
 
 If no import list is supplied, all possible restrictions are assumed.
 (This is the safest mode to operate in, but is sometimes too strict for
-casual programming.)  Currently, there are four possible things to be
-strict about:  "subs", "vars", "refs", and "untie".
+casual programming.)  Currently, there are three possible things to be
+strict about:  "subs", "vars", and "refs".
 
 =over 6
 
@@ -66,24 +65,6 @@ appears in curly braces or on the left hand side of the "=E<gt>" symbol.
 
 
 
-=item C<strict untie>
-
-This generates a runtime error if any references to the object returned
-by C<tie> (or C<tied>) still exist when C<untie> is called. Note that
-to get this strict behaviour, the C<use strict 'untie'> statement must
-be in the same scope as the C<untie>. See L<perlfunc/tie>,
-L<perlfunc/untie>, L<perlfunc/tied> and L<perltie>.
-
-    use strict 'untie';
-    $a = tie %a, 'SOME_PKG';
-    $b = tie %b, 'SOME_PKG';
-    $b = 0;
-    tie %c, PKG;
-    $c = tied %c;
-    untie %a ;         # blows up, $a is a valid object reference.
-    untie %b;          # ok, $b is not a reference to the object.
-    untie %c ;         # blows up, $c is a valid object reference.
-
 =back
 
 See L<perlmod/Pragmatic Modules>.
@@ -97,19 +78,18 @@ sub bits {
        $bits |= 0x00000002 if $sememe eq 'refs';
        $bits |= 0x00000200 if $sememe eq 'subs';
        $bits |= 0x00000400 if $sememe eq 'vars';
-       $bits |= 0x00000800 if $sememe eq 'untie';
     }
     $bits;
 }
 
 sub import {
     shift;
-    $^H |= bits(@_ ? @_ : qw(refs subs vars untie));
+    $^H |= bits(@_ ? @_ : qw(refs subs vars));
 }
 
 sub unimport {
     shift;
-    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars untie));
+    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
 }
 
 1;
diff --git a/lib/subs.pm b/lib/subs.pm

index 84c913a..aa4c7e7 100644 (file)
--- a/lib/subs.pm
+++ b/lib/subs.pm
@@ -15,7 +15,12 @@ This will predeclare all the subroutine whose names are
 in the list, allowing you to use them without parentheses
 even before they're declared.
 
-See L<perlmod/Pragmatic Modules> and L<strict/subs>.
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
+See L<perlmod/Pragmatic Modules> and L<strict/strict subs>.
 
 =cut
 require 5.000;
diff --git a/lib/syslog.pl b/lib/syslog.pl

index 614068e..8807ef0 100644 (file)
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -140,7 +140,7 @@ sub main'syslog {
 
 sub xlate {
     local($name) = @_;
-    $name =~ y/a-z/A-Z/;
+    $name = uc $name;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "syslog'$name";
     eval(&$name) || -1;
diff --git a/lib/termcap.pl b/lib/termcap.pl

index e8f108d..c36575a 100644 (file)
--- a/lib/termcap.pl
+++ b/lib/termcap.pl
@@ -63,6 +63,9 @@ sub Tgetent {
            $entry = $1;
            $_ = $2;
            s/\\E/\033/g;
+           s/\\(200)/pack('c',0)/eg;                   # NUL character
+           s/\\(0\d\d)/pack('c',oct($1))/eg;   # octal
+           s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg;        # hex
            s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
            s/\\n/\n/g;
            s/\\r/\r/g;
diff --git a/lib/timelocal.pl b/lib/timelocal.pl

index 75f1ac1..ad32275 100644 (file)
--- a/lib/timelocal.pl
+++ b/lib/timelocal.pl
@@ -4,106 +4,15 @@
 ;#     $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
 ;#     $time = timegm($sec,$min,$hours,$mday,$mon,$year);
 
-;# These routines are quite efficient and yet are always guaranteed to agree
-;# with localtime() and gmtime().  We manage this by caching the start times
-;# of any months we've seen before.  If we know the start time of the month,
-;# we can always calculate any time within the month.  The start times
-;# themselves are guessed by successive approximation starting at the
-;# current time, since most dates seen in practice are close to the
-;# current date.  Unlike algorithms that do a binary search (calling gmtime
-;# once for each bit of the time value, resulting in 32 calls), this algorithm
-;# calls it at most 6 times, and usually only once or twice.  If you hit
-;# the month cache, of course, it doesn't call it at all.
+;# This file has been superseded by the Time::Local library module.
+;# It is implemented as a call to that module for backwards compatibility
+;# with code written for perl4; new code should use Time::Local directly.
 
-;# timelocal is implemented using the same cache.  We just assume that we're
-;# translating a GMT time, and then fudge it when we're done for the timezone
-;# and daylight savings arguments.  The timezone is determined by examining
-;# the result of localtime(0) when the package is initialized.  The daylight
-;# savings offset is currently assumed to be one hour.
+;# The current implementation shares with the original the questionable
+;# behavior of defining the timelocal() and timegm() functions in the
+;# namespace of whatever package was current when the first instance of
+;# C<require 'timelocal.pl';> was executed in a program.
 
-;# Both routines return -1 if the integer limit is hit. I.e. for dates
-;# after the 1st of January, 2038 on most machines.
+use Time::Local;
 
-CONFIG: {
-    package timelocal;
-    
-    local($[) = 0;
-    @epoch = localtime(0);
-    $tzmin = $epoch[2] * 60 + $epoch[1];       # minutes east of GMT
-    if ($tzmin > 0) {
-       $tzmin = 24 * 60 - $tzmin;              # minutes west of GMT
-       $tzmin -= 24 * 60 if $epoch[5] == 70;   # account for the date line
-    }
-
-    $SEC = 1;
-    $MIN = 60 * $SEC;
-    $HR = 60 * $MIN;
-    $DAYS = 24 * $HR;
-    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
-    1;
-}
-
-sub timegm {
-    package timelocal;
-
-    local($[) = 0;
-    $ym = pack(C2, @_[5,4]);
-    $cheat = $cheat{$ym} || &cheat;
-    return -1 if $cheat<0;
-    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
-}
-
-sub timelocal {
-    package timelocal;
-
-    local($[) = 0;
-    $time = &main'timegm + $tzmin*$MIN;
-    return -1 if $cheat<0;
-    @test = localtime($time);
-    $time -= $HR if $test[2] != $_[2];
-    $time;
-}
-
-package timelocal;
-
-sub cheat {
-    $year = $_[5];
-    $month = $_[4];
-    die "Month out of range 0..11 in timelocal.pl\n" 
-       if $month > 11 || $month < 0;
-    die "Day out of range 1..31 in timelocal.pl\n" 
-       if $_[3] > 31 || $_[3] < 1;
-    die "Hour out of range 0..23 in timelocal.pl\n"
-       if $_[2] > 23 || $_[2] < 0;
-    die "Minute out of range 0..59 in timelocal.pl\n"
-       if $_[1] > 59 || $_[1] < 0;
-    die "Second out of range 0..59 in timelocal.pl\n"
-       if $_[0] > 59 || $_[0] < 0;
-    $guess = $^T;
-    @g = gmtime($guess);
-    $year += $YearFix if $year < $epoch[5];
-    $lastguess = "";
-    while ($diff = $year - $g[5]) {
-       $guess += $diff * (363 * $DAYS);
-       @g = gmtime($guess);
-       if (($thisguess = "@g") eq $lastguess){
-           return -1; #date beyond this machine's integer limit
-       }
-       $lastguess = $thisguess;
-    }
-    while ($diff = $month - $g[4]) {
-       $guess += $diff * (27 * $DAYS);
-       @g = gmtime($guess);
-       if (($thisguess = "@g") eq $lastguess){
-           return -1; #date beyond this machine's integer limit
-       }
-       $lastguess = $thisguess;
-    }
-    @gfake = gmtime($guess-1); #still being sceptic
-    if ("@gfake" eq $lastguess){
-       return -1; #date beyond this machine's integer limit
-    }
-    $g[3]--;
-    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
-    $cheat{$ym} = $guess;
-}
+*timelocal::cheat = \&Time::Local::cheat;
diff --git a/lib/vars.pm b/lib/vars.pm

index 0dd5758..f0a6e54 100644 (file)
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -14,6 +14,11 @@ This will predeclare all the variables whose names are
 in the list, allowing you to use them under "use strict", and
 disabling any typo warnings.
 
+Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
+C<use subs> declarations are not BLOCK-scoped.  They are thus effective
+for the entire file in which they appear.  You may not rescind such
+declarations with C<no vars> or C<no subs>.
+
 Packages such as the B<AutoLoader> and B<SelfLoader> that delay loading
 of subroutines within packages can create problems with package lexicals
 defined using C<my()>. While the B<vars> pragma cannot duplicate the
diff --git a/malloc.c b/malloc.c

index 680b734..042c233 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -145,6 +145,79 @@ static u_int start_slack;
 #  define M_OVERHEAD (sizeof(union overhead) + RSLOP)
 
 /*
+ * Big allocations are often of the size 2^n bytes. To make them a
+ * little bit better, make blocks of size 2^n+pagesize for big n.
+ */
+
+#ifdef TWO_POT_OPTIMIZE
+
+#  define PERL_PAGESIZE 4096
+#  define FIRST_BIG_TWO_POT 14         /* 16K */
+#  define FIRST_BIG_BLOCK (1<<FIRST_BIG_TWO_POT) /* 16K */
+/* If this value or more, check against bigger blocks. */
+#  define FIRST_BIG_BOUND (FIRST_BIG_BLOCK - M_OVERHEAD)
+/* If less than this value, goes into 2^n-overhead-block. */
+#  define LAST_SMALL_BOUND ((FIRST_BIG_BLOCK>>1) - M_OVERHEAD)
+
+#endif /* TWO_POT_OPTIMIZE */
+
+#ifdef PERL_EMERGENCY_SBRK
+
+#ifndef BIG_SIZE
+#  define BIG_SIZE (1<<16)             /* 64K */
+#endif 
+
+static char *emergency_buffer;
+static MEM_SIZE emergency_buffer_size;
+
+static char *
+emergency_sbrk(size)
+    MEM_SIZE size;
+{
+    if (size >= BIG_SIZE) {
+       /* Give the possibility to recover: */
+       die("Out of memory during request for %i bytes", size);
+       /* croak may eat too much memory. */
+    }
+
+    if (!emergency_buffer) {           
+       /* First offense, give a possibility to recover by dieing. */
+       /* No malloc involved here: */
+       GV **gvp = (GV**)hv_fetch(defstash, "^M", 2, 0);
+       SV *sv;
+       char *pv;
+
+       if (!gvp) gvp = (GV**)hv_fetch(defstash, "\015", 1, 0);
+       if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) 
+           || (SvLEN(sv) < (1<<11) - M_OVERHEAD)) 
+           return (char *)-1;          /* Now die die die... */
+
+       /* Got it, now detach SvPV: */
+       pv = SvPV(sv);
+       /* Check alignment: */
+       if ((pv - M_OVERHEAD) & (1<<11 - 1)) {
+           PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
+           return -1;                  /* die die die */
+       }
+
+       emergency_buffer = pv - M_OVERHEAD;
+       emergency_buffer_size = SvLEN(sv) + M_OVERHEAD;
+       SvPOK_off(sv);
+       SvREADONLY_on(sv);
+       die("Out of memory!");          /* croak may eat too much memory. */
+    } else if (emergency_buffer_size >= size) {
+       emergency_buffer_size -= size;
+       return emergency_buffer + emergency_buffer_size;
+    }
+    
+    return (char *)-1;                 /* poor guy... */
+}
+
+#else /* !PERL_EMERGENCY_SBRK */
+#  define emergency_sbrk(size) -1
+#endif /* !PERL_EMERGENCY_SBRK */
+
+/*
  * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
  * smallest allocatable block is 8 bytes.  The overhead information
  * precedes the data area returned to the user.
@@ -188,22 +261,22 @@ malloc(nbytes)
        register int bucket = 0;
        register MEM_SIZE shiftr;
 
-#ifdef safemalloc
+#ifdef PERL_CORE
 #ifdef DEBUGGING
        MEM_SIZE size = nbytes;
 #endif
 
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT
        if (nbytes > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", (long)nbytes);
                my_exit(1);
        }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
        if ((long)nbytes < 0)
            croak("panic: malloc");
 #endif
-#endif /* safemalloc */
+#endif /* PERL_CORE */
 
        /*
         * Convert amount of memory requested into
@@ -214,6 +287,11 @@ malloc(nbytes)
 #ifdef PACK_MALLOC
        if (nbytes > MAX_2_POT_ALGO) {
 #endif
+#ifdef TWO_POT_OPTIMIZE
+           if (nbytes >= FIRST_BIG_BOUND) {
+               nbytes -= PERL_PAGESIZE;
+           }
+#endif 
            nbytes += M_OVERHEAD;
            nbytes = (nbytes + 3) &~ 3; 
 #ifdef PACK_MALLOC
@@ -232,7 +310,7 @@ malloc(nbytes)
        if (nextf[bucket] == NULL)    
                morecore(bucket);
        if ((p = (union overhead *)nextf[bucket]) == NULL) {
-#ifdef safemalloc
+#ifdef PERL_CORE
                if (!nomemok) {
                    PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
                    my_exit(1);
@@ -242,10 +320,10 @@ malloc(nbytes)
 #endif
        }
 
-#ifdef safemalloc
+#ifdef PERL_CORE
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",
        (unsigned long)(p+1),an++,(long)size));
-#endif /* safemalloc */
+#endif /* PERL_CORE */
 
        /* remove from linked list */
 #ifdef RCHECK
@@ -289,6 +367,9 @@ morecore(bucket)
 
        if (nextf[bucket])
                return;
+       if (bucket == (sizeof(MEM_SIZE)*8 - 3)) {
+           croak("Allocation too large");
+       }
        /*
         * Insure memory is allocated
         * on a page boundary.  Should
@@ -323,9 +404,16 @@ morecore(bucket)
        nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
        /* if (rnu < bucket)
                rnu = bucket;   Why anyone needs this? */
+#ifdef TWO_POT_OPTIMIZE
+       op = (union overhead *)sbrk((1L << rnu) 
+                                   + ( bucket >= (FIRST_BIG_TWO_POT - 3) 
+                                       ? PERL_PAGESIZE : 0));
+#else
        op = (union overhead *)sbrk(1L << rnu);
+#endif 
        /* no more room! */
-       if ((int)op == -1)
+       if ((int)op == -1 &&
+           (int)(op = (union overhead *)emergency_sbrk(size)) == -1)
                return;
        /*
         * Round up to minimum allocation size boundary
@@ -390,9 +478,9 @@ free(mp)
        u_char bucket;
 #endif 
 
-#ifdef safemalloc
+#ifdef PERL_CORE
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(unsigned long)cp,an++));
-#endif /* safemalloc */
+#endif /* PERL_CORE */
 
        if (cp == NULL)
                return;
@@ -461,30 +549,30 @@ realloc(mp, nbytes)
        int was_alloced = 0;
        char *cp = (char*)mp;
 
-#ifdef safemalloc
+#ifdef PERL_CORE
 #ifdef DEBUGGING
        MEM_SIZE size = nbytes;
 #endif
 
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT
        if (nbytes > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Reallocation too large: %lx\n", size);
                my_exit(1);
        }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
        if (!cp)
                return malloc(nbytes);
 #ifdef DEBUGGING
        if ((long)nbytes < 0)
                croak("panic: realloc");
 #endif
-#endif /* safemalloc */
+#endif /* PERL_CORE */
 
        op = (union overhead *)((caddr_t)cp 
                                - sizeof (union overhead) * CHUNK_SHIFT);
        i = OV_INDEX(op);
        if (OV_MAGIC(op, i) == MAGIC) {
-               was_alloced++;
+               was_alloced = 1;
        } else {
                /*
                 * Already free, doing "compaction".
@@ -507,10 +595,24 @@ realloc(mp, nbytes)
 #else
            M_OVERHEAD
 #endif
+#ifdef TWO_POT_OPTIMIZE
+           + (i >= (FIRST_BIG_TWO_POT - 3) ? PERL_PAGESIZE : 0)
+#endif
            ;
-       /* avoid the copy if same size block */
+       /* 
+        *  avoid the copy if same size block.
+        *  We are not agressive with boundary cases. Note that it is
+        *  possible for small number of cases give false negative if
+        *  both new size and old one are in the bucket for
+        *  FIRST_BIG_TWO_POT, but the new one is near the lower end.
+        */
        if (was_alloced &&
-           nbytes <= onb && nbytes > (onb >> 1) - M_OVERHEAD) {
+           nbytes <= onb && (nbytes > ( (onb >> 1) - M_OVERHEAD )
+#ifdef TWO_POT_OPTIMIZE
+                             || (i == (FIRST_BIG_TWO_POT - 3) 
+                                 && nbytes >= LAST_SMALL_BOUND )
+#endif 
+               )) {
 #ifdef RCHECK
                /*
                 * Record new allocated size of block and
@@ -540,7 +642,7 @@ realloc(mp, nbytes)
                        free(cp);
        }
 
-#ifdef safemalloc
+#ifdef PERL_CORE
 #ifdef DEBUGGING
     if (debug & 128) {
        PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) rfree\n",(unsigned long)res,an++);
@@ -548,7 +650,7 @@ realloc(mp, nbytes)
            (unsigned long)res,an++,(long)size);
     }
 #endif
-#endif /* safemalloc */
+#endif /* PERL_CORE */
        return ((Malloc_t)res);
 }
 
@@ -681,7 +783,7 @@ int size;
     int small, reqsize;
 
     if (!size) return 0;
-#ifdef safemalloc
+#ifdef PERL_CORE
     reqsize = size; /* just for the DEBUG_m statement */
 #endif
     if (size <= Perl_sbrk_oldsize) {
@@ -692,7 +794,7 @@ int size;
       if (size >= PERLSBRK_32_K) {
        small = 0;
       } else {
-#ifndef safemalloc
+#ifndef PERL_CORE
        reqsize = size;
 #endif
        size = PERLSBRK_64_K;
@@ -706,7 +808,7 @@ int size;
       }
     }
 
-#ifdef safemalloc
+#ifdef PERL_CORE
     DEBUG_m(PerlIO_printf(PerlIO_stderr(), "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
                    size, reqsize, Perl_sbrk_oldsize, got));
 #endif
diff --git a/mg.c b/mg.c

index 821de5b..c2a006b 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1161,6 +1161,16 @@ MAGIC* mg;
 }
 
 int
+magic_setfm(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    sv_unmagic(sv, 'f');
+    SvCOMPILED_off(sv);
+    return 0;
+}
+
+int
 magic_setuvar(sv,mg)
 SV* sv;
 MAGIC* mg;
diff --git a/old_embed.pl b/old_embed.pl

index e69de29..eb3d306 100755 (executable)
--- a/old_embed.pl
+++ b/old_embed.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+#
+# FOR BACKWARDS COMPATIBILITY WITH OLD VERSIONS OF PERL
+#
+# This script uses an old method of creating "embed.h".  Use it
+# if you need to maintain binary compatibility with older versions
+# Perl with the EMBED feature enabled.
+#
+
+open(EM, ">embed.h") || die "Can't create embed.h: $!\n";
+
+print EM <<'END';
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+   This file is built by old_embed.pl from old_global.sym and interp.sym.
+   Any changes made here will be lost.
+   THIS FILE IS FOR BINARY COMPATIBILITY WITH OLD PERL VERSIONS.
+   Run "embed.pl" to get an up-to-date version.
+*/
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+#ifndef NO_EMBED
+#  define EMBED 1 
+#endif
+
+#ifdef EMBED
+
+/* globals we need to hide from the world */
+END
+
+open(GL, "<old_global.sym") || die "Can't open old_global.sym: $!\n";
+
+while(<GL>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/^\s*(\S+).*$/#define $1\t\tPerl_$1/;
+       $global{$1} = 1; 
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+
+close(GL) || warn "Can't close old_global.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* EMBED */
+
+/* Put interpreter specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+/* Undefine symbols that were defined by EMBED. Somewhat ugly */
+
+END
+
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/^\s*(\S*).*$/#undef $1/;
+       print EM $_ if (exists $global{$1});
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM "\n";
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/^\s*(\S+).*$/#define $1\t\t(curinterp->I$1)/;
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#else  /* not multiple, so translate interpreter symbols the other way... */
+
+END
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+       s/[ \t]*#.*//;          # Delete comments.
+       next unless /\S/;
+       s/^\s*(\S+).*$/#define I$1\t\t$1/;
+       s/(................\t)\t/$1/;
+       print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* MULTIPLICITY */
+END
+
diff --git a/old_global.sym b/old_global.sym

new file mode 100644 (file)

index 0000000..4a9dd48
--- /dev/null
+++ b/old_global.sym
@@ -0,0 +1,1082 @@
+# Global symbols that need to be hidden in embedded applications.
+
+# Variables
+
+AMG_names
+No
+Sv
+He
+Xpv
+Yes
+abs_amg
+add_amg
+add_ass_amg
+additem
+amagic_generation
+an
+atan2_amg
+band_amg
+bool__amg
+bor_amg
+buf
+bufend
+bufptr
+bxor_amg
+check
+compiling
+compl_amg
+compcv
+comppad
+comppad_name
+comppad_name_fill
+comppad_name_floor
+concat_amg
+concat_ass_amg
+cop_seqmax
+cos_amg
+cryptseen
+cshlen
+cshname
+curcop
+curcopdb
+curinterp
+curpad
+cv_const_sv
+dc
+debug
+dec_amg
+di
+div_amg
+div_ass_amg
+do_undump
+ds
+egid
+envgv
+eq_amg
+error_count
+euid
+evalseq
+exp_amg
+expect
+expectterm
+fallback_amg
+filter_add
+filter_del
+filter_read
+fold
+freq
+ge_amg
+gid
+gt_amg
+hexdigit
+hints
+in_my
+inc_amg
+io_close
+know_next
+last_lop
+last_lop_op
+last_uni
+le_amg
+lex_state
+lex_defer
+lex_expect
+lex_brackets
+lex_formbrack
+lex_fakebrack
+lex_casemods
+lex_dojoin
+lex_starts
+lex_stuff
+lex_repl
+lex_op
+lex_inpat
+lex_inwhat
+lex_brackstack
+lex_casestack
+linestr
+log_amg
+lshift_amg
+lshift_ass_amg
+lt_amg
+markstack
+markstack_max
+markstack_ptr
+maxo
+max_intro_pending
+min_intro_pending
+mod_amg
+mod_ass_amg
+mult_amg
+mult_ass_amg
+multi_close
+multi_end
+multi_open
+multi_start
+na
+ncmp_amg
+nextval
+nexttype
+nexttoke
+ne_amg
+neg_amg
+nexttype
+nextval
+no_aelem
+no_dir_func
+no_func
+no_helem
+no_mem
+no_modify
+no_security
+no_sock_func
+no_usym
+nointrp
+nomem
+nomemok
+nomethod_amg
+not_amg
+numer_amg
+oldbufptr
+oldoldbufptr
+op
+op_desc
+op_name
+op_seqmax
+opargs
+origalen
+origenviron
+osname
+padix
+patleave
+pow_amg
+pow_ass_amg
+ppaddr
+profiledata
+provide_ref
+psig_ptr
+psig_name
+qrt_amg
+rcsid
+reall_srchlen
+regarglen
+regbol
+regcode
+regdummy
+regendp
+regeol
+regfold
+reginput
+regkind
+reglastparen
+regmyendp
+regmyp_size
+regmystartp
+regnarrate
+regnaughty
+regnpar
+regparse
+regprecomp
+regprev
+regsawback
+regsize
+regstartp
+regtill
+regxend
+repeat_amg
+repeat_ass_amg
+retstack
+retstack_ix
+retstack_max
+rsfp
+rsfp_filters
+rshift_amg
+rshift_ass_amg
+save_pptr
+savestack
+savestack_ix
+savestack_max
+saw_return
+scmp_amg
+scopestack
+scopestack_ix
+scopestack_max
+scrgv
+seq_amg
+sge_amg
+sgt_amg
+sig_name
+sig_num
+siggv
+sighandler
+simple
+sin_amg
+sle_amg
+slt_amg
+sne_amg
+stack_base
+stack_max
+stack_sp
+statbuf
+string_amg
+sub_generation
+subline
+subname
+subtr_amg
+subtr_ass_amg
+sv_no
+sv_undef
+sv_yes
+tainting
+thisexpr
+timesbuf
+tokenbuf
+uid
+varies
+vert
+vtbl_amagic
+vtbl_amagicelem
+vtbl_arylen
+vtbl_bm
+vtbl_dbline
+vtbl_env
+vtbl_envelem
+vtbl_glob
+vtbl_isa
+vtbl_isaelem
+vtbl_mglob
+vtbl_pack
+vtbl_packelem
+vtbl_pos
+vtbl_sig
+vtbl_sigelem
+vtbl_substr
+vtbl_sv
+vtbl_taint
+vtbl_uvar
+vtbl_vec
+warn_nl
+warn_nosemi
+warn_reserved
+watchaddr
+watchok
+yychar
+yycheck
+yydebug
+yydefred
+yydgoto
+yyerrflag
+yygindex
+yylen
+yylhs
+yylval
+yyname
+yynerrs
+yyrindex
+yyrule
+yysindex
+yytable
+yyval
+
+# Functions
+
+Gv_AMupdate
+amagic_call
+append_elem
+append_list
+apply
+assertref
+av_clear
+av_extend
+av_fake
+av_fetch
+av_fill
+av_len
+av_make
+av_pop
+av_push
+av_shift
+av_store
+av_undef
+av_unshift
+bind_match
+block_end
+block_start
+calllist
+cando
+cast_ulong
+check_uni
+checkcomma
+ck_aelem
+ck_concat
+ck_delete
+ck_eof
+ck_eval
+ck_exec
+ck_formline
+ck_ftst
+ck_fun
+ck_glob
+ck_grep
+ck_gvconst
+ck_index
+ck_lengthconst
+ck_lfun
+ck_listiob
+ck_match
+ck_null
+ck_repeat
+ck_require
+ck_retarget
+ck_rfun
+ck_rvconst
+ck_select
+ck_shift
+ck_sort
+ck_spair
+ck_split
+ck_subr
+ck_svconst
+ck_trunc
+convert
+cpytill
+croak
+cv_clone
+cv_undef
+cx_dump
+cxinc
+deb
+deb_growlevel
+debop
+debprofdump
+debstack
+debstackptrs
+deprecate
+die
+die_where
+do_aexec
+do_chomp
+do_chop
+do_close
+do_eof
+do_exec
+do_execfree
+do_ipcctl
+do_ipcget
+do_join
+do_kv
+do_msgrcv
+do_msgsnd
+do_open
+do_pipe
+do_print
+do_readline
+do_seek
+do_semop
+do_shmio
+do_sprintf
+do_tell
+do_trans
+do_vecset
+do_vop
+doeval
+dofindlabel
+dopoptoeval
+dounwind
+dowantarray
+dump_all
+dump_eval
+dump_fds
+dump_form
+dump_gv
+dump_mstats
+dump_op
+dump_packsubs
+dump_pm
+dump_sub
+fbm_compile
+fbm_instr
+fetch_gv
+fetch_io
+filter_add
+filter_del
+filter_read
+fold_constants
+force_ident
+force_list
+force_next
+force_word
+free_tmps
+gen_constant_list
+gp_free
+gp_ref
+gv_AVadd
+gv_HVadd
+gv_IOadd
+gv_check
+gv_efullname
+gv_fetchfile
+gv_fetchmeth
+gv_fetchmethod
+gv_fetchpv
+gv_fullname
+gv_init
+gv_stashpv
+gv_stashpvn
+gv_stashsv
+he_delayfree
+he_free
+he_root
+hoistmust
+hv_clear
+hv_delete
+hv_delete_ent
+hv_exists
+hv_exists_ent
+hv_fetch
+hv_fetch_ent
+hv_iterinit
+hv_iterkey
+hv_iterkeysv
+hv_iternext
+hv_iternextsv
+hv_iterval
+hv_magic
+hv_stashpv
+hv_store
+hv_store_ent
+hv_undef
+ibcmp
+ingroup
+instr
+intuit_more
+invert
+jmaybe
+keyword
+leave_scope
+lex_end
+lex_start
+linklist
+list
+listkids
+localize
+looks_like_number
+magic_clearenv
+magic_clearpack
+magic_clearsig
+magic_existspack
+magic_get
+magic_getarylen
+magic_getglob
+magic_getpack
+magic_getpos
+magic_getsig
+magic_gettaint
+magic_getuvar
+magic_len
+magic_nextpack
+magic_set
+magic_setamagic
+magic_setarylen
+magic_setbm
+magic_setdbline
+magic_setenv
+magic_setglob
+magic_setisa
+magic_setmglob
+magic_setpack
+magic_setpos
+magic_setsig
+magic_setsubstr
+magic_settaint
+magic_setuvar
+magic_setvec
+magic_wipepack
+magicname
+markstack_grow
+mess
+mg_clear
+mg_copy
+mg_find
+mg_free
+mg_get
+mg_len
+mg_magical
+mg_set
+mod
+modkids
+moreswitches
+mstats
+my
+my_bcopy
+my_bzero
+my_chsize
+my_exit
+my_htonl
+my_lstat
+my_memcmp
+my_ntohl
+my_pclose
+my_popen
+my_setenv
+my_stat
+my_swap
+my_unexec
+newANONHASH
+newANONLIST
+newANONSUB
+newASSIGNOP
+newAV
+newAVREF
+newBINOP
+newCONDOP
+newCVREF
+newFORM
+newFOROP
+newGVOP
+newGVREF
+newGVgen
+newHV
+newHVREF
+newIO
+newLISTOP
+newLOGOP
+newLOOPEX
+newLOOPOP
+newNULLLIST
+newOP
+newPMOP
+newPROG
+newPVOP
+newRANGE
+newRV
+newSLICEOP
+newSTATEOP
+newSUB
+newSV
+newSVOP
+newSVREF
+newSViv
+newSVnv
+newSVpv
+newSVrv
+newSVsv
+newUNOP
+newWHILEOP
+newXS
+newXSUB
+nextargv
+ninstr
+no_fh_allowed
+no_op
+oopsAV
+oopsCV
+oopsHV
+op_free
+package
+pad_alloc
+pad_allocmy
+pad_findmy
+pad_free
+pad_leavemy
+pad_reset
+pad_sv
+pad_swipe
+peep
+pidgone
+pmflag
+pmruntime
+pmtrans
+pop_return
+pop_scope
+pp_aassign
+pp_abs
+pp_accept
+pp_add
+pp_aelem
+pp_aelemfast
+pp_alarm
+pp_and
+pp_andassign
+pp_anoncode
+pp_anonhash
+pp_anonlist
+pp_aslice
+pp_atan2
+pp_av2arylen
+pp_backtick
+pp_bind
+pp_binmode
+pp_bit_and
+pp_bit_or
+pp_bit_xor
+pp_bless
+pp_caller
+pp_chdir
+pp_chmod
+pp_chomp
+pp_chop
+pp_chown
+pp_chr
+pp_chroot
+pp_close
+pp_closedir
+pp_complement
+pp_concat
+pp_cond_expr
+pp_connect
+pp_const
+pp_cos
+pp_crypt
+pp_cswitch
+pp_dbmclose
+pp_dbmopen
+pp_dbstate
+pp_defined
+pp_delete
+pp_die
+pp_divide
+pp_dofile
+pp_dump
+pp_each
+pp_egrent
+pp_ehostent
+pp_enetent
+pp_enter
+pp_entereval
+pp_enteriter
+pp_enterloop
+pp_entersub
+pp_entersubr
+pp_entertry
+pp_enterwrite
+pp_eof
+pp_eprotoent
+pp_epwent
+pp_eq
+pp_eservent
+pp_evalonce
+pp_exec
+pp_exists
+pp_exit
+pp_exp
+pp_fcntl
+pp_fileno
+pp_flip
+pp_flock
+pp_flop
+pp_fork
+pp_formline
+pp_ftatime
+pp_ftbinary
+pp_ftblk
+pp_ftchr
+pp_ftctime
+pp_ftdir
+pp_fteexec
+pp_fteowned
+pp_fteread
+pp_ftewrite
+pp_ftfile
+pp_ftis
+pp_ftlink
+pp_ftmtime
+pp_ftpipe
+pp_ftrexec
+pp_ftrowned
+pp_ftrread
+pp_ftrwrite
+pp_ftsgid
+pp_ftsize
+pp_ftsock
+pp_ftsuid
+pp_ftsvtx
+pp_fttext
+pp_fttty
+pp_ftzero
+pp_ge
+pp_gelem
+pp_getc
+pp_getlogin
+pp_getpeername
+pp_getpgrp
+pp_getppid
+pp_getpriority
+pp_getsockname
+pp_ggrent
+pp_ggrgid
+pp_ggrnam
+pp_ghbyaddr
+pp_ghbyname
+pp_ghostent
+pp_glob
+pp_gmtime
+pp_gnbyaddr
+pp_gnbyname
+pp_gnetent
+pp_goto
+pp_gpbyname
+pp_gpbynumber
+pp_gprotoent
+pp_gpwent
+pp_gpwnam
+pp_gpwuid
+pp_grepstart
+pp_grepwhile
+pp_gsbyname
+pp_gsbyport
+pp_gservent
+pp_gsockopt
+pp_gt
+pp_gv
+pp_gvsv
+pp_helem
+pp_hex
+pp_hslice
+pp_i_add
+pp_i_divide
+pp_i_eq
+pp_i_ge
+pp_i_gt
+pp_i_le
+pp_i_lt
+pp_i_modulo
+pp_i_multiply
+pp_i_ncmp
+pp_i_ne
+pp_i_negate
+pp_i_subtract
+pp_index
+pp_indread
+pp_int
+pp_interp
+pp_ioctl
+pp_iter
+pp_join
+pp_keys
+pp_kill
+pp_last
+pp_lc
+pp_lcfirst
+pp_le
+pp_leave
+pp_leaveeval
+pp_leaveloop
+pp_leavesub
+pp_leavetry
+pp_leavewrite
+pp_left_shift
+pp_length
+pp_lineseq
+pp_link
+pp_list
+pp_listen
+pp_localtime
+pp_log
+pp_lslice
+pp_lstat
+pp_lt
+pp_map
+pp_mapstart
+pp_mapwhile
+pp_match
+pp_method
+pp_mkdir
+pp_modulo
+pp_msgctl
+pp_msgget
+pp_msgrcv
+pp_msgsnd
+pp_multiply
+pp_ncmp
+pp_ne
+pp_negate
+pp_next
+pp_nextstate
+pp_not
+pp_nswitch
+pp_null
+pp_oct
+pp_open
+pp_open_dir
+pp_or
+pp_orassign
+pp_ord
+pp_pack
+pp_padany
+pp_padav
+pp_padhv
+pp_padsv
+pp_pipe_op
+pp_pop
+pp_pos
+pp_postdec
+pp_postinc
+pp_pow
+pp_predec
+pp_preinc
+pp_print
+pp_prototype
+pp_prtf
+pp_push
+pp_pushmark
+pp_pushre
+pp_quotemeta
+pp_rand
+pp_range
+pp_rcatline
+pp_read
+pp_readdir
+pp_readline
+pp_readlink
+pp_recv
+pp_redo
+pp_ref
+pp_refgen
+pp_regcmaybe
+pp_regcomp
+pp_rename
+pp_repeat
+pp_require
+pp_reset
+pp_return
+pp_reverse
+pp_rewinddir
+pp_right_shift
+pp_rindex
+pp_rmdir
+pp_rv2av
+pp_rv2cv
+pp_rv2gv
+pp_rv2hv
+pp_rv2sv
+pp_sassign
+pp_scalar
+pp_schomp
+pp_schop
+pp_scmp
+pp_scope
+pp_seek
+pp_seekdir
+pp_select
+pp_semctl
+pp_semget
+pp_semop
+pp_send
+pp_seq
+pp_setpgrp
+pp_setpriority
+pp_sge
+pp_sgrent
+pp_sgt
+pp_shift
+pp_shmctl
+pp_shmget
+pp_shmread
+pp_shmwrite
+pp_shostent
+pp_shutdown
+pp_sin
+pp_sle
+pp_sleep
+pp_slt
+pp_sne
+pp_snetent
+pp_socket
+pp_sockpair
+pp_sort
+pp_splice
+pp_split
+pp_sprintf
+pp_sprotoent
+pp_spwent
+pp_sqrt
+pp_srand
+pp_srefgen
+pp_sselect
+pp_sservent
+pp_ssockopt
+pp_stat
+pp_stringify
+pp_stub
+pp_study
+pp_subst
+pp_substcont
+pp_substr
+pp_subtract
+pp_symlink
+pp_syscall
+pp_sysopen
+pp_sysread
+pp_system
+pp_syswrite
+pp_tell
+pp_telldir
+pp_tie
+pp_tied
+pp_time
+pp_tms
+pp_trans
+pp_truncate
+pp_uc
+pp_ucfirst
+pp_umask
+pp_undef
+pp_unlink
+pp_unpack
+pp_unshift
+pp_unstack
+pp_untie
+pp_utime
+pp_values
+pp_vec
+pp_wait
+pp_waitpid
+pp_wantarray
+pp_warn
+pp_xor
+pregcomp
+pregexec
+pregfree
+prepend_elem
+push_return
+push_scope
+q
+ref
+refkids
+regdump
+regnext
+regprop
+repeatcpy
+rninstr
+runops
+same_dirent
+save_I32
+save_aptr
+save_ary
+save_clearsv
+save_delete
+save_destructor
+save_freeop
+save_freepv
+save_freesv
+save_hash
+save_hptr
+save_int
+save_item
+save_list
+save_long
+save_nogv
+save_pptr
+save_scalar
+save_sptr
+save_svref
+savepv
+savepvn
+savestack_grow
+sawparens
+scalar
+scalarkids
+scalarseq
+scalarvoid
+scan_const
+scan_formline
+scan_heredoc
+scan_hex
+scan_ident
+scan_inputsymbol
+scan_num
+scan_oct
+scan_pat
+scan_prefix
+scan_str
+scan_subst
+scan_trans
+scan_word
+scope
+screaminstr
+setdefout
+setenv_getix
+sharepvn
+sighandler
+skipspace
+stack_grow
+start_subparse
+sublex_done
+sublex_start
+sv_2bool
+sv_2cv
+sv_2io
+sv_2iv
+sv_2mortal
+sv_2nv
+sv_2pv
+sv_add_arena
+sv_backoff
+sv_bless
+sv_catpv
+sv_catpvn
+sv_catsv
+sv_chop
+sv_clean_all
+sv_clean_objs
+sv_clear
+sv_cmp
+sv_dec
+sv_dump
+sv_eq
+sv_free
+sv_free_arenas
+sv_gets
+sv_grow
+sv_inc
+sv_insert
+sv_isa
+sv_isobject
+sv_len
+sv_magic
+sv_mortalcopy
+sv_newmortal
+sv_newref
+sv_peek
+sv_pvn_force
+sv_ref
+sv_reftype
+sv_replace
+sv_report_used
+sv_reset
+sv_setiv
+sv_setnv
+sv_setptrobj
+sv_setpv
+sv_setpvn
+sv_setref_iv
+sv_setref_nv
+sv_setref_pv
+sv_setref_pvn
+sv_setsv
+sv_unmagic
+sv_unref
+sv_upgrade
+sv_usepvn
+taint_env
+taint_not
+taint_proper
+too_few_arguments
+too_many_arguments
+unlnk
+unsharepvn
+utilize
+wait4pid
+warn
+watch
+whichsig
+xiv_arenaroot
+xiv_root
+xnv_root
+xpv_root
+xrv_root
+yyerror
+yylex
+yyparse
+yywarn
diff --git a/op.c b/op.c

index d3b0344..a73e429 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1269,22 +1269,25 @@ OP *o;
 }
 
 int
-block_start()
+block_start(full)
+int full;
 {
     int retval = savestack_ix;
-    SAVEINT(comppad_name_floor);
-    if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
-       comppad_name_floor = comppad_name_fill;
-    else
-       comppad_name_floor = 0;
-    SAVEINT(min_intro_pending);
-    SAVEINT(max_intro_pending);
+    SAVEI32(comppad_name_floor);
+    if (full) {
+       if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
+           comppad_name_floor = comppad_name_fill;
+       else
+           comppad_name_floor = 0;
+    }
+    SAVEI32(min_intro_pending);
+    SAVEI32(max_intro_pending);
     min_intro_pending = 0;
-    SAVEINT(comppad_name_fill);
-    SAVEINT(padix_floor);
+    SAVEI32(comppad_name_fill);
+    SAVEI32(padix_floor);
     padix_floor = padix;
     pad_reset_pending = FALSE;
-    SAVEINT(hints);
+    SAVEI32(hints);
     hints &= ~HINT_BLOCK_SCOPE;
     return retval;
 }
@@ -2976,6 +2979,9 @@ OP *block;
     if (perldb && curstash != debstash) {
        SV *sv;
        SV *tmpstr = sv_newmortal();
+       static GV *db_postponed;
+       CV *cv;
+       HV *hv;
 
        sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
        sv = newSVpv(buf,0);
@@ -2984,6 +2990,18 @@ OP *block;
        sv_catpv(sv,buf);
        gv_efullname3(tmpstr, gv, Nullch);
        hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+       if (!db_postponed) {
+           db_postponed = gv_fetchpv("DB::postponed", TRUE, SVt_PVHV);
+       }
+       hv = GvHVn(db_postponed);
+       if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+           && (cv = GvCV(db_postponed))) {
+           dSP;
+           PUSHMARK(sp);
+           XPUSHs(tmpstr);
+           PUTBACK;
+           perl_call_sv((SV*)cv, G_DISCARD);
+       }
     }
     op_free(op);
     copline = NOLINE;
@@ -3261,6 +3279,14 @@ OP *o;
 /* Check routines. */
 
 OP *
+ck_bitop(op)
+OP *op;
+{
+    op->op_private = hints;
+    return op;
+}
+
+OP *
 ck_concat(op)
 OP *op;
 {
diff --git a/opcode.h b/opcode.h

index ce83340..c4902ef 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1052,6 +1052,7 @@ EXT char *op_desc[] = {
 };
 #endif
 
+OP *   ck_bitop        _((OP* op));
 OP *   ck_concat       _((OP* op));
 OP *   ck_delete       _((OP* op));
 OP *   ck_eof          _((OP* op));
@@ -1845,8 +1846,8 @@ EXT OP * (*check[]) _((OP *op)) = {
        ck_null,        /* i_subtract */
        ck_concat,      /* concat */
        ck_fun,         /* stringify */
-       ck_null,        /* left_shift */
-       ck_null,        /* right_shift */
+       ck_bitop,       /* left_shift */
+       ck_bitop,       /* right_shift */
        ck_null,        /* lt */
        ck_null,        /* i_lt */
        ck_null,        /* gt */
@@ -1868,13 +1869,13 @@ EXT OP * (*check[]) _((OP *op)) = {
        ck_null,        /* seq */
        ck_null,        /* sne */
        ck_null,        /* scmp */
-       ck_null,        /* bit_and */
-       ck_null,        /* bit_xor */
-       ck_null,        /* bit_or */
+       ck_bitop,       /* bit_and */
+       ck_bitop,       /* bit_xor */
+       ck_bitop,       /* bit_or */
        ck_null,        /* negate */
        ck_null,        /* i_negate */
        ck_null,        /* not */
-       ck_null,        /* complement */
+       ck_bitop,       /* complement */
        ck_fun,         /* atan2 */
        ck_fun,         /* sin */
        ck_fun,         /* cos */
@@ -2195,8 +2196,8 @@ EXT U32 opargs[] = {
        0x0000111e,     /* i_subtract */
        0x0000110e,     /* concat */
        0x0000010e,     /* stringify */
-       0x0000111e,     /* left_shift */
-       0x0000111e,     /* right_shift */
+       0x0000110e,     /* left_shift */
+       0x0000110e,     /* right_shift */
        0x00001136,     /* lt */
        0x00001116,     /* i_lt */
        0x00001136,     /* gt */
@@ -2247,11 +2248,11 @@ EXT U32 opargs[] = {
        0x0000099e,     /* ord */
        0x0000098e,     /* chr */
        0x0000110e,     /* crypt */
-       0x0000010e,     /* ucfirst */
-       0x0000010e,     /* lcfirst */
-       0x0000010e,     /* uc */
-       0x0000010e,     /* lc */
-       0x0000010e,     /* quotemeta */
+       0x0000098e,     /* ucfirst */
+       0x0000098e,     /* lcfirst */
+       0x0000098e,     /* uc */
+       0x0000098e,     /* lc */
+       0x0000098e,     /* quotemeta */
        0x00000048,     /* rv2av */
        0x00001304,     /* aelemfast */
        0x00001304,     /* aelem */
diff --git a/opcode.pl b/opcode.pl

index 9271cdd..93fcbd7 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -278,8 +278,8 @@ i_subtract  integer subtraction     ck_null         ifst    S S
 concat         concatenation           ck_concat       fst     S S
 stringify      string                  ck_fun          fst     S
 
-left_shift     left bitshift           ck_null         ifst    S S
-right_shift    right bitshift          ck_null         ifst    S S
+left_shift     left bitshift           ck_bitop        fst     S S
+right_shift    right bitshift          ck_bitop        fst     S S
 
 lt             numeric lt              ck_null         Iifs    S S
 i_lt           integer lt              ck_null         ifs     S S
@@ -304,14 +304,14 @@ seq               string eq               ck_null         ifs     S S
 sne            string ne               ck_null         ifs     S S
 scmp           string comparison       ck_null         ifst    S S
 
-bit_and                bitwise and             ck_null         fst     S S
-bit_xor                bitwise xor             ck_null         fst     S S
-bit_or         bitwise or              ck_null         fst     S S
+bit_and                bitwise and             ck_bitop        fst     S S
+bit_xor                bitwise xor             ck_bitop        fst     S S
+bit_or         bitwise or              ck_bitop        fst     S S
 
 negate         negate                  ck_null         Ifst    S
 i_negate       integer negate          ck_null         ifst    S
 not            not                     ck_null         ifs     S
-complement     1's complement          ck_null         fst     S
+complement     1's complement          ck_bitop        fst     S
 
 # High falutin' math.
 
@@ -343,11 +343,11 @@ formline  formline                ck_formline     ms      S L
 ord            ord                     ck_fun          ifstu   S?
 chr            chr                     ck_fun          fstu    S?
 crypt          crypt                   ck_fun          fst     S S
-ucfirst                upper case first        ck_fun          fst     S
-lcfirst                lower case first        ck_fun          fst     S
-uc             upper case              ck_fun          fst     S
-lc             lower case              ck_fun          fst     S
-quotemeta      quote metachars         ck_fun          fst     S
+ucfirst                upper case first        ck_fun          fstu    S?
+lcfirst                lower case first        ck_fun          fstu    S?
+uc             upper case              ck_fun          fstu    S?
+lc             lower case              ck_fun          fstu    S?
+quotemeta      quote metachars         ck_fun          fstu    S?
 
 # Arrays.
 
diff --git a/os2/Changes b/os2/Changes

index 9a9524f..2bd48b2 100644 (file)
--- a/os2/Changes
+++ b/os2/Changes
@@ -104,3 +104,11 @@ after 5.003_05:
                perl___ - cannot fork, can dynalink.
        The build of the first one - perl - is rather convoluted, and
          requires a build of miniperl_.
+
+after 5.003_07:
+       custom tmpfile and tmpname which may use $TMP, $TEMP.
+       all the calls to OS/2 API wrapped so that it is safe to use
+               them under DOS (may die(), though).
+       Tested that popen works under DOS with modified PDKSH and RSX.
+       File::Copy works under DOS.
+       MakeMaker modified to work under DOS (perlmain.c.tmp and sh -c true).
diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs

index a1fcaa4..c498706 100644 (file)
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -49,6 +49,8 @@ perl5.def: perl.linkexp
        echo '  "dlsym"'                                >>$@
        echo '  "dlerror"'                              >>$@
        echo '  "perl_init_i18nl10n"'                   >>$@
+       echo '  "my_tmpfile"'                           >>$@
+       echo '  "my_tmpnam"'                            >>$@
 !NO!SUBS!
 
 if [ ! -z "$myttyname" ] ; then
diff --git a/os2/os2.c b/os2/os2.c

index 37219c8..f192dd6 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -73,6 +73,7 @@ setpriority(int which, int pid, int val)
 
   prio = sys_prio(pid);
 
+  if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
   if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) {
       /* Do not change class. */
       return CheckOSError(DosSetPriority((pid < 0) 
@@ -114,6 +115,7 @@ getpriority(int which /* ignored */, int pid)
   PIB *pib;
   ULONG rc, ret;
 
+  if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
   /* DosGetInfoBlocks has old priority! */
 /*   if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) return -1; */
 /*   if (pid != pib->pib_ulpid) { */
@@ -409,6 +411,8 @@ tcp0(char *name)
 {
     static BYTE buf[20];
     PFN fcn;
+
+    if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */
     if (!htcp)
        DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
     if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
@@ -421,6 +425,8 @@ tcp1(char *name, int arg)
 {
     static BYTE buf[20];
     PFN fcn;
+
+    if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */
     if (!htcp)
        DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
     if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
@@ -601,6 +607,7 @@ os2error(int rc)
        static char buf[300];
        ULONG len;
 
+        if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */
        if (rc == 0)
                return NULL;
        if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, rc, "OSO001.MSG", &len))
@@ -947,8 +954,12 @@ Xs_OS2_init()
     char *file = __FILE__;
     {
        GV *gv;
-       
-        newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
+
+       if (_emx_env & 0x200) { /* OS/2 */
+            newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
+            newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file);
+            newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file);
+       }
         newXS("DynaLoader::mod2fname", XS_DynaLoader_mod2fname, file);
         newXS("Cwd::current_drive", XS_Cwd_current_drive, file);
         newXS("Cwd::sys_chdir", XS_Cwd_sys_chdir, file);
@@ -958,8 +969,6 @@ Xs_OS2_init()
         newXS("Cwd::sys_is_relative", XS_Cwd_sys_is_relative, file);
         newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
         newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
-        newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file);
-        newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file);
        gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV);
        GvMULTI_on(gv);
 #ifdef PERL_IS_AOUT
@@ -992,3 +1001,33 @@ Perl_OS2_init()
     }
 }
 
+#undef tmpnam
+#undef tmpfile
+
+char *
+my_tmpnam (char *str)
+{
+    char *p = getenv("TMP"), *tpath;
+    int len;
+
+    if (!p) p = getenv("TEMP");
+    tpath = tempnam(p, "pltmp");
+    if (str && tpath) {
+       strcpy(str, tpath);
+       return str;
+    }
+    return tpath;
+}
+
+FILE *
+my_tmpfile ()
+{
+    struct stat s;
+
+    stat(".", &s);
+    if (s.st_mode & S_IWOTH) {
+       return tmpfile();
+    }
+    return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but
+                                            grants TMP. */
+}
diff --git a/os2/os2ish.h b/os2/os2ish.h

index 6510a1f..0597fdc 100644 (file)
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -99,6 +99,11 @@ extern char *tmppath;
 PerlIO *my_syspopen(char *cmd, char *mode);
 /* Cannot prototype with I32 at this point. */
 int my_syspclose(PerlIO *f);
+FILE *my_tmpfile (void);
+char *my_tmpnam (char *);
+
+#define tmpfile        my_tmpfile
+#define tmpnam my_tmpnam
 
 /*
  * fwrite1() should be a routine with the same calling sequence as fwrite(),
diff --git a/patchlevel.h b/patchlevel.h

index 30bb120..e1a4da8 100644 (file)
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 3
-#define SUBVERSION 7
+#define SUBVERSION 8
 
 /*
        local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.c b/perl.c

index b340b73..9255258 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -524,7 +524,7 @@ setuid perl scripts securely.\n");
     else if (scriptname == Nullch) {
 #ifdef MSDOS
        if ( isatty(PerlIO_fileno(PerlIO_stdin())) )
-           moreswitches("v");
+           moreswitches("h");
 #endif
        scriptname = "-";
     }
@@ -1299,7 +1299,10 @@ char *s;
        printf("\n\nCopyright 1987-1996, Larry Wall\n");
        printf("\n\t+ suidperl security patch");
 #ifdef MSDOS
-       printf("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
+       printf("\n\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
+#endif
+#ifdef DJGPP
+       printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
 #endif
 #ifdef OS2
        printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
@@ -1311,9 +1314,6 @@ char *s;
        printf("\n\
 Perl may be copied only under the terms of either the Artistic License or the\n\
 GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n");
-#ifdef MSDOS
-        usage(origargv[0]);
-#endif
        exit(0);
     case 'w':
        dowarn = TRUE;
diff --git a/perl.h b/perl.h

index 675b6a6..a779886 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -16,8 +16,12 @@
  * Above symbol is defined via -D in 'x2p/Makefile.SH'
  * Decouple x2p stuff from some of perls more extreme eccentricities. 
  */
-#undef MULTIPLICITY
 #undef EMBED
+#undef NO_EMBED
+#define NO_EMBED
+#undef MULTIPLICITY
+#undef HIDEMYMALLOC
+#undef EMBEDMYMALLOC
 #undef USE_STDIO
 #define USE_STDIO
 #endif /* PERL_FOR_X2P */
@@ -50,6 +54,16 @@
 #define VOIDUSED 1
 #include "config.h"
 
+/*
+ * SOFT_CAST can be used for args to prototyped functions to retain some
+ * type checking; it only casts if the compiler does not know prototypes.
+ */
+#if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
+#define SOFT_CAST(type)        
+#else
+#define SOFT_CAST(type)        (type)
+#endif
+
 #ifndef BYTEORDER
 #   define BYTEORDER 0x1234
 #endif
@@ -179,8 +193,6 @@
 #include <locale.h>
 #endif
 
-EXT int lc_collate_active;
-
 #ifdef METHOD  /* Defined by OSF/1 v3.0 by ctype.h */
 #undef METHOD
 #endif
@@ -200,22 +212,34 @@ EXT int lc_collate_active;
 #   include <stdlib.h>
 #endif /* STANDARD_C */
 
-/* Maybe this comes after <stdlib.h> so we don't try to change 
-   the standard library prototypes?.  We'll use our own in 
-   proto.h instead.  I guess.  The patch had no explanation.
-*/
+/* This comes after <stdlib.h> so we don't try to change the standard
+ * library prototypes; we'll use our own in proto.h instead. */
+
 #ifdef MYMALLOC
+
 #   ifdef HIDEMYMALLOC
-#      define malloc Mymalloc
+#      define malloc  Mymalloc
+#      define calloc  Mycalloc
 #      define realloc Myremalloc
-#      define free Myfree
-#      define calloc Mycalloc
+#      define free    Myfree
+#   endif
+#   ifdef EMBEDMYMALLOC
+#      define malloc  Perl_malloc
+#      define calloc  Perl_calloc
+#      define realloc Perl_realloc
+#      define free    Perl_free
 #   endif
-#   define safemalloc malloc
+
+#   undef safemalloc
+#   undef safecalloc
+#   undef saferealloc
+#   undef safefree
+#   define safemalloc  malloc
+#   define safecalloc  calloc
 #   define saferealloc realloc
-#   define safefree free
-#   define safecalloc calloc
-#endif
+#   define safefree    free
+
+#endif /* MYMALLOC */
 
 #define MEM_SIZE Size_t
 
@@ -335,10 +359,8 @@ EXT int lc_collate_active;
 #   endif
 #endif
 
-#ifndef MSDOS
-#  if defined(HAS_TIMES) && defined(I_SYS_TIMES)
+#if defined(HAS_TIMES) && defined(I_SYS_TIMES)
 #    include <sys/times.h>
-#  endif
 #endif
 
 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
@@ -367,10 +389,8 @@ EXT int lc_collate_active;
 #   define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END
 #endif
 
-#ifndef MSDOS
-#   ifndef errno
+#ifndef errno
        extern int errno;     /* ANSI allows errno to be an lvalue expr */
-#   endif
 #endif
 
 #ifdef HAS_STRERROR
@@ -1140,16 +1160,15 @@ I32 unlnk _((char*));
 #define SCAN_TR 1
 #define SCAN_REPL 2
 
-#ifdef MYMALLOC
-# ifndef DEBUGGING_MSTATS
-#  define DEBUGGING_MSTATS
-# endif
-#endif
-
 #ifdef DEBUGGING
 # ifndef register
 #  define register
 # endif
+# ifdef MYMALLOC
+#  ifndef DEBUGGING_MSTATS
+#   define DEBUGGING_MSTATS
+#  endif
+# endif
 # define PAD_SV(po) pad_sv(po)
 #else
 # define PAD_SV(po) curpad[po]
@@ -1173,6 +1192,7 @@ EXT char *** environ_pointer;
 #  endif
 #endif /* environ processing */
 
+EXT int                lc_collate_active;
 EXT int                uid;            /* current real user id */
 EXT int                euid;           /* current effective user id */
 EXT int                gid;            /* current real group id */
@@ -1483,7 +1503,6 @@ EXT U32           hints;          /* various compilation flags */
 #define HINT_BLOCK_SCOPE       0x00000100
 #define HINT_STRICT_SUBS       0x00000200
 #define HINT_STRICT_VARS       0x00000400
-#define HINT_STRICT_UNTIE      0x00000800
 
 /**************************************************************************/
 /* This regexp stuff is global since it always happens within 1 expr eval */
@@ -1792,6 +1811,8 @@ EXT MGVTBL vtbl_pos =     {magic_getpos,
                                        0,      0,      0};
 EXT MGVTBL vtbl_bm =   {0,     magic_setbm,
                                        0,      0,      0};
+EXT MGVTBL vtbl_fm =   {0,     magic_setfm,
+                                       0,      0,      0};
 EXT MGVTBL vtbl_uvar = {magic_getuvar,
                                magic_setuvar,
                                        0,      0,      0};
@@ -1823,6 +1844,7 @@ EXT MGVTBL vtbl_substr;
 EXT MGVTBL vtbl_vec;
 EXT MGVTBL vtbl_pos;
 EXT MGVTBL vtbl_bm;
+EXT MGVTBL vtbl_fm;
 EXT MGVTBL vtbl_uvar;
 
 #ifdef OVERLOAD
diff --git a/perl_exp.SH b/perl_exp.SH

index 3a44e27..821c4d5 100755 (executable)
--- a/perl_exp.SH
+++ b/perl_exp.SH
@@ -28,7 +28,7 @@ sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp
 cat <<END >> perl.exp
 perl_init_ext
 perl_init_fold
-perl_init_i18nl14n
+perl_init_i18nl10n
 perl_alloc
 perl_construct
 perl_destruct
diff --git a/perly.c b/perly.c

index 8e94e1a..6aff359 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -14,28 +14,31 @@ dep()
 
 #define YYERRCODE 256
 short yylhs[] = {                                        -1,
-   31,    0,    5,    3,    6,    6,    6,    7,    7,    7,
-    7,   21,   21,   21,   21,   21,   21,   11,   11,   11,
-    9,    9,    9,    9,   30,   30,    8,    8,    8,    8,
-    8,    8,    8,    8,   10,   10,   25,   25,   29,   29,
-    1,    1,    1,    1,    2,    2,   32,   32,   28,   28,
-    4,   33,   33,   34,   13,   13,   13,   12,   12,   12,
-   26,   26,   26,   26,   26,   26,   26,   26,   27,   27,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
-   14,   14,   14,   14,   22,   22,   23,   23,   23,   20,
-   15,   16,   17,   18,   19,   24,   24,   24,   24,
+   40,    0,    7,    5,    8,    9,    6,   10,   10,   10,
+   11,   11,   11,   11,   23,   23,   23,   23,   23,   23,
+   14,   14,   14,   13,   13,   13,   13,   37,   37,   12,
+   12,   12,   12,   12,   12,   12,   41,   42,   12,   12,
+   25,   25,   26,   26,   27,   28,   29,   30,   39,   39,
+    1,    1,    1,    1,    3,    3,   43,   43,   36,   36,
+    4,   44,   44,   45,   15,   15,   15,   24,   24,   24,
+   34,   34,   34,   34,   34,   34,   34,   34,   35,   35,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   31,   31,   32,   32,   32,    2,
+    2,   38,   22,   17,   18,   19,   20,   21,   33,   33,
+   33,   33,
 };
 short yylen[] = {                                         2,
-    0,    2,    4,    0,    0,    2,    2,    2,    1,    2,
-    3,    1,    1,    3,    3,    3,    3,    0,    2,    6,
-    6,    6,    4,    4,    0,    2,    7,    7,    5,    5,
-    8,    7,   10,    3,    0,    1,    0,    1,    0,    1,
+    0,    2,    4,    0,    5,    0,    0,    0,    2,    2,
+    2,    1,    2,    3,    1,    1,    3,    3,    3,    3,
+    0,    2,    6,    7,    7,    4,    4,    0,    2,    8,
+    8,    5,    5,   10,    8,    8,    0,    0,   13,    3,
+    0,    1,    0,    1,    1,    1,    1,    1,    0,    1,
     1,    1,    1,    1,    4,    3,    5,    5,    0,    1,
     0,    3,    2,    6,    3,    3,    1,    2,    3,    1,
     3,    5,    6,    3,    5,    2,    4,    4,    1,    1,
@@ -46,1071 +49,995 @@ short yylen[] = {                                         2,
     5,    6,    5,    6,    5,    4,    5,    1,    1,    3,
     4,    3,    2,    2,    4,    5,    4,    5,    1,    2,
     2,    1,    2,    2,    2,    1,    3,    1,    3,    4,
-    4,    6,    1,    1,    0,    1,    0,    1,    2,    2,
-    2,    2,    2,    2,    2,    1,    1,    1,    1,
+    4,    6,    1,    1,    0,    1,    0,    1,    2,    1,
+    1,    1,    2,    2,    2,    2,    2,    2,    1,    1,
+    1,    1,
 };
 short yydefred[] = {                                      1,
-    0,    5,    0,   40,   51,   51,    0,   51,    6,   41,
-    7,    9,    0,   42,   43,   44,    0,    0,    0,   53,
-    0,   12,    4,  143,    0,    0,  118,    0,  138,    0,
-   51,   51,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    8,    0,   50,   61,   61,    0,   61,    9,   51,
+   10,   12,    0,   52,   53,   54,    0,    0,    0,   63,
+    0,   15,    4,  153,    0,    0,  128,    0,  148,    0,
+   61,   61,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  160,  161,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   13,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   11,    0,    0,
+    0,    0,  118,  120,    0,    0,    0,    0,  154,    0,
+   56,    0,   62,    0,    8,  169,  172,  171,  170,    0,
+    0,    0,    0,    0,    0,    4,    0,    4,    0,    4,
+    0,    4,    0,    4,    4,    0,    0,    0,    0,    0,
+  167,    0,  134,    0,    0,    0,    0,    0,  163,    0,
+    0,    0,    0,   76,    0,  143,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  108,    0,  164,  165,
+  166,  168,    0,    0,   40,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,   10,    0,    0,    0,
-    0,    0,    0,    0,    0,    8,    0,    0,    0,    0,
-    0,  108,  110,    0,    0,    0,  144,    0,   46,    0,
-   52,    0,    5,  156,  159,  158,  157,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,  154,    0,  124,
-    0,    0,    0,    0,    0,    0,  150,    0,    0,    0,
-    0,   66,    0,  133,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,   98,    0,  151,  152,  153,  155,
-    0,   34,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,   90,   91,    0,    0,    0,    0,
-    0,    0,    0,    0,   11,   45,   50,    0,    0,    0,
-   64,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,   36,    0,  137,  139,
-    0,    0,    0,    0,    0,    0,  100,    0,  122,    0,
-    0,    0,   97,   26,    0,    0,    0,    0,    0,    0,
-   55,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   69,    0,   70,
-    0,    0,    0,    0,    0,    0,    0,  120,    0,   48,
-   47,    0,    3,    0,  141,    0,   68,  101,    0,   29,
-    0,   30,    0,    0,    0,   23,    0,   24,    0,    0,
-    0,  140,  149,   67,    0,  125,    0,  127,    0,   99,
-    0,    0,    0,    0,    0,    0,    0,  107,    0,  105,
-    0,  116,    0,  121,   54,   65,    0,    0,    0,    0,
-   19,    0,    0,    0,    0,    0,   62,  126,  128,  115,
-    0,  113,    0,    0,  106,    0,  111,  117,  103,  142,
-   27,   28,   21,    0,   22,    0,   32,    0,  114,  112,
-   63,    0,    0,   31,    0,    0,   20,   33,
+    0,    0,    0,    0,    0,    0,  100,  101,    0,    0,
+    0,    0,    0,    0,    0,    0,   14,    0,   55,   60,
+    0,    0,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  147,
+  149,    0,    0,    0,    0,    0,    0,  110,    0,  132,
+    0,    0,    0,  107,   29,    0,    0,   20,    0,    0,
+    0,   65,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   79,    0,
+   80,    0,    0,    0,    0,    0,    0,    0,  130,    0,
+    0,   58,   57,    0,    3,    0,  151,    0,   78,  111,
+    0,   47,    0,   32,   48,    0,   33,    0,    0,    0,
+    0,   26,    0,   27,  162,    0,    0,   42,    0,    0,
+  150,  159,   77,    0,  135,    0,  137,    0,  109,    0,
+    0,    0,    0,    0,    0,    0,  117,    0,  115,    0,
+  126,    0,  131,   64,   75,    0,    0,    0,    0,    6,
+   22,    0,    0,    0,    0,   37,    0,   72,  136,  138,
+  125,    0,  123,    0,    0,  116,    0,  121,  127,  113,
+  152,    0,    0,    0,    7,    0,    0,    0,    0,    0,
+    0,  124,  122,   73,   30,   31,   24,    8,    0,   25,
+    0,   36,    0,   35,    0,    0,    0,   38,    5,   23,
+   34,    0,    0,    0,   39,
 };
 short yydgoto[] = {                                       1,
-    9,   10,   83,   17,   86,    3,   11,   12,   66,  195,
-  266,   67,  202,   69,   70,   71,   72,   73,   74,   75,
-  197,  122,  203,   88,  187,   77,  241,  178,   13,  142,
-    2,   14,   15,   16,
+    9,   66,   10,   17,   85,  348,   88,  311,  335,    3,
+   11,   12,   68,  272,  203,   70,   71,   72,   73,   74,
+   75,   76,  278,   78,  279,  262,  265,  269,  263,  266,
+  124,  204,   90,   79,  242,  181,  145,  276,   13,    2,
+  340,  362,   14,   15,   16,
 };
 short yysindex[] = {                                      0,
-    0,    0,  303,    0,    0,    0,  -53,    0,    0,    0,
-    0,    0,  607,    0,    0,    0, -111, -242,  -32,    0,
- -216,    0,    0,    0,  149,  149,    0,    8,    0, 2109,
-    0,    0,  -15,   -8,    4,    6,   32, 2109,   13,   20,
-   57,  149,  994, 2109, 1057, -206,  149, 2109,  938, 1291,
- 2109, 2109, 2109, 2109, 2109, 1347,    0, 2109, 2109, 1403,
-  149,  149,  149,  149, -203,    0,   68,  664,  491,  -67,
-  -52,    0,    0,  -21,   73,   65,    0,    7,    0, -135,
-    0, -126,    0,    0,    0,    0,    0, 2109,   92, 2109,
-  491,    7, -135, 2109,    7, 2109,    7, 2109,    7, 2109,
-    7, 1466,  101,  491,  112, 1700,  938,    0,  102,    0,
- 1228,  -22, 1228,   39,  -58, 2109,    0,   68,    0,   68,
-  -67,    0, 2109,    0, 1228,  472,  472,  472,  -88,  -88,
-   78,  -10,  472,  472,    0,  -85,    0,    0,    0,    0,
-    7,    0, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109,
- 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109, 2109,
- 2109, 2109, 2109, 2109,    0,    0,  -29, 2109, 2109, 2109,
- 2109, 2109, 2109, 1756,    0,    0,    0,  -46, 2109,  391,
-    0, 2109,  -25, 2109,    7, -214,  129, -203,   -5, -203,
-    1, -167,    9, -167,  117,   52,    0, 2109,    0,    0,
-   23,   60,  132, 2109, 1812, 1875,    0,   53,    0,   68,
- 2109,   86,    0,    0,  491, -214, -214, -214, -214, -147,
-    0,  -54,  382, 1228, 1090,  771,  115,  491, 2942, 1523,
-  314, 1554,  392,  677,  472,  472, 2109,    0, 2109,    0,
-  141,   89,  -42,   99,   46,  114,   64,    0,   26,    0,
-    0,  124,    0,  143,    0, 2109,    0,    0,    7,    0,
-    7,    0,    7,    7,  146,    0,    7,    0, 2109,    7,
-   35,    0,    0,    0,   37,    0,   49,    0,   55,    0,
-  130, 2109,   63, 2109,   67,  166, 2109,    0,   66,    0,
-   71,    0,   74,    0,    0,    0, 1170, -203, -203, -167,
-    0, 2109, -167,  131, -203,    7,    0,    0,    0,    0,
-  185,    0, 1119,   76,    0,  161,    0,    0,    0,    0,
-    0,    0,    0,   58,    0, 1466,    0, -203,    0,    0,
-    0,    7,  162,    0, -167,    7,    0,    0,
+    0,    0,  408,    0,    0,    0,  -36,    0,    0,    0,
+    0,    0,  618,    0,    0,    0, -116, -216,  -12,    0,
+ -203,    0,    0,    0,   68,   68,    0,   16,    0, 1972,
+    0,    0,   -6,    5,    6,   21,  -34, 1972,   22,   26,
+   31,   68,  950, 1006, -176,    0,    0,   68, 1972,  -21,
+ 1070, 1972, 1972, 1972, 1972, 1972, 1346,    0, 1972, 1972,
+ 1402,   68,   68,   68,   68, 1972, -202,    0,  287, 3838,
+  -59,  -56,    0,    0,  -35,   57,   41,   63,    0,   -9,
+    0, -150,    0, -145,    0,    0,    0,    0,    0, 1972,
+   87, 1972, 3838,   -9, -150,    0,   -9,    0,   -9,    0,
+   -9,    0,   -9,    0,    0,   90, 3838,   91, 1461,  -21,
+    0,  103,    0,  267,   -7,   23,  -50, 1972,    0,   63,
+    0,  -59,   63,    0, 1972,    0,  267,  611,  611,  611,
+  -86,  -86,   62,  -38,  611,  611,    0,  -83,    0,    0,
+    0,    0,  267,   -9,    0, 1972, 1972, 1972, 1972, 1972,
+ 1972, 1972, 1972, 1972, 1972, 1972, 1972, 1972, 1972, 1972,
+ 1972, 1972, 1972, 1972, 1972, 1972,    0,    0,  -28, 1972,
+ 1972, 1972, 1972, 1972, 1972, 1521,    0, 1972,    0,    0,
+  -33, 1972,  225,    0, 1972, 2008, 1972,   -9, 1972, -202,
+ 1972, -202, 1972, -208, 1972, -208,   95, 1797, 1972,    0,
+    0,  -30,    7,  114, 1972, 1853, 1909,    0,   25,    0,
+   63, 1972,   73,    0,    0, -173, -173,    0, -173, -173,
+ -140,    0,  -46, 3340,  267, 2662,  374, 1221, 3838, 3801,
+ 3898, 1616, 3272,  320,  383,  611,  611, 1972,    0, 1972,
+    0,  127,  -79,  -41,  -73,   40,  -43,   59,    0,  -16,
+ 3838,    0,    0,  111,    0,  130,    0, 1972,    0,    0,
+ -173,    0,  136,    0,    0,  138,    0, -173,  142,   58,
+  144,    0,  146,    0,    0,  149,  369,    0,  131,  -14,
+    0,    0,    0,  -11,    0,   -3,    0,   -1,    0,  113,
+ 1972,   70, 1972,   66,  140, 1972,    0,   71,    0,   72,
+    0,   79,    0,    0,    0, 1675,   58,   58,   58,    0,
+    0, 1972,   58, 1972,   58,    0,   -9,    0,    0,    0,
+    0,  182,    0, 3868,   84,    0,  170,    0,    0,    0,
+    0, -202, -202, -208,    0,  173, -208,    1, -202, 1972,
+ -202,    0,    0,    0,    0,    0,    0,    0,   58,    0,
+   58,    0,  156,    0,  343, -208, -202,    0,    0,    0,
+    0, 1797,  177,   58,    0,
 };
 short yyrindex[] = {                                      0,
-    0,    0,  269,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  165,    0,    0,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0, 2241, 1964,    0,
-    0,    0,    0,    0,    0,    0,    0,    0, 2857, 2901,
+    0,    0,    0,    0,    0,    0,    0, 2164,  426,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0, 2786,
+ 2862,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   49,    0,   18,  293,
+ 2907, 2987,    0,    0, 2209, 2062,    0,  373,    0,    0,
+    0,  -20,    0,    0,    0,    0,    0,    0,    0, 2260,
+    0,    0, 1179,    0,   96,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0, 1299,    0,    0,  179,
+    0, 2121,    0, 3614, 2907,    0,    0, 2260,    0, 2319,
+  493,  559, 2461,    0,    0,    0, 3653, 3142, 3183, 3222,
+ 3049, 3097, 2523,    0, 3268, 3316,    0,    0,    0,    0,
+    0,    0, 3727,    0,    0,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,  107,    0,  360,   -1,   62, 3027,
- 3078,    0,    0, 2286, 2020,    0,    0,    0,    0,  -12,
-    0,    0,    0,    0,    0,    0,    0, 2415,    0,    0,
- 1251,    0,   82,  173,    0,    0,    0,    0,    0,    0,
-    0,  157,    0, 1661,    0,    0,  178,    0, 2150,    0,
- 3927, 3027, 3958,    0,    0, 2415,    0, 2537,  454, 2581,
-  548,    0,    0,    0, 3989, 3384, 3425, 3461, 3122, 3163,
- 2636,    0, 3497, 3533,    0,    0,    0,    0,    0,    0,
-    0,    0, 2680,    0,    0,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0, 2582,    0,    0,
+    0,  167,  894,    0,  179,    0, 2260,    0,  190,   49,
+    0,   49,    0,  109,    0,  109,    0,  188,    0,    0,
+    0,    0,  210,    0,    0,    0,    0,    0,    0,    0,
+ 2627,    0, 2724,    0,    0,   24,   39,    0,   52,   60,
+ 1307,    0,    0, 1046, 1187, 1243, 1131, 3503, 1575,    0,
+ 3770, 1639, 1583, 2399, 3551, 3418, 3457,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,  163,  882,
-    0,  178,    0, 2415,    0,    2,    0,  107,    0,  107,
-    0,  175,    0,  175,    0,  165,    0,    0,    0,    0,
-    0,  180,    0,    0,    0,    0,    0,    0,    0, 2723,
-    0, 2985,    0,    0, 2785,   11,   14,   33,   59,  833,
-    0,    0,  -30, 4020, 4036, 3817, 3850, 3275,    0, 1611,
- 4179, 4114, 4098, 3894, 3569, 3646,    0,    0,    0,    0,
+ 1729,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   65,    0,    0,    0,    0,    0,    0,  226,    0,    0,
+    0,    0,    0,    0,    0,    0,  215,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  179,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,  168,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,  178,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,  107,  107,  175,
-    0,    0,  175,    0,  107,    0,    0,    0,    0,    0,
-    0,    0, 2462,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,  190,    0,  107,    0,    0,
-    0,    0,    0,    0,  175,    0,    0,    0,
+    0,    0,    0,  845,    0,    0,    0,    0,    0,    0,
+    0,   49,   49,  109,    0,    0,  109,    0,   49,  227,
+   49,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  894,  109,   49,    0,    0,    0,
+    0,  257,    0,    0,    0,
 };
 short yygindex[] = {                                      0,
-    0,    0,    0,  148,  -13,  106,    0,    0,    0,  -91,
- -184,  452,  -11, 4373,  886,    0,    0,    0,    0,    0,
-  234,  -62, -173,  460,  -20,    0,    0,  174,    0, -131,
-    0,    0,    0,    0,
+    0,    0,    0,   47,  416,    0,  447,  194,    0,  -84,
+    0,    0,    0, -168,  -13, 3819,  917,    0,    0,    0,
+    0,    0,  291,  901,  -62,  -29,  197,   14,    0,  150,
+  -61, -181,   10,    0,    0,  253,  637,    0,    0,    0,
+    0,    0,    0,    0,    0,
 };
-#define YYTABLESIZE 4657
-short yytable[] = {                                      65,
-  208,   68,  168,   79,  283,   20,   61,  213,  254,  268,
-   80,   23,  250,   80,   80,  255,  289,  206,  256,   95,
-   97,   99,  101,  170,   94,  181,   81,   80,   80,  110,
-  212,   96,   80,  115,  150,  261,  124,  157,  172,   13,
-   82,  263,   38,   98,  132,  100,   49,   90,  136,  267,
-  116,   16,  105,  209,   17,  169,  260,   13,  262,  106,
-   38,  239,   80,  272,  176,  168,  294,   61,  170,   16,
-  171,  102,   17,   14,  141,  306,   23,  307,  184,  148,
-  149,  188,  186,  190,  189,  192,  191,  194,  193,  308,
-  196,   14,  270,  237,  201,  309,  107,  150,  332,   15,
-  169,  173,   60,  273,  291,   60,   25,   23,  264,  265,
-   49,  143,  174,  316,   23,  323,  252,   15,  325,   60,
-   60,  257,  293,  175,  177,  314,   23,  214,   23,   23,
-  179,  182,  216,  217,  218,  219,  220,  221,  222,   25,
-  198,  205,   25,   25,   25,   78,   25,  149,   25,   25,
-  337,   25,  199,   18,   60,   21,  242,  243,  244,  245,
-  246,  247,  249,  207,  251,   25,  321,  322,  211,  259,
-   25,  258,  274,  327,   18,  269,  282,  280,   92,   93,
-  287,  288,  295,  296,   61,  302,  271,  312,  180,  326,
-  317,  290,  275,  277,  279,  318,  334,   25,  319,  281,
-  330,  331,  336,   19,   49,  168,  292,   18,  148,  149,
-   18,   18,   18,   37,   18,   35,   18,   18,  147,   18,
-  148,  145,  310,   13,  167,  285,   37,  286,  238,   25,
-   35,   25,   25,   18,  333,  148,  149,  150,   18,  148,
-  149,   80,   80,   80,   80,  298,   76,  299,  304,  300,
-  301,  148,  149,  303,    0,  151,  305,  186,  315,  152,
-  153,  154,  155,   80,   80,   18,  185,   80,    2,    0,
-  311,   23,  156,  158,  159,  160,  161,  329,  162,  163,
-    0,    0,  164,  148,  149,  165,  166,  167,  148,  149,
-  324,    0,  328,    0,  148,  149,    0,   18,    0,   18,
-   18,   39,  148,  149,   39,   39,   39,    0,   39,    0,
-   39,   39,    0,   39,   68,    0,  148,  149,  335,  148,
-  149,    0,  338,  144,  145,  146,  147,   39,  148,  149,
-  148,  149,   39,   60,   60,   60,   60,    0,    0,  148,
-  149,    0,  148,  149,    0,  148,  149,    0,  148,  149,
-    0,  148,  149,  148,  149,   60,   60,  148,  149,   39,
-  148,  149,   25,   25,   25,   25,   25,   25,    0,   25,
-   25,   25,   25,   25,   25,   25,   25,   25,   25,   25,
-   25,   25,  148,  149,    0,   25,   25,    0,   25,   25,
-   25,   39,  148,  149,   39,   25,   25,   25,   25,   25,
-   57,  154,   25,   25,  168,   84,    0,  148,  149,   25,
-   85,    0,    0,   25,    0,   25,   25,    0,   57,  163,
-    0,    0,  164,  148,  149,  165,  166,  167,    0,    0,
-   18,   18,   18,   18,   18,   18,  150,   18,   18,   18,
-   18,   18,   18,   18,   18,   18,   18,   18,   18,   18,
-    0,    0,   57,   18,   18,    0,   18,   18,   18,  148,
-  149,    0,    0,   18,   18,   18,   18,   18,    0,    0,
-   18,   18,  168,    0,    0,    0,    0,   18,  148,  149,
-    0,   18,  168,   18,   18,   89,  156,    0,    0,  156,
-  156,  156,    0,  156,  143,  156,  156,  143,  156,  118,
-  120,  108,    0,    0,  150,    0,  117,    0,  123,    0,
-    0,  143,  143,    0,  150,  253,  143,  156,    0,    0,
-  137,  138,  139,  140,   39,   39,   39,   39,   39,   39,
-    0,   39,   39,   39,    0,    0,    0,   39,    0,  120,
-   39,   39,   39,   39,  143,    0,  143,   39,   39,    0,
-   39,   39,   39,  157,    0,    0,    0,   39,   39,   39,
-   39,   39,  168,    0,   39,   39,  204,  120,    4,    5,
-    6,   39,    7,    8,  210,   39,  143,   39,   39,  156,
-  157,  168,    0,  157,  157,  157,    0,  157,  102,  157,
-  157,  102,  157,    0,  150,    0,    0,    0,  152,  153,
-  154,  155,    0,    0,    0,  102,  102,    0,    0,    0,
-  102,  157,    0,  150,  160,  161,    0,  162,  163,    0,
-    0,  164,    0,    0,  165,  166,  167,    0,    0,    0,
-  120,   57,   57,   57,   57,  120,    0,    0,    0,   51,
-  102,    0,   61,   63,   47,    0,   56,    0,   64,   59,
-    0,   58,    0,   57,   57,    0,    4,    5,    6,    0,
-    7,    8,    0,    0,    0,   57,  152,  153,  154,  155,
-   62,    0,    0,  157,    0,    0,  152,  153,  154,  155,
-  158,  159,  160,  161,    0,  162,  163,    0,    0,  164,
-    0,    0,  165,  166,  167,  162,  163,   60,    0,  164,
-    0,    0,  165,  166,  167,    0,    0,    0,    0,    0,
-  156,  156,  156,  156,  156,    0,  156,  156,  156,    0,
-    0,    0,  156,    0,    0,  143,  143,  143,  143,   23,
-    0,    0,   52,  156,  143,  156,  156,  156,  143,  143,
-  143,  143,  156,  156,  156,  156,  156,  143,  143,  156,
-  156,  143,  143,  143,  143,  143,  156,  143,  143,    0,
-  156,  143,  156,  156,  143,  143,  143,  168,    0,    0,
-    0,  151,    0,    0,    0,  152,  153,  154,  155,  164,
-    0,    0,  165,  166,  167,    0,    0,    0,  156,  158,
-  159,  160,  161,    0,  162,  163,    0,    0,  164,  150,
-    0,  165,  166,  167,  157,  157,  157,  157,  157,    0,
-  157,  157,  157,    0,    0,    0,  157,    0,    0,  102,
-  102,  102,  102,    0,    0,    0,    0,  157,  102,  157,
-  157,  157,  102,  102,  102,  102,  157,  157,  157,  157,
-  157,  102,  102,  157,  157,  102,  102,  102,  102,  102,
-  157,  102,  102,    0,  157,  102,  157,  157,  102,  102,
-  102,  168,   22,   24,   25,   26,   27,   28,    0,   29,
-   30,   31,    0,   56,    0,   32,   56,    0,   33,   34,
-   35,   36,    0,    0,    0,   37,   38,    0,   39,   40,
-   41,   56,    0,  150,    0,   42,   43,   44,   45,   46,
-    0,    0,   48,   49,    0,    0,    0,    0,    0,   50,
-   87,   87,    0,   53,   39,   54,   55,   39,   39,   39,
-    0,   39,  103,   39,   39,   56,   39,   87,  112,    0,
-    0,    0,   87,    0,  121,  144,  145,  146,  147,    0,
-   39,    0,    0,    0,    0,   39,   87,   87,   87,   87,
-    0,    0,    0,    0,    0,    0,    0,  148,  149,    0,
-    0,    0,    0,  154,  155,    0,    0,    0,    0,    0,
-   51,    0,   39,   61,   63,   47,    0,   56,    0,   64,
-   59,  163,   58,    0,  164,    0,    0,  165,  166,  167,
-    0,    0,  121,    0,    0,    0,    0,    0,    0,    0,
-    0,   62,    0,    0,   39,    0,    0,   39,    0,    0,
+#define YYTABLESIZE 4212
+short yytable[] = {                                      69,
+  183,   62,  213,  256,  170,  105,   23,   62,  209,  214,
+  281,   52,  292,  297,   62,   64,   48,  298,   57,  299,
+   65,   60,   20,   59,  303,  252,  317,  274,  184,  318,
+  117,  172,  207,   96,  174,   91,  152,  319,   59,  320,
+   82,  351,   63,  134,   98,  100,   83,  138,   28,  301,
+  282,  111,   18,   84,   21,   92,  210,  119,   16,  125,
+  102,  108,  240,  171,   19,  109,  173,  270,  271,   61,
+  110,  139,  140,  141,  142,  144,   16,   94,   95,   45,
+  118,   28,   19,  172,   28,   28,   28,  175,   28,   23,
+   28,   28,   17,   28,  238,  202,  176,   45,  300,  177,
+   18,   23,   59,   62,   53,   44,  178,   28,   21,  180,
+   17,  182,   28,   23,  327,  171,   23,  302,   18,  205,
+  254,  150,  151,   44,  325,  259,  185,   23,   23,  199,
+   62,  200,  216,  217,  219,  220,  221,  222,  223,   28,
+   80,   21,  206,   23,   21,   21,   21,  208,   21,  289,
+   21,   21,  212,   21,  283,  151,  243,  244,  245,  246,
+  247,  248,  250,  291,    2,  347,  296,   21,  350,  304,
+  305,   28,   21,   28,   28,  261,  307,  217,  308,  268,
+  310,  217,  309,  312,  277,  280,  313,  360,  314,  316,
+   23,  284,  286,  288,  323,  328,  329,   49,  290,   21,
+   49,   49,   49,  330,   49,  321,   49,   49,  343,   49,
+  344,  150,  151,  349,  358,  150,  151,  364,   59,  157,
+   19,  150,  151,   49,  294,  155,  295,  169,   49,  239,
+   43,   21,  326,   21,   21,  121,   25,   26,   27,   28,
+   87,   29,   30,   31,  150,  151,   41,   32,  150,  151,
+  158,  150,  151,  150,  151,   49,  150,  151,   38,  104,
+   39,   40,   41,  355,  150,  151,   46,   42,   43,   44,
+   45,   46,   47,   16,  342,   49,   50,  322,  150,  151,
+  150,  151,   51,  150,  151,   43,   54,   49,   55,   56,
+   49,  150,  151,  150,  151,  150,  151,   41,  268,  363,
+  338,  150,  151,   77,   28,   28,   28,   28,   28,   28,
+  353,   28,   28,   28,   28,   28,   28,   28,   28,   28,
+   28,   28,   28,   28,   86,  336,  261,   28,   28,   87,
+   28,   28,   28,   70,  150,  151,   70,   28,   28,   28,
+   28,   28,   28,  218,  273,   28,   28,  188,   69,  255,
+   70,   70,   28,  150,  151,    0,   28,  170,   28,   28,
+  150,  151,    0,    0,   21,   21,   21,   21,   21,   21,
+    0,   21,   21,   21,   21,   21,   21,   21,   21,   21,
+   21,   21,   21,   21,    0,   70,    0,   21,   21,  152,
+   21,   21,   21,    0,    0,    0,    0,   21,   21,   21,
+   21,   21,   21,    0,    0,   21,   21,  150,  151,  315,
+  170,    0,   21,   67,    0,    0,   21,    0,   21,   21,
+   49,   49,   49,   49,   49,   49,    0,   49,   49,   49,
+    0,   67,    0,   49,  150,  151,   49,   49,   49,   49,
+    0,    0,  152,   49,   49,    0,   49,   49,   49,    0,
+    0,    0,    0,   49,   49,   49,   49,   49,   49,   67,
+    0,   49,   49,   81,  170,   67,  146,  359,   49,  146,
+    0,    0,   49,  170,   49,   49,  150,  151,    0,   97,
+   99,  101,  103,  146,  146,    0,    0,    0,  146,  113,
+    4,    5,    6,    0,    7,    8,  152,  126,    0,    0,
+  332,  333,  334,    0,    0,  152,  337,    0,  339,    0,
+    0,  189,    0,  191,    0,  193,  146,  195,  146,  197,
+  198,    0,    0,    0,    0,  169,  179,    0,  169,  169,
+  169,    0,  169,  153,  169,  169,  153,  169,    0,    0,
+  187,    0,  356,  190,  357,  192,    0,  194,  146,  196,
+  153,  153,    0,  156,  157,  153,  169,  365,  146,  147,
+  148,  149,    0,    0,   70,   70,   70,   70,    0,    0,
+    0,  164,  165,    0,    0,  166,    0,    0,  167,  168,
+  169,  150,  151,  153,    0,  153,    0,   70,   70,    0,
+  215,  170,    0,    0,  170,  170,  170,    0,  170,  112,
+  170,  170,  112,  170,  154,  155,  156,  157,    4,    5,
+    6,    0,    7,    8,    0,  153,  112,  112,  169,    0,
+    0,  112,  170,    0,  164,  165,    0,  253,  166,    0,
+    0,  167,  168,  169,  260,    0,    0,    0,    0,    0,
+  146,  147,  148,  149,   67,   67,   67,   67,    0,    0,
+   52,  112,    0,   62,   64,   48,    0,   57,    0,   65,
+   60,    0,   59,  150,  151,    0,    0,   67,   67,  156,
+  157,    0,    0,    4,    5,    6,   58,    7,    8,  165,
+    0,   63,  166,    0,  170,  167,  168,  169,  165,    0,
+    0,  166,    0,    0,  167,  168,  169,  146,  146,  146,
+  146,  170,    0,    0,    0,    0,  146,    0,   61,    0,
+  146,  146,  146,  146,    0,    0,    0,    0,    0,    0,
+  146,  146,    0,    0,  146,  146,  146,  146,  146,    0,
+  146,  146,    0,  152,  146,    0,    0,  146,  146,  146,
+   23,    0,    0,   53,    0,    0,    0,    0,    0,  169,
+  169,  169,  169,  169,    0,  169,  169,  169,    0,    0,
+    0,  169,    0,  341,  153,  153,  153,  153,    0,    0,
+    0,    0,  169,  153,  169,  169,  169,  153,  153,  153,
+  153,  169,  169,  169,  169,  169,  169,  153,  153,  169,
+  169,  153,  153,  153,  153,  153,  169,  153,  153,    0,
+  169,  153,  169,  169,  153,  153,  153,    0,    0,    0,
+    0,    0,    0,    0,    0,  170,  170,  170,  170,  170,
+    0,  170,  170,  170,    0,    0,  264,  170,  267,    0,
+  112,  112,  112,  112,    0,    0,    0,    0,  170,  112,
+  170,  170,  170,  112,  112,  112,  112,  170,  170,  170,
+  170,  170,  170,  112,  112,  170,  170,  112,  112,  112,
+  112,  112,  170,  112,  112,    0,  170,  112,  170,  170,
+  112,  112,  112,   22,   24,   25,   26,   27,   28,    0,
+   29,   30,   31,    0,    0,   93,   32,    0,   93,   33,
+   34,   35,   36,    0,    0,    0,   37,   38,    0,   39,
+   40,   41,   93,   93,    0,    0,   42,   43,   44,   45,
+   46,   47,    0,    0,   49,   50,    0,    0,    0,  166,
+    0,   51,  167,  168,  169,   54,   49,   55,   56,   49,
+   49,   49,    0,   49,    0,   49,   49,   93,   49,    0,
+    0,   89,   89,    0,    0,    0,    0,    0,    0,  120,
+  123,    0,   49,  106,    0,    0,    0,   49,   89,  115,
+    0,    0,    0,    0,   89,    0,  122,    0,  345,  346,
+    0,    0,    0,    0,    0,  352,    0,  354,   89,   89,
+   89,   89,   52,    0,   49,   62,   64,   48,    0,   57,
+  123,   65,   60,  361,   59,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,   51,    0,   60,   61,
-   63,   47,    0,   56,    0,   64,   59,    0,   58,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,  240,    0,    0,    0,    0,   62,    0,    0,
-   23,    0,    0,   52,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,  163,    0,    0,  164,    0,
-    0,  165,  166,  167,   60,    0,    0,    0,    0,   51,
-    0,    0,   61,   63,   47,    0,   56,    0,   64,   59,
-    0,   58,    0,    0,   56,   56,   56,   56,    0,    0,
-    0,    0,    0,    0,    0,  114,   23,    0,    0,   52,
-   62,    0,    0,    0,    0,    0,   56,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   39,   39,   39,
-   39,   39,   39,    0,   39,   39,   39,   60,    0,    0,
-   39,    0,    0,   39,   39,   39,   39,    0,    0,    0,
-   39,   39,    0,   39,   39,   39,    0,    0,    0,    0,
-   39,   39,   39,   39,   39,    0,    0,   39,   39,    0,
-  168,  157,   52,    0,   39,    0,    0,    0,   39,    0,
-   39,   39,    0,    0,  119,   25,   26,   27,   28,   85,
-   29,   30,   31,    0,    0,    0,   32,    0,    0,  168,
-  320,    0,  150,    0,    0,    0,    0,   38,    0,   39,
-   40,   41,    0,    0,    0,    0,   42,   43,   44,   45,
-   46,    0,  157,   48,   49,    0,    0,    0,    0,    0,
-   50,  150,    0,    0,   53,    0,   54,   55,    0,    0,
-  109,   25,   26,   27,   28,    0,   29,   30,   31,    0,
-  168,    0,   32,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,   38,    0,   39,   40,   41,    0,    0,
-    0,    0,   42,   43,   44,   45,   46,    0,    0,   48,
-   49,  135,  150,    0,  135,    0,   50,    0,    0,    0,
-   53,    0,   54,   55,    0,    0,    0,    0,  135,  135,
-    0,    0,    0,   24,   25,   26,   27,   28,  168,   29,
-   30,   31,    0,   51,    0,   32,   61,   63,   47,    0,
-   56,    0,   64,   59,    0,   58,   38,    0,   39,   40,
-   41,    0,    0,  135,    0,   42,   43,   44,   45,   46,
-  150,    0,   48,   49,   62,    0,    0,    0,    0,   50,
-    0,    0,    0,   53,    0,   54,   55,    0,    0,    0,
-    0,    0,    0,    0,  152,    0,  154,  155,    0,   51,
-    0,   60,   61,   63,   47,    0,   56,  131,   64,   59,
-    0,   58,    0,  162,  163,    0,    0,  164,    0,  151,
-  165,  166,  167,  152,  153,  154,  155,    0,    0,    0,
-   62,    0,    0,   23,    0,    0,   52,  158,  159,  160,
-  161,    0,  162,  163,    0,    0,  164,    0,    0,  165,
-  166,  167,    0,    0,    0,   51,    0,   60,   61,   63,
-   47,    0,   56,    0,   64,   59,    0,   58,    0,    0,
-  151,    0,    0,    0,  152,  153,  154,  155,    0,    0,
-    0,    0,    0,    0,    0,    0,   62,  156,  158,  159,
-  160,  161,   52,  162,  163,    0,    0,  164,    0,    0,
-  165,  166,  167,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,   60,    0,  135,    0,    0,   51,    0,
-    0,   61,   63,   47,    0,   56,    0,   64,   59,    0,
-   58,    0,    0,    0,  154,  155,    0,    0,    0,    0,
-    0,    0,  135,  135,  135,  135,    0,    0,   52,   62,
-    0,  162,  163,    0,    0,  164,    0,    0,  165,  166,
-  167,    0,    0,    0,  135,  135,    0,   24,   25,   26,
-   27,   28,    0,   29,   30,   31,   60,    0,    0,   32,
+    0,    0,    0,   63,    0,    0,   49,    0,  123,   49,
+    0,    0,    0,    0,    0,  211,  122,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   52,    0,
+   61,   62,   64,   48,    0,   57,    0,   65,   60,    0,
+   59,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  116,    0,    0,    0,    0,   63,
+    0,    0,   23,    0,    0,   53,    0,    0,    0,    0,
+    0,    0,  123,    0,    0,  241,   90,  123,    0,   90,
+    0,    0,    0,    0,    0,    0,   61,    0,    0,    0,
+    0,    0,   52,   90,   90,   62,   64,   48,   90,   57,
+    0,   65,   60,  275,   59,    0,   93,   93,   93,   93,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   53,    0,   63,    0,    0,    0,    0,   90,   93,
+   93,    0,    0,   93,    0,    0,    0,    0,    0,   49,
+   49,   49,   49,   49,   49,    0,   49,   49,   49,    0,
+   61,    0,   49,    0,    0,   49,   49,   49,   49,    0,
+    0,   83,   49,   49,   83,   49,   49,   49,    0,    0,
+    0,    0,   49,   49,   49,   49,   49,   49,   83,   83,
+   49,   49,   23,   83,    0,   53,    0,   49,    0,    0,
+    0,   49,    0,   49,   49,    0,  112,   25,   26,   27,
+   28,    0,   29,   30,   31,    0,    0,    0,   32,  145,
+    0,    0,  145,   83,    0,    0,    0,   86,    0,   38,
+   86,   39,   40,   41,    0,    0,  145,  145,   42,   43,
+   44,   45,   46,   47,   86,   86,   49,   50,    0,   86,
+    0,    0,    0,   51,    0,    0,    0,   54,    0,   55,
+   56,    0,   24,   25,   26,   27,   28,    0,   29,   30,
+   31,  145,    0,    0,   32,    0,    0,    0,    0,   86,
+    0,    0,    0,   87,    0,   38,   87,   39,   40,   41,
+    0,    0,    0,    0,   42,   43,   44,   45,   46,   47,
+   87,   87,   49,   50,    0,   87,    0,    0,    0,   51,
+    0,  170,    0,   54,    0,   55,   56,   90,   90,   90,
+   90,    0,    0,    0,    0,    0,   24,   25,   26,   27,
+   28,    0,   29,   30,   31,   87,    0,    0,   32,  140,
+   90,   90,  140,  152,   90,    0,    0,   66,    0,   38,
+   66,   39,   40,   41,    0,    0,  140,  140,   42,   43,
+   44,   45,   46,   47,    0,   66,   49,   50,    0,    0,
+    0,    0,    0,   51,    0,    0,    0,   54,   52,   55,
+   56,   62,   64,   48,    0,   57,  133,   65,   60,    0,
+   59,  140,    0,    0,    0,    0,    0,    0,    0,   66,
+    0,    0,   83,   83,   83,   83,    0,    0,    0,   63,
+    0,   83,    0,    0,    0,   83,   83,   83,   83,    0,
+    0,    0,    0,    0,    0,   83,   83,    0,    0,   83,
+   83,   83,   83,   83,   52,   83,   61,   62,   64,   48,
+    0,   57,    0,   65,   60,    0,   59,    0,    0,    0,
+  145,  145,  145,  145,    0,    0,    0,    0,   86,   86,
+   86,   86,    0,    0,    0,   63,    0,   86,    0,    0,
+    0,   53,   86,  145,  145,    0,    0,    0,    0,    0,
+    0,   86,   86,    0,    0,   86,   86,   86,   86,   86,
+    0,    0,   61,   52,  137,    0,   62,   64,   48,    0,
+   57,  201,   65,   60,    0,   59,    0,  156,    0,    0,
+    0,    0,    0,    0,   87,   87,   87,   87,    0,    0,
+    0,    0,    0,   87,   63,    0,  165,   53,    0,  166,
+    0,    0,  167,  168,  169,    0,    0,   87,   87,    0,
+    0,   87,   87,   87,   87,   87,    0,    0,    0,    0,
+    0,   61,    0,   52,    0,    0,   62,   64,   48,    0,
+   57,  249,   65,   60,    0,   59,    0,    0,    0,    0,
+  140,  140,  140,  140,    0,    0,    0,    0,   66,   66,
+   66,   66,    0,    0,   63,    0,   53,    0,    0,    0,
+    0,    0,    0,  140,  140,    0,    0,    0,    0,    0,
+    0,   66,   24,   25,   26,   27,   28,    0,   29,   30,
+   31,   61,    0,    0,   32,   81,    0,    0,   81,    0,
+    0,    0,    0,   89,    0,   38,   89,   39,   40,   41,
+    0,    0,   81,   81,   42,   43,   44,   45,   46,   47,
+   89,   89,   49,   50,    0,   89,   53,    0,    0,   51,
+    0,    0,    0,   54,    0,   55,   56,    0,   24,   25,
+   26,   27,   28,    0,   29,   30,   31,   81,    0,    0,
+   32,    0,    0,    0,    0,   89,    0,    0,    0,   91,
+    0,   38,   91,   39,   40,   41,    0,    0,    0,    0,
+   42,   43,   44,   45,   46,   47,   91,   91,   49,   50,
+    0,   91,    0,    0,    0,   51,  170,    0,    0,   54,
+    0,   55,   56,    0,    0,  331,    0,   24,   25,   26,
+   27,   28,    0,   29,   30,   31,    0,    0,    0,   32,
+    0,   91,    0,    0,    0,    0,    0,  159,  152,    0,
+   38,    0,   39,   40,   41,    0,    0,    0,    0,   42,
+   43,   44,   45,   46,   47,    0,    0,   49,   50,    0,
+    0,    0,    0,    0,   51,  170,    0,    0,   54,   69,
+   55,   56,   69,    0,    0,    0,    0,   24,   25,   26,
+   27,   28,    0,   29,   30,   31,   69,   69,    0,   32,
+    0,    0,    0,    0,    0,    0,    0,  152,    0,    0,
    38,    0,   39,   40,   41,    0,    0,    0,    0,   42,
-   43,   44,   45,   46,    0,    0,   48,   49,    0,    0,
-    0,   52,    0,   50,    0,    0,    0,   53,    0,   54,
-   55,    0,    0,   24,   25,   26,   27,   28,    0,   29,
-   30,   31,    0,  168,    0,   32,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,   38,    0,   39,   40,
+   43,   44,   45,   46,   47,    0,    0,   49,   50,    0,
+    0,   69,    0,    0,   51,    0,    0,    0,   54,   52,
+   55,   56,   62,   64,   48,    0,   57,    0,   65,   60,
+    0,   59,    0,    0,    0,    0,   81,   81,   81,   81,
+    0,    0,    0,    0,   89,   89,   89,   89,    0,    0,
+   63,    0,    0,   89,    0,    0,    0,    0,    0,   81,
+   81,    0,    0,    0,    0,    0,    0,   89,   89,    0,
+    0,   89,   89,   89,   89,   52,    0,   61,   62,   64,
+   48,    0,   57,  285,   65,   60,    0,   59,    0,    0,
+  154,  155,  156,  157,    0,    0,    0,    0,    0,    0,
+   91,   91,   91,   91,    0,    0,   63,  162,  163,   91,
+  164,  165,   53,    0,  166,    0,    0,  167,  168,  169,
+    0,    0,    0,   91,   91,    0,    0,   91,   91,   91,
+    0,   52,    0,   61,   62,   64,   48,    0,   57,  287,
+   65,   60,    0,   59,    0,  153,    0,    0,    0,  154,
+  155,  156,  157,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   63,  158,  160,  161,  162,  163,   53,  164,
+  165,    0,    0,  166,    0,    0,  167,  168,  169,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   61,
+   69,   69,   69,   69,   52,    0,    0,   62,   64,   48,
+    0,   57,    0,   65,   60,    0,   59,    0,    0,    0,
+    0,    0,    0,   69,   69,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   53,   63,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  257,    0,
+    0,  258,   22,   24,   25,   26,   27,   28,    0,   29,
+   30,   31,   61,    0,    0,   32,    0,    0,    0,    0,
+  159,    0,    0,    0,    0,    0,   38,    0,   39,   40,
    41,    0,    0,    0,    0,   42,   43,   44,   45,   46,
-    0,    0,   48,   49,  168,  150,    0,    0,    0,   50,
-    0,   82,    0,   53,   82,   54,   55,    0,    0,   24,
-   25,   26,   27,   28,    0,   29,   30,   31,   82,   82,
-    0,   32,    0,   82,    0,    0,  150,    0,    0,    0,
-    0,    0,   38,    0,   39,   40,   41,    0,    0,    0,
-    0,   42,   43,   44,   45,   46,    0,    0,   48,   49,
-    0,  130,    0,   82,  130,   50,    0,    0,    0,   53,
-    0,   54,   55,    0,    0,    0,    0,    0,  130,  130,
-    0,   22,   24,   25,   26,   27,   28,    0,   29,   30,
-   31,    0,   51,    0,   32,   61,   63,   47,    0,   56,
-  200,   64,   59,    0,   58,   38,    0,   39,   40,   41,
-    0,    0,    0,  130,   42,   43,   44,   45,   46,    0,
-    0,   48,   49,   62,    0,    0,    0,    0,   50,    0,
-    0,    0,   53,    0,   54,   55,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,   51,    0,
-   60,   61,   63,   47,    0,   56,  248,   64,   59,    0,
-   58,    0,    0,    0,    0,    0,    0,  152,  153,  154,
-  155,    0,    0,    0,    0,    0,    0,    0,    0,   62,
-    0,    0,  159,  160,  161,   52,  162,  163,    0,    0,
-  164,    0,    0,  165,  166,  167,    0,    0,  152,  153,
-  154,  155,    0,    0,   51,    0,   60,   61,   63,   47,
-    0,   56,  276,   64,   59,  161,   58,  162,  163,    0,
-    0,  164,    0,    0,  165,  166,  167,    0,    0,    0,
-    0,    0,    0,    0,    0,   62,    0,    0,    0,    0,
-    0,   52,   82,   82,   82,   82,    0,    0,    0,    0,
-    0,   82,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,   60,    0,   82,   82,    0,   51,   82,   82,
-   61,   63,   47,    0,   56,  278,   64,   59,    0,   58,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,  130,  130,  130,  130,    0,   52,   62,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,  130,  130,   24,   25,   26,   27,
-   28,    0,   29,   30,   31,   60,    0,    0,   32,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,   38,
-    0,   39,   40,   41,    0,    0,    0,    0,   42,   43,
-   44,   45,   46,    0,    0,   48,   49,    0,    0,    0,
-   52,    0,   50,    0,  136,    0,   53,  136,   54,   55,
-    0,    0,   24,   25,   26,   27,   28,    0,   29,   30,
-   31,  136,  136,    0,   32,    0,  136,    0,    0,    0,
-    0,    0,    0,    0,    0,   38,    0,   39,   40,   41,
-    0,    0,    0,    0,   42,   43,   44,   45,   46,    0,
-    0,   48,   49,    0,  136,    0,  136,    0,   50,    0,
-  119,    0,   53,  119,   54,   55,    0,    0,   24,   25,
-   26,   27,   28,    0,   29,   30,   31,  119,  119,    0,
-   32,    0,  119,    0,    0,    0,  136,    0,    0,    0,
-    0,   38,    0,   39,   40,   41,    0,    0,    0,    0,
-   42,   43,   44,   45,   46,    0,    0,   48,   49,    0,
-  119,    0,  119,    0,   50,    0,    0,    0,   53,    0,
-   54,   55,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,   24,   25,   26,   27,   28,    0,   29,   30,   31,
-    0,   51,  119,   32,   61,   63,   47,    0,   56,    0,
-   64,   59,    0,   58,   38,    0,   39,   40,   41,    0,
-    0,    0,    0,   42,   43,   44,   45,   46,    0,    0,
-   48,   49,   62,    0,    0,    0,    0,   50,    0,    0,
-    0,   53,    0,   54,   55,    0,    0,    0,    0,    0,
-  143,    0,    0,  143,    0,    0,    0,    0,    0,   60,
-    0,    0,    0,    0,    0,    0,    0,  143,  143,    0,
-    0,    0,  143,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,   52,  136,  136,  136,  136,    0,
-  143,    0,  143,    0,  136,    0,    0,    0,  136,  136,
-  136,  136,    0,    0,    0,    0,    0,  136,  136,    0,
-    0,  136,  136,  136,  136,  136,    0,  136,  136,    0,
-    0,  136,  143,    0,  136,  136,  136,    0,    0,    0,
-    0,  129,    0,    0,  129,    0,    0,    0,    0,    0,
-    0,  119,  119,  119,  119,    0,    0,    0,  129,  129,
-  119,    0,    0,  129,  119,  119,  119,  119,    0,    0,
-    0,    0,    0,  119,  119,    0,    0,  119,  119,  119,
-  119,  119,    0,  119,  119,    0,  104,  119,    0,  104,
-  119,  119,  119,  129,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,  104,  104,    0,    0,    0,  104,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,  129,    0,   24,   25,   26,   27,   28,
-    0,   29,   30,   31,    0,    0,  104,   32,  104,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,   38,    0,
+   47,    0,    0,   49,   50,    0,    0,   53,  170,    0,
+   51,    0,  129,    0,   54,  129,   55,   56,    0,   24,
+   25,   26,   27,   28,    0,   29,   30,   31,    0,  129,
+  129,   32,    0,    0,  129,    0,    0,    0,    0,    0,
+  152,    0,   38,    0,   39,   40,   41,    0,    0,    0,
+    0,   42,   43,   44,   45,   46,   47,    0,    0,   49,
+   50,    0,  129,    0,  129,    0,   51,    0,    0,    0,
+   54,  153,   55,   56,  153,   24,   25,   26,   27,   28,
+    0,   29,   30,   31,    0,    0,    0,   32,  153,  153,
+    0,    0,    0,  153,  129,    0,    0,    0,   38,    0,
    39,   40,   41,    0,    0,    0,    0,   42,   43,   44,
-   45,   46,    0,    0,   48,   49,    0,    0,    0,    0,
-    0,   50,    0,    0,    0,   53,    0,   54,   55,    0,
-    0,  143,  143,  143,  143,    0,    0,    0,    0,    0,
-  143,    0,    0,    0,  143,  143,  143,  143,    0,    0,
-    0,    0,    0,  143,  143,    0,    0,  143,  143,  143,
-  143,  143,    0,  143,  143,  145,    0,  143,  145,    0,
-  143,  143,  143,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,  145,  145,    0,    0,    0,  145,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,   83,    0,    0,   83,    0,  145,    0,    0,
-    0,    0,  129,  129,  129,  129,    0,    0,    0,   83,
-   83,  129,    0,    0,    0,  129,  129,  129,  129,    0,
-    0,    0,    0,    0,  129,  129,    0,  145,  129,  129,
-  129,  129,  129,    0,  129,  129,    0,    0,  129,    0,
-    0,  129,  129,  129,   83,    0,    0,  104,  104,  104,
-  104,    0,    0,    0,    0,    0,  104,    0,    0,    0,
-  104,  104,  104,  104,    0,    0,    0,  131,    0,  104,
-  104,    0,    0,  104,  104,  104,  104,  104,    0,  104,
-  104,    0,    0,  104,  131,  131,  104,  104,  104,  131,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,  146,    0,    0,    0,    0,    0,  131,    0,  131,
-    0,    0,    0,    0,    0,    0,    0,    0,  146,  146,
-    0,    0,    0,  146,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,  131,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,  146,    0,  146,    0,    0,   96,    0,    0,   96,
-    0,    0,    0,    0,    0,    0,  145,  145,  145,  145,
-    0,    0,    0,   96,   96,  145,    0,    0,   96,  145,
-  145,  145,  145,  146,    0,    0,    0,    0,  145,  145,
-    0,    0,  145,  145,  145,  145,  145,    0,  145,  145,
-   58,    0,  145,   58,    0,  145,  145,  145,   96,    0,
-    0,    0,    0,   83,   83,   83,   83,   58,   58,    0,
-    0,    0,   58,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,   83,   83,    0,   96,   83,
-    0,    0,    0,   61,    0,    0,    0,    0,    0,    0,
-    0,    0,   58,    0,    0,    0,    0,    0,    0,    0,
-   61,   61,    0,    0,    0,   61,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,   58,    0,    0,    0,    0,    0,  131,  131,
-  131,  131,    0,   61,    0,   61,    0,  131,    0,    0,
-    0,  131,  131,  131,  131,   59,    0,    0,   59,    0,
-  131,  131,    0,    0,  131,  131,  131,  131,  131,    0,
-  131,  131,   59,   59,  131,   61,    0,  131,  131,  131,
-    0,    0,  146,  146,  146,  146,    0,    0,    0,    0,
-    0,  146,    0,    0,    0,  146,  146,  146,  146,    0,
-    0,    0,    0,    0,  146,  146,    0,   59,  146,  146,
-  146,  146,  146,    0,  146,  146,    0,    0,  146,    0,
-    0,  146,  146,  146,    0,    0,    0,  145,    0,    0,
-  145,    0,    0,    0,    0,    0,    0,   96,   96,   96,
-   96,    0,    0,    0,  145,  145,   96,    0,    0,  145,
-   96,   96,   96,   96,    0,    0,    0,    0,    0,   96,
-   96,    0,    0,   96,   96,   96,   96,   96,    0,   96,
-   96,  132,    0,   96,  132,    0,   96,   96,   96,  145,
-    0,   58,   58,   58,   58,    0,    0,    0,  132,  132,
-   58,    0,    0,  132,   58,   58,   58,   58,    0,    0,
-    0,    0,    0,   58,   58,    0,    0,   58,   58,   58,
-   58,   58,    0,   58,   58,    0,    0,   58,    0,    0,
-   58,   58,   58,  132,   61,   61,   61,   61,    0,  284,
-    0,    0,    0,   61,  157,    0,    0,   61,   61,   61,
-   61,    0,    0,    0,    0,    0,   61,   61,    0,    0,
-   61,   61,   61,   61,   61,   95,   61,   61,   95,    0,
-   61,    0,  168,   61,   61,   61,    0,    0,    0,    0,
-    0,    0,   95,   95,    0,    0,    0,   95,    0,    0,
-    0,    0,    0,    0,    0,    0,   59,   59,   59,   59,
-    0,    0,    0,    0,  150,    0,    0,  102,    0,    0,
-  102,    0,    0,    0,    0,    0,    0,   95,   59,   59,
-    0,    0,    0,    0,  102,  102,    0,    0,    0,  102,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   95,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,  109,  102,
-    0,  109,    0,    0,    0,    0,    0,    0,  145,  145,
-  145,  145,    0,    0,    0,  109,  109,  145,    0,    0,
-  109,  145,  145,  145,  145,    0,    0,    0,    0,    0,
-  145,  145,    0,    0,  145,  145,  145,  145,  145,    0,
-  145,  145,   92,    0,  145,   92,    0,  145,  145,  145,
-  109,    0,  132,  132,  132,  132,    0,    0,    0,   92,
-   92,  132,    0,    0,   92,  132,  132,  132,  132,    0,
-    0,    0,    0,    0,  132,  132,    0,    0,  132,  132,
-  132,  132,  132,   93,  132,  132,   93,    0,  132,    0,
-    0,  132,  132,  132,   92,    0,    0,    0,    0,    0,
-   93,   93,  151,    0,    0,   93,  152,  153,  154,  155,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,  156,
-  158,  159,  160,  161,    0,  162,  163,    0,    0,  164,
-    0,    0,  165,  166,  167,   93,   95,   95,   95,   95,
-    0,    0,    0,    0,    0,   95,    0,    0,    0,   95,
-   95,   95,   95,    0,    0,    0,    0,    0,   95,   95,
-    0,    0,   95,   95,   95,   95,   95,    0,   95,   95,
-    0,    0,   95,    0,    0,   95,   95,   95,  102,  102,
-  102,  102,    0,    0,    0,    0,    0,  102,    0,    0,
-    0,  102,  102,  102,  102,   71,    0,    0,   71,    0,
-  102,  102,    0,    0,  102,  102,  102,  102,  102,    0,
-  102,  102,   71,   71,  102,    0,    0,  102,  102,  102,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,  109,
-  109,  109,  109,    0,    0,    0,    0,    0,  109,    0,
-    0,    0,  109,  109,  109,  109,    0,   71,    0,    0,
-    0,  109,  109,    0,    0,  109,  109,  109,  109,  109,
-    0,  109,  109,    0,    0,  109,    0,    0,  109,  109,
-  109,    0,    0,   92,   92,   92,   92,    0,    0,    0,
-    0,    0,   92,    0,    0,    0,   92,   92,   92,   92,
-    0,    0,    0,    0,    0,   92,   92,    0,    0,   92,
-   92,   92,   92,   92,   87,   92,   92,   87,    0,   92,
-    0,    0,    0,    0,   93,   93,   93,   93,    0,    0,
-    0,   87,   87,   93,    0,    0,   87,   93,   93,   93,
-   93,    0,    0,    0,    0,    0,   93,   93,    0,    0,
-   93,   93,   93,   93,   93,   88,   93,   93,   88,    0,
-   93,    0,    0,    0,    0,    0,   87,    0,    0,    0,
-    0,    0,   88,   88,    0,    0,    0,   88,    0,    0,
+   45,   46,   47,    0,  139,   49,   50,  139,    0,    0,
+    0,  153,   51,  153,    0,    0,   54,    0,   55,   56,
+    0,  139,  139,    0,    0,    0,  139,    0,   24,   25,
+   26,   27,   28,    0,   29,   30,   31,    0,    0,    0,
+   32,    0,    0,  153,    0,    0,    0,    0,    0,  114,
+    0,   38,  114,   39,   40,   41,  139,    0,    0,    0,
+   42,   43,   44,   45,   46,   47,  114,  114,   49,   50,
+    0,  114,    0,    0,    0,   51,    0,    0,    0,   54,
+    0,   55,   56,    0,    0,    0,  139,    0,  153,    0,
+    0,    0,  154,  155,  156,  157,    0,    0,    0,  114,
+  155,  114,    0,  155,    0,    0,  158,  160,  161,  162,
+  163,    0,  164,  165,    0,    0,  166,  155,  155,  167,
+  168,  169,  155,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  129,  129,  129,  129,    0,    0,    0,
+    0,    0,  129,    0,    0,    0,  129,  129,  129,  129,
+    0,    0,  155,    0,    0,    0,  129,  129,    0,  141,
+  129,  129,  129,  129,  129,    0,  129,  129,    0,    0,
+  129,    0,    0,  129,  129,  129,  141,  141,    0,    0,
+    0,  141,  155,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  153,  153,  153,  153,    0,    0,    0,    0,
+    0,  153,    0,    0,    0,  153,  153,  153,  153,  141,
+    0,  141,    0,    0,    0,  153,  153,    0,    0,  153,
+  153,  153,  153,  153,    0,  153,  153,    0,    0,  153,
+    0,    0,  153,  153,  153,  139,  139,  139,  139,   88,
+    0,  141,   88,    0,  139,    0,    0,    0,  139,  139,
+  139,  139,    0,    0,    0,    0,   88,   88,  139,  139,
+    0,   88,  139,  139,  139,  139,  139,    0,  139,  139,
+    0,    0,  139,    0,    0,  139,  139,  139,    0,    0,
+  114,  114,  114,  114,    0,    0,    0,    0,    0,  114,
+    0,   88,    0,  114,  114,  114,  114,    0,    0,    0,
+    0,  156,    0,  114,  114,    0,    0,  114,  114,  114,
+  114,  114,    0,  114,  114,    0,    0,  114,  156,  156,
+  114,  114,  114,  156,    0,    0,    0,    0,    0,    0,
+    0,  155,  155,  155,  155,    0,    0,    0,    0,    0,
+  155,    0,    0,    0,  155,  155,  155,  155,    0,    0,
+    0,  156,    0,  156,  155,  155,    0,    0,  155,  155,
+  155,  155,  155,  106,  155,  155,  106,    0,  155,    0,
+    0,  155,  155,  155,    0,    0,    0,    0,    0,    0,
+  106,  106,    0,  156,    0,  106,    0,    0,    0,    0,
+  141,  141,  141,  141,    0,    0,    0,    0,    0,  141,
+    0,    0,    0,  141,  141,  141,  141,    0,    0,    0,
+    0,    0,    0,  141,  141,  106,    0,  141,  141,  141,
+  141,  141,   68,  141,  141,   68,    0,  141,    0,    0,
+  141,  141,  141,    0,    0,    0,    0,    0,    0,   68,
+   68,    0,    0,    0,   68,  106,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,   89,    0,    0,   89,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   88,   89,   89,
-    0,    0,    0,   89,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   85,    0,    0,
-   85,    0,    0,    0,    0,    0,   71,   71,   71,   71,
-    0,    0,    0,   89,   85,   85,    0,    0,    0,   85,
-    0,    0,    0,    0,    0,    0,    0,    0,   71,   71,
-    0,    0,    0,   86,    0,    0,   86,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,   85,
-   86,   86,    0,    0,    0,   86,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,   84,
-    0,    0,   84,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,   86,   84,   84,    0,    0,
-    0,   84,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   71,    0,    0,
+   88,   88,   88,   88,   68,    0,    0,    0,    0,   88,
+    0,    0,    0,    0,   71,   71,    0,    0,    0,   71,
+    0,    0,    0,   88,   88,    0,    0,   88,   88,   88,
+   88,   88,    0,    0,   68,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   71,    0,   71,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,   87,   87,   87,   87,    0,
-    0,   84,    0,    0,   87,    0,    0,    0,   87,   87,
-   87,   87,    0,    0,    0,    0,    0,   87,   87,    0,
-    0,   87,   87,   87,   87,   87,   72,   87,   87,   72,
-    0,    0,    0,    0,    0,    0,   88,   88,   88,   88,
-    0,    0,    0,   72,   72,   88,    0,    0,   72,   88,
-   88,   88,   88,    0,    0,    0,    0,    0,   88,   88,
-    0,    0,   88,   88,   88,   88,   88,    0,   88,   88,
-    0,    0,   89,   89,   89,   89,    0,    0,   72,    0,
-    0,   89,    0,    0,    0,   89,   89,   89,   89,    0,
-    0,    0,    0,    0,   89,   89,    0,    0,   89,   89,
-   89,   89,   89,    0,   89,   89,    0,    0,   85,   85,
-   85,   85,    0,    0,    0,    0,    0,   85,    0,    0,
-    0,   85,   85,   85,   85,    0,    0,    0,    0,    0,
-   85,   85,    0,    0,   85,   85,   85,   85,   85,    0,
-   85,   85,    0,    0,   86,   86,   86,   86,    0,    0,
-    0,    0,    0,   86,    0,    0,    0,   86,   86,   86,
-   86,    0,    0,    0,    0,    0,   86,   86,    0,    0,
-   86,   86,   86,   86,   86,    0,   86,   86,    0,    0,
-   84,   84,   84,   84,    0,    0,    0,    0,    0,   84,
-    0,    0,    0,   84,   84,   84,   84,   73,    0,    0,
-   73,    0,   84,   84,    0,    0,   84,   84,   84,   84,
-   84,    0,   84,   84,   73,   73,    0,    0,    0,   73,
+    0,    0,  156,  156,  156,  156,    0,    0,    0,    0,
+    0,  156,    0,    0,    0,  156,  156,  156,  156,   71,
+    0,    0,  170,    0,    0,  156,  156,    0,    0,  156,
+  156,  156,  156,  156,  105,  156,  156,  105,    0,  156,
+    0,    0,  156,  156,  156,    0,    0,    0,    0,    0,
+    0,  105,  105,    0,  152,    0,  105,    0,    0,    0,
+    0,    0,    0,    0,  106,  106,  106,  106,    0,    0,
+    0,    0,    0,  106,    0,    0,    0,  106,  106,  106,
+  106,    0,    0,    0,    0,    0,  105,  106,  106,    0,
+    0,  106,  106,  106,  106,  106,  155,  106,  106,  155,
+    0,  106,    0,    0,  106,  106,  106,    0,    0,    0,
+    0,    0,    0,  155,  155,    0,  105,    0,  155,    0,
+    0,    0,    0,   68,   68,   68,   68,    0,    0,    0,
+    0,    0,   68,    0,    0,    0,   68,   68,   68,   68,
+    0,    0,    0,    0,    0,    0,   68,   68,  155,    0,
+   68,   68,   68,   68,   68,    0,   68,   68,    0,    0,
+   68,    0,    0,   68,   68,   68,    0,    0,   71,   71,
+   71,   71,  142,    0,    0,  142,    0,   71,    0,    0,
+    0,   71,   71,   71,   71,    0,    0,    0,    0,  142,
+  142,   71,   71,    0,  142,   71,   71,   71,   71,   71,
+    0,   71,   71,    0,    0,   71,    0,    0,   71,   71,
+   71,    0,    0,    0,    0,    0,  154,  112,  156,  157,
+  112,    0,    0,    0,  142,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  112,  112,  164,  165,    0,  112,
+  166,    0,    0,  167,  168,  169,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-   74,    0,    0,   74,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,   74,   74,   73,
-    0,    0,   74,    0,    0,    0,    0,   72,   72,   72,
-   72,    0,    0,    0,    0,    0,   72,    0,    0,    0,
-   72,   72,   72,   72,   75,    0,    0,   75,    0,   72,
-   72,    0,   74,   72,   72,   72,   72,   72,    0,   72,
-   72,   75,   75,    0,    0,    0,   75,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,  123,    0,    0,
-  123,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,  123,  123,   75,    0,    0,  123,
-    0,    0,    0,    0,    0,    0,    0,    0,   94,    0,
-    0,   94,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,   94,   94,    0,    0,  123,
-   94,    0,    0,    0,    0,    0,    0,    0,    0,  134,
-    0,    0,  134,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,  134,  134,    0,    0,
-   94,  134,    0,    0,    0,    0,    0,    0,    0,    0,
-   76,    0,    0,   76,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,   77,   76,   76,   77,
-    0,  134,   76,    0,    0,    0,    0,    0,   73,   73,
-   73,   73,    0,   77,   77,    0,    0,   73,   77,    0,
-    0,   73,   73,   73,   73,    0,    0,    0,    0,    0,
-   73,   73,   76,    0,   73,   73,   73,   73,   73,    0,
-   73,   74,   74,   74,   74,    0,    0,    0,   77,    0,
-   74,    0,    0,    0,   74,   74,    0,   74,   78,    0,
-    0,   78,    0,   74,   74,    0,    0,   74,   74,   74,
-   74,   74,    0,   74,   79,   78,   78,   79,    0,    0,
-   78,    0,    0,    0,    0,   75,   75,   75,   75,    0,
-    0,   79,   79,    0,   75,    0,   79,    0,   75,   75,
-    0,    0,    0,    0,    0,    0,    0,   75,   75,    0,
-   78,   75,   75,   75,   75,   75,    0,   75,  123,  123,
-  123,  123,    0,    0,    0,    0,   79,  123,    0,    0,
-    0,  123,  123,    0,    0,    0,    0,    0,    0,   81,
-  123,  123,   81,    0,  123,  123,  123,  123,  123,   94,
-   94,   94,   94,    0,    0,    0,   81,   81,   94,    0,
-    0,   81,   94,   94,    0,    0,    0,    0,    0,    0,
-    0,   94,   94,    0,    0,   94,   94,   94,   94,   94,
-  134,  134,  134,  134,    0,    0,    0,    0,    0,  134,
-    0,   81,    0,  134,  134,    0,    0,    0,    0,    0,
-    0,    0,  134,  134,    0,    0,  134,  134,  134,  134,
-  134,   76,   76,   76,   76,    0,    0,    0,    0,    0,
-   76,    0,    0,    0,    0,   76,    0,   77,   77,   77,
-   77,    0,    0,   76,   76,    0,   77,   76,   76,   76,
-   76,   76,    0,    0,    0,    0,    0,    0,    0,   77,
-   77,    0,    0,   77,   77,   77,   77,   77,    0,    0,
+    0,    0,    0,    0,    0,  105,  105,  105,  105,  112,
+    0,    0,    0,    0,  105,    0,    0,    0,  105,  105,
+  105,  105,    0,    0,    0,    0,    0,    0,  105,  105,
+    0,    0,  105,  105,  105,  105,  105,  119,  105,  105,
+  119,    0,  105,    0,    0,  105,  105,  105,    0,    0,
+    0,    0,    0,    0,  119,  119,    0,    0,    0,  119,
+    0,    0,    0,    0,    0,    0,    0,  155,  155,  155,
+  155,    0,    0,    0,    0,    0,  155,    0,    0,    0,
+  155,  155,  155,  155,    0,    0,    0,    0,    0,  119,
+  155,  155,    0,    0,  155,  155,  155,  155,  155,  102,
+  155,  155,  102,    0,  155,    0,    0,  155,  155,  155,
+    0,    0,    0,    0,    0,    0,  102,  102,    0,    0,
+    0,  102,    0,    0,    0,    0,    0,    0,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  142,  142,  142,  142,  103,    0,    0,
+  103,  102,  142,    0,    0,    0,  142,  142,  142,  142,
+    0,    0,    0,    0,  103,  103,  142,  142,    0,  103,
+  142,  142,  142,  142,  142,    0,  142,  142,    0,    0,
+  142,    0,    0,  142,  142,  142,    0,    0,  112,  112,
+  112,  112,   97,    0,    0,   97,    0,  112,    0,  103,
+    0,  112,  112,  112,  112,    0,    0,    0,    0,   97,
+   97,  112,  112,    0,   97,  112,  112,  112,  112,  112,
+    0,  112,  112,    0,    0,  112,    0,    0,  112,  112,
+  112,    0,    0,   98,    0,    0,   98,    0,    0,    0,
+    0,    0,    0,    0,   97,    0,    0,    0,    0,    0,
+   98,   98,    0,    0,    0,   98,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  119,  119,
+  119,  119,   99,    0,    0,   99,    0,  119,    0,    0,
+    0,  119,  119,  119,  119,   98,    0,    0,    0,   99,
+   99,  119,  119,    0,   99,  119,  119,  119,  119,  119,
+    0,  119,  119,    0,    0,  119,    0,    0,  119,  119,
+  119,    0,    0,    0,    0,    0,    0,    0,   95,    0,
+    0,   95,    0,    0,   99,    0,    0,    0,    0,    0,
+  102,  102,  102,  102,    0,   95,   95,    0,    0,  102,
+   95,    0,    0,  102,  102,  102,  102,    0,    0,    0,
+    0,    0,    0,  102,  102,    0,    0,  102,  102,  102,
+  102,  102,    0,  102,  102,    0,   96,  102,    0,   96,
+   95,    0,  170,    0,    0,    0,    0,    0,  103,  103,
+  103,  103,    0,   96,   96,    0,    0,  103,   96,    0,
+    0,  103,  103,  103,  103,    0,    0,    0,    0,    0,
+    0,  103,  103,    0,  152,  103,  103,  103,  103,  103,
+    0,  103,  103,    0,    0,  103,    0,    0,   96,    0,
+    0,    0,    0,   97,   97,   97,   97,    0,    0,    0,
+    0,    0,   97,    0,    0,    0,   97,   97,   97,   97,
+  170,    0,    0,    0,    0,    0,   97,   97,    0,    0,
+   97,   97,   97,   97,   97,    0,   97,   97,    0,    0,
+    0,    0,    0,    0,   98,   98,   98,   98,   94,    0,
+    0,   94,  152,   98,    0,    0,    0,   98,   98,   98,
+   98,    0,    0,    0,    0,   94,   94,   98,   98,    0,
+   94,   98,   98,   98,   98,   98,    0,   98,   98,    0,
+    0,    0,    0,   99,   99,   99,   99,   82,    0,    0,
+   82,    0,   99,    0,    0,    0,   99,   99,   99,   99,
+   94,    0,    0,    0,   82,   82,   99,   99,    0,   82,
+   99,   99,   99,   99,   99,    0,   99,   99,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   95,
+   95,   95,   95,   84,    0,    0,   84,    0,   95,   82,
+    0,    0,   95,   95,   95,   95,  154,  155,  156,  157,
+   84,   84,   95,   95,    0,   84,   95,   95,   95,   95,
+   95,    0,   95,   95,  163,    0,  164,  165,    0,    0,
+  166,    0,    0,  167,  168,  169,    0,   96,   96,   96,
+   96,   85,    0,    0,   85,   84,   96,    0,    0,    0,
+   96,   96,   96,   96,    0,    0,    0,    0,   85,   85,
+   96,   96,    0,   85,   96,   96,   96,   96,   96,    0,
+   96,   96,    0,    0,  154,  155,  156,  157,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  160,
+  161,  162,  163,   85,  164,  165,    0,    0,  166,    0,
+    0,  167,  168,  169,  133,    0,    0,  133,    0,    0,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,   78,
-   78,   78,   78,    0,    0,    0,    0,    0,   78,    0,
-    0,    0,    0,    0,    0,   79,   79,   79,   79,    0,
-    0,   78,   78,    0,   79,   78,   78,   78,   78,   78,
-    0,    0,   91,    0,    0,    0,    0,   79,   79,    0,
-  104,   79,   79,   79,   79,  111,  113,    0,    0,    0,
-    0,    0,  125,  126,  127,  128,  129,  130,    0,    0,
-  133,  134,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  133,  133,    0,    0,    0,  133,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   94,
+   94,   94,   94,  144,    0,    0,  144,    0,   94,    0,
+    0,    0,   94,   94,   94,   94,  133,    0,    0,    0,
+  144,  144,   94,   94,    0,  144,   94,   94,   94,   94,
+   94,    0,   94,   94,    0,    0,    0,    0,   82,   82,
+   82,   82,    0,    0,    0,    0,    0,   82,    0,    0,
+    0,   82,   82,   82,   82,  144,    0,    0,    0,    0,
+    0,   82,   82,    0,    0,   82,   82,   82,   82,   82,
+    0,   82,   82,    0,    0,    0,    0,  104,    0,    0,
+  104,    0,    0,    0,   84,   84,   84,   84,    0,    0,
+    0,    0,    0,   84,  104,  104,    0,   84,   84,  104,
+   84,    0,    0,    0,    0,    0,    0,   84,   84,    0,
+    0,   84,   84,   84,   84,   84,    0,   84,    0,    0,
+   92,    0,    0,   92,    0,    0,    0,    0,    0,  104,
+    0,    0,   85,   85,   85,   85,    0,   92,   92,    0,
+    0,   85,   92,    0,    0,   85,   85,    0,    0,    0,
+    0,    0,    0,    0,    0,   85,   85,    0,   93,   85,
+   85,   85,   85,   85,    0,   85,  107,    0,  293,    0,
+    0,  114,   92,  159,    0,    0,    0,    0,    0,  127,
+  128,  129,  130,  131,  132,    0,    0,  135,  136,    0,
+    0,    0,    0,    0,  143,  133,  133,  133,  133,    0,
+    0,  170,    0,    0,  133,    0,    0,    0,  133,  133,
+  159,    0,    0,    0,    0,    0,    0,    0,  133,  133,
+  186,    0,  133,  133,  133,  133,  133,    0,    0,    0,
+    0,    0,    0,  152,  144,  144,  144,  144,  170,    0,
+  159,    0,    0,  144,    0,    0,    0,  144,  144,    0,
+    0,    0,    0,    0,    0,    0,    0,  144,  144,    0,
+    0,  144,  144,  144,  144,  144,    0,    0,  170,    0,
+  152,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  224,  225,  226,  227,  228,  229,  230,  231,  232,
+  233,  234,  235,  236,  237,    0,    0,    0,  170,    0,
+  152,    0,    0,    0,    0,    0,  251,    0,  104,  104,
+  104,  104,    0,    0,    0,    0,    0,  104,    0,    0,
+    0,  104,  104,    0,    0,    0,    0,    0,    0,    0,
+  152,  104,  104,    0,    0,  104,  104,  104,  104,  104,
     0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-   81,   81,   81,   81,    0,    0,    0,    0,    0,   81,
-    0,    0,  183,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,   81,   81,    0,    0,   81,   81,   81,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,  215,    0,    0,    0,    0,
-    0,    0,    0,  223,  224,  225,  226,  227,  228,  229,
-  230,  231,  232,  233,  234,  235,  236,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,  297,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-    0,    0,    0,    0,    0,    0,  313,
+    0,   92,   92,   92,   92,    0,    0,    0,    0,    0,
+   92,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   92,   92,    0,    0,   92,   92,
+    0,    0,    0,    0,    0,    0,  306,    0,    0,    0,
+    0,  153,    0,    0,    0,  154,  155,  156,  157,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  158,
+  160,  161,  162,  163,    0,  164,  165,    0,    0,  166,
+    0,  324,  167,  168,  169,    0,    0,    0,  153,    0,
+    0,    0,  154,  155,  156,  157,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  158,  160,  161,  162,
+  163,    0,  164,  165,    0,    0,  166,    0,  153,  167,
+  168,  169,  154,  155,  156,  157,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  160,  161,  162,
+  163,    0,  164,  165,    0,    0,  166,    0,    0,  167,
+  168,  169,  154,  155,  156,  157,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  161,  162,
+  163,    0,  164,  165,    0,    0,  166,    0,    0,  167,
+  168,  169,
 };
 short yycheck[] = {                                      13,
-   59,   13,   91,   17,   59,   59,   36,   93,  182,  194,
-   41,  123,   59,   44,  257,   41,   59,   40,   44,   33,
-   34,   35,   36,   91,   40,   88,   59,   58,   59,   43,
-   41,   40,   63,   45,  123,   41,   50,   63,   91,   41,
-  257,   41,   41,   40,   56,   40,   59,   40,   60,   41,
-  257,   41,   40,  116,   41,  123,  188,   59,  190,   40,
-   59,   91,   93,   41,   78,   91,   41,   36,   91,   59,
-  123,   40,   59,   41,  278,   41,  123,   41,   92,  294,
-  295,   95,   94,   97,   96,   99,   98,  101,  100,   41,
-  102,   59,   41,  123,  106,   41,   40,  123,   41,   41,
-  123,  123,   41,   44,   59,   44,    0,  123,  276,  277,
-  123,   44,   40,  287,  123,  300,  179,   59,  303,   58,
-   59,  184,   59,   59,  260,   59,  123,  141,  123,  123,
-  257,   40,  144,  145,  146,  147,  148,  149,  150,   33,
-   40,   40,   36,   37,   38,  257,   40,  295,   42,   43,
-  335,   45,   41,    6,   93,    8,  168,  169,  170,  171,
-  172,  173,  174,  125,  178,   59,  298,  299,   91,   41,
-   64,  185,   41,  305,    0,   59,   91,  125,   31,   32,
-   40,   93,   59,   41,   36,   40,  198,  125,   83,   59,
-  125,   93,  204,  205,  206,  125,  328,   91,  125,  211,
-  125,   41,   41,  257,  123,   91,   93,   33,  294,  295,
-   36,   37,   38,   41,   40,   59,   42,   43,   41,   45,
-   41,   59,   93,   59,  313,  237,   59,  239,  258,  123,
-   41,  125,  126,   59,  326,  294,  295,  123,   64,  294,
-  295,  272,  273,  274,  275,  259,   13,  261,  269,  263,
-  264,  294,  295,  267,   -1,  281,  270,  269,   93,  285,
-  286,  287,  288,  294,  295,   91,   93,  298,    0,   -1,
-  282,  123,  298,  299,  300,  301,  302,   93,  304,  305,
-   -1,   -1,  308,  294,  295,  311,  312,  313,  294,  295,
-  302,   -1,  306,   -1,  294,  295,   -1,  123,   -1,  125,
-  126,   33,  294,  295,   36,   37,   38,   -1,   40,   -1,
-   42,   43,   -1,   45,  326,   -1,  294,  295,  332,  294,
-  295,   -1,  336,  272,  273,  274,  275,   59,  294,  295,
-  294,  295,   64,  272,  273,  274,  275,   -1,   -1,  294,
-  295,   -1,  294,  295,   -1,  294,  295,   -1,  294,  295,
-   -1,  294,  295,  294,  295,  294,  295,  294,  295,   91,
-  294,  295,  256,  257,  258,  259,  260,  261,   -1,  263,
-  264,  265,  266,  267,  268,  269,  270,  271,  272,  273,
-  274,  275,  294,  295,   -1,  279,  280,   -1,  282,  283,
-  284,  123,  294,  295,  126,  289,  290,  291,  292,  293,
-   41,  287,  296,  297,   91,  257,   -1,  294,  295,  303,
-  262,   -1,   -1,  307,   -1,  309,  310,   -1,   59,  305,
-   -1,   -1,  308,  294,  295,  311,  312,  313,   -1,   -1,
-  256,  257,  258,  259,  260,  261,  123,  263,  264,  265,
-  266,  267,  268,  269,  270,  271,  272,  273,  274,  275,
-   -1,   -1,   93,  279,  280,   -1,  282,  283,  284,  294,
-  295,   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,
-  296,  297,   91,   -1,   -1,   -1,   -1,  303,  294,  295,
-   -1,  307,   91,  309,  310,   26,   33,   -1,   -1,   36,
-   37,   38,   -1,   40,   41,   42,   43,   44,   45,   48,
-   49,   42,   -1,   -1,  123,   -1,   47,   -1,   49,   -1,
-   -1,   58,   59,   -1,  123,  125,   63,   64,   -1,   -1,
-   61,   62,   63,   64,  256,  257,  258,  259,  260,  261,
-   -1,  263,  264,  265,   -1,   -1,   -1,  269,   -1,   88,
-  272,  273,  274,  275,   91,   -1,   93,  279,  280,   -1,
-  282,  283,  284,   63,   -1,   -1,   -1,  289,  290,  291,
-  292,  293,   91,   -1,  296,  297,  107,  116,  266,  267,
-  268,  303,  270,  271,  123,  307,  123,  309,  310,  126,
-   33,   91,   -1,   36,   37,   38,   -1,   40,   41,   42,
-   43,   44,   45,   -1,  123,   -1,   -1,   -1,  285,  286,
-  287,  288,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
-   63,   64,   -1,  123,  301,  302,   -1,  304,  305,   -1,
-   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,   -1,
-  179,  272,  273,  274,  275,  184,   -1,   -1,   -1,   33,
-   93,   -1,   36,   37,   38,   -1,   40,   -1,   42,   43,
-   -1,   45,   -1,  294,  295,   -1,  266,  267,  268,   -1,
-  270,  271,   -1,   -1,   -1,   59,  285,  286,  287,  288,
-   64,   -1,   -1,  126,   -1,   -1,  285,  286,  287,  288,
-  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,
-   -1,   -1,  311,  312,  313,  304,  305,   91,   -1,  308,
-   -1,   -1,  311,  312,  313,   -1,   -1,   -1,   -1,   -1,
-  257,  258,  259,  260,  261,   -1,  263,  264,  265,   -1,
-   -1,   -1,  269,   -1,   -1,  272,  273,  274,  275,  123,
-   -1,   -1,  126,  280,  281,  282,  283,  284,  285,  286,
-  287,  288,  289,  290,  291,  292,  293,  294,  295,  296,
-  297,  298,  299,  300,  301,  302,  303,  304,  305,   -1,
-  307,  308,  309,  310,  311,  312,  313,   91,   -1,   -1,
-   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,  308,
-   -1,   -1,  311,  312,  313,   -1,   -1,   -1,  298,  299,
-  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,  123,
-   -1,  311,  312,  313,  257,  258,  259,  260,  261,   -1,
-  263,  264,  265,   -1,   -1,   -1,  269,   -1,   -1,  272,
-  273,  274,  275,   -1,   -1,   -1,   -1,  280,  281,  282,
-  283,  284,  285,  286,  287,  288,  289,  290,  291,  292,
-  293,  294,  295,  296,  297,  298,  299,  300,  301,  302,
-  303,  304,  305,   -1,  307,  308,  309,  310,  311,  312,
-  313,   91,  256,  257,  258,  259,  260,  261,   -1,  263,
-  264,  265,   -1,   41,   -1,  269,   44,   -1,  272,  273,
-  274,  275,   -1,   -1,   -1,  279,  280,   -1,  282,  283,
-  284,   59,   -1,  123,   -1,  289,  290,  291,  292,  293,
-   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,   -1,  303,
-   25,   26,   -1,  307,   33,  309,  310,   36,   37,   38,
-   -1,   40,   37,   42,   43,   93,   45,   42,   43,   -1,
-   -1,   -1,   47,   -1,   49,  272,  273,  274,  275,   -1,
-   59,   -1,   -1,   -1,   -1,   64,   61,   62,   63,   64,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
-   -1,   -1,   -1,  287,  288,   -1,   -1,   -1,   -1,   -1,
-   33,   -1,   91,   36,   37,   38,   -1,   40,   -1,   42,
-   43,  305,   45,   -1,  308,   -1,   -1,  311,  312,  313,
-   -1,   -1,  107,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   64,   -1,   -1,  123,   -1,   -1,  126,   -1,   -1,
+   85,   36,   41,  185,   91,   40,  123,   36,   59,   93,
+   41,   33,   59,   93,   36,   37,   38,   59,   40,   93,
+   42,   43,   59,   45,   41,   59,   41,  196,   90,   41,
+   44,   91,   40,   40,   91,   26,  123,   41,   59,   41,
+  257,   41,   64,   57,   40,   40,   59,   61,    0,   93,
+   44,   42,    6,  257,    8,   40,  118,   48,   41,   50,
+   40,   40,   91,  123,   41,   40,  123,  276,  277,   91,
+   40,   62,   63,   64,   65,  278,   59,   31,   32,   41,
+  257,   33,   59,   91,   36,   37,   38,  123,   40,  123,
+   42,   43,   41,   45,  123,  109,   40,   59,   59,   59,
+   41,  123,  123,   36,  126,   41,   44,   59,    0,  260,
+   59,  257,   64,  123,  296,  123,  123,   59,   59,  110,
+  182,  295,  296,   59,   59,  187,   40,  123,  123,   40,
+   36,   41,  146,  147,  148,  149,  150,  151,  152,   91,
+  257,   33,   40,  123,   36,   37,   38,  125,   40,  125,
+   42,   43,   91,   45,   41,  296,  170,  171,  172,  173,
+  174,  175,  176,   91,    0,  334,   40,   59,  337,   59,
+   41,  123,   64,  125,  126,  189,   41,  191,   41,  193,
+  123,  195,   41,   40,  198,  199,   41,  356,   40,   59,
+  123,  205,  206,  207,  125,  125,  125,   33,  212,   91,
+   36,   37,   38,  125,   40,   93,   42,   43,  125,   45,
+   41,  295,  296,   41,   59,  295,  296,   41,  123,   41,
+  257,  295,  296,   59,  238,   59,  240,  314,   64,  258,
+   41,  123,   93,  125,  126,  257,  258,  259,  260,  261,
+  262,  263,  264,  265,  295,  296,   59,  269,  295,  296,
+   41,  295,  296,  295,  296,   91,  295,  296,  280,  294,
+  282,  283,  284,  348,  295,  296,   41,  289,  290,  291,
+  292,  293,  294,   59,   93,  297,  298,  291,  295,  296,
+  295,  296,  304,  295,  296,   59,  308,  123,  310,  311,
+  126,  295,  296,  295,  296,  295,  296,   41,  312,  362,
+  314,  295,  296,   13,  256,  257,  258,  259,  260,  261,
+  340,  263,  264,  265,  266,  267,  268,  269,  270,  271,
+  272,  273,  274,  275,  257,  312,  340,  279,  280,  262,
+  282,  283,  284,   41,  295,  296,   44,  289,  290,  291,
+  292,  293,  294,  147,  195,  297,  298,   95,  362,  125,
+   58,   59,  304,  295,  296,   -1,  308,   91,  310,  311,
+  295,  296,   -1,   -1,  256,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,  266,  267,  268,  269,  270,  271,
+  272,  273,  274,  275,   -1,   93,   -1,  279,  280,  123,
+  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
+  292,  293,  294,   -1,   -1,  297,  298,  295,  296,   41,
+   91,   -1,  304,   41,   -1,   -1,  308,   -1,  310,  311,
+  256,  257,  258,  259,  260,  261,   -1,  263,  264,  265,
+   -1,   59,   -1,  269,  295,  296,  272,  273,  274,  275,
+   -1,   -1,  123,  279,  280,   -1,  282,  283,  284,   -1,
+   -1,   -1,   -1,  289,  290,  291,  292,  293,  294,   13,
+   -1,  297,  298,   17,   91,   93,   41,  125,  304,   44,
+   -1,   -1,  308,   91,  310,  311,  295,  296,   -1,   33,
+   34,   35,   36,   58,   59,   -1,   -1,   -1,   63,   43,
+  266,  267,  268,   -1,  270,  271,  123,   51,   -1,   -1,
+  307,  308,  309,   -1,   -1,  123,  313,   -1,  315,   -1,
+   -1,   96,   -1,   98,   -1,  100,   91,  102,   93,  104,
+  105,   -1,   -1,   -1,   -1,   33,   80,   -1,   36,   37,
+   38,   -1,   40,   41,   42,   43,   44,   45,   -1,   -1,
+   94,   -1,  349,   97,  351,   99,   -1,  101,  123,  103,
+   58,   59,   -1,  287,  288,   63,   64,  364,  272,  273,
+  274,  275,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,  313,
+  314,  295,  296,   91,   -1,   93,   -1,  295,  296,   -1,
+  144,   33,   -1,   -1,   36,   37,   38,   -1,   40,   41,
+   42,   43,   44,   45,  285,  286,  287,  288,  266,  267,
+  268,   -1,  270,  271,   -1,  123,   58,   59,  126,   -1,
+   -1,   63,   64,   -1,  305,  306,   -1,  181,  309,   -1,
+   -1,  312,  313,  314,  188,   -1,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,  272,  273,  274,  275,   -1,   -1,
+   33,   93,   -1,   36,   37,   38,   -1,   40,   -1,   42,
+   43,   -1,   45,  295,  296,   -1,   -1,  295,  296,  287,
+  288,   -1,   -1,  266,  267,  268,   59,  270,  271,  306,
+   -1,   64,  309,   -1,  126,  312,  313,  314,  306,   -1,
+   -1,  309,   -1,   -1,  312,  313,  314,  272,  273,  274,
+  275,   91,   -1,   -1,   -1,   -1,  281,   -1,   91,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,
+  295,  296,   -1,   -1,  299,  300,  301,  302,  303,   -1,
+  305,  306,   -1,  123,  309,   -1,   -1,  312,  313,  314,
+  123,   -1,   -1,  126,   -1,   -1,   -1,   -1,   -1,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,
+   -1,  269,   -1,  317,  272,  273,  274,  275,   -1,   -1,
+   -1,   -1,  280,  281,  282,  283,  284,  285,  286,  287,
+  288,  289,  290,  291,  292,  293,  294,  295,  296,  297,
+  298,  299,  300,  301,  302,  303,  304,  305,  306,   -1,
+  308,  309,  310,  311,  312,  313,  314,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   -1,  190,  269,  192,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,  280,  281,
+  282,  283,  284,  285,  286,  287,  288,  289,  290,  291,
+  292,  293,  294,  295,  296,  297,  298,  299,  300,  301,
+  302,  303,  304,  305,  306,   -1,  308,  309,  310,  311,
+  312,  313,  314,  256,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   -1,   -1,   41,  269,   -1,   44,  272,
+  273,  274,  275,   -1,   -1,   -1,  279,  280,   -1,  282,
+  283,  284,   58,   59,   -1,   -1,  289,  290,  291,  292,
+  293,  294,   -1,   -1,  297,  298,   -1,   -1,   -1,  309,
+   -1,  304,  312,  313,  314,  308,   33,  310,  311,   36,
+   37,   38,   -1,   40,   -1,   42,   43,   93,   45,   -1,
+   -1,   25,   26,   -1,   -1,   -1,   -1,   -1,   -1,   49,
+   50,   -1,   59,   37,   -1,   -1,   -1,   64,   42,   43,
+   -1,   -1,   -1,   -1,   48,   -1,   50,   -1,  332,  333,
+   -1,   -1,   -1,   -1,   -1,  339,   -1,  341,   62,   63,
+   64,   65,   33,   -1,   91,   36,   37,   38,   -1,   40,
+   90,   42,   43,  357,   45,   -1,   -1,   -1,   -1,   -1,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,   91,   36,
-   37,   38,   -1,   40,   -1,   42,   43,   -1,   45,   -1,
+   -1,   -1,   -1,   64,   -1,   -1,  123,   -1,  118,  126,
+   -1,   -1,   -1,   -1,   -1,  125,  110,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,
+   91,   36,   37,   38,   -1,   40,   -1,   42,   43,   -1,
+   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,   64,
+   -1,   -1,  123,   -1,   -1,  126,   -1,   -1,   -1,   -1,
+   -1,   -1,  182,   -1,   -1,  169,   41,  187,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   91,   -1,   -1,   -1,
+   -1,   -1,   33,   58,   59,   36,   37,   38,   63,   40,
+   -1,   42,   43,  197,   45,   -1,  272,  273,  274,  275,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,  167,   -1,   -1,   -1,   -1,   64,   -1,   -1,
-  123,   -1,   -1,  126,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,  305,   -1,   -1,  308,   -1,
-   -1,  311,  312,  313,   91,   -1,   -1,   -1,   -1,   33,
-   -1,   -1,   36,   37,   38,   -1,   40,   -1,   42,   43,
-   -1,   45,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   59,  123,   -1,   -1,  126,
-   64,   -1,   -1,   -1,   -1,   -1,  294,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,  257,  258,
-  259,  260,  261,   -1,  263,  264,  265,   91,   -1,   -1,
-  269,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
-  279,  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,
-  289,  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,
-   91,   63,  126,   -1,  303,   -1,   -1,   -1,  307,   -1,
-  309,  310,   -1,   -1,  257,  258,  259,  260,  261,  262,
-  263,  264,  265,   -1,   -1,   -1,  269,   -1,   -1,   91,
-   41,   -1,  123,   -1,   -1,   -1,   -1,  280,   -1,  282,
-  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,
-  293,   -1,   63,  296,  297,   -1,   -1,   -1,   -1,   -1,
-  303,  123,   -1,   -1,  307,   -1,  309,  310,   -1,   -1,
+   -1,  126,   -1,   64,   -1,   -1,   -1,   -1,   93,  295,
+  296,   -1,   -1,  299,   -1,   -1,   -1,   -1,   -1,  256,
   257,  258,  259,  260,  261,   -1,  263,  264,  265,   -1,
-   91,   -1,  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,
-   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,
-  297,   41,  123,   -1,   44,   -1,  303,   -1,   -1,   -1,
-  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   58,   59,
-   -1,   -1,   -1,  257,  258,  259,  260,  261,   91,  263,
-  264,  265,   -1,   33,   -1,  269,   36,   37,   38,   -1,
-   40,   -1,   42,   43,   -1,   45,  280,   -1,  282,  283,
-  284,   -1,   -1,   93,   -1,  289,  290,  291,  292,  293,
-  123,   -1,  296,  297,   64,   -1,   -1,   -1,   -1,  303,
-   -1,   -1,   -1,  307,   -1,  309,  310,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,  285,   -1,  287,  288,   -1,   33,
-   -1,   91,   36,   37,   38,   -1,   40,   41,   42,   43,
-   -1,   45,   -1,  304,  305,   -1,   -1,  308,   -1,  281,
-  311,  312,  313,  285,  286,  287,  288,   -1,   -1,   -1,
-   64,   -1,   -1,  123,   -1,   -1,  126,  299,  300,  301,
-  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
-  312,  313,   -1,   -1,   -1,   33,   -1,   91,   36,   37,
-   38,   -1,   40,   -1,   42,   43,   -1,   45,   -1,   -1,
-  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   64,  298,  299,  300,
-  301,  302,  126,  304,  305,   -1,   -1,  308,   -1,   -1,
-  311,  312,  313,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   91,   -1,   93,   -1,   -1,   33,   -1,
-   -1,   36,   37,   38,   -1,   40,   -1,   42,   43,   -1,
-   45,   -1,   -1,   -1,  287,  288,   -1,   -1,   -1,   -1,
-   -1,   -1,  272,  273,  274,  275,   -1,   -1,  126,   64,
-   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,
-  313,   -1,   -1,   -1,  294,  295,   -1,  257,  258,  259,
-  260,  261,   -1,  263,  264,  265,   91,   -1,   -1,  269,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   91,   -1,  269,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   41,  279,  280,   44,  282,  283,  284,   -1,   -1,
+   -1,   -1,  289,  290,  291,  292,  293,  294,   58,   59,
+  297,  298,  123,   63,   -1,  126,   -1,  304,   -1,   -1,
+   -1,  308,   -1,  310,  311,   -1,  257,  258,  259,  260,
+  261,   -1,  263,  264,  265,   -1,   -1,   -1,  269,   41,
+   -1,   -1,   44,   93,   -1,   -1,   -1,   41,   -1,  280,
+   44,  282,  283,  284,   -1,   -1,   58,   59,  289,  290,
+  291,  292,  293,  294,   58,   59,  297,  298,   -1,   63,
+   -1,   -1,   -1,  304,   -1,   -1,   -1,  308,   -1,  310,
+  311,   -1,  257,  258,  259,  260,  261,   -1,  263,  264,
+  265,   93,   -1,   -1,  269,   -1,   -1,   -1,   -1,   93,
+   -1,   -1,   -1,   41,   -1,  280,   44,  282,  283,  284,
+   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,  294,
+   58,   59,  297,  298,   -1,   63,   -1,   -1,   -1,  304,
+   -1,   91,   -1,  308,   -1,  310,  311,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  257,  258,  259,  260,
+  261,   -1,  263,  264,  265,   93,   -1,   -1,  269,   41,
+  295,  296,   44,  123,  299,   -1,   -1,   41,   -1,  280,
+   44,  282,  283,  284,   -1,   -1,   58,   59,  289,  290,
+  291,  292,  293,  294,   -1,   59,  297,  298,   -1,   -1,
+   -1,   -1,   -1,  304,   -1,   -1,   -1,  308,   33,  310,
+  311,   36,   37,   38,   -1,   40,   41,   42,   43,   -1,
+   45,   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   64,
+   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,   -1,  299,
+  300,  301,  302,  303,   33,  305,   91,   36,   37,   38,
+   -1,   40,   -1,   42,   43,   -1,   45,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,  272,  273,
+  274,  275,   -1,   -1,   -1,   64,   -1,  281,   -1,   -1,
+   -1,  126,  286,  295,  296,   -1,   -1,   -1,   -1,   -1,
+   -1,  295,  296,   -1,   -1,  299,  300,  301,  302,  303,
+   -1,   -1,   91,   33,   93,   -1,   36,   37,   38,   -1,
+   40,   41,   42,   43,   -1,   45,   -1,  287,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   -1,   -1,   -1,  281,   64,   -1,  306,  126,   -1,  309,
+   -1,   -1,  312,  313,  314,   -1,   -1,  295,  296,   -1,
+   -1,  299,  300,  301,  302,  303,   -1,   -1,   -1,   -1,
+   -1,   91,   -1,   33,   -1,   -1,   36,   37,   38,   -1,
+   40,   41,   42,   43,   -1,   45,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,  272,  273,
+  274,  275,   -1,   -1,   64,   -1,  126,   -1,   -1,   -1,
+   -1,   -1,   -1,  295,  296,   -1,   -1,   -1,   -1,   -1,
+   -1,  295,  257,  258,  259,  260,  261,   -1,  263,  264,
+  265,   91,   -1,   -1,  269,   41,   -1,   -1,   44,   -1,
+   -1,   -1,   -1,   41,   -1,  280,   44,  282,  283,  284,
+   -1,   -1,   58,   59,  289,  290,  291,  292,  293,  294,
+   58,   59,  297,  298,   -1,   63,  126,   -1,   -1,  304,
+   -1,   -1,   -1,  308,   -1,  310,  311,   -1,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   93,   -1,   -1,
+  269,   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,   41,
+   -1,  280,   44,  282,  283,  284,   -1,   -1,   -1,   -1,
+  289,  290,  291,  292,  293,  294,   58,   59,  297,  298,
+   -1,   63,   -1,   -1,   -1,  304,   91,   -1,   -1,  308,
+   -1,  310,  311,   -1,   -1,   41,   -1,  257,  258,  259,
+  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,  269,
+   -1,   93,   -1,   -1,   -1,   -1,   -1,   63,  123,   -1,
+  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,  289,
+  290,  291,  292,  293,  294,   -1,   -1,  297,  298,   -1,
+   -1,   -1,   -1,   -1,  304,   91,   -1,   -1,  308,   41,
+  310,  311,   44,   -1,   -1,   -1,   -1,  257,  258,  259,
+  260,  261,   -1,  263,  264,  265,   58,   59,   -1,  269,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   -1,
   280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,  289,
-  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,
-   -1,  126,   -1,  303,   -1,   -1,   -1,  307,   -1,  309,
-  310,   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,
-  264,  265,   -1,   91,   -1,  269,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
+  290,  291,  292,  293,  294,   -1,   -1,  297,  298,   -1,
+   -1,   93,   -1,   -1,  304,   -1,   -1,   -1,  308,   33,
+  310,  311,   36,   37,   38,   -1,   40,   -1,   42,   43,
+   -1,   45,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   64,   -1,   -1,  281,   -1,   -1,   -1,   -1,   -1,  295,
+  296,   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,
+   -1,  299,  300,  301,  302,   33,   -1,   91,   36,   37,
+   38,   -1,   40,   41,   42,   43,   -1,   45,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   64,  302,  303,  281,
+  305,  306,  126,   -1,  309,   -1,   -1,  312,  313,  314,
+   -1,   -1,   -1,  295,  296,   -1,   -1,  299,  300,  301,
+   -1,   33,   -1,   91,   36,   37,   38,   -1,   40,   41,
+   42,   43,   -1,   45,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   64,  299,  300,  301,  302,  303,  126,  305,
+  306,   -1,   -1,  309,   -1,   -1,  312,  313,  314,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   91,
+  272,  273,  274,  275,   33,   -1,   -1,   36,   37,   38,
+   -1,   40,   -1,   42,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,   -1,  295,  296,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  126,   64,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   44,  256,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   91,   -1,   -1,  269,   -1,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
   284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,
-   -1,   -1,  296,  297,   91,  123,   -1,   -1,   -1,  303,
-   -1,   41,   -1,  307,   44,  309,  310,   -1,   -1,  257,
-  258,  259,  260,  261,   -1,  263,  264,  265,   58,   59,
-   -1,  269,   -1,   63,   -1,   -1,  123,   -1,   -1,   -1,
-   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,
-   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,  297,
-   -1,   41,   -1,   93,   44,  303,   -1,   -1,   -1,  307,
-   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,   58,   59,
-   -1,  256,  257,  258,  259,  260,  261,   -1,  263,  264,
-  265,   -1,   33,   -1,  269,   36,   37,   38,   -1,   40,
-   41,   42,   43,   -1,   45,  280,   -1,  282,  283,  284,
-   -1,   -1,   -1,   93,  289,  290,  291,  292,  293,   -1,
-   -1,  296,  297,   64,   -1,   -1,   -1,   -1,  303,   -1,
-   -1,   -1,  307,   -1,  309,  310,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,
-   91,   36,   37,   38,   -1,   40,   41,   42,   43,   -1,
-   45,   -1,   -1,   -1,   -1,   -1,   -1,  285,  286,  287,
-  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   64,
-   -1,   -1,  300,  301,  302,  126,  304,  305,   -1,   -1,
-  308,   -1,   -1,  311,  312,  313,   -1,   -1,  285,  286,
-  287,  288,   -1,   -1,   33,   -1,   91,   36,   37,   38,
-   -1,   40,   41,   42,   43,  302,   45,  304,  305,   -1,
-   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   64,   -1,   -1,   -1,   -1,
-   -1,  126,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
-   -1,  281,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   91,   -1,  294,  295,   -1,   33,  298,  299,
-   36,   37,   38,   -1,   40,   41,   42,   43,   -1,   45,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,  272,  273,  274,  275,   -1,  126,   64,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,  294,  295,  257,  258,  259,  260,
-  261,   -1,  263,  264,  265,   91,   -1,   -1,  269,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,
-   -1,  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,
-  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,
-  126,   -1,  303,   -1,   41,   -1,  307,   44,  309,  310,
-   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,  264,
-  265,   58,   59,   -1,  269,   -1,   63,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
-   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,   -1,
-   -1,  296,  297,   -1,   91,   -1,   93,   -1,  303,   -1,
-   41,   -1,  307,   44,  309,  310,   -1,   -1,  257,  258,
-  259,  260,  261,   -1,  263,  264,  265,   58,   59,   -1,
-  269,   -1,   63,   -1,   -1,   -1,  123,   -1,   -1,   -1,
-   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,
-  289,  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,
-   91,   -1,   93,   -1,  303,   -1,   -1,   -1,  307,   -1,
-  309,  310,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,  257,  258,  259,  260,  261,   -1,  263,  264,  265,
-   -1,   33,  123,  269,   36,   37,   38,   -1,   40,   -1,
-   42,   43,   -1,   45,  280,   -1,  282,  283,  284,   -1,
-   -1,   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,
-  296,  297,   64,   -1,   -1,   -1,   -1,  303,   -1,   -1,
-   -1,  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,
-   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   91,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
-   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,  126,  272,  273,  274,  275,   -1,
-   91,   -1,   93,   -1,  281,   -1,   -1,   -1,  285,  286,
-  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
-   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
-   -1,  308,  123,   -1,  311,  312,  313,   -1,   -1,   -1,
-   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,
-   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
-  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
-   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
-  301,  302,   -1,  304,  305,   -1,   41,  308,   -1,   44,
-  311,  312,  313,   93,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,  123,   -1,  257,  258,  259,  260,  261,
-   -1,  263,  264,  265,   -1,   -1,   91,  269,   93,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  294,   -1,   -1,  297,  298,   -1,   -1,  126,   91,   -1,
+  304,   -1,   41,   -1,  308,   44,  310,  311,   -1,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   -1,   58,
+   59,  269,   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,
+  123,   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,
+   -1,  289,  290,  291,  292,  293,  294,   -1,   -1,  297,
+  298,   -1,   91,   -1,   93,   -1,  304,   -1,   -1,   -1,
+  308,   41,  310,  311,   44,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   -1,   -1,  269,   58,   59,
+   -1,   -1,   -1,   63,  123,   -1,   -1,   -1,  280,   -1,
   282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
-  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,
-   -1,  303,   -1,   -1,   -1,  307,   -1,  309,  310,   -1,
+  292,  293,  294,   -1,   41,  297,  298,   44,   -1,   -1,
+   -1,   91,  304,   93,   -1,   -1,  308,   -1,  310,  311,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,
+  269,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,   41,
+   -1,  280,   44,  282,  283,  284,   93,   -1,   -1,   -1,
+  289,  290,  291,  292,  293,  294,   58,   59,  297,  298,
+   -1,   63,   -1,   -1,   -1,  304,   -1,   -1,   -1,  308,
+   -1,  310,  311,   -1,   -1,   -1,  123,   -1,  281,   -1,
+   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,   91,
+   41,   93,   -1,   44,   -1,   -1,  299,  300,  301,  302,
+  303,   -1,  305,  306,   -1,   -1,  309,   58,   59,  312,
+  313,  314,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   -1,   -1,   93,   -1,   -1,   -1,  295,  296,   -1,   41,
+  299,  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,
+  309,   -1,   -1,  312,  313,  314,   58,   59,   -1,   -1,
+   -1,   63,  123,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
+   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,   91,
+   -1,   93,   -1,   -1,   -1,  295,  296,   -1,   -1,  299,
+  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,  309,
+   -1,   -1,  312,  313,  314,  272,  273,  274,  275,   41,
+   -1,  123,   44,   -1,  281,   -1,   -1,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   58,   59,  295,  296,
+   -1,   63,  299,  300,  301,  302,  303,   -1,  305,  306,
+   -1,   -1,  309,   -1,   -1,  312,  313,  314,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
+   -1,   93,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   41,   -1,  295,  296,   -1,   -1,  299,  300,  301,
+  302,  303,   -1,  305,  306,   -1,   -1,  309,   58,   59,
+  312,  313,  314,   63,   -1,   -1,   -1,   -1,   -1,   -1,
    -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
   281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,
-   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
-  301,  302,   -1,  304,  305,   41,   -1,  308,   44,   -1,
-  311,  312,  313,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   41,   -1,   -1,   44,   -1,   93,   -1,   -1,
-   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,
-   59,  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,
-   -1,   -1,   -1,   -1,  294,  295,   -1,  123,  298,  299,
-  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
-   -1,  311,  312,  313,   93,   -1,   -1,  272,  273,  274,
-  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
-  285,  286,  287,  288,   -1,   -1,   -1,   41,   -1,  294,
-  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
-  305,   -1,   -1,  308,   58,   59,  311,  312,  313,   63,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   41,   -1,   -1,   -1,   -1,   -1,   91,   -1,   93,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,
-   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   91,   -1,   93,   -1,   -1,   41,   -1,   -1,   44,
-   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
-   -1,   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,
-  286,  287,  288,  123,   -1,   -1,   -1,   -1,  294,  295,
-   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
-   41,   -1,  308,   44,   -1,  311,  312,  313,   93,   -1,
-   -1,   -1,   -1,  272,  273,  274,  275,   58,   59,   -1,
-   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,  123,  298,
-   -1,   -1,   -1,   41,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,
+   -1,   91,   -1,   93,  295,  296,   -1,   -1,  299,  300,
+  301,  302,  303,   41,  305,  306,   44,   -1,  309,   -1,
+   -1,  312,  313,  314,   -1,   -1,   -1,   -1,   -1,   -1,
+   58,   59,   -1,  123,   -1,   63,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,   -1,  295,  296,   93,   -1,  299,  300,  301,
+  302,  303,   41,  305,  306,   44,   -1,  309,   -1,   -1,
+  312,  313,  314,   -1,   -1,   -1,   -1,   -1,   -1,   58,
+   59,   -1,   -1,   -1,   63,  123,   -1,   -1,   -1,   -1,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,  272,  273,
-  274,  275,   -1,   91,   -1,   93,   -1,  281,   -1,   -1,
-   -1,  285,  286,  287,  288,   41,   -1,   -1,   44,   -1,
-  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
-  304,  305,   58,   59,  308,  123,   -1,  311,  312,  313,
-   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
-   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,
-   -1,   -1,   -1,   -1,  294,  295,   -1,   93,  298,  299,
-  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
-   -1,  311,  312,  313,   -1,   -1,   -1,   41,   -1,   -1,
-   44,   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,
-  275,   -1,   -1,   -1,   58,   59,  281,   -1,   -1,   63,
-  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,
-  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
-  305,   41,   -1,  308,   44,   -1,  311,  312,  313,   93,
-   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
-  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
-   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
-  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,
-  311,  312,  313,   93,  272,  273,  274,  275,   -1,   58,
-   -1,   -1,   -1,  281,   63,   -1,   -1,  285,  286,  287,
-  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
-  298,  299,  300,  301,  302,   41,  304,  305,   44,   -1,
-  308,   -1,   91,  311,  312,  313,   -1,   -1,   -1,   -1,
-   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
-   -1,   -1,   -1,   -1,  123,   -1,   -1,   41,   -1,   -1,
-   44,   -1,   -1,   -1,   -1,   -1,   -1,   93,  294,  295,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+  272,  273,  274,  275,   93,   -1,   -1,   -1,   -1,  281,
    -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,  295,  296,   -1,   -1,  299,  300,  301,
+  302,  303,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   91,   -1,   93,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   93,
-   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,
-  274,  275,   -1,   -1,   -1,   58,   59,  281,   -1,   -1,
-   63,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
-  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
-  304,  305,   41,   -1,  308,   44,   -1,  311,  312,  313,
-   93,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,
-   59,  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,
-   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
-  300,  301,  302,   41,  304,  305,   44,   -1,  308,   -1,
-   -1,  311,  312,  313,   93,   -1,   -1,   -1,   -1,   -1,
-   58,   59,  281,   -1,   -1,   63,  285,  286,  287,  288,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  298,
-  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,
-   -1,   -1,  311,  312,  313,   93,  272,  273,  274,  275,
-   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,
-  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
-   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
-   -1,   -1,  308,   -1,   -1,  311,  312,  313,  272,  273,
-  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,
-   -1,  285,  286,  287,  288,   41,   -1,   -1,   44,   -1,
-  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
-  304,  305,   58,   59,  308,   -1,   -1,  311,  312,  313,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  272,
-  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,
-   -1,   -1,  285,  286,  287,  288,   -1,   93,   -1,   -1,
-   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
-   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,
-  313,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
-   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
-   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,
-  299,  300,  301,  302,   41,  304,  305,   44,   -1,  308,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
+   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,  123,
+   -1,   -1,   91,   -1,   -1,  295,  296,   -1,   -1,  299,
+  300,  301,  302,  303,   41,  305,  306,   44,   -1,  309,
+   -1,   -1,  312,  313,  314,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,  123,   -1,   63,   -1,   -1,   -1,
    -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
-   -1,   58,   59,  281,   -1,   -1,   63,  285,  286,  287,
-  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
-  298,  299,  300,  301,  302,   41,  304,  305,   44,   -1,
-  308,   -1,   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,
-   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,   58,   59,
-   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
-   44,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
-   -1,   -1,   -1,   93,   58,   59,   -1,   -1,   -1,   63,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,
-   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,
-   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,
-   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   93,   58,   59,   -1,   -1,
-   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
-   -1,   93,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,
-  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
-   -1,  298,  299,  300,  301,  302,   41,  304,  305,   44,
-   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
-   -1,   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,
-  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
-   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
-   -1,   -1,  272,  273,  274,  275,   -1,   -1,   93,   -1,
-   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,
-   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
-  300,  301,  302,   -1,  304,  305,   -1,   -1,  272,  273,
-  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,
-   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
-  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
-  304,  305,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
    -1,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,
-  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
-  298,  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,
-  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
-   -1,   -1,   -1,  285,  286,  287,  288,   41,   -1,   -1,
-   44,   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,
-  302,   -1,  304,  305,   58,   59,   -1,   -1,   -1,   63,
+  288,   -1,   -1,   -1,   -1,   -1,   93,  295,  296,   -1,
+   -1,  299,  300,  301,  302,  303,   41,  305,  306,   44,
+   -1,  309,   -1,   -1,  312,  313,  314,   -1,   -1,   -1,
+   -1,   -1,   -1,   58,   59,   -1,  123,   -1,   63,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,   93,   -1,
+  299,  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,
+  309,   -1,   -1,  312,  313,  314,   -1,   -1,  272,  273,
+  274,  275,   41,   -1,   -1,   44,   -1,  281,   -1,   -1,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   58,
+   59,  295,  296,   -1,   63,  299,  300,  301,  302,  303,
+   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,  313,
+  314,   -1,   -1,   -1,   -1,   -1,  285,   41,  287,  288,
+   44,   -1,   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,  305,  306,   -1,   63,
+  309,   -1,   -1,  312,  313,  314,   -1,   -1,   -1,   -1,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   93,
-   -1,   -1,   63,   -1,   -1,   -1,   -1,  272,  273,  274,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   93,
+   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,
+   -1,   -1,  299,  300,  301,  302,  303,   41,  305,  306,
+   44,   -1,  309,   -1,   -1,  312,  313,  314,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,
   275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
-  285,  286,  287,  288,   41,   -1,   -1,   44,   -1,  294,
-  295,   -1,   93,  298,  299,  300,  301,  302,   -1,  304,
-  305,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
-   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   58,   59,   93,   -1,   -1,   63,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
-   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   93,
-   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,
-   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   93,
+  295,  296,   -1,   -1,  299,  300,  301,  302,  303,   41,
+  305,  306,   44,   -1,  309,   -1,   -1,  312,  313,  314,
    -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,
-   93,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   41,   58,   59,   44,
-   -1,   93,   63,   -1,   -1,   -1,   -1,   -1,  272,  273,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   41,   -1,   -1,
+   44,   93,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   58,   59,  295,  296,   -1,   63,
+  299,  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,
+  309,   -1,   -1,  312,  313,  314,   -1,   -1,  272,  273,
+  274,  275,   41,   -1,   -1,   44,   -1,  281,   -1,   93,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   58,
+   59,  295,  296,   -1,   63,  299,  300,  301,  302,  303,
+   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,  313,
+  314,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,
+   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,
+  274,  275,   41,   -1,   -1,   44,   -1,  281,   -1,   -1,
+   -1,  285,  286,  287,  288,   93,   -1,   -1,   -1,   58,
+   59,  295,  296,   -1,   63,  299,  300,  301,  302,  303,
+   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,  313,
+  314,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   44,   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   58,   59,   -1,   -1,  281,
+   63,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,   -1,  295,  296,   -1,   -1,  299,  300,  301,
+  302,  303,   -1,  305,  306,   -1,   41,  309,   -1,   44,
+   93,   -1,   91,   -1,   -1,   -1,   -1,   -1,  272,  273,
   274,  275,   -1,   58,   59,   -1,   -1,  281,   63,   -1,
    -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
-  294,  295,   93,   -1,  298,  299,  300,  301,  302,   -1,
-  304,  272,  273,  274,  275,   -1,   -1,   -1,   93,   -1,
-  281,   -1,   -1,   -1,  285,  286,   -1,  288,   41,   -1,
-   -1,   44,   -1,  294,  295,   -1,   -1,  298,  299,  300,
-  301,  302,   -1,  304,   41,   58,   59,   44,   -1,   -1,
-   63,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
-   -1,   58,   59,   -1,  281,   -1,   63,   -1,  285,  286,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
-   93,  298,  299,  300,  301,  302,   -1,  304,  272,  273,
-  274,  275,   -1,   -1,   -1,   -1,   93,  281,   -1,   -1,
-   -1,  285,  286,   -1,   -1,   -1,   -1,   -1,   -1,   41,
-  294,  295,   44,   -1,  298,  299,  300,  301,  302,  272,
-  273,  274,  275,   -1,   -1,   -1,   58,   59,  281,   -1,
-   -1,   63,  285,  286,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
-  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
-   -1,   93,   -1,  285,  286,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,
-  302,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
-  281,   -1,   -1,   -1,   -1,  286,   -1,  272,  273,  274,
-  275,   -1,   -1,  294,  295,   -1,  281,  298,  299,  300,
-  301,  302,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,
-  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  295,  296,   -1,  123,  299,  300,  301,  302,  303,
+   -1,  305,  306,   -1,   -1,  309,   -1,   -1,   93,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   91,   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,   -1,
+  299,  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   41,   -1,
+   -1,   44,  123,  281,   -1,   -1,   -1,  285,  286,  287,
+  288,   -1,   -1,   -1,   -1,   58,   59,  295,  296,   -1,
+   63,  299,  300,  301,  302,  303,   -1,  305,  306,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   41,   -1,   -1,
+   44,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   93,   -1,   -1,   -1,   58,   59,  295,  296,   -1,   63,
+  299,  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  272,
-  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,
-   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
-   -1,  294,  295,   -1,  281,  298,  299,  300,  301,  302,
-   -1,   -1,   30,   -1,   -1,   -1,   -1,  294,  295,   -1,
-   38,  298,  299,  300,  301,   43,   44,   -1,   -1,   -1,
-   -1,   -1,   50,   51,   52,   53,   54,   55,   -1,   -1,
-   58,   59,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
-   -1,   -1,   90,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,  143,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,  151,  152,  153,  154,  155,  156,  157,
-  158,  159,  160,  161,  162,  163,  164,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,   -1,
+  273,  274,  275,   41,   -1,   -1,   44,   -1,  281,   93,
+   -1,   -1,  285,  286,  287,  288,  285,  286,  287,  288,
+   58,   59,  295,  296,   -1,   63,  299,  300,  301,  302,
+  303,   -1,  305,  306,  303,   -1,  305,  306,   -1,   -1,
+  309,   -1,   -1,  312,  313,  314,   -1,  272,  273,  274,
+  275,   41,   -1,   -1,   44,   93,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   58,   59,
+  295,  296,   -1,   63,  299,  300,  301,  302,  303,   -1,
+  305,  306,   -1,   -1,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  300,
+  301,  302,  303,   93,  305,  306,   -1,   -1,  309,   -1,
+   -1,  312,  313,  314,   41,   -1,   -1,   44,   -1,   -1,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  272,
+  273,  274,  275,   41,   -1,   -1,   44,   -1,  281,   -1,
+   -1,   -1,  285,  286,  287,  288,   93,   -1,   -1,   -1,
+   58,   59,  295,  296,   -1,   63,  299,  300,  301,  302,
+  303,   -1,  305,  306,   -1,   -1,   -1,   -1,  272,  273,
+  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,
+   -1,  285,  286,  287,  288,   93,   -1,   -1,   -1,   -1,
+   -1,  295,  296,   -1,   -1,  299,  300,  301,  302,  303,
+   -1,  305,  306,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   -1,   -1,   -1,  281,   58,   59,   -1,  285,  286,   63,
+  288,   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,
+   -1,  299,  300,  301,  302,  303,   -1,  305,   -1,   -1,
+   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   93,
+   -1,   -1,  272,  273,  274,  275,   -1,   58,   59,   -1,
+   -1,  281,   63,   -1,   -1,  285,  286,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,   30,  299,
+  300,  301,  302,  303,   -1,  305,   38,   -1,   58,   -1,
+   -1,   43,   93,   63,   -1,   -1,   -1,   -1,   -1,   51,
+   52,   53,   54,   55,   56,   -1,   -1,   59,   60,   -1,
+   -1,   -1,   -1,   -1,   66,  272,  273,  274,  275,   -1,
+   -1,   91,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,
+   92,   -1,  299,  300,  301,  302,  303,   -1,   -1,   -1,
+   -1,   -1,   -1,  123,  272,  273,  274,  275,   91,   -1,
+   63,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  295,  296,   -1,
+   -1,  299,  300,  301,  302,  303,   -1,   -1,   91,   -1,
+  123,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  153,  154,  155,  156,  157,  158,  159,  160,  161,
+  162,  163,  164,  165,  166,   -1,   -1,   -1,   91,   -1,
+  123,   -1,   -1,   -1,   -1,   -1,  178,   -1,  272,  273,
+  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,
+   -1,  285,  286,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  123,  295,  296,   -1,   -1,  299,  300,  301,  302,  303,
    -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
-   -1,   -1,   -1,   -1,   -1,   -1,  284,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  295,  296,   -1,   -1,  299,  300,
+   -1,   -1,   -1,   -1,   -1,   -1,  258,   -1,   -1,   -1,
+   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  299,
+  300,  301,  302,  303,   -1,  305,  306,   -1,   -1,  309,
+   -1,  293,  312,  313,  314,   -1,   -1,   -1,  281,   -1,
+   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  299,  300,  301,  302,
+  303,   -1,  305,  306,   -1,   -1,  309,   -1,  281,  312,
+  313,  314,  285,  286,  287,  288,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  300,  301,  302,
+  303,   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,
+  313,  314,  285,  286,  287,  288,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,
+  303,   -1,  305,  306,   -1,   -1,  309,   -1,   -1,  312,
+  313,  314,
 };
 #define YYFINAL 1
 #ifndef YYDEBUG
 #define YYDEBUG 0
 #endif
-#define YYMAXTOKEN 313
+#define YYMAXTOKEN 314
 #if YYDEBUG
 char *yyname[] = {
 "end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -1124,7 +1051,7 @@ char *yyname[] = {
 "PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB",
 "ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF",
 "CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP",
-"MULOP","ADDOP","DOLSHARP","DO","LOCAL","HASHBRACK","NOAMP","OROP","ANDOP",
+"MULOP","ADDOP","DOLSHARP","DO","HASHBRACK","NOAMP","LOCAL","MY","OROP","ANDOP",
 "NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP",
 "SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC",
 "POSTDEC","ARROW",
@@ -1135,6 +1062,9 @@ char *yyrule[] = {
 "prog : $$1 lineseq",
 "block : '{' remember lineseq '}'",
 "remember :",
+"mblock : '{' mintro mremember lineseq '}'",
+"mintro :",
+"mremember :",
 "lineseq :",
 "lineseq : lineseq decl",
 "lineseq : lineseq line",
@@ -1147,28 +1077,35 @@ char *yyrule[] = {
 "sideff : expr IF expr",
 "sideff : expr UNLESS expr",
 "sideff : expr WHILE expr",
-"sideff : expr UNTIL expr",
+"sideff : expr UNTIL iexpr",
 "else :",
-"else : ELSE block",
-"else : ELSIF '(' expr ')' block else",
-"cond : IF '(' expr ')' block else",
-"cond : UNLESS '(' expr ')' block else",
+"else : ELSE mblock",
+"else : ELSIF '(' mexpr ')' mblock else",
+"cond : IF '(' remember mexpr ')' mblock else",
+"cond : UNLESS '(' remember miexpr ')' mblock else",
 "cond : IF block block else",
 "cond : UNLESS block block else",
 "cont :",
 "cont : CONTINUE block",
-"loop : label WHILE '(' texpr ')' block cont",
-"loop : label UNTIL '(' expr ')' block cont",
+"loop : label WHILE '(' remember mtexpr ')' mblock cont",
+"loop : label UNTIL '(' remember miexpr ')' mblock cont",
 "loop : label WHILE block block cont",
 "loop : label UNTIL block block cont",
+"loop : label FOR MY remember my_scalar '(' expr ')' mblock cont",
 "loop : label FOR scalar '(' expr ')' block cont",
-"loop : label FOR '(' expr ')' block cont",
-"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block",
+"loop : label FOR '(' remember expr ')' mblock cont",
+"$$2 :",
+"$$3 :",
+"loop : label FOR '(' remember nexpr ';' $$2 texpr ';' $$3 nexpr ')' mblock",
 "loop : label block cont",
 "nexpr :",
 "nexpr : sideff",
 "texpr :",
 "texpr : expr",
+"iexpr : expr",
+"mexpr : expr",
+"mtexpr : texpr",
+"miexpr : iexpr",
 "label :",
 "label : LABEL",
 "decl : format",
@@ -1224,7 +1161,7 @@ char *yyrule[] = {
 "term : term POSTDEC",
 "term : PREINC term",
 "term : PREDEC term",
-"term : LOCAL term",
+"term : local term",
 "term : '(' expr ')'",
 "term : '(' ')'",
 "term : '[' expr ']'",
@@ -1280,6 +1217,9 @@ char *yyrule[] = {
 "listexprcom :",
 "listexprcom : expr",
 "listexprcom : expr ','",
+"local : LOCAL",
+"local : MY",
+"my_scalar : scalar",
 "amper : '&' indirob",
 "scalar : '$' indirob",
 "ary : '@' indirob",
@@ -1312,9 +1252,9 @@ int yyerrflag;
 int yychar;
 YYSTYPE yyval;
 YYSTYPE yylval;
-#line 571 "perly.y"
+#line 631 "perly.y"
  /* PROGRAM */
-#line 1388 "y.tab.c"
+#line 1329 "perly.c"
 #define YYABORT goto yyabort
 #define YYACCEPT goto yyaccept
 #define YYERROR goto yyerrlab
@@ -1539,7 +1479,7 @@ yyreduce:
     switch (yyn)
     {
 case 1:
-#line 84 "perly.y"
+#line 85 "perly.y"
 {
 #if defined(YYDEBUG) && defined(DEBUGGING)
                    yydebug = (debug & 1);
@@ -1548,38 +1488,55 @@ case 1:
                }
 break;
 case 2:
-#line 91 "perly.y"
+#line 92 "perly.y"
 { newPROG(yyvsp[0].opval); }
 break;
 case 3:
-#line 95 "perly.y"
+#line 96 "perly.y"
 { yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); }
 break;
 case 4:
-#line 99 "perly.y"
-{ yyval.ival = block_start(); }
+#line 100 "perly.y"
+{ yyval.ival = block_start(TRUE); }
 break;
 case 5:
-#line 103 "perly.y"
-{ yyval.opval = Nullop; }
+#line 104 "perly.y"
+{ if (yyvsp[-3].opval)
+                           yyvsp[-1].opval = yyvsp[-1].opval ? append_list(OP_LINESEQ,
+                                         (LISTOP*)yyvsp[-3].opval, (LISTOP*)yyvsp[-1].opval) : yyvsp[-3].opval;
+                         yyval.opval = block_end(yyvsp[-4].ival, yyvsp[-2].ival, yyvsp[-1].opval); }
 break;
 case 6:
-#line 105 "perly.y"
-{ yyval.opval = yyvsp[-1].opval; }
+#line 111 "perly.y"
+{ yyval.opval = min_intro_pending
+                             ? newSTATEOP(0, Nullch, newOP(OP_NULL, 0))
+                             : NULL; }
 break;
 case 7:
-#line 107 "perly.y"
+#line 117 "perly.y"
+{ yyval.ival = block_start(FALSE); }
+break;
+case 8:
+#line 121 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 9:
+#line 123 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 10:
+#line 125 "perly.y"
 {   yyval.opval = append_list(OP_LINESEQ,
                                (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
                            pad_reset_pending = TRUE;
                            if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; }
 break;
-case 8:
-#line 114 "perly.y"
+case 11:
+#line 132 "perly.y"
 { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); }
 break;
-case 10:
-#line 117 "perly.y"
+case 13:
+#line 135 "perly.y"
 { if (yyvsp[-1].pval != Nullch) {
                              yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0));
                            }
@@ -1589,467 +1546,507 @@ case 10:
                            }
                            expect = XSTATE; }
 break;
-case 11:
-#line 126 "perly.y"
+case 14:
+#line 144 "perly.y"
 { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
                          expect = XSTATE; }
 break;
-case 12:
-#line 131 "perly.y"
+case 15:
+#line 149 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 13:
-#line 133 "perly.y"
+case 16:
+#line 151 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 14:
-#line 135 "perly.y"
+case 17:
+#line 153 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); }
 break;
-case 15:
-#line 137 "perly.y"
+case 18:
+#line 155 "perly.y"
 { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); }
 break;
-case 16:
-#line 139 "perly.y"
+case 19:
+#line 157 "perly.y"
 { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); }
 break;
-case 17:
-#line 141 "perly.y"
-{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);}
+case 20:
+#line 159 "perly.y"
+{ yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);}
 break;
-case 18:
-#line 145 "perly.y"
+case 21:
+#line 163 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 19:
-#line 147 "perly.y"
+case 22:
+#line 165 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
-case 20:
-#line 149 "perly.y"
+case 23:
+#line 167 "perly.y"
 { copline = yyvsp[-5].ival;
-                           yyval.opval = newSTATEOP(0, 0,
-                               newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
+                           yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval);
                            hints |= HINT_BLOCK_SCOPE; }
 break;
-case 21:
-#line 156 "perly.y"
-{ copline = yyvsp[-5].ival;
-                           yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); }
+case 24:
+#line 173 "perly.y"
+{ copline = yyvsp[-6].ival;
+                           yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival,
+                                   newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
 break;
-case 22:
-#line 159 "perly.y"
-{ copline = yyvsp[-5].ival;
-                           yyval.opval = newCONDOP(0,
-                               invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); }
+case 25:
+#line 177 "perly.y"
+{ copline = yyvsp[-6].ival;
+                           yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival,
+                                   newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
 break;
-case 23:
-#line 163 "perly.y"
+case 26:
+#line 181 "perly.y"
 { copline = yyvsp[-3].ival;
                            deprecate("if BLOCK BLOCK");
                            yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); }
 break;
-case 24:
-#line 167 "perly.y"
+case 27:
+#line 185 "perly.y"
 { copline = yyvsp[-3].ival;
                            deprecate("unless BLOCK BLOCK");
                            yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))),
                                                scope(yyvsp[-1].opval), yyvsp[0].opval); }
 break;
-case 25:
-#line 174 "perly.y"
+case 28:
+#line 192 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 26:
-#line 176 "perly.y"
+case 29:
+#line 194 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
-case 27:
-#line 180 "perly.y"
-{ copline = yyvsp[-5].ival;
-                           yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); }
+case 30:
+#line 198 "perly.y"
+{ copline = yyvsp[-6].ival;
+                           yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival,
+                                  newSTATEOP(0, yyvsp[-7].pval,
+                                     newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) )); }
 break;
-case 28:
-#line 185 "perly.y"
-{ copline = yyvsp[-5].ival;
-                           yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); }
+case 31:
+#line 204 "perly.y"
+{ copline = yyvsp[-6].ival;
+                           yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival,
+                                  newSTATEOP(0, yyvsp[-7].pval,
+                                     newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) )); }
 break;
-case 29:
-#line 190 "perly.y"
+case 32:
+#line 210 "perly.y"
 { copline = yyvsp[-3].ival;
                            yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
                                    newWHILEOP(0, 1, (LOOP*)Nullop,
                                        scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); }
 break;
-case 30:
-#line 195 "perly.y"
+case 33:
+#line 215 "perly.y"
 { copline = yyvsp[-3].ival;
                            yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
                                    newWHILEOP(0, 1, (LOOP*)Nullop,
                                        invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
-case 31:
-#line 200 "perly.y"
+case 34:
+#line 220 "perly.y"
+{ yyval.opval = block_end(yyvsp[-8].ival, yyvsp[-6].ival,
+                                 newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
+break;
+case 35:
+#line 223 "perly.y"
 { yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP),
                                yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
-case 32:
-#line 203 "perly.y"
-{ yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+case 36:
+#line 226 "perly.y"
+{ yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival,
+                                newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
-case 33:
-#line 206 "perly.y"
-{  copline = yyvsp[-8].ival;
-                           yyval.opval = append_elem(OP_LINESEQ,
-                                   newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)),
-                                   newSTATEOP(0, yyvsp[-9].pval,
-                                       newWHILEOP(0, 1, (LOOP*)Nullop,
-                                           scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); }
+case 37:
+#line 229 "perly.y"
+{ if (yyvsp[-1].opval) {
+                                   yyvsp[-1].opval = scalar(yyvsp[-1].opval);
+                                   if (min_intro_pending)
+                                     yyvsp[-1].opval = newSTATEOP(0, Nullch, yyvsp[-1].opval); } }
 break;
-case 34:
-#line 213 "perly.y"
+case 38:
+#line 234 "perly.y"
+{ yyvsp[-1].opval = scalar(yyvsp[-1].opval);
+                                 if (min_intro_pending)
+                                   yyvsp[-1].opval = newSTATEOP(0, Nullch, yyvsp[-1].opval); }
+break;
+case 39:
+#line 239 "perly.y"
+{ copline = yyvsp[-11].ival;
+                           yyval.opval = block_end(yyvsp[-11].ival, yyvsp[-9].ival,
+                                  append_elem(OP_LINESEQ, yyvsp[-8].opval,
+                                     newSTATEOP(0, yyvsp[-12].pval,
+                                        newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                   yyvsp[-5].opval, yyvsp[0].opval, scalar(yyvsp[-2].opval))))); }
+break;
+case 40:
+#line 246 "perly.y"
 { yyval.opval = newSTATEOP(0,
                                yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop,
                                        Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
-case 35:
-#line 219 "perly.y"
+case 41:
+#line 252 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 37:
-#line 224 "perly.y"
+case 43:
+#line 257 "perly.y"
 { (void)scan_num("1"); yyval.opval = yylval.opval; }
 break;
-case 39:
-#line 229 "perly.y"
+case 45:
+#line 262 "perly.y"
+{ yyval.opval = invert(scalar(yyvsp[0].opval)); }
+break;
+case 46:
+#line 266 "perly.y"
+{ yyval.opval = min_intro_pending
+                               ? newSTATEOP(0, Nullch, yyvsp[0].opval) : yyvsp[0].opval; }
+break;
+case 47:
+#line 271 "perly.y"
+{ yyval.opval = min_intro_pending
+                               ? newSTATEOP(0, Nullch, yyvsp[0].opval) : yyvsp[0].opval; }
+break;
+case 48:
+#line 276 "perly.y"
+{ yyval.opval = min_intro_pending
+                               ? newSTATEOP(0, Nullch, yyvsp[0].opval) : yyvsp[0].opval; }
+break;
+case 49:
+#line 281 "perly.y"
 { yyval.pval = Nullch; }
 break;
-case 41:
-#line 234 "perly.y"
+case 51:
+#line 286 "perly.y"
 { yyval.ival = 0; }
 break;
-case 42:
-#line 236 "perly.y"
+case 52:
+#line 288 "perly.y"
 { yyval.ival = 0; }
 break;
-case 43:
-#line 238 "perly.y"
+case 53:
+#line 290 "perly.y"
 { yyval.ival = 0; }
 break;
-case 44:
-#line 240 "perly.y"
+case 54:
+#line 292 "perly.y"
 { yyval.ival = 0; }
 break;
-case 45:
-#line 244 "perly.y"
+case 55:
+#line 296 "perly.y"
 { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
-case 46:
-#line 246 "perly.y"
+case 56:
+#line 298 "perly.y"
 { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); }
 break;
-case 47:
-#line 250 "perly.y"
+case 57:
+#line 302 "perly.y"
 { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
-case 48:
-#line 252 "perly.y"
+case 58:
+#line 304 "perly.y"
 { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; }
 break;
-case 49:
-#line 256 "perly.y"
+case 59:
+#line 308 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 51:
-#line 261 "perly.y"
+case 61:
+#line 313 "perly.y"
 { yyval.ival = start_subparse(); }
 break;
-case 52:
-#line 265 "perly.y"
+case 62:
+#line 317 "perly.y"
 { package(yyvsp[-1].opval); }
 break;
-case 53:
-#line 267 "perly.y"
+case 63:
+#line 319 "perly.y"
 { package(Nullop); }
 break;
-case 54:
-#line 271 "perly.y"
+case 64:
+#line 323 "perly.y"
 { utilize(yyvsp[-5].ival, yyvsp[-4].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
 break;
-case 55:
-#line 275 "perly.y"
+case 65:
+#line 327 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 56:
-#line 277 "perly.y"
+case 66:
+#line 329 "perly.y"
 { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 58:
-#line 282 "perly.y"
+case 68:
+#line 334 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
-case 59:
-#line 284 "perly.y"
+case 69:
+#line 336 "perly.y"
 { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 61:
-#line 289 "perly.y"
+case 71:
+#line 341 "perly.y"
 { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
                                prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
 break;
-case 62:
-#line 292 "perly.y"
+case 72:
+#line 344 "perly.y"
 { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
                                prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
 break;
-case 63:
-#line 295 "perly.y"
+case 73:
+#line 347 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
-                                   prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval),
+                                   prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval),
                                    newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
 break;
-case 64:
-#line 300 "perly.y"
+case 74:
+#line 352 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
                                    prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
                                    newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
 break;
-case 65:
-#line 305 "perly.y"
+case 75:
+#line 357 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
                                    prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
                                    newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
 break;
-case 66:
-#line 310 "perly.y"
+case 76:
+#line 362 "perly.y"
 { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
-case 67:
-#line 312 "perly.y"
+case 77:
+#line 364 "perly.y"
 { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
-case 68:
-#line 314 "perly.y"
+case 78:
+#line 366 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST,
                              prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval),
                              yyvsp[-3].opval)); }
 break;
-case 71:
-#line 325 "perly.y"
+case 81:
+#line 377 "perly.y"
 { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
 break;
-case 72:
-#line 327 "perly.y"
+case 82:
+#line 379 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 73:
-#line 329 "perly.y"
+case 83:
+#line 381 "perly.y"
 {   if (yyvsp[-1].ival != OP_REPEAT)
                                scalar(yyvsp[-2].opval);
                            yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
 break;
-case 74:
-#line 333 "perly.y"
+case 84:
+#line 385 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 75:
-#line 335 "perly.y"
+case 85:
+#line 387 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 76:
-#line 337 "perly.y"
+case 86:
+#line 389 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 77:
-#line 339 "perly.y"
+case 87:
+#line 391 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 78:
-#line 341 "perly.y"
+case 88:
+#line 393 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 79:
-#line 343 "perly.y"
+case 89:
+#line 395 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
-case 80:
-#line 345 "perly.y"
+case 90:
+#line 397 "perly.y"
 { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
 break;
-case 81:
-#line 347 "perly.y"
+case 91:
+#line 399 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 82:
-#line 349 "perly.y"
+case 92:
+#line 401 "perly.y"
 { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 83:
-#line 351 "perly.y"
+case 93:
+#line 403 "perly.y"
 { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 84:
-#line 353 "perly.y"
+case 94:
+#line 405 "perly.y"
 { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
-case 85:
-#line 356 "perly.y"
+case 95:
+#line 408 "perly.y"
 { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
 break;
-case 86:
-#line 358 "perly.y"
+case 96:
+#line 410 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 87:
-#line 360 "perly.y"
+case 97:
+#line 412 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
-case 88:
-#line 362 "perly.y"
+case 98:
+#line 414 "perly.y"
 { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
 break;
-case 89:
-#line 364 "perly.y"
+case 99:
+#line 416 "perly.y"
 { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
 break;
-case 90:
-#line 366 "perly.y"
+case 100:
+#line 418 "perly.y"
 { yyval.opval = newUNOP(OP_POSTINC, 0,
                                        mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
 break;
-case 91:
-#line 369 "perly.y"
+case 101:
+#line 421 "perly.y"
 { yyval.opval = newUNOP(OP_POSTDEC, 0,
                                        mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
 break;
-case 92:
-#line 372 "perly.y"
+case 102:
+#line 424 "perly.y"
 { yyval.opval = newUNOP(OP_PREINC, 0,
                                        mod(scalar(yyvsp[0].opval), OP_PREINC)); }
 break;
-case 93:
-#line 375 "perly.y"
+case 103:
+#line 427 "perly.y"
 { yyval.opval = newUNOP(OP_PREDEC, 0,
                                        mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
 break;
-case 94:
-#line 378 "perly.y"
+case 104:
+#line 430 "perly.y"
 { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
 break;
-case 95:
-#line 380 "perly.y"
+case 105:
+#line 432 "perly.y"
 { yyval.opval = sawparens(yyvsp[-1].opval); }
 break;
-case 96:
-#line 382 "perly.y"
+case 106:
+#line 434 "perly.y"
 { yyval.opval = sawparens(newNULLLIST()); }
 break;
-case 97:
-#line 384 "perly.y"
+case 107:
+#line 436 "perly.y"
 { yyval.opval = newANONLIST(yyvsp[-1].opval); }
 break;
-case 98:
-#line 386 "perly.y"
+case 108:
+#line 438 "perly.y"
 { yyval.opval = newANONLIST(Nullop); }
 break;
-case 99:
-#line 388 "perly.y"
+case 109:
+#line 440 "perly.y"
 { yyval.opval = newANONHASH(yyvsp[-2].opval); }
 break;
-case 100:
-#line 390 "perly.y"
+case 110:
+#line 442 "perly.y"
 { yyval.opval = newANONHASH(Nullop); }
 break;
-case 101:
-#line 392 "perly.y"
+case 111:
+#line 444 "perly.y"
 { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
-case 102:
-#line 394 "perly.y"
+case 112:
+#line 446 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 103:
-#line 396 "perly.y"
+case 113:
+#line 448 "perly.y"
 { yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
 break;
-case 104:
-#line 398 "perly.y"
+case 114:
+#line 450 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 105:
-#line 400 "perly.y"
+case 115:
+#line 452 "perly.y"
 { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
 break;
-case 106:
-#line 402 "perly.y"
+case 116:
+#line 454 "perly.y"
 { yyval.opval = newBINOP(OP_AELEM, 0,
                                        ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
                                        scalar(yyvsp[-1].opval));}
 break;
-case 107:
-#line 406 "perly.y"
+case 117:
+#line 458 "perly.y"
 { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
                                        ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
                                        scalar(yyvsp[-1].opval));}
 break;
-case 108:
-#line 410 "perly.y"
+case 118:
+#line 462 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 109:
-#line 412 "perly.y"
+case 119:
+#line 464 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 110:
-#line 414 "perly.y"
+case 120:
+#line 466 "perly.y"
 { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
 break;
-case 111:
-#line 416 "perly.y"
+case 121:
+#line 468 "perly.y"
 { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
                            expect = XOPERATOR; }
 break;
-case 112:
-#line 419 "perly.y"
+case 122:
+#line 471 "perly.y"
 { yyval.opval = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
                                        jmaybe(yyvsp[-2].opval));
                            expect = XOPERATOR; }
 break;
-case 113:
-#line 424 "perly.y"
+case 123:
+#line 476 "perly.y"
 { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
                                        jmaybe(yyvsp[-2].opval));
                            expect = XOPERATOR; }
 break;
-case 114:
-#line 429 "perly.y"
+case 124:
+#line 481 "perly.y"
 { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
 break;
-case 115:
-#line 431 "perly.y"
+case 125:
+#line 483 "perly.y"
 { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
 break;
-case 116:
-#line 433 "perly.y"
+case 126:
+#line 485 "perly.y"
 { yyval.opval = prepend_elem(OP_ASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_ASLICE, 0,
                                        list(yyvsp[-1].opval),
                                        ref(yyvsp[-3].opval, OP_ASLICE))); }
 break;
-case 117:
-#line 439 "perly.y"
+case 127:
+#line 491 "perly.y"
 { yyval.opval = prepend_elem(OP_HSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_HSLICE, 0,
@@ -2057,38 +2054,38 @@ case 117:
                                        ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)));
                            expect = XOPERATOR; }
 break;
-case 118:
-#line 446 "perly.y"
+case 128:
+#line 498 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 119:
-#line 448 "perly.y"
+case 129:
+#line 500 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
 break;
-case 120:
-#line 450 "perly.y"
+case 130:
+#line 502 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
 break;
-case 121:
-#line 452 "perly.y"
+case 131:
+#line 504 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
 break;
-case 122:
-#line 455 "perly.y"
+case 132:
+#line 507 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
-case 123:
-#line 458 "perly.y"
+case 133:
+#line 510 "perly.y"
 { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
 break;
-case 124:
-#line 460 "perly.y"
+case 134:
+#line 512 "perly.y"
 { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
 break;
-case 125:
-#line 462 "perly.y"
+case 135:
+#line 514 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
@@ -2097,8 +2094,8 @@ case 125:
                                    scalar(yyvsp[-2].opval)
                                )),Nullop)); dep();}
 break;
-case 126:
-#line 470 "perly.y"
+case 136:
+#line 522 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
                            OPf_SPECIAL|OPf_STACKED,
                            append_elem(OP_LIST,
@@ -2108,139 +2105,151 @@ case 126:
                                    scalar(yyvsp[-3].opval)
                                )))); dep();}
 break;
-case 127:
-#line 479 "perly.y"
+case 137:
+#line 531 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
 break;
-case 128:
-#line 483 "perly.y"
+case 138:
+#line 535 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
                            prepend_elem(OP_LIST,
                                yyvsp[-1].opval,
                                scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
 break;
-case 129:
-#line 488 "perly.y"
+case 139:
+#line 540 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
                            hints |= HINT_BLOCK_SCOPE; }
 break;
-case 130:
-#line 491 "perly.y"
+case 140:
+#line 543 "perly.y"
 { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
-case 131:
-#line 493 "perly.y"
+case 141:
+#line 545 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
-case 132:
-#line 495 "perly.y"
+case 142:
+#line 547 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
-case 133:
-#line 497 "perly.y"
+case 143:
+#line 549 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
-case 134:
-#line 499 "perly.y"
+case 144:
+#line 551 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
-case 135:
-#line 501 "perly.y"
+case 145:
+#line 553 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
-case 136:
-#line 504 "perly.y"
+case 146:
+#line 556 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
-case 137:
-#line 506 "perly.y"
+case 147:
+#line 558 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, 0); }
 break;
-case 138:
-#line 508 "perly.y"
+case 148:
+#line 560 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0,
                                scalar(yyvsp[0].opval)); }
 break;
-case 139:
-#line 511 "perly.y"
+case 149:
+#line 563 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
 break;
-case 140:
-#line 513 "perly.y"
+case 150:
+#line 565 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
-case 141:
-#line 515 "perly.y"
+case 151:
+#line 567 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
 break;
-case 142:
-#line 517 "perly.y"
+case 152:
+#line 569 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
 break;
-case 145:
-#line 523 "perly.y"
+case 155:
+#line 575 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 146:
-#line 525 "perly.y"
+case 156:
+#line 577 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 147:
-#line 529 "perly.y"
+case 157:
+#line 581 "perly.y"
 { yyval.opval = Nullop; }
 break;
-case 148:
-#line 531 "perly.y"
+case 158:
+#line 583 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-case 149:
-#line 533 "perly.y"
+case 159:
+#line 585 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
-case 150:
-#line 537 "perly.y"
+case 160:
+#line 588 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 161:
+#line 589 "perly.y"
+{ yyval.ival = 1; }
+break;
+case 162:
+#line 593 "perly.y"
+{ in_my = 0; yyval.opval = my(yyvsp[0].opval); }
+break;
+case 163:
+#line 597 "perly.y"
 { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
-case 151:
-#line 541 "perly.y"
+case 164:
+#line 601 "perly.y"
 { yyval.opval = newSVREF(yyvsp[0].opval); }
 break;
-case 152:
-#line 545 "perly.y"
+case 165:
+#line 605 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
-case 153:
-#line 549 "perly.y"
+case 166:
+#line 609 "perly.y"
 { yyval.opval = newHVREF(yyvsp[0].opval); }
 break;
-case 154:
-#line 553 "perly.y"
+case 167:
+#line 613 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
-case 155:
-#line 557 "perly.y"
+case 168:
+#line 617 "perly.y"
 { yyval.opval = newGVREF(0,yyvsp[0].opval); }
 break;
-case 156:
-#line 561 "perly.y"
+case 169:
+#line 621 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval); }
 break;
-case 157:
-#line 563 "perly.y"
+case 170:
+#line 623 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval);  }
 break;
-case 158:
-#line 565 "perly.y"
+case 171:
+#line 625 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
-case 159:
-#line 568 "perly.y"
+case 172:
+#line 628 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2230 "y.tab.c"
+#line 2240 "perly.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
diff --git a/perly.c.diff b/perly.c.diff

index f31072a..cc55c40 100644 (file)
--- a/perly.c.diff
+++ b/perly.c.diff
@@ -1,7 +1,6 @@
-*** perly.c.orig       Sun Jul  7 23:27:45 1996
---- perly.c    Sun Jul  7 23:27:46 1996
+Index: perly.c
 ***************
-*** 12,82 ****
+*** 12,83 ****
       deprecate("\"do\" to call subroutines");
   }
   
@@ -47,35 +46,36 @@
 - #define ADDOP 288
 - #define DOLSHARP 289
 - #define DO 290
-- #define LOCAL 291
-- #define HASHBRACK 292
-- #define NOAMP 293
-- #define OROP 294
-- #define ANDOP 295
-- #define NOTOP 296
-- #define LSTOP 297
-- #define ASSIGNOP 298
-- #define OROR 299
-- #define ANDAND 300
-- #define BITOROP 301
-- #define BITANDOP 302
-- #define UNIOP 303
-- #define SHIFTOP 304
-- #define MATCHOP 305
-- #define UMINUS 306
-- #define REFGEN 307
-- #define POWOP 308
-- #define PREINC 309
-- #define PREDEC 310
-- #define POSTINC 311
-- #define POSTDEC 312
-- #define ARROW 313
+- #define HASHBRACK 291
+- #define NOAMP 292
+- #define LOCAL 293
+- #define MY 294
+- #define OROP 295
+- #define ANDOP 296
+- #define NOTOP 297
+- #define LSTOP 298
+- #define ASSIGNOP 299
+- #define OROR 300
+- #define ANDAND 301
+- #define BITOROP 302
+- #define BITANDOP 303
+- #define UNIOP 304
+- #define SHIFTOP 305
+- #define MATCHOP 306
+- #define UMINUS 307
+- #define REFGEN 308
+- #define POWOP 309
+- #define PREINC 310
+- #define PREDEC 311
+- #define POSTINC 312
+- #define POSTDEC 313
+- #define ARROW 314
   #define YYERRCODE 256
   short yylhs[] = {                                        -1,
-     31,    0,    5,    3,    6,    6,    6,    7,    7,    7,
+     40,    0,    7,    5,    8,    9,    6,   10,   10,   10,
 --- 12,17 ----
 ***************
-*** 1375,1387 ****
+*** 1316,1342 ****
   int yynerrs;
   int yyerrflag;
   int yychar;
@@ -86,13 +86,32 @@
 - short yyss[YYSTACKSIZE];
 - YYSTYPE yyvs[YYSTACKSIZE];
 - #define yystacksize YYSTACKSIZE
-  #line 571 "perly.y"
+  #line 631 "perly.y"
    /* PROGRAM */
-  #line 1388 "y.tab.c"
---- 1310,1317 ----
-***************
-*** 1388,1401 ****
---- 1318,1376 ----
+  #line 1329 "y.tab.c"
+  #define YYABORT goto yyabort
+  #define YYACCEPT goto yyaccept
+  #define YYERROR goto yyerrlab
+  int
+  yyparse()
+  {
+      register int yym, yyn, yystate;
+  #if YYDEBUG
+      register char *yys;
+      extern char *getenv();
+  
+      if (yys = getenv("YYDEBUG"))
+      {
+          yyn = *yys;
+--- 1250,1316 ----
+  int yynerrs;
+  int yyerrflag;
+  int yychar;
+  YYSTYPE yyval;
+  YYSTYPE yylval;
+  #line 631 "perly.y"
+   /* PROGRAM */
+  #line 1329 "y.tab.c"
   #define YYABORT goto yyabort
   #define YYACCEPT goto yyaccept
   #define YYERROR goto yyerrlab
@@ -138,7 +157,7 @@
       register char *yys;
       extern char *getenv();
 + #endif
-  
++ 
 +     struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
 +     SAVEDESTRUCTOR(yydestruct, ysave);
 +     ysave->oldyydebug        = yydebug;
@@ -147,14 +166,14 @@
 +     ysave->oldyychar = yychar;
 +     ysave->oldyyval  = yyval;
 +     ysave->oldyylval = yylval;
-+ 
+  
 + #if YYDEBUG
       if (yys = getenv("YYDEBUG"))
       {
           yyn = *yys;
 ***************
-*** 1408,1413 ****
---- 1383,1396 ----
+*** 1349,1354 ****
+--- 1323,1336 ----
       yyerrflag = 0;
       yychar = (-1);
   
@@ -170,7 +189,7 @@
       yyvsp = yyvs;
       *yyssp = yystate = 0;
 ***************
-*** 1423,1429 ****
+*** 1364,1370 ****
               yys = 0;
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
@@ -178,7 +197,7 @@
                       yychar, yys);
           }
   #endif
---- 1406,1412 ----
+--- 1346,1352 ----
               yys = 0;
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
@@ -187,7 +206,7 @@
           }
   #endif
 ***************
-*** 1433,1444 ****
+*** 1374,1385 ****
       {
   #if YYDEBUG
           if (yydebug)
@@ -200,7 +219,7 @@
           }
           *++yyssp = yystate = yytable[yyn];
           *++yyvsp = yylval;
---- 1416,1441 ----
+--- 1356,1381 ----
       {
   #if YYDEBUG
           if (yydebug)
@@ -228,7 +247,7 @@
           *++yyssp = yystate = yytable[yyn];
           *++yyvsp = yylval;
 ***************
-*** 1474,1485 ****
+*** 1415,1426 ****
               {
   #if YYDEBUG
                   if (yydebug)
@@ -241,7 +260,7 @@
                   }
                   *++yyssp = yystate = yytable[yyn];
                   *++yyvsp = yylval;
---- 1471,1497 ----
+--- 1411,1437 ----
               {
   #if YYDEBUG
                   if (yydebug)
@@ -270,7 +289,7 @@
                   *++yyssp = yystate = yytable[yyn];
                   *++yyvsp = yylval;
 ***************
-*** 1489,1496 ****
+*** 1430,1437 ****
               {
   #if YYDEBUG
                   if (yydebug)
@@ -279,7 +298,7 @@
   #endif
                   if (yyssp <= yyss) goto yyabort;
                   --yyssp;
---- 1501,1509 ----
+--- 1441,1449 ----
               {
   #if YYDEBUG
                   if (yydebug)
@@ -290,7 +309,7 @@
                   if (yyssp <= yyss) goto yyabort;
                   --yyssp;
 ***************
-*** 1507,1514 ****
+*** 1448,1455 ****
               yys = 0;
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
@@ -299,7 +318,7 @@
           }
   #endif
           yychar = (-1);
---- 1520,1528 ----
+--- 1460,1468 ----
               yys = 0;
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
@@ -310,7 +329,7 @@
   #endif
           yychar = (-1);
 ***************
-*** 1517,1523 ****
+*** 1458,1464 ****
   yyreduce:
   #if YYDEBUG
       if (yydebug)
@@ -318,7 +337,7 @@
                   yystate, yyn, yyrule[yyn]);
   #endif
       yym = yylen[yyn];
---- 1531,1537 ----
+--- 1471,1477 ----
   yyreduce:
   #if YYDEBUG
       if (yydebug)
@@ -327,7 +346,7 @@
   #endif
       yym = yylen[yyn];
 ***************
-*** 2236,2243 ****
+*** 2246,2253 ****
       {
   #if YYDEBUG
           if (yydebug)
@@ -336,7 +355,7 @@
   #endif
           yystate = YYFINAL;
           *++yyssp = YYFINAL;
---- 2250,2258 ----
+--- 2259,2267 ----
       {
   #if YYDEBUG
           if (yydebug)
@@ -347,7 +366,7 @@
           yystate = YYFINAL;
           *++yyssp = YYFINAL;
 ***************
-*** 2251,2257 ****
+*** 2261,2267 ****
                   yys = 0;
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
@@ -355,7 +374,7 @@
                           YYFINAL, yychar, yys);
               }
   #endif
---- 2266,2272 ----
+--- 2275,2281 ----
                   yys = 0;
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
@@ -364,7 +383,7 @@
               }
   #endif
 ***************
-*** 2266,2285 ****
+*** 2276,2295 ****
           yystate = yydgoto[yym];
   #if YYDEBUG
       if (yydebug)
@@ -385,7 +404,7 @@
   yyaccept:
 !     return (0);
   }
---- 2281,2315 ----
+--- 2290,2324 ----
           yystate = yydgoto[yym];
   #if YYDEBUG
       if (yydebug)
diff --git a/perly.h b/perly.h

index 43f9d04..1d9f7ad 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -32,29 +32,30 @@
 #define ADDOP 288
 #define DOLSHARP 289
 #define DO 290
-#define LOCAL 291
-#define HASHBRACK 292
-#define NOAMP 293
-#define OROP 294
-#define ANDOP 295
-#define NOTOP 296
-#define LSTOP 297
-#define ASSIGNOP 298
-#define OROR 299
-#define ANDAND 300
-#define BITOROP 301
-#define BITANDOP 302
-#define UNIOP 303
-#define SHIFTOP 304
-#define MATCHOP 305
-#define UMINUS 306
-#define REFGEN 307
-#define POWOP 308
-#define PREINC 309
-#define PREDEC 310
-#define POSTINC 311
-#define POSTDEC 312
-#define ARROW 313
+#define HASHBRACK 291
+#define NOAMP 292
+#define LOCAL 293
+#define MY 294
+#define OROP 295
+#define ANDOP 296
+#define NOTOP 297
+#define LSTOP 298
+#define ASSIGNOP 299
+#define OROR 300
+#define ANDAND 301
+#define BITOROP 302
+#define BITANDOP 303
+#define UNIOP 304
+#define SHIFTOP 305
+#define MATCHOP 306
+#define UMINUS 307
+#define REFGEN 308
+#define POWOP 309
+#define PREINC 310
+#define PREDEC 311
+#define POSTINC 312
+#define POSTDEC 313
+#define ARROW 314
 typedef union {
     I32        ival;
     char *pval;
@@ -62,3 +63,4 @@ typedef union {
     GV *gvval;
 } YYSTYPE;
 extern YYSTYPE yylval;
+extern YYSTYPE yylval;
diff --git a/perly.y b/perly.y

index 57c9630..4feb549 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -43,15 +43,16 @@ dep()
 %token <ival> LOOPEX DOTDOT
 %token <ival> FUNC0 FUNC1 FUNC
 %token <ival> RELOP EQOP MULOP ADDOP
-%token <ival> DOLSHARP DO LOCAL HASHBRACK NOAMP
+%token <ival> DOLSHARP DO HASHBRACK NOAMP
+%token LOCAL MY
 
-%type <ival> prog decl format remember startsub '&'
-%type <opval> block lineseq line loop cond nexpr else argexpr
+%type <ival> prog decl local format startsub remember mremember '&'
+%type <opval> block mblock mintro lineseq line loop cond else
 %type <opval> expr term scalar ary hsh arylen star amper sideff
+%type <opval> argexpr nexpr texpr iexpr mexpr mtexpr miexpr
 %type <opval> listexpr listexprcom indirob
-%type <opval> texpr listop method proto
+%type <opval> listop method proto cont my_scalar
 %type <pval> label
-%type <opval> cont
 
 %left <ival> OROP
 %left ANDOP
@@ -95,8 +96,25 @@ block        :       '{' remember lineseq '}'
                        { $$ = block_end($1,$2,$3); }
        ;
 
-remember:      /* NULL */      /* start a lexical scope */
-                       { $$ = block_start(); }
+remember:      /* NULL */      /* start a full lexical scope */
+                       { $$ = block_start(TRUE); }
+       ;
+
+mblock :       '{' mintro mremember lineseq '}'
+                       { if ($2)
+                           $4 = $4 ? append_list(OP_LINESEQ,
+                                         (LISTOP*)$2, (LISTOP*)$4) : $2;
+                         $$ = block_end($1, $3, $4); }
+       ;
+
+mintro :       /* NULL */      /* introduce pending lexicals */
+                       { $$ = min_intro_pending
+                             ? newSTATEOP(0, Nullch, newOP(OP_NULL, 0))
+                             : NULL; }
+       ;
+
+mremember:     /* NULL */      /* start a partial lexical scope */
+                       { $$ = block_start(FALSE); }
        ;
 
 lineseq        :       /* NULL */
@@ -137,28 +155,28 @@ sideff    :       error
                        { $$ = newLOGOP(OP_OR, 0, $3, $1); }
        |       expr WHILE expr
                        { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
-       |       expr UNTIL expr
-                       { $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);}
+       |       expr UNTIL iexpr
+                       { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
        ;
 
 else   :       /* NULL */
                        { $$ = Nullop; }
-       |       ELSE block
+       |       ELSE mblock
                        { $$ = scope($2); }
-       |       ELSIF '(' expr ')' block else
+       |       ELSIF '(' mexpr ')' mblock else
                        { copline = $1;
-                           $$ = newSTATEOP(0, 0,
-                               newCONDOP(0, $3, scope($5), $6));
+                           $$ = newCONDOP(0, $3, scope($5), $6);
                            hints |= HINT_BLOCK_SCOPE; }
        ;
 
-cond   :       IF '(' expr ')' block else
+cond   :       IF '(' remember mexpr ')' mblock else
                        { copline = $1;
-                           $$ = newCONDOP(0, $3, scope($5), $6); }
-       |       UNLESS '(' expr ')' block else
+                           $$ = block_end($1, $3,
+                                   newCONDOP(0, $4, scope($6), $7)); }
+       |       UNLESS '(' remember miexpr ')' mblock else
                        { copline = $1;
-                           $$ = newCONDOP(0,
-                               invert(scalar($3)), scope($5), $6); }
+                           $$ = block_end($1, $3,
+                                   newCONDOP(0, $4, scope($6), $7)); }
        |       IF block block else
                        { copline = $1;
                            deprecate("if BLOCK BLOCK");
@@ -176,16 +194,18 @@ cont      :       /* NULL */
                        { $$ = scope($2); }
        ;
 
-loop   :       label WHILE '(' texpr ')' block cont
+loop   :       label WHILE '(' remember mtexpr ')' mblock cont
                        { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       $4, $6, $7) ); }
-       |       label UNTIL '(' expr ')' block cont
+                           $$ = block_end($2, $4,
+                                  newSTATEOP(0, $1,
+                                     newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                $5, $7, $8) )); }
+       |       label UNTIL '(' remember miexpr ')' mblock cont
                        { copline = $2;
-                           $$ = newSTATEOP(0, $1,
-                                   newWHILEOP(0, 1, (LOOP*)Nullop,
-                                       invert(scalar($4)), $6, $7) ); }
+                           $$ = block_end($2, $4,
+                                  newSTATEOP(0, $1,
+                                     newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                $5, $7, $8) )); }
        |       label WHILE block block cont
                        { copline = $2;
                            $$ = newSTATEOP(0, $1,
@@ -196,19 +216,32 @@ loop      :       label WHILE '(' texpr ')' block cont
                            $$ = newSTATEOP(0, $1,
                                    newWHILEOP(0, 1, (LOOP*)Nullop,
                                        invert(scalar(scope($3))), $4, $5)); }
+       |       label FOR MY remember my_scalar '(' expr ')' mblock cont
+                       { $$ = block_end($2, $4,
+                                 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
        |       label FOR scalar '(' expr ')' block cont
                        { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
                                $5, $7, $8); }
-       |       label FOR '(' expr ')' block cont
-                       { $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); }
-       |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+       |       label FOR '(' remember expr ')' mblock cont
+                       { $$ = block_end($2, $4,
+                                newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
+       |       label FOR '(' remember nexpr ';'
+                               { if ($5) {
+                                   $5 = scalar($5);
+                                   if (min_intro_pending)
+                                     $5 = newSTATEOP(0, Nullch, $5); } }
+                             texpr ';'
+                               { $8 = scalar($8);
+                                 if (min_intro_pending)
+                                   $8 = newSTATEOP(0, Nullch, $8); }
+                             nexpr ')' mblock
                        /* basically fake up an initialize-while lineseq */
-                       {  copline = $2;
-                           $$ = append_elem(OP_LINESEQ,
-                                   newSTATEOP(0, $1, scalar($4)),
-                                   newSTATEOP(0, $1,
-                                       newWHILEOP(0, 1, (LOOP*)Nullop,
-                                           scalar($6), $10, scalar($8)) )); }
+                       { copline = $2;
+                           $$ = block_end($2, $4,
+                                  append_elem(OP_LINESEQ, $5,
+                                     newSTATEOP(0, $1,
+                                        newWHILEOP(0, 1, (LOOP*)Nullop,
+                                                   $8, $13, scalar($11))))); }
        |       label block cont  /* a block is a loop that happens once */
                        { $$ = newSTATEOP(0,
                                $1, newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -225,6 +258,25 @@ texpr      :       /* NULL means true */
        |       expr
        ;
 
+iexpr  :       expr
+                       { $$ = invert(scalar($1)); }
+       ;
+
+mexpr  :       expr
+                       { $$ = min_intro_pending
+                               ? newSTATEOP(0, Nullch, $1) : $1; }
+       ;
+
+mtexpr :       texpr
+                       { $$ = min_intro_pending
+                               ? newSTATEOP(0, Nullch, $1) : $1; }
+       ;
+
+miexpr :       iexpr
+                       { $$ = min_intro_pending
+                               ? newSTATEOP(0, Nullch, $1) : $1; }
+       ;
+
 label  :       /* empty */
                        { $$ = Nullch; }
        |       LABEL
@@ -294,7 +346,7 @@ listop      :       LSTOP indirob argexpr
        |       term ARROW method '(' listexprcom ')'
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
-                                   prepend_elem(OP_LIST, $1, $5),
+                                   prepend_elem(OP_LIST, scalar($1), $5),
                                    newUNOP(OP_METHOD, 0, $3))); }
        |       METHOD indirob listexpr
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
@@ -374,7 +426,7 @@ term        :       term ASSIGNOP term
        |       PREDEC term
                        { $$ = newUNOP(OP_PREDEC, 0,
                                        mod(scalar($2), OP_PREDEC)); }
-       |       LOCAL term      %prec UNIOP
+       |       local term      %prec UNIOP
                        { $$ = localize($2,$1); }
        |       '(' expr ')'
                        { $$ = sawparens($2); }
@@ -533,6 +585,14 @@ listexprcom:       /* NULL */
                        { $$ = $1; }
        ;
 
+local  :       LOCAL   { $$ = 0; }
+       |       MY      { $$ = 1; }
+       ;
+
+my_scalar:     scalar
+                       { in_my = 0; $$ = my($1); }
+       ;
+
 amper  :       '&' indirob
                        { $$ = newCVREF($1,$2); }
        ;
diff --git a/pod/buildtoc b/pod/buildtoc

index 8a9b7ff..daf26c1 100644 (file)
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -126,7 +126,7 @@ podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
 
        =head1 AUTHOR
 
-       Larry Wall E<lt>F<lwall\@sems.com>E<gt>, with the help of oodles 
+       Larry Wall E<lt>F<larry\@wall.org>E<gt>, with the help of oodles 
        of other folks.
 
 
diff --git a/pod/perldata.pod b/pod/perldata.pod

index 34fd199..c114471 100644 (file)
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -239,12 +239,13 @@ integer formats:
     0377               # octal
     4_294_967_296      # underline for legibility
 
-String literals are usually delimited by either single or double quotes.  They
-work much like shell quotes:  double-quoted string literals are subject
-to backslash and variable substitution; single-quoted strings are not
-(except for "C<\'>" and "C<\\>").  The usual Unix backslash rules apply for making
-characters such as newline, tab, etc., as well as some more exotic
-forms.  See L<perlop/qq> for a list.
+String literals are usually delimited by either single or double
+quotes.  They work much like shell quotes: double-quoted string
+literals are subject to backslash and variable substitution;
+single-quoted strings are not (except for "C<\'>" and "C<\\>").
+The usual Unix backslash rules apply for making characters such as
+newline, tab, etc., as well as some more exotic forms.  See
+L<perlop/Quote and Quotelike Operators> for a list.
 
 You can also embed newlines directly in your strings, i.e. they can end
 on a different line than they begin.  This is nice, but if you forget
@@ -324,17 +325,18 @@ and is almost always right.  If it does guess wrong, or if you're just
 plain paranoid, you can force the correct interpretation with curly
 brackets as above.
 
-A line-oriented form of quoting is based on the shell "here-doc" syntax.
-Following a C<E<lt>E<lt>> you specify a string to terminate the quoted material,
-and all lines following the current line down to the terminating string
-are the value of the item.  The terminating string may be either an
-identifier (a word), or some quoted text.  If quoted, the type of
-quotes you use determines the treatment of the text, just as in regular
-quoting.  An unquoted identifier works like double quotes.  There must
-be no space between the C<E<lt>E<lt>> and the identifier.  (If you put a space it
-will be treated as a null identifier, which is valid, and matches the
-first blank line.)  The terminating string must appear by itself 
-(unquoted and with no surrounding whitespace) on the terminating line.
+A line-oriented form of quoting is based on the shell "here-doc"
+syntax.  Following a C<E<lt>E<lt>> you specify a string to terminate
+the quoted material, and all lines following the current line down to
+the terminating string are the value of the item.  The terminating
+string may be either an identifier (a word), or some quoted text.  If
+quoted, the type of quotes you use determines the treatment of the
+text, just as in regular quoting.  An unquoted identifier works like
+double quotes.  There must be no space between the C<E<lt>E<lt>> and
+the identifier.  (If you put a space it will be treated as a null
+identifier, which is valid, and matches the first blank line.)  The
+terminating string must appear by itself (unquoted and with no
+surrounding whitespace) on the terminating line.
 
        print <<EOF;    
     The price is $Price.
@@ -511,34 +513,16 @@ Note that just because a hash is initialized in that order doesn't
 mean that it comes out in that order.  See L<perlfunc/sort> for examples
 of how to arrange for an output ordering.
 
-=head2 Typeglobs and FileHandles
+=head2 Typeglobs
 
 Perl uses an internal type called a I<typeglob> to hold an entire
 symbol table entry.  The type prefix of a typeglob is a C<*>, because
 it represents all types.  This used to be the preferred way to 
 pass arrays and hashes by reference into a function, but now that
-we have real references, this is seldom needed.
+we have real references, this is seldom needed.  It also used to be the
+preferred way to pass filehandles into a function, but now
+that we have the *foo{THING} notation it isn't often needed for that,
+either.
 
-One place where you still use typeglobs (or references thereto)
-is for passing or storing filehandles.  If you want to save away
-a filehandle, do it this way:
-
-    $fh = *STDOUT;
-
-or perhaps as a real reference, like this:
-
-    $fh = \*STDOUT;
-
-This is also the way to create a local filehandle.  For example:
-
-    sub newopen {
-       my $path = shift;
-       local *FH;  # not my!
-       open (FH, $path) || return undef;
-       return \*FH;
-    }
-    $fh = newopen('/etc/passwd');
-
-See L<perlref>, L<perlsub>, and L<perlmod/"Symbols Tables"> for more
-discussion on typeglobs.  See L<perlfunc/open> for other ways of
-generating filehandles.
+See L<perlref>, L<perlsub>, and L<perlmod/"Symbol Tables"> for more
+discussion on typeglobs.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod

index 4eed9de..240ebcc 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -162,7 +162,11 @@ the return value of your socket() call?  See L<perlfunc/accept>.
 
 =item Allocation too large: %lx
 
-(F) You can't allocate more than 64K on an MSDOS machine.
+(X) You can't allocate more than 64K on an MSDOS machine.
+
+=item Allocation too large
+
+(F) You can't allocate more than 2^31+"small amount" bytes.
 
 =item Arg too short for msgsnd
 
@@ -387,7 +391,7 @@ that you can chdir to, possibly because it doesn't exist.
 =item Can't coerce %s to integer in %s
 
 (F) Certain types of SVs, in particular real symbol table entries
-(type GLOB), can't be forced to stop being what they are.  So you can't
+(typeglobs), can't be forced to stop being what they are.  So you can't
 say things like:
 
     *foo += 1;
@@ -402,12 +406,12 @@ but then $foo no longer contains a glob.
 =item Can't coerce %s to number in %s
 
 (F) Certain types of SVs, in particular real symbol table entries
-(type GLOB), can't be forced to stop being what they are.
+(typeglobs), can't be forced to stop being what they are.
 
 =item Can't coerce %s to string in %s
 
 (F) Certain types of SVs, in particular real symbol table entries
-(type GLOB), can't be forced to stop being what they are.
+(typeglobs), can't be forced to stop being what they are.
 
 =item Can't create pipe mailbox
 
@@ -692,11 +696,6 @@ redefined subroutine while the old routine is running.  Go figure.
 (F) You tried to unshift an "unreal" array that can't be unshifted, such
 as the main Perl stack.
 
-=item Can't untie: %d inner references still exist
-
-(F) With "use strict untie" in effect, a copy of the object returned
-from C<tie> (or C<tied>) was still valid when C<untie> was called.
-
 =item Can't upgrade that kind of scalar
 
 (P) The internal sv_upgrade routine adds "members" to an SV, making
@@ -1344,7 +1343,7 @@ format, but this indicates you did, and that it didn't exist.
 
 =item Not a GLOB reference
 
-(F) Perl was trying to evaluate a reference to a "type glob" (that is,
+(F) Perl was trying to evaluate a reference to a "typeglob" (that is,
 a symbol table entry that looks like C<*foo>), but found a reference to
 something else instead.  You can use the ref() function to find out
 what kind of ref it really was.  See L<perlref>.
@@ -1399,6 +1398,12 @@ See L<perlform>.
 (F) You can't require the null filename, especially since on many machines
 that means the current directory!  See L<perlfunc/require>.
 
+=item Null picture in formline
+
+(F) The first argument to formline must be a valid format picture
+specification.  It was found to be empty, which probably means you
+supplied it an uninitialized value.  See L<perlform>.
+
 =item NULL OP IN RUN
 
 (P) Some internal routine called run() with a null opcode pointer.
@@ -1448,8 +1453,29 @@ but realloc() wouldn't give it more memory, virtual or otherwise.
 
 =item Out of memory!
 
-(X) The malloc() function returned 0, indicating there was insufficient
-remaining memory (or virtual memory) to satisfy the request.
+(X|F) The malloc() function returned 0, indicating there was insufficient
+remaining memory (or virtual memory) to satisfy the request. Depending
+on the way perl was compiled it may use the contents of C<$^M> as an
+emergency pool after die()ing with this message. In this case the
+error is trappable I<once>.
+
+=item Out of memory during request for %s
+
+(F) The malloc() function returned 0, indicating there was insufficient
+remaining memory (or virtual memory) to satisfy the request. However,
+the request was judged large enough (compile-time default is 64K), so
+a possibility to shut down by trapping this error is granted.
+
+=item Out of memory!
+
+(X|F) The malloc() function returned 0, indicating there was insufficient
+remaining memory (or virtual memory) to satisfy the request. 
+
+The request was judged to be small, so the possibility to trap it
+depends on the way perl was compiled. By default it is not
+trappable. However, if compiled for this, Perl may use the contents of
+C<$^M> as an emergency pool after die()ing with this message. In this
+case the error is trappable I<once>.
 
 =item page overflow
 
@@ -2259,6 +2285,11 @@ a scalar context, the comma is treated like C's comma operator, which
 throws away the left argument, which is not what you want.  See
 L<perlref> for more on this.
 
+=item untie attempted while %d inner references still exist
+
+(W) A copy of the object returned from C<tie> (or C<tied>) was still
+valid when C<untie> was called.
+
 =item Variable "%s" is not exported
 
 (F) While "use strict" in effect, you referred to a global variable
diff --git a/pod/perlembed.pod b/pod/perlembed.pod

index d636a15..186dc88 100644 (file)
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -20,8 +20,8 @@ Read about backquotes and about C<system> and C<exec> in L<perlfunc>.
 
 =item B<Use Perl from Perl?>
 
-Read about C<do> and C<eval> in L<perlfunc> and C<use>
-and C<require> in L<perlmod>.
+Read about C<do> and C<eval> in L<perlfunc/do> and L<perlfunc/eval> and C<use>
+and C<require> in L<perlmod> and L<perlfunc/require>, L<perlfunc/use>.
 
 =item B<Use C from C?>
 
@@ -236,7 +236,7 @@ ours I<perl_eval()>) that wraps around Perl's L<perlfunc/eval>.
 Arguably, this is the only routine you'll ever need to execute
 snippets of Perl code from within your C program.  Your string can be
 as long as you wish; it can contain multiple statements; it can
-use L<perlmod/require> or L<perlfunc/do> to include external Perl
+use L<perlfunc/require> or L<perlfunc/do> to include external Perl
 files.
 
 Our I<perl_eval()> lets us evaluate individual Perl strings, and then
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod

index cb2d93f..d4998cf 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -845,7 +845,9 @@ EXPR is parsed and executed as if it were a little Perl program.  It
 is executed in the context of the current Perl program, so that any
 variable settings, subroutine or format definitions remain afterwards.
 The value returned is the value of the last expression evaluated, or a
-return statement may be used, just as with subroutines.
+return statement may be used, just as with subroutines.  The last
+expression is evaluated in scalar or array context, depending on the
+context of the eval.
 
 If there is a syntax error or runtime error, or a die() statement is
 executed, an undefined value is returned by eval(), and C<$@> is set to the
@@ -898,8 +900,10 @@ instead, as in case 6.
 
 =item exec LIST
 
-The exec() function executes a system command I<AND NEVER RETURNS>.  Use
-the system() function if you want it to return.
+The exec() function executes a system command I<AND NEVER RETURNS>,
+unless the command does not exist and is executed directly instead of
+via C</bin/sh -c> (see below).  Use system() instead of exec() if you
+want it to return.
 
 If there is more than one argument in LIST, or if LIST is an array with
 more than one value, calls execvp(3) with the arguments in LIST.  If
@@ -1447,6 +1451,21 @@ function.  Here's a descending numeric sort of a hash by its values:
        printf "%4d %s\n", $hash{$key}, $key;
     }
 
+As an lvalue C<keys> allows you to increase the number of hash buckets
+allocated for the given associative array.  This can gain you a measure
+of efficiency if you know the hash is going to get big.  (This is
+similar to pre-extending an array by assigning a larger number to
+$#array.)  If you say
+
+    keys %hash = 200;
+
+then C<%hash> will have at least 200 buckets allocated for it.  These
+buckets will be retained even if you do C<%hash = ()>, use C<undef
+%hash> if you want to free the storage while C<%hash> is still in scope.
+You can't shrink the number of buckets allocated for the hash using
+C<keys> in this way (but you needn't worry about doing this by accident,
+as trying has no effect).
+
 =item kill LIST
 
 Sends a signal to a list of processes.  The first element of 
@@ -2653,6 +2672,13 @@ but if you're in the C<FooPack> package, it's
 
     @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 
+The comparison function is required to behave.  If it returns
+inconsistent results (sometimes saying $x[1] is less than $x[2] and
+sometimes saying the opposite, for example) the Perl interpreter will
+probably crash and dump core.  This is entirely due to and dependent
+upon your system's qsort(3) library routine; this routine often avoids
+sanity checks in the interest of speed.
+
 =item splice ARRAY,OFFSET,LENGTH,LIST
 
 =item splice ARRAY,OFFSET,LENGTH
@@ -3236,7 +3262,9 @@ call into the "Module" package to tell the module to import the list of
 features back into the current package.  The module can implement its
 import method any way it likes, though most modules just choose to
 derive their import method via inheritance from the Exporter class that
-is defined in the Exporter module. See L<Exporter>.
+is defined in the Exporter module. See L<Exporter>.  If no import
+method can be found then the error is currently silently ignored. This
+may change to a fatal error in a future version.
 
 If you don't want your namespace altered, explicitly supply an empty list:
 
@@ -3269,6 +3297,8 @@ by use, i.e. it calls C<unimport Module LIST> instead of C<import>.
     no integer;
     no strict 'refs';
 
+If no unimport method can be found the call fails with a fatal error.
+
 See L<perlmod> for a list of standard modules and pragmas.
 
 =item utime LIST
diff --git a/pod/perlguts.pod b/pod/perlguts.pod

index 2e89807..3f36396 100644 (file)
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -146,11 +146,11 @@ Take this code:
 This code tries to return a new SV (which contains the value 42) if it should
 return a real value, or undef otherwise.  Instead it has returned a null
 pointer which, somewhere down the line, will cause a segmentation violation,
-or just weird results.  Change the zero to C<&sv_undef> in the first line and
-all will be well.
+bus error, or just plain weird results.  Change the zero to C<&sv_undef> in
+the first line and all will be well.
 
 To free an SV that you've created, call C<SvREFCNT_dec(SV*)>.  Normally this
-call is not necessary.  See the section on B<MORTALITY>.
+call is not necessary.  See the section on L<Mortality>.
 
 =head2 What's Really Stored in an SV?
 
@@ -345,7 +345,7 @@ A reference can be blessed into a package with the following function:
     SV* sv_bless(SV* sv, HV* stash);
 
 The C<sv> argument must be a reference.  The C<stash> argument specifies
-which class the reference will belong to.  See the L<"Stashes">
+which class the reference will belong to.  See the section on L<Stashes>
 for information on converting class names into stashes.
 
 /* Still under construction */
@@ -448,31 +448,205 @@ to use the macros:
     XPUSHp(char*, I32)
     XPUSHs(SV*)
 
-These macros automatically adjust the stack for you, if needed.
+These macros automatically adjust the stack for you, if needed.  Thus, you
+do not need to call C<EXTEND> to extend the stack.
 
 For more information, consult L<perlxs>.
 
-=head1 Mortality
+=head1 Localizing Changes
+
+Perl has a very handy construction
+
+  {
+    local $var = 2;
+    ...
+  }
+
+This construction is I<approximately> equivalent to
+
+  {
+    my $oldvar = $var;
+    $var = 2;
+    ...
+    $var = $oldvar;
+  }
+
+The biggest difference is that the first construction would would
+reinstate the initial value of $var, irrespective of how control exits
+the block: C<goto>, C<return>, C<die>/C<eval> etc. It is a little bit
+more efficient as well.
+
+There is a way to achieve a similar task from C via Perl API: create a
+I<pseudo-block>, and arrange for some changes to be automatically
+undone at the end of it, either explicit, or via a non-local exit (via
+die()). A I<block>-like construct is created by a pair of
+C<ENTER>/C<LEAVE> macros (see L<perlcall/EXAMPLE/"Returning a
+Scalar">).  Such a construct may be created specially for some
+important localized task, or an existing one (like boundaries of
+enclosing Perl subroutine/block, or an existing pair for freeing TMPs)
+may be used. (In the second case the overhead of additional
+localization must be almost negligible.) Note that any XSUB is
+automatically enclosed in an C<ENTER>/C<LEAVE> pair.
+
+Inside such a I<pseudo-block> the following service is available:
+
+=over
+
+=item C<SAVEINT(int i)>
+
+=item C<SAVEIV(IV i)>
+
+=item C<SAVEI16(I16 i)>
+
+=item C<SAVEI32(I32 i)>
+
+=item C<SAVELONG(long i)>
+
+These macros arrange things to restore the value of integer variable
+C<i> at the end of enclosing I<pseudo-block>.
+
+=item C<SAVESPTR(p)>
+
+=item C<SAVEPPTR(s)>
+
+These macros arrange things to restore the value of pointers C<s> and
+C<p>. C<p> must be a pointer of a type which survives conversion to
+C<SV*> and back, C<s> should be able to survive conversion to C<char*>
+and back.
+
+=item C<SAVEFREESV(SV *sv)>
+
+The refcount of C<sv> would be decremented at the end of
+I<pseudo-block>. This is similar to C<sv_2mortal>, which should (?) be
+used instead.
+
+=item C<SAVEFREEOP(OP *op)>
+
+The C<OP *> is op_free()ed at the end of I<pseudo-block>.
+
+=item C<SAVEFREEPV(p)>
+
+The chunk of memory which is pointed to by C<p> is Safefree()ed at the
+end of I<pseudo-block>.
+
+=item C<SAVECLEARSV(SV *sv)>
+
+Clears a slot in the current scratchpad which corresponds to C<sv> at
+the end of I<pseudo-block>.
+
+=item C<SAVEDELETE(HV *hv, char *key, I32 length)>
 
-In Perl, values are normally "immortal" -- that is, they are not freed unless
-explicitly done so (via the Perl C<undef> call or other routines in Perl
-itself).
+The key C<key> of C<hv> is deleted at the end of I<pseudo-block>. The
+string pointed to by C<key> is Safefree()ed.  If one has a I<key> in
+short-lived storage, the corresponding string may be reallocated like
+this:
 
-Add cruft about reference counts.
-       int SvREFCNT(SV* sv);
-       void SvREFCNT_inc(SV* sv);
-       void SvREFCNT_dec(SV* sv);
+  SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf));
 
-In the above example with C<tzname>, we needed to create two new SVs to push
-onto the argument stack, that being the two strings.  However, we don't want
-these new SVs to stick around forever because they will eventually be
-copied into the SVs that hold the two scalar variables.
+=item C<SAVEDESTRUCTOR(f,p)>
+
+At the end of I<pseudo-block> the function C<f> is called with the
+only argument (of type C<void*>) C<p>.
+
+=item C<SAVESTACK_POS()>
+
+The current offset on the Perl internal stack (cf. C<SP>) is restored
+at the end of I<pseudo-block>.
+
+=back
+
+The following API list contains functions, thus one needs to
+provide pointers to the modifiable data explicitly (either C pointers,
+or Perlish C<GV *>s):
+
+=over
+
+=item C<SV* save_scalar(GV *gv)>
+
+Equivalent to Perl code C<local $gv>.
+
+=item C<AV* save_ary(GV *gv)>
+
+=item C<HV* save_hash(GV *gv)>
+
+Similar to C<save_scalar>, but localize C<@gv> and C<%gv>.
+
+=item C<void save_item(SV *item)>
+
+Duplicates the current value of C<SV>, on the exit from the current
+C<ENTER>/C<LEAVE> I<pseudo-block> will restore the value of C<SV>
+using the stored value.
+
+=item C<void save_list(SV **sarg, I32 maxsarg)>
+
+A variant of C<save_item> which takes multiple arguments via an array
+C<sarg> of C<SV*> of length C<maxsarg>.
+
+=item C<SV* save_svref(SV **sptr)>
+
+Similar to C<save_scalar>, but will reinstate a C<SV *>.
+
+=item C<void save_aptr(AV **aptr)>
+
+=item C<void save_hptr(HV **hptr)>
+
+Similar to C<save_svref>, but localize C<AV *> and C<HV *>.
+
+=item C<void save_nogv(GV *gv)>
+
+Will postpone destruction of a I<stub> glob.
+
+=back
+
+=head1 Mortality
 
-An SV (or AV or HV) that is "mortal" acts in all ways as a normal "immortal"
-SV, AV, or HV, but is only valid in the "current context".  When the Perl
-interpreter leaves the current context, the mortal SV, AV, or HV is
-automatically freed.  Generally the "current context" means a single
-Perl statement.
+Perl uses an reference count-driven garbage collection mechanism. SV's,
+AV's, or HV's (xV for short in the following) start their life with a
+reference count of 1.  If the reference count of an xV ever drops to 0,
+then they will be destroyed and their memory made available for reuse.
+
+This normally doesn't happen at the Perl level unless a variable is
+undef'ed.  At the internal level, however, reference counts can be
+manipulated with the following macros:
+
+    int SvREFCNT(SV* sv);
+    void SvREFCNT_inc(SV* sv);
+    void SvREFCNT_dec(SV* sv);
+
+However, there is one other function which manipulates the reference
+count of its argument.  The C<newRV> function, as you should recall,
+creates a reference to the specified argument.  As a side effect, it
+increments the argument's reference count, which is ok in most
+circumstances.  But imagine you want to return a reference from an XS
+function.  You create a new SV which initially has a reference count
+of 1.  Then you call C<newRV>, passing the just-created SV.  This returns
+the reference as a new SV, but the reference count of the SV you passed
+to C<newRV> has been incremented to 2.  Now you return the reference and
+forget about the SV.  But Perl hasn't!  Whenever the returned reference
+is destroyed, the reference count of the original SV is decreased to 1
+and nothing happens.  The SV will hang around without any way to access
+it until Perl itself terminates.  This is a memory leak.
+
+The correct procedure, then, is to call C<SvREFCNT_dec> on the SV after
+C<newRV> has returned.  Then, if and when the reference is destroyed,
+the reference count of the SV will go to 0 and also be destroyed, stopping
+any memory leak.
+
+There are some convenience functions available that can help with this
+process.  These functions introduce the concept of "mortality".  An xV
+that is mortal has had its reference count marked to be decremented,
+but not actually decremented, until the "current context" is left.
+Generally the "current context" means a single Perl statement, such as
+a call to an XSUB function.
+
+"Mortalization" then is at its simplest a deferred C<SvREFCNT_dec>.
+However, if you mortalize a variable twice, the reference count will
+later be decremented twice.
+
+You should be careful about creating mortal variables.  Strange things
+can happen if you make the same value mortal within multiple contexts,
+or if you make a variable mortal multiple times.  Doing the latter can
+cause a variable to become invalid prematurely.
 
 To create a mortal variable, use the functions:
 
@@ -487,7 +661,7 @@ The mortal routines are not just for SVs -- AVs and HVs can be made mortal
 by passing their address (and casting them to C<SV*>) to the C<sv_2mortal> or
 C<sv_mortalcopy> routines.
 
-From Ilya:
+I<From Ilya:>
 Beware that the sv_2mortal() call is eventually equivalent to
 svREFCNT_dec(). A value can happily be mortal in two different contexts,
 and it will be svREFCNT_dec()ed twice, once on exit from these
@@ -496,9 +670,6 @@ that you should be very careful to make a value mortal exactly as many
 times as it is needed. The value that go to the Perl stack I<should>
 be mortal.
 
-You should be careful about creating mortal variables.  It is possible for
-strange things to happen should you make the same value mortal within
-multiple contexts.
 
 =head1 Stashes
 
@@ -597,7 +768,7 @@ associated with an SV.
 
 The C<name> and C<namlem> arguments are used to associate a string with
 the magic, typically the name of a variable. C<namlem> is stored in the
-C<mg_len> field and if C<name> is non-null and C<namlem> E<gt>= 0 a malloc'd
+C<mg_len> field and if C<name> is non-null and C<namlem> >= 0 a malloc'd
 copy of the name is stored in C<mg_ptr> field.
 
 The sv_magic function uses C<how> to determine which, if any, predefined
@@ -2398,14 +2569,14 @@ destination, C<n> is the number of items, and C<t> is the type.
 
 =head1 AUTHOR
 
-Jeff Okamoto E<lt>F<okamoto@corp.hp.com>E<gt>
+Jeff Okamoto <okamoto@corp.hp.com>
 
 With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
 Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
-Bowers, Matthew Green, Tim Bunce, and Spider Boardman.
+Bowers, Matthew Green, Tim Bunce, Spider Boardman, and Ulrich Pfeifer.
 
-API Listing by Dean Roehrich E<lt>F<roehrich@cray.com>E<gt>.
+API Listing by Dean Roehrich <roehrich@cray.com>.
 
 =head1 DATE
 
-Version 22: 1996/9/23
+Version 23.1: 1996/10/19
diff --git a/pod/perlmod.pod b/pod/perlmod.pod

index 731b25e..7cb3a49 100644 (file)
--- a/pod/perlmod.pod
+++ b/pod/perlmod.pod
@@ -155,6 +155,25 @@ Another use of symbol tables is for making "constant"  scalars.
 
 Now you cannot alter $PI, which is probably a good thing all in all.
 
+You can say C<*foo{PACKAGE}> and C<*foo{NAME}> to find out what name and
+package the *foo symbol table entry comes from.  This may be useful
+in a subroutine which is passed typeglobs as arguments
+
+    sub identify_typeglob {
+        my $glob = shift;
+        print 'You gave me ', *{$glob}{PACKAGE}, '::', *{$glob}{NAME}, "\n";
+    }
+    identify_typeglob *foo;
+    identify_typeglob *bar::baz;
+
+This prints
+
+    You gave me main::foo
+    You gave me bar::baz
+
+The *foo{THING} notation can also be used to obtain references to the
+individual elements of *foo, see L<perlref>.
+
 =head2 Package Constructors and Destructors
 
 There are two special subroutine definitions that function as package
@@ -316,53 +335,64 @@ conversion, but it's just a mechanical process, so is far from bulletproof.
 
 They work somewhat like pragmas in that they tend to affect the compilation of
 your program, and thus will usually only work well when used within a
-C<use>, or C<no>.  These are locally scoped, so an inner BLOCK
-may countermand any of these by saying
+C<use>, or C<no>.  Most of these are locally scoped, so an inner BLOCK
+may countermand any of these by saying:
 
     no integer;
     no strict 'refs';
 
 which lasts until the end of that BLOCK.
 
-The following programs are defined (and have their own documentation).
+Unlike the pragrmas that effect the C<$^H> hints variable, the C<use
+vars> and C<use subs> declarations are not BLOCK-scoped.  They allow
+you to pre-declare a variables or subroutines within a particular
+<I>file</I> rather than just a block.  Such declarations are effective
+for the entire file for which they were declared.  You cannot rescind
+them with C<no vars> or C<no subs>.
+
+The following pragmas are defined (and have their own documentation).
 
 =over 12
 
 =item diagnostics
 
-Pragma to produce enhanced diagnostics
+force verbose warning diagnostics
 
 =item integer
 
-Pragma to compute arithmetic in integer instead of double
+compute arithmetic in integer instead of double
 
 =item less
 
-Pragma to request less of something from the compiler
+request less of something from the compiler
+
+=item lib
+
+manipulate @INC at compile time
 
 =item ops
 
-Pragma to restrict use of unsafe opcodes
+restrict unsafe operations when compiling
 
 =item overload
 
-Pragma for overloading operators 
+package for overloading perl operations
 
 =item sigtrap
 
-Pragma to enable stack backtrace on unexpected signals
+enable simple signal handling
 
 =item strict
 
-Pragma to restrict unsafe constructs
+restrict unsafe constructs
 
 =item subs
 
-Pragma to predeclare sub names
+predeclare sub names
 
 =item vars
 
-Pragma to predeclare global symbols
+predeclare global variable names
 
 =back
 
@@ -396,7 +426,7 @@ warn of errors (from perspective of caller)
 
 =item Config
 
-access Perl configuration option
+access Perl configuration information
 
 =item Cwd
 
@@ -404,27 +434,39 @@ get pathname of current working directory
 
 =item DB_File
 
-Perl access to Berkeley DB
+access to Berkeley DB
 
 =item Devel::SelfStubber
 
 generate stubs for a SelfLoading module
 
+=item DirHandle
+
+supply object methods for directory handles
+
 =item DynaLoader
 
 Dynamically load C libraries into Perl code
 
 =item English
 
-use nice English (or B<awk>) names for ugly punctuation variables
+use nice English (or awk) names for ugly punctuation variables
 
 =item Env
 
-perl module that imports environment variables
+import environment variables
 
 =item Exporter
 
-provide import/export controls for Perl modules
+implements default import method for modules
+
+=item ExtUtils::Embed
+
+Utilities for embedding Perl in C/C++ applications
+
+=item ExtUtils::Install
+
+install files from here to there
 
 =item ExtUtils::Liblist
 
@@ -438,13 +480,37 @@ create an extension Makefile
 
 utilities to write and check a MANIFEST file
 
+=item ExtUtils::Miniperl
+
+write the C code for perlmain.c
+
 =item ExtUtils::Mkbootstrap
 
 make a bootstrap file for use by DynaLoader
 
-=item ExtUtils::Miniperl
+=item ExtUtils::Mksymlists
+
+write linker options files for dynamic extension
+
+=item ExtUtils::MM_OS2
+
+methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=item ExtUtils::MM_Unix
+
+methods used by ExtUtils::MakeMaker
+
+=item ExtUtils::MM_VMS
+
+methods to override UN*X behaviour in ExtUtils::MakeMaker
 
-!!!GOOD QUESTION!!!
+=item ExtUtils::testlib
+
+add blib/* directories to @INC
+
+=item Fatal
+
+replace functions with equivalents which succeed or die
 
 =item Fcntl
 
@@ -454,10 +520,18 @@ load the C Fcntl.h defines
 
 parse file specifications
 
+=item FileCache
+
+keep more files open than the system permits
+
 =item File::CheckTree
 
 run many filetest checks on a tree
 
+=item File::Copy
+
+Copy files or filehandles
+
 =item File::Find
 
 traverse a file tree
@@ -470,46 +544,146 @@ supply object methods for filehandles
 
 create or remove a series of directories
 
+=item FindBin
+
+locate directory of original perl script
+
+=item GDBM_File
+
+access to the gdbm library.
+
 =item Getopt::Long
 
-extended getopt processing
+extended processing of command line options
 
 =item Getopt::Std
 
-Process single-character switches with switch clustering
+process single-character switches with switch clustering
 
 =item I18N::Collate
 
 compare 8-bit scalar data according to the current locale
 
+=item IO
+
+load various IO modules
+
+=item IO::File
+
+supply object methods for filehandles
+
+=item IO::Handle
+
+supply object methods for I/O handles
+
+=item IO::Pipe
+
+supply object methods for pipes
+
+=item IO::Seekable
+
+supply seek based methods for I/O objects
+
+=item IO::Select
+
+OO interface to the select system call
+
+=item IO::Socket
+
+object interface to socket communications
+
 =item IPC::Open2
 
-a process for both reading and writing
+open a process for both reading and writing
 
 =item IPC::Open3
 
 open a process for reading, writing, and error handling
 
+=item Math::BigFloat
+
+arbitrary length float math package
+
+=item Math::BigInt
+
+arbitrary size integer math package
+
+=item Math::Complex
+
+complex numbers and associated mathematical functions
+
+=item NDBM_File
+
+tied access to ndbm files
+
 =item Net::Ping
 
 check a host for upness
 
+=item Opcode
+
+disable named opcodes when compiling perl code
+
+=item Pod::Text
+
+convert POD data to formatted ASCII text
+
 =item POSIX
 
-Perl interface to IEEE Std 1003.1
+interface to IEEE Std 1003.1
+
+=item Safe
+
+compile and execute code in restricted compartments
+
+=item SDBM_File
+
+tied access to sdbm files
+
+=item Search::Dict
+
+search for key in dictionary file
+
+=item SelectSaver
+
+save and restore selected file handle
 
 =item SelfLoader
 
 load functions only on demand
 
-=item Safe
+=item Shell
 
-Creation controlled compartments in which perl code can be evaluated.
+run shell commands transparently within perl
 
 =item Socket
 
 load the C socket.h defines and structure manipulators
 
+=item Symbol
+
+manipulate Perl symbols and their names
+
+=item Sys::Hostname
+
+try every conceivable way to get hostname
+
+=item Sys::Syslog
+
+interface to the UNIX syslog(3) calls
+
+=item Term::Cap
+
+Perl termcap interface
+
+=item Term::Complete
+
+word completion module
+
+=item Term::ReadLine
+
+interface to various readline packages. 
+
 =item Test::Harness
 
 run perl standard test scripts with statistics
@@ -518,6 +692,42 @@ run perl standard test scripts with statistics
 
 create an abbreviation table from a list
 
+=item Text::ParseWords
+
+parse text into an array of tokens
+
+=item Text::Soundex
+
+implementation of the Soundex Algorithm as Described by Knuth
+
+=item Text::Tabs
+
+expand and unexpand tabs per the unix expand(1) and unexpand(1)
+
+=item Text::Wrap
+
+line wrapping to form simple paragraphs
+
+=item Tie::Hash
+
+base class definitions for tied hashes
+
+=item Tie::Scalar
+
+base class definitions for tied scalars
+
+=item Tie::SubstrHash
+
+fixed-table-size, fixed-key-length hashing
+
+=item Time::Local
+
+efficiently compute time from local and GMT time
+
+=item UNIVERSAL
+
+base class for ALL classes (blessed references)
+
 =back
 
 To find out I<all> the modules installed on your system, including
@@ -927,7 +1137,7 @@ Copying, ToDo etc.
 
 =item Adding a Copyright Notice.
 
-How you choose to license your work is a personal decision.
+How you choose to licence your work is a personal decision.
 The general mechanism is to assert your Copyright and then make
 a declaration of how others may copy/use/modify your work.
 
diff --git a/pod/perlobj.pod b/pod/perlobj.pod

index 54e052f..d504d9c 100644 (file)
--- a/pod/perlobj.pod
+++ b/pod/perlobj.pod
@@ -24,7 +24,7 @@ with object references.
 =item 3.
 
 A method is simply a subroutine that expects an object reference (or
-a package name, for static methods) as the first argument.
+a package name, for class methods) as the first argument.
 
 =back
 
@@ -156,17 +156,18 @@ Unlike say C++, Perl doesn't provide any special syntax for method
 definition.  (It does provide a little syntax for method invocation
 though.  More on that later.)  A method expects its first argument
 to be the object or package it is being invoked on.  There are just two
-types of methods, which we'll call static and virtual, in honor of
-the two C++ method types they most closely resemble.
+types of methods, which we'll call class and instance. 
+(Sometimes you'll hear these called static and virtual, in honor of
+the two C++ method types they most closely resemble.)
 
-A static method expects a class name as the first argument.  It
+A class method expects a class name as the first argument.  It
 provides functionality for the class as a whole, not for any individual
-object belonging to the class.  Constructors are typically static
-methods.  Many static methods simply ignore their first argument, since
+object belonging to the class.  Constructors are typically class
+methods.  Many class methods simply ignore their first argument, since
 they already know what package they're in, and don't care what package
 they were invoked via.  (These aren't necessarily the same, since
-static methods follow the inheritance tree just like ordinary virtual
-methods.)  Another typical use for static methods is to look up an
+class methods follow the inheritance tree just like ordinary instance
+methods.)  Another typical use for class methods is to look up an
 object by name:
 
     sub find {
@@ -174,7 +175,7 @@ object by name:
        $objtable{$name};
     }
 
-A virtual method expects an object reference as its first argument.
+An instance method expects an object reference as its first argument.
 Typically it shifts the first argument into a "self" or "this" variable,
 and then uses that as an ordinary reference.
 
@@ -194,9 +195,9 @@ already had an "indirect object" syntax that you use when you say
 
     print STDERR "help!!!\n";
 
-This same syntax can be used to call either static or virtual methods.
-We'll use the two methods defined above, the static method to lookup
-an object reference and the virtual method to print out its attributes.
+This same syntax can be used to call either class or instance methods.
+We'll use the two methods defined above, the class method to lookup
+an object reference and the instance method to print out its attributes.
 
     $fred = find Critter "Fred";
     display $fred 'Height', 'Weight';
@@ -300,7 +301,7 @@ I<undef> is returned.
 
 C<VERSION> returns the VERSION number of the class (package). If
 an argument is given then it will check that the current version is not 
-less that the given argument. This method is normally called as a static
+less that the given argument. This method is normally called as a class
 method. This method is also called when the C<VERSION> form of C<use> is
 used.
 
diff --git a/pod/perlop.pod b/pod/perlop.pod

index 4752148..5645234 100644 (file)
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -145,6 +145,7 @@ is returned.  One effect of these rules is that C<-bareword> is equivalent
 to C<"-bareword">.
 
 Unary "~" performs bitwise negation, i.e. 1's complement.
+(See also L<Integer Arithmetic>.)
 
 Unary "+" has no effect whatsoever, even on strings.  It is useful
 syntactically for separating a function name from a parenthesized expression
@@ -204,13 +205,13 @@ Binary "." concatenates two strings.
 
 =head2 Shift Operators
 
-Binary "E<lt>E<lt>" returns the value of its left argument shifted left by the
-number of bits specified by the right argument.  Arguments should be 
-integers.
+Binary "<<" returns the value of its left argument shifted left by the
+number of bits specified by the right argument.  Arguments should be
+integers.  (See also L<Integer Arithmetic>.)
 
-Binary "E<gt>E<gt>" returns the value of its left argument shifted right by the
-number of bits specified by the right argument.  Arguments should be 
-integers.
+Binary ">>" returns the value of its left argument shifted right by
+the number of bits specified by the right argument.  Arguments should
+be integers.  (See also L<Integer Arithmetic>.)
 
 =head2 Named Unary Operators
 
@@ -292,12 +293,15 @@ less than, equal to, or greater than the right argument.
 =head2 Bitwise And
 
 Binary "&" returns its operators ANDed together bit by bit.
+(See also L<Integer Arithmetic>.)
 
 =head2 Bitwise Or and Exclusive Or
 
 Binary "|" returns its operators ORed together bit by bit.
+(See also L<Integer Arithmetic>.)
 
 Binary "^" returns its operators XORed together bit by bit.
+(See also L<Integer Arithmetic>.)
 
 =head2 C-style Logical And
 
@@ -1103,7 +1107,7 @@ expression represents so that the interpreter
 won't have to.
 
 
-=head2 Integer arithmetic
+=head2 Integer Arithmetic
 
 By default Perl assumes that it must do most of its arithmetic in
 floating point.  But by saying
@@ -1118,3 +1122,9 @@ countermand this by saying
 
 which lasts until the end of that BLOCK.
 
+The bitwise operators ("&", "|", "^", "~", "<<", and ">>") always
+produce integral results.  However, C<use integer> still has meaning
+for them.  By default, their results are interpreted as unsigned
+integers.  However, if C<use integer> is in effect, their results are
+interpeted as signed integers.  For example, C<~0> usually evaluates
+to a large integral value.  However, C<use integer; ~0> is -1.
diff --git a/pod/perlre.pod b/pod/perlre.pod

index 55dc120..c4dbac6 100644 (file)
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -13,10 +13,28 @@ The matching operations can
 have various modifiers, some of which relate to the interpretation of
 the regular expression inside.  These are:
 
-    i   Do case-insensitive pattern matching.
-    m   Treat string as multiple lines.
-    s   Treat string as single line.
-    x   Extend your pattern's legibility with whitespace and comments.
+=over 4
+
+=item i
+
+Do case-insensitive pattern matching.
+
+=item m   
+
+Treat string as multiple lines.  That is, change "^" and "$" from matching
+only at the very start or end of the string to the start or end of any
+line anywhere within the string,
+
+=item s   
+
+Treat string as single line.  That is, change "." to match any character
+whatsoever, even a newline, which it normally would not match.
+
+=item x   
+
+Extend your pattern's legibility by permitting whitespace and comments.
+
+=back
 
 These are usually written as "the C</x> modifier", even though the delimiter
 in question might not actually be a slash.  In fact, any of these
@@ -24,13 +42,15 @@ modifiers may also be embedded within the regular expression itself using
 the new C<(?...)> construct.  See below.
 
 The C</x> modifier itself needs a little more explanation.  It tells
-the regular expression parser to ignore whitespace that is not
-backslashed or within a character class.  You can use this to break up
+the regular expression parser to ignore whitespace that is neither
+backslashed nor within a character class.  You can use this to break up
 your regular expression into (slightly) more readable parts.  The C<#>
 character is also treated as a metacharacter introducing a comment,
-just as in ordinary Perl code.  Taken together, these features go a
-long way towards making Perl 5 a readable language.  See the C comment
-deletion code in L<perlop>.
+just as in ordinary Perl code.  This also means that if you want real
+whitespace or C<#> characters in the pattern that you'll have to either
+escape them or encode them using octal or hex escapes.  Taken together,
+these features go a long way towards making Perl's regular expressions
+more readable.  See the C comment deletion code in L<perlop>.
 
 =head2 Regular Expressions
 
@@ -63,7 +83,7 @@ on the pattern match operator.  (Older programs did this by setting C<$*>,
 but this practice is deprecated in Perl 5.)
 
 To facilitate multi-line substitutions, the "." character never matches a
-newline unless you use the C</s> modifier, which tells Perl to pretend
+newline unless you use the C</s> modifier, which in effect tells Perl to pretend
 the string is a single line--even if it isn't.  The C</s> modifier also
 overrides the setting of C<$*>, in case you have some (badly behaved) older
 code that sets it in another module.
diff --git a/pod/perlref.pod b/pod/perlref.pod

index a7c7f43..18e3553 100644 (file)
--- a/pod/perlref.pod
+++ b/pod/perlref.pod
@@ -53,8 +53,11 @@ reference that the backslash returned.  Here are some examples:
     $arrayref  = \@ARGV;
     $hashref   = \%ENV;
     $coderef   = \&handler;
-    $globref   = \*STDOUT;
+    $globref   = \*foo;
 
+It isn't possible to create a reference to a filehandle using the
+backslash operator.  See the explanation of the *foo{THING} syntax
+below.
 
 =item 2.
 
@@ -188,22 +191,37 @@ talked about dereferencing yet, we can't show you any examples yet.
 
 =item 7.
 
-References to filehandles can be created by taking a reference to 
-a typeglob.  This is currently the best way to pass filehandles into or
-out of subroutines, or to store them in larger data structures.
+A reference can be created by using a special syntax, lovingly known as
+the *foo{THING} syntax.  *foo{THING} returns a reference to the THING
+slot in *foo (which is the symbol table entry which holds everything
+known as foo).
 
-    splutter(\*STDOUT);
+    $scalarref = *foo{SCALAR};
+    $arrayref  = *ARGV{ARRAY};
+    $hashref   = *ENV{HASH};
+    $coderef   = *handler{CODE};
+    $fhref     = *STDIN{FILEHANDLE};
+    $globref   = *foo{GLOB};
+
+Using *foo{FILEHANDLE} is the best way to pass filehandles into or out
+of subroutines, or to store them in larger data structures.
+
+    splutter(*STDOUT{FILEHANDLE});
     sub splutter {
        my $fh = shift;
        print $fh "her um well a hmmm\n";
     }
 
-    $rec = get_rec(\*STDIN);
+    $rec = get_rec(*STDIN{FILEHANDLE});
     sub get_rec {
        my $fh = shift;
        return scalar <$fh>;
     }
 
+The best way to do this used to be to use the entire *foo typeglob (or a
+reference to it), so you'll probably come accross old code which does it
+that way.
+
 =back
 
 That's it for creating references.  By now you're probably dying to
diff --git a/pod/perlrun.pod b/pod/perlrun.pod

index 5042d67..c69a03e 100644 (file)
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -100,7 +100,7 @@ Switches include:
 
 =item B<-0>[I<digits>]
 
-specifies the record separator (C<$/>) as an octal number.  If there are
+specifies the input record separator (C<$/>) as an octal number.  If there are
 no digits, the null character is the separator.  Other switches may
 precede or follow the digits.  For example, if you have a version of
 B<find> which can print filenames terminated by the null character, you
@@ -245,9 +245,10 @@ searches /usr/include and /usr/lib/perl.
 =item B<-l>[I<octnum>]
 
 enables automatic line-ending processing.  It has two effects:  first,
-it automatically chomps the line terminator when used with B<-n> or
-B<-p>, and second, it assigns "C<$\>" to have the value of I<octnum> so that
-any print statements will have that line terminator added back on.  If
+it automatically chomps "C<$/>" (the input record separator) when used
+with B<-n> or B<-p>, and second, it assigns "C<$\>"
+(the output record separator) to have the value of I<octnum> so that
+any print statements will have that separator added back on.  If
 I<octnum> is omitted, sets "C<$\>" to the current value of "C<$/>".  For
 instance, to trim lines to 80 columns:
 
diff --git a/pod/perlsub.pod b/pod/perlsub.pod

index 870b2b5..1c3a3c0 100644 (file)
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -187,11 +187,12 @@ Synopsis:
     my @oof = @bar;    # declare @oof lexical, and init it
 
 A "my" declares the listed variables to be confined (lexically) to the
-enclosing block, subroutine, C<eval>, or C<do/require/use>'d file.  If
-more than one value is listed, the list must be placed in parens.  All
-listed elements must be legal lvalues.  Only alphanumeric identifiers may
-be lexically scoped--magical builtins like $/ must currently be localized with
-"local" instead.  
+enclosing block, conditional (C<if/unless/elsif/else>), loop
+(C<for/foreach/while/until/continue>), subroutine, C<eval>, or
+C<do/require/use>'d file.  If more than one value is listed, the list
+must be placed in parens.  All listed elements must be legal lvalues.
+Only alphanumeric identifiers may be lexically scoped--magical
+builtins like $/ must currently be localized with "local" instead.
 
 Unlike dynamic variables created by the "local" statement, lexical
 variables declared with "my" are totally hidden from the outside world,
@@ -250,6 +251,49 @@ the expression
 
 is false unless the old $x happened to have the value 123.
 
+Lexical scopes of control structures are not bounded precisely by the
+braces that delimit their controlled blocks; control expressions are
+part of the scope, too.  Thus in the loop
+
+    while (my $line = <>) {
+        $line = lc $line;
+    } continue {
+        print $line;
+    }
+
+the scope of $line extends from its declaration throughout the rest of
+the loop construct (including the C<continue> clause), but not beyond
+it.  Similarly, in the conditional
+
+    if ((my $answer = <STDIN>) =~ /^yes$/i) {
+        user_agrees();
+    } elsif ($answer =~ /^no$/i) {
+        user_disagrees();
+    } else {
+       chomp $answer;
+        die "'$answer' is neither 'yes' nor 'no'";
+    }
+
+the scope of $answer extends from its declaration throughout the rest
+of the conditional (including C<elsif> and C<else> clauses, if any),
+but not beyond it.
+
+(None of the foregoing applies to C<if/unless> or C<while/until>
+modifiers appended to simple statements.  Such modifiers are not
+control structures and have no effect on scoping.)
+
+The C<foreach> loop defaults to dynamically scoping its index variable
+(in the manner of C<local>; see below).  However, if the index
+variable is prefixed with the keyword "my", then it is lexically
+scoped instead.  Thus in the loop
+
+    for my $i (1, 2, 3) {
+        some_function();
+    }
+
+the scope of $i extends to the end of the loop, but not beyond it, and
+so the value of $i is unavailable in some_function().
+
 Some users may wish to encourage the use of lexically scoped variables.
 As an aid to catching implicit references to package variables,
 if you say
@@ -422,11 +466,11 @@ Sometimes you don't want to pass the value of an array to a subroutine
 but rather the name of it, so that the subroutine can modify the global
 copy of it rather than working with a local copy.  In perl you can
 refer to all objects of a particular name by prefixing the name
-with a star: C<*foo>.  This is often known as a "type glob", since the
+with a star: C<*foo>.  This is often known as a "typeglob", since the
 star on the front can be thought of as a wildcard match for all the
 funny prefix characters on variables and subroutines and such.
 
-When evaluated, the type glob produces a scalar value that represents
+When evaluated, the typeglob produces a scalar value that represents
 all the objects of that name, including any filehandle, format or
 subroutine.  When assigned to, it causes the name mentioned to refer to
 whatever "*" value was assigned to it.  Example:
@@ -450,14 +494,15 @@ an array.  It will certainly be faster to pass the typeglob (or reference).
 Even if you don't want to modify an array, this mechanism is useful for
 passing multiple arrays in a single LIST, since normally the LIST
 mechanism will merge all the array values so that you can't extract out
-the individual arrays.  For more on typeglobs, see L<perldata/"Typeglobs">.
+the individual arrays.  For more on typeglobs, see
+L<perldata/"Typeglobs and FileHandles">.
 
 =head2 Pass by Reference
 
-If you want to pass more than one array or hash into a function--or 
-return them from it--and have them maintain their integrity,
-then you're going to have to use an explicit pass-by-reference.
-Before you do that, you need to understand references as detailed in L<perlref>.
+If you want to pass more than one array or hash into a function--or
+return them from it--and have them maintain their integrity, then
+you're going to have to use an explicit pass-by-reference.  Before you
+do that, you need to understand references as detailed in L<perlref>.
 This section may not make much sense to you otherwise.
 
 Here are a few simple examples.  First, let's pass in several
@@ -538,34 +583,6 @@ Here we're using the typeglobs to do symbol table aliasing.  It's
 a tad subtle, though, and also won't work if you're using my()
 variables, since only globals (well, and local()s) are in the symbol table.
 
-If you're passing around filehandles, you could usually just use the bare
-typeglob, like *STDOUT, but typeglobs references would be better because
-they'll still work properly under C<use strict 'refs'>.  For example:
-
-    splutter(\*STDOUT);
-    sub splutter {
-       my $fh = shift;
-       print $fh "her um well a hmmm\n";
-    }
-
-    $rec = get_rec(\*STDIN);
-    sub get_rec {
-       my $fh = shift;
-       return scalar <$fh>;
-    }
-
-If you're planning on generating new filehandles, you could do this:
-
-    sub openit {
-       my $name = shift;
-       local *FH;
-       return open (FH, $path) ? \*FH : undef;
-    } 
-
-Although that will actually produce a small memory leak.  See the bottom
-of L<perlfunc/open()> for a somewhat cleaner way using the FileHandle
-functions supplied with the POSIX package.
-
 =head2 Prototypes
 
 As of the 5.002 release of perl, if you declare
@@ -645,7 +662,7 @@ The interesting thing about & is that you can generate new syntax with it:
            &$catch;
        }
     }
-    sub catch (&) { @_ }
+    sub catch (&) { $_[0] }
 
     try {
        die "phooey";
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod

index 459795e..b0f77f4 100644 (file)
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -244,6 +244,9 @@ is the same as this:
        $i++;
     }
 
+(There is one minor difference: The first form implies a lexical scope
+for variables declared with C<my> in the initialization expression.)
+
 Besides the normal array index looping, C<for> can lend itself
 to many other interesting applications.  Here's one that avoids the
 problem you get into if you explicitly test for end-of-file on 
@@ -259,12 +262,14 @@ hang.
 =head2 Foreach Loops
 
 The C<foreach> loop iterates over a normal list value and sets the
-variable VAR to be each element of the list in turn.  The variable is
-implicitly local to the loop and regains its former value upon exiting the
-loop.  If the variable was previously declared with C<my>, it uses that
-variable instead of the global one, but it's still localized to the loop.
-This can cause problems if you have subroutine or format declarations
-within that block's scope.
+variable VAR to be each element of the list in turn.  If the variable
+is preceded with the keyword C<my>, then it is lexically scoped, and
+is therefore visible only within the loop.  Otherwise, the variable is
+implicitly local to the loop and regains its former value upon exiting
+the loop.  If the variable was previously declared with C<my>, it uses
+that variable instead of the global one, but it's still localized to
+the loop.  (Note that a lexically scoped variable can cause problems
+with you have subroutine or format declarations.)
 
 The C<foreach> keyword is actually a synonym for the C<for> keyword, so
 you can use C<foreach> for readability or C<for> for brevity.  If VAR is
@@ -278,7 +283,7 @@ Examples:
 
     for (@ary) { s/foo/bar/ }
 
-    foreach $elem (@elements) {
+    foreach my $elem (@elements) {
        $elem *= 2;
     }
 
@@ -294,8 +299,8 @@ Examples:
 
 Here's how a C programmer might code up a particular algorithm in Perl:
 
-    for ($i = 0; $i < @ary1; $i++) {
-       for ($j = 0; $j < @ary2; $j++) {
+    for (my $i = 0; $i < @ary1; $i++) {
+       for (my $j = 0; $j < @ary2; $j++) {
            if ($ary1[$i] > $ary2[$j]) {
                last; # can't go to outer :-(
            }
@@ -307,8 +312,8 @@ Here's how a C programmer might code up a particular algorithm in Perl:
 Whereas here's how a Perl programmer more comfortable with the idiom might
 do it:
 
-    OUTER: foreach $wid (@ary1) { 
-    INNER:   foreach $jet (@ary2) {
+    OUTER: foreach my $wid (@ary1) { 
+    INNER:   foreach my $jet (@ary2) {
                next OUTER if $wid > $jet;
                $wid += $jet;
             } 
@@ -324,12 +329,12 @@ equivalent C<for> loop.
 
 =head2 Basic BLOCKs and Switch Statements
 
-A BLOCK by itself (labeled or not) is semantically equivalent to a loop
-that executes once.  Thus you can use any of the loop control
-statements in it to leave or restart the block.  (Note that this
-is I<NOT> true in C<eval{}>, C<sub{}>, or contrary to popular belief C<do{}> blocks,
-which do I<NOT> count as loops.)  The C<continue> block
-is optional.  
+A BLOCK by itself (labeled or not) is semantically equivalent to a
+loop that executes once.  Thus you can use any of the loop control
+statements in it to leave or restart the block.  (Note that this is
+I<NOT> true in C<eval{}>, C<sub{}>, or contrary to popular belief
+C<do{}> blocks, which do I<NOT> count as loops.)  The C<continue>
+block is optional.
 
 The BLOCK construct is particularly nice for doing case
 structures.
diff --git a/pod/perltoc.pod b/pod/perltoc.pod

index 81b81cc..7c16f94 100644 (file)
--- a/pod/perltoc.pod
+++ b/pod/perltoc.pod
@@ -232,7 +232,7 @@ y/SEARCHLIST/REPLACEMENTLIST/cds
 =item Constant Folding
 
 
-=item Integer arithmetic
+=item Integer Arithmetic
 
 
 
@@ -247,6 +247,8 @@ y/SEARCHLIST/REPLACEMENTLIST/cds
 =item DESCRIPTION
 
 
+i, m, s, x
+
 =over
 
 =item Regular Expressions
@@ -742,6 +744,11 @@ structures, objects
 =item Method Invocation
 
 
+=item Default UNIVERSAL methods
+
+isa(CLASS), can(METHOD), VERSION([VERSION]), class(), is_instance()
+
+
 =item Destructors
 
 
@@ -857,20 +864,43 @@ FIRSTKEY this, NEXTKEY this, lastkey, DESTROY this
 =item DESCRIPTION
 
 
+=item The Perl Debugger
+
+
 =over
 
-=item Debugging
+=item Debugger Commands
+
+
+h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n,
+E<lt>CRE<gt>, c [line], l, l min+incr, l min-max, l line, l subname,
+-, w [line], f filename, /pattern/, ?pattern?, L, S [[!]pattern], t, t
+expr, b [line] [condition], b subname [condition], d [line], D, a
+[line] command, A, O [opt[=val]] [opt"val"] [opt?].., recallCommand,
+ShellBang, pager, arrayDepth, hashDepth, compactDump, veryCompact,
+globPrint, DumpDBFiles, DumpPackages, quote, HighBit, undefPrint,
+tkRunning, signalLevel, warnLevel. dieLevel, E<lt> command, E<gt>
+command, ! number, ! -number, ! pattern, !! cmd, H -number, q or ^D,
+R, |dbcmd, ||dbcmd, = [alias value], command, p expr
 
 
-h, T, s, n, f, c, c line, <CR>, l min+incr, l min-max, l line, l, -, w
-line, l subname, /pattern/, ?pattern?, L, S, t, b line [ condition ], b
-subname [ condition ], d line, D, a line command, A, < command, >
-command, V package [symbols], X [symbols], ! number, ! -number, H
--number, q or ^D, command, p expr
+=item Debugger Customization
 
-=item Customization
 
+=item Readline Support
 
+
+=item Editor Support for Debugging
+
+
+=item The Perl Profiler
+
+
+=item Debugger Internals
+
+TTY, noTTY, ReadLine, NonStop, LineInfo
+
+  
 =item Other resources
 
 
@@ -899,10 +929,14 @@ command, V package [symbols], X [symbols], ! number, ! -number, H
 
 =over
 
-=item Format Variables
+=item Laundering and Detecting Tainted Data
+
 
+=item Cleaning Up Your Path
 
 
+=item Security Bugs
+  
 
 =back
 
@@ -3147,7 +3181,7 @@ have man pages yet:
 
 =head1 AUTHOR
 
-Larry Wall E<lt><F<larry@wall.org>E<gt>, with the help of oodles of
+Larry Wall E<lt>F<larry@wall.org>E<gt>, with the help of oodles of
 other folks.
 
 
diff --git a/pod/perltrap.pod b/pod/perltrap.pod

index 3d31173..e85f5c9 100644 (file)
--- a/pod/perltrap.pod
+++ b/pod/perltrap.pod
@@ -549,6 +549,36 @@ behave like C<split /\s+/> (which does).
     # perl4 prints: :hi:mom
     # perl5 prints: hi:mom
 
+=item * BugFix
+
+Perl 4 would ignore any text which was attached to an C<-e> switch,
+always taking the code snippet from the following arg.  Additionally, it
+would silently accept an C<-e> switch without a following arg.  Both of
+these behaviors have been fixed.
+
+    perl -e'print "attached to -e"' 'print "separate arg"'
+    
+    # perl4 prints: separate arg
+    # perl5 prints: attached to -e
+    
+    perl -e
+
+    # perl4 prints:
+    # perl5 dies: No code specified for -e.
+
+=item * Discontinuance
+
+In Perl 4 the return value of C<push> was undocumented, but it was
+actually the last value being pushed onto the target list.  In Perl 5
+the return value of C<push> is documented, but has changed, it is the
+number of elements in the resulting list.
+
+    @x = ('existing');
+    print push(@x, 'first new', 'second new');
+    
+    # perl4 prints: second new
+    # perl5 prints: 3
+
 =item * Deprecation
 
 Some error messages will be different.
@@ -640,8 +670,8 @@ Logical tests now return an null, instead of 0
     # perl4 prints: 0
     # perl5 prints:
 
-Also see the L<General Regular Expression Traps> tests for another example 
-of this new feature...
+Also see the L<General Regular Expression Traps using s///, etc.>
+tests for another example of this new feature...
 
 =back
 
diff --git a/pod/pod2man.PL b/pod/pod2man.PL

index a4a3c25..0a51fc8 100644 (file)
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -15,7 +15,7 @@ use File::Basename qw(&basename &dirname);
 chdir(dirname($0));
 ($file = basename($0)) =~ s/\.PL$//;
 $file =~ s/\.pl$//
-       if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+       if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'amigaos');  # "case-forgiving"
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -388,8 +388,11 @@ $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
 
 $name = @ARGV ? $ARGV[0] : "<STDIN>";
 $Filename = $name;
-$name = uc($name) if $section =~ /^1/;
-$name =~ s/\.[^.]*$//;
+if ($section =~ /^1/) {
+    require File::Basename;
+    $name = uc File::Basename::basename($name);
+}
+$name =~ s/\.(pod|p[lm])$//i;
 $name =~ s(/)(::)g; # translate Getopt/Long to Getopt::Long, etc.
 
 if ($name ne 'something') {
diff --git a/pp.c b/pp.c

index 48e3321..525e7af 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -575,14 +575,11 @@ PP(pp_undef)
 PP(pp_predec)
 {
     dSP;
-    if (SvIOK(TOPs)) {
-       if (SvIVX(TOPs) == IV_MIN) {
-           sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
-       }
-       else {
-           --SvIVX(TOPs);
-           SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
-       }
+    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+       SvIVX(TOPs) != IV_MIN)
+    {
+       --SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
        sv_dec(TOPs);
@@ -594,14 +591,11 @@ PP(pp_postinc)
 {
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
-    if (SvIOK(TOPs)) {
-       if (SvIVX(TOPs) == IV_MAX) {
-           sv_setnv(TOPs, (double)SvIVX(TOPs) + 1.0);
-       }
-       else {
-           ++SvIVX(TOPs);
-           SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
-       }
+    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+       SvIVX(TOPs) != IV_MAX)
+    {
+       ++SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
        sv_inc(TOPs);
@@ -616,14 +610,11 @@ PP(pp_postdec)
 {
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
-    if (SvIOK(TOPs)) {
-       if (SvIVX(TOPs) == IV_MIN) {
-           sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
-       }
-       else {
-           --SvIVX(TOPs);
-           SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
-       }
+    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+       SvIVX(TOPs) != IV_MIN)
+    {
+       --SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
        sv_dec(TOPs);
@@ -773,9 +764,12 @@ PP(pp_left_shift)
 {
     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
     {
-        dPOPTOPiirl;
-        SETi( left << right );
-        RETURN;
+      dPOPTOPiirl;
+      if (op->op_private & HINT_INTEGER)
+       SETi( left << right );
+      else
+       SETu( (UV)left << right );
+      RETURN;
     }
 }
 
@@ -784,7 +778,10 @@ PP(pp_right_shift)
     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
     {
       dPOPTOPiirl;
-      SETi( left >> right );
+      if (op->op_private & HINT_INTEGER)
+       SETi( left >> right );
+      else
+       SETu( (UV)left >> right );
       RETURN;
     }
 }
@@ -917,17 +914,17 @@ PP(pp_scmp)
     }
 }
 
-PP(pp_bit_and) {
+PP(pp_bit_and)
+{
     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       unsigned long value = U_L(SvNV(left));
-       value = value & U_L(SvNV(right));
-       if ((IV)value == value)
-           SETi(value);
+       UV value = SvIV(left) & SvIV(right);
+       if (op->op_private & HINT_INTEGER)
+         SETi( (IV)value );
        else
-           SETn((double)value);
+         SETu( value );
       }
       else {
        do_vop(op->op_type, TARG, left, right);
@@ -943,12 +940,11 @@ PP(pp_bit_xor)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       unsigned long value = U_L(SvNV(left));
-       value = value ^ U_L(SvNV(right));
-       if ((IV)value == value)
-           SETi(value);
+       UV value = SvIV(left) ^ SvIV(right);
+       if (op->op_private & HINT_INTEGER)
+         SETi( (IV)value );
        else
-           SETn((double)value);
+         SETu( value );
       }
       else {
        do_vop(op->op_type, TARG, left, right);
@@ -964,12 +960,11 @@ PP(pp_bit_or)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       unsigned long value = U_L(SvNV(left));
-       value = value | U_L(SvNV(right));
-       if ((IV)value == value)
-           SETi(value);
+       UV value = SvIV(left) | SvIV(right);
+       if (op->op_private & HINT_INTEGER)
+         SETi( (IV)value );
        else
-           SETn((double)value);
+         SETu( value );
       }
       else {
        do_vop(op->op_type, TARG, left, right);
@@ -986,7 +981,9 @@ PP(pp_negate)
        dTOPss;
        if (SvGMAGICAL(sv))
            mg_get(sv);
-       if (SvNIOKp(sv))
+       if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
+           SETi(-SvIVX(sv));
+       else if (SvNIOKp(sv))
            SETn(-SvNV(sv));
        else if (SvPOKp(sv)) {
            STRLEN len;
@@ -1023,18 +1020,17 @@ PP(pp_complement)
     dSP; dTARGET; tryAMAGICun(compl); 
     {
       dTOPss;
-      register I32 anum;
-
       if (SvNIOKp(sv)) {
-       UV value = ~SvIV(sv);
-       if ((IV)value == value)
-           SETi(value);
+       UV value = ~(UV)SvIV(sv);
+       if (op->op_private & HINT_INTEGER)
+         SETi( (IV)value );
        else
-           SETn((double)value);
+         SETu( value );
       }
       else {
        register char *tmps;
        register long *tmpl;
+       register I32 anum;
        STRLEN len;
 
        SvSetSV(TARG, sv);
@@ -1371,22 +1367,17 @@ PP(pp_hex)
 {
     dSP; dTARGET;
     char *tmps;
-    unsigned long value;
     I32 argtype;
 
     tmps = POPp;
-    value = scan_hex(tmps, 99, &argtype);
-    if ((IV)value >= 0)
-       XPUSHi(value);
-    else
-       XPUSHn(U_V(value));
+    XPUSHu(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
 
 PP(pp_oct)
 {
     dSP; dTARGET;
-    unsigned long value;
+    UV value;
     I32 argtype;
     char *tmps;
 
@@ -1399,10 +1390,7 @@ PP(pp_oct)
        value = scan_hex(++tmps, 99, &argtype);
     else
        value = scan_oct(tmps, 99, &argtype);
-    if ((IV)value >= 0)
-       XPUSHi(value);
-    else
-       XPUSHn(U_V(value));
+    XPUSHu(value);
     RETURN;
 }
 
@@ -2330,6 +2318,35 @@ PP(pp_reverse)
     RETURN;
 }
 
+static SV      *
+mul128(sv, m)
+     SV             *sv;
+     U8              m;
+{
+  STRLEN          len;
+  char           *s = SvPV(sv, len);
+  char           *t;
+  U32             i = 0;
+
+  if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
+    SV             *new = newSVpv("0000000000", 10);
+
+    sv_catsv(new, sv);
+    SvREFCNT_dec(sv);          /* free old sv */
+    sv = new;
+    s = SvPV(sv, len);
+  }
+  t = s + len - 1;
+  while (!*t)                   /* trailing '\0'? */
+    t--;
+  while (t > s) {
+    i = ((*t - '0') << 7) + m;
+    *(t--) = '0' + (i % 10);
+    m = i / 10;
+  }
+  return (sv);
+}
+
 /* Explosives and implosives. */
 
 PP(pp_unpack)
@@ -2800,7 +2817,7 @@ PP(pp_unpack)
               while  (len > 0) {
                 if (s >= strend) {
                   if (auint) {
-                    DIE("Unterminated compressed integer");
+                    croak("Unterminated compressed integer");
                   } else {
                     break;
                   }
@@ -2813,17 +2830,29 @@ PP(pp_unpack)
                   len--;
                   auint = 0;
                   bytes = 0;
-                } else if (++bytes >= sizeof(auint)) {         /* promote to double */
-                  adouble = auint;
+                } else if (++bytes >= sizeof(auint)) { /* promote to string */
+                  char            zero[10];
 
+                  (void) sprintf(zero, "%010ld", auint);
+                  sv = newSVpv(zero, 10);
+            
                   while (*s &  0x80) {
-                    adouble = (adouble * 128) + (*(++s) & 0x7f);
+                    sv = mul128(sv, (U8) (*(++s) & 0x7f));
                     if (s >= strend) {
-                      DIE("Unterminated compressed integer");
+                      croak("Unterminated compressed integer");
                     }
                   }
-                  sv = NEWSV(40, 0);
-                  sv_setnv(sv, adouble);
+                  /* remove leading '0's */
+                  {
+                    char           *s = SvPV(sv, na);
+            
+                    while (*s == '0') {
+                      s++;
+                      na--;
+                    }
+                    /* overlapping copy !! */
+                    sv_setpvn(sv, s, na);
+                  }
                   PUSHs(sv_2mortal(sv));
                   len--;
                   auint = 0;
@@ -3029,6 +3058,85 @@ register I32 len;
     sv_catpvn(sv, "\n", 1);
 }
 
+static SV      *
+is_an_int(s, l)
+     char           *s;
+     STRLEN          l;
+{
+  SV             *result = newSVpv("", l);
+  char           *result_c = SvPV(result, na); /* convenience */
+  char           *out = result_c;
+  bool            skip = 1;
+  bool            ignore = 0;
+
+  while (*s) {
+    switch (*s) {
+    case ' ':
+      break;
+    case '+':
+      if (!skip) {
+       SvREFCNT_dec(result);
+       return (NULL);
+      }
+      break;
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      skip = 0;
+      if (!ignore) {
+       *(out++) = *s;
+      }
+      break;
+    case '.':
+      ignore = 1;
+      break;
+    default:
+      SvREFCNT_dec(result);
+      return (NULL);
+    }
+    s++;
+  }
+  *(out++) = '\0';
+  SvCUR_set(result, out - result_c);
+  return (result);
+}
+
+static int
+div128(pnum, done)
+     SV             *pnum;                 /* must be '\0' terminated */
+     bool           *done;
+{
+  STRLEN          len;
+  char           *s = SvPV(pnum, len);
+  int             m = 0;
+  int             r = 0;
+  char           *t = s;
+
+  *done = 1;
+  while (*t) {
+    int             i;
+
+    i = m * 10 + (*t - '0');
+    m = i & 0x7F;
+    r = (i >> 7);              /* r < 10 */
+    if (r) {
+      *done = 0;
+    }
+    *(t++) = '0' + r;
+  }
+  *(t++) = '\0';
+  SvCUR_set(pnum, (STRLEN) (t - s));
+  return (m);
+}
+
+
 PP(pp_pack)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
@@ -3313,34 +3421,64 @@ PP(pp_pack)
               fromstr = NEXTFROM;
               adouble = floor((double)SvNV(fromstr));
 
-              if (adouble < 268435456) {           /* we can use integers */
-                unsigned char buf[4];              /* buffer for compressed int */
-                unsigned char *in = buf + 3;
+              if (adouble <= PERL_ULONG_MAX) { /* we can use integers */
+                unsigned char   buf[5];         /* buffer for compressed int */
+                unsigned char  *in = buf + 4;
+            
                 auint = U_I(adouble);
+
                 do {
                   *(in--) = (unsigned char) ((auint & 0x7f) |  0x80); 
                   auint >>= 7;
                 } while (auint);
-                buf[3]  &= 0x7f;                   /* clear continue bit */
-                sv_catpvn(cat, (char*) in+1, buf+3-in);
+                buf[4] &= 0x7f;                /* clear continue bit */
+                sv_catpvn(cat, (char *) in + 1, buf + 4 - in);
+              } else if (SvPOKp(fromstr)) {     /* decimal string arithmetics */
+                char           *from;
+                SV             *norm;
+                STRLEN          len;
+            
+                /* Copy string and check for compliance */
+                from = SvPV(fromstr, len);
+                if ((norm = is_an_int(from, len)) == NULL) {
+                  croak("can compress only unsigned integer");
               } else {
-                unsigned char buf[sizeof(double)*2]; /* buffer for compressed int */
-                I8       msize = sizeof(double)*2; /* 8/7 would be enough */
+                  bool            done = 0;
+                  char           *result, *in;
+            
+                  New('w', result, len, char);
+                  in = result + len;
+                  while (!done) {
+                    U8              digit = div128(norm, &done);
+            
+                    *(--in) = digit | 0x80;
+                  }
+                  result[len - 1] &= 0x7F;
+                  sv_catpvn(cat, in, result + len - in);
+                  SvREFCNT_dec(norm);  /* free norm */
+                }
+              } else if (SvNOKp(fromstr)) {
+                I8              msize = sizeof(double) * 2; /* 8/7 <= 2 */
+                unsigned char   buf[sizeof(double) * 2];
                 unsigned char *in = buf + msize -1;
+            
                 if (adouble<0) {
                   croak("Cannot compress negative numbers");
                 }
                 do  {
                   double next = adouble/128;
+            
                   *in = (unsigned char) (adouble - floor(next)*128);
                   *in |= 0x80;                     /* set continue bit */
                   if (--in < buf) {                /* this cannot happen ;-) */
                     croak ("Cannot compress integer");
                   }
                   adouble = next;
-                } while (floor(adouble)>0);        /* floor() not necessary? */
+                } while (floor(adouble));      /* floor() not necessary? */
                 buf[msize-1] &= 0x7f;              /* clear continue bit */
                 sv_catpvn(cat, (char*) in+1, buf+msize-in-1);
+              } else {
+                croak("Cannot compress non integer");
               }
             }
             break;
diff --git a/pp.h b/pp.h

index 7dc918c..0448152 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -55,12 +55,14 @@
 #define POPp           (SvPVx(POPs, na))
 #define POPn           (SvNVx(POPs))
 #define POPi           ((IV)SvIVx(POPs))
+#define POPu           ((UV)SvIVx(POPs))
 #define POPl           ((long)SvIVx(POPs))
 
 #define TOPs           (*sp)
 #define TOPp           (SvPV(TOPs, na))
 #define TOPn           (SvNV(TOPs))
 #define TOPi           ((IV)SvIV(TOPs))
+#define TOPu           ((UV)SvIV(TOPs))
 #define TOPl           ((long)SvIV(TOPs))
 
 /* Go to some pains in the rare event that we must extend the stack. */
@@ -80,18 +82,21 @@
 #define PUSHp(p,l)     STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
 #define PUSHn(n)       STMT_START { sv_setnv(TARG, (double)(n)); PUSHTARG; } STMT_END
 #define PUSHi(i)       STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
+#define PUSHu(u)       STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
 
 #define XPUSHs(s)      STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
 #define XPUSHTARG      STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
 #define XPUSHp(p,l)    STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
 #define XPUSHn(n)      STMT_START { sv_setnv(TARG, (double)(n)); XPUSHTARG; } STMT_END
 #define XPUSHi(i)      STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
+#define XPUSHu(u)      STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
 
 #define SETs(s)                (*sp = s)
 #define SETTARG                STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
 #define SETp(p,l)      STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
 #define SETn(n)                STMT_START { sv_setnv(TARG, (double)(n)); SETTARG; } STMT_END
 #define SETi(i)                STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
+#define SETu(u)                STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
 
 #define dTOPss         SV *sv = TOPs
 #define dPOPss         SV *sv = POPs
@@ -99,14 +104,18 @@
 #define dPOPnv         double value = POPn
 #define dTOPiv         IV value = TOPi
 #define dPOPiv         IV value = POPi
+#define dTOPuv         UV value = TOPu
+#define dPOPuv         UV value = POPu
 
 #define dPOPPOPssrl    SV *right = POPs; SV *left = POPs
 #define dPOPPOPnnrl    double right = POPn; double left = POPn
 #define dPOPPOPiirl    IV right = POPi; IV left = POPi
+#define dPOPPOPuurl    UV right = POPu; UV left = POPu
 
 #define dPOPTOPssrl    SV *right = POPs; SV *left = TOPs
 #define dPOPTOPnnrl    double right = POPn; double left = TOPn
 #define dPOPTOPiirl    IV right = POPi; IV left = TOPi
+#define dPOPTOPuurl    UV right = POPu; UV left = TOPu
 
 #define RETPUSHYES     RETURNX(PUSHs(&sv_yes))
 #define RETPUSHNO      RETURNX(PUSHs(&sv_no))
diff --git a/pp_ctl.c b/pp_ctl.c

index 0c7e3d4..6d6b469 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -174,7 +174,7 @@ PP(pp_formline)
     bool gotsome;
     STRLEN len;
 
-    if (!SvCOMPILED(form)) {
+    if (!SvMAGICAL(form) || !SvCOMPILED(form)) {
        SvREADONLY_off(form);
        doparseform(form);
     }
@@ -708,12 +708,16 @@ PP(pp_flop)
 
        if (SvNIOKp(left) || !SvPOKp(left) ||
          (looks_like_number(left) && *SvPVX(left) != '0') ) {
+           SV *sv_iv;
+
            i = SvIV(left);
            max = SvIV(right);
            if (max > i)
                EXTEND(SP, max - i + 1);
+           sv_iv = sv_2mortal(newSViv(i));
+           if (i++ <= max) PUSHs(sv_iv);
            while (i <= max) {
-               sv = sv_mortalcopy(&sv_no);
+               sv = sv_mortalcopy(sv_iv);
                sv_setiv(sv,i++);
                PUSHs(sv);
            }
@@ -1295,7 +1299,7 @@ PP(pp_dbstate)
        SAVETMPS;
 
        SAVEI32(debug);
-       SAVESPTR(stack_sp);
+       SAVESTACK_POS();
        debug = 0;
        hasargs = 0;
        sp = stack_sp;
@@ -1996,13 +2000,13 @@ int gimme;
 
     /* set up a scratch pad */
 
-    SAVEINT(padix);
+    SAVEI32(padix);
     SAVESPTR(curpad);
     SAVESPTR(comppad);
     SAVESPTR(comppad_name);
-    SAVEINT(comppad_name_fill);
-    SAVEINT(min_intro_pending);
-    SAVEINT(max_intro_pending);
+    SAVEI32(comppad_name_fill);
+    SAVEI32(min_intro_pending);
+    SAVEI32(max_intro_pending);
 
     SAVESPTR(compcv);
     compcv = (CV*)NEWSV(1104,0);
@@ -2080,6 +2084,20 @@ int gimme;
 
     DEBUG_x(dump_eval());
 
+    /* Register with debugger: */
+
+    if (perldb && saveop->op_type == OP_REQUIRE) {
+       CV *cv = perl_get_cv("DB::postponed", FALSE);
+       
+       if (cv) {
+           dSP;
+           PUSHMARK(sp);
+           XPUSHs((SV*)compiling.cop_filegv);
+           PUTBACK;
+           perl_call_sv((SV*)cv, G_DISCARD);
+       }
+    }
+
     /* compiled okay, so do it */
 
     SP = stack_base + POPMARK;         /* pop original mark */
@@ -2213,9 +2231,10 @@ PP(pp_entereval)
     dSP;
     register CONTEXT *cx;
     dPOPss;
-    I32 gimme = GIMME;
-    char tmpbuf[32];
+    I32 gimme = GIMME, was = sub_generation;
+    char tmpbuf[32], *safestr;
     STRLEN len;
+    OP *ret;
 
     if (!SvPV(sv,len) || !len)
        RETPUSHUNDEF;
@@ -2231,7 +2250,13 @@ PP(pp_entereval)
     sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
     compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
     compiling.cop_line = 1;
-    SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf));
+    /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
+       deleting the eval's FILEGV from the stash before gv_check() runs
+       (i.e. before run-time proper). To work around the coredump that
+       ensues, we always turn GvMULTI_on for any globals that were
+       introduced within evals. See force_ident(). GSAR 96-10-12 */
+    safestr = savepv(tmpbuf);
+    SAVEDELETE(defstash, safestr, strlen(safestr));
     SAVEI32(hints);
     hints = op->op_targ;
 
@@ -2244,7 +2269,11 @@ PP(pp_entereval)
     if (perldb && curstash != debstash)
        save_lines(GvAV(compiling.cop_filegv), linestr);
     PUTBACK;
-    return doeval(gimme);
+    ret = doeval(gimme);
+    if (perldb && was != sub_generation) { /* Some subs defined here. */
+       strcpy(safestr, "_<(eval )");   /* Anything fake and short. */
+    }
+    return ret;
 }
 
 PP(pp_leaveeval)
@@ -2388,7 +2417,10 @@ SV *sv;
     register I32 arg;
     bool ischop;
 
-    New(804, fops, (send - s)*3+2, U16);    /* Almost certainly too long... */
+    if (len == 0)
+       die("Null picture in formline");
+    
+    New(804, fops, (send - s)*3+10, U16);    /* Almost certainly too long... */
     fpc = fops;
 
     if (s < send) {
@@ -2543,5 +2575,6 @@ SV *sv;
     }
     Copy(fops, s, arg, U16);
     Safefree(fops);
+    sv_magic(sv, Nullsv, 'f', Nullch, 0);
     SvCOMPILED_on(sv);
 }
diff --git a/pp_hot.c b/pp_hot.c

index 150afe2..d8b2bfc 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -251,14 +251,11 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
-    if (SvIOK(TOPs)) {
-       if (SvIVX(TOPs) == IV_MAX) {
-           sv_setnv(TOPs, (double)(SvIVX(TOPs)) + 1.0 );
-       }
-       else {
-           ++SvIVX(TOPs);
-           SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
-       }
+    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+       SvIVX(TOPs) != IV_MAX)
+    {
+       ++SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
        sv_inc(TOPs);
diff --git a/pp_sys.c b/pp_sys.c

index 8ce02b5..40a0d35 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -98,6 +98,12 @@ static int dooneliner _((char *cmd, char *filename));
 # define my_chsize chsize
 #endif
 
+#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+  static int lockf_emulate_flock _((int fd, int operation));
+# define flock lockf_emulate_flock
+#endif
+
+
 /* Pushy I/O. */
 
 PP(pp_backtick)
@@ -156,7 +162,7 @@ PP(pp_glob)
 #ifndef CSH
     *SvPVX(rs) = '\n';
 #endif /* !CSH */
-#endif /* !MSDOS */
+#endif /* !DOSISH */
 
     result = do_readline();
     LEAVE;
@@ -372,7 +378,7 @@ PP(pp_binmode)
 
     EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
-       RETSETUNDEF;
+       RETPUSHUNDEF;
 
 #ifdef DOSISH
 #ifdef atarist
@@ -467,8 +473,8 @@ PP(pp_untie)
     SV * sv ;
 
     sv = POPs;
-    if (hints & HINT_STRICT_UNTIE)
-    {
+
+    if (dowarn) {
         MAGIC * mg ;
         if (SvMAGICAL(sv)) {
             if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
@@ -477,7 +483,7 @@ PP(pp_untie)
                 mg = mg_find(sv, 'q') ;
     
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
-               croak("Can't untie: %d inner references still exist", 
+               warn("untie attempted while %d inner references still exist",
                        SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
         }
     }
@@ -486,7 +492,7 @@ PP(pp_untie)
        sv_unmagic(sv, 'P');
     else
        sv_unmagic(sv, 'q');
-    RETSETYES;
+    RETPUSHYES;
 }
 
 PP(pp_tied)
@@ -1357,18 +1363,14 @@ PP(pp_ioctl)
        DIE("ioctl is not implemented");
 #endif
     else
-#if defined(DOSISH) && !defined(OS2)
-       DIE("fcntl is not implemented");
-#else
-#   ifdef HAS_FCNTL
-#     if defined(OS2) && defined(__EMX__)
+#ifdef HAS_FCNTL
+#if defined(OS2) && defined(__EMX__)
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
-#     else
+#else
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
-#     endif 
-#   else
+#endif 
+#else
        DIE("fcntl is not implemented");
-#   endif
 #endif
 
     if (SvPOK(argsv)) {
@@ -1398,10 +1400,6 @@ PP(pp_flock)
     GV *gv;
     PerlIO *fp;
 
-#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
-#  define flock lockf_emulate_flock
-#endif
-
 #if defined(HAS_FLOCK) || defined(flock)
     argtype = POPi;
     if (MAXARG <= 0)
@@ -2842,7 +2840,7 @@ PP(pp_system)
     Signal_t (*ihand)();     /* place to save signal during system() */
     Signal_t (*qhand)();     /* place to save signal during system() */
 
-#if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
     if (SP - MARK == 1) {
        if (tainting) {
            char *junk = SvPV(TOPs, na);
@@ -3084,7 +3082,7 @@ PP(pp_tms)
 {
     dSP;
 
-#if defined(MSDOS) || !defined(HAS_TIMES)
+#ifndef HAS_TIMES
     DIE("times not implemented");
 #else
     EXTEND(SP, 4);
@@ -3104,7 +3102,7 @@ PP(pp_tms)
        PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
     }
     RETURN;
-#endif /* MSDOS */
+#endif /* HAS_TIMES */
 }
 
 PP(pp_localtime)
@@ -4106,7 +4104,7 @@ PP(pp_syscall)
 #  define LOCK_UN 8
 # endif
 
-int
+static int
 lockf_emulate_flock (fd, operation)
 int fd;
 int operation;
diff --git a/proto.h b/proto.h

index 51d50c0..851567b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -29,7 +29,7 @@ void  av_undef _((AV* ar));
 void   av_unshift _((AV* ar, I32 num));
 OP*    bind_match _((I32 type, OP* left, OP* pat));
 OP*    block_end _((int line, int floor, OP* seq));
-int    block_start _((void));
+int    block_start _((int full));
 void   boot_core_UNIVERSAL _((void));
 void   calllist _((AV* list));
 I32    cando _((I32 bit, I32 effective, struct stat* statbufp));
@@ -195,6 +195,7 @@ int magic_setarylen _((SV* sv, MAGIC* mg));
 int    magic_setbm     _((SV* sv, MAGIC* mg));
 int    magic_setdbline _((SV* sv, MAGIC* mg));
 int    magic_setenv    _((SV* sv, MAGIC* mg));
+int    magic_setfm     _((SV* sv, MAGIC* mg));
 int    magic_setisa    _((SV* sv, MAGIC* mg));
 int    magic_setglob   _((SV* sv, MAGIC* mg));
 int    magic_setmglob  _((SV* sv, MAGIC* mg));
@@ -209,15 +210,6 @@ int        magic_setvec    _((SV* sv, MAGIC* mg));
 int    magic_wipepack  _((SV* sv, MAGIC* mg));
 void   magicname _((char* sym, char* name, I32 namlen));
 int    main _((int argc, char** argv, char** env));
-#if !defined(STANDARD_C)
-Malloc_t       malloc _((MEM_SIZE nbytes));
-#endif
-#if defined(MYMALLOC) && defined(HIDEMYMALLOC)
-extern Malloc_t malloc _((MEM_SIZE nbytes));
-extern Malloc_t realloc _((Malloc_t, MEM_SIZE));
-extern Free_t   free _((Malloc_t));
-extern Malloc_t calloc _((MEM_SIZE, MEM_SIZE));
-#endif
 void   markstack_grow _((void));
 char*  mem_collxfrm _((const char *m, const Size_t n, Size_t * nx));
 char*  mess _((char* pat, va_list* args));
@@ -329,7 +321,7 @@ SV* perl_get_sv _((char* name, I32 create));
 AV*    perl_get_av _((char* name, I32 create));
 HV*    perl_get_hv _((char* name, I32 create));
 CV*    perl_get_cv _((char* name, I32 create));
-int    perl_init_fold _(());
+void   perl_init_fold _(());
 int    perl_init_i18nl10n _((int printwarn));
 int    perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env));
 void   perl_require_pv _((char* pv));
@@ -356,22 +348,6 @@ char*      regprop _((char* op));
 void   repeatcpy _((char* to, char* from, I32 len, I32 count));
 char*  rninstr _((char* big, char* bigend, char* little, char* lend));
 int    runops _((void));
-#ifndef safemalloc
-void   safefree _((Malloc_t where));
-Malloc_t       safemalloc _((MEM_SIZE size));
-#ifndef MSDOS
-Malloc_t       saferealloc _((Malloc_t where, MEM_SIZE size));
-#else
-Malloc_t       saferealloc _((Malloc_t where, unsigned long size));
-#endif
-Malloc_t       safecalloc _((MEM_SIZE cnt, MEM_SIZE size));
-#endif
-#ifdef LEAKTEST
-void   safexfree _((Malloc_t where));
-Malloc_t       safexmalloc _((I32 x, MEM_SIZE size));
-Malloc_t       safexrealloc _((Malloc_t where, MEM_SIZE size));
-Malloc_t       safexcalloc _((I32 x, MEM_SIZE size, MEM_SIZE size));
-#endif
 #ifndef HAS_RENAME
 I32    same_dirent _((char* a, char* b));
 #endif
@@ -392,9 +368,11 @@ void       save_freeop _((OP* op));
 void   save_freepv _((char* pv));
 HV*    save_hash _((GV* gv));
 void   save_hptr _((HV** hptr));
+void   save_I16 _((I16* intp));
 void   save_I32 _((I32* intp));
 void   save_int _((int* intp));
 void   save_item _((SV* item));
+void   save_iv _((IV* iv));
 void   save_list _((SV** sarg, I32 maxsarg));
 void   save_long _((long *longp));
 void   save_nogv _((GV* gv));
@@ -407,9 +385,9 @@ OP* scalar _((OP* o));
 OP*    scalarkids _((OP* op));
 OP*    scalarseq _((OP* o));
 OP*    scalarvoid _((OP* op));
-unsigned long  scan_hex _((char* start, I32 len, I32* retlen));
+UV     scan_hex _((char* start, I32 len, I32* retlen));
 char*  scan_num _((char* s));
-unsigned long  scan_oct _((char* start, I32 len, I32* retlen));
+UV     scan_oct _((char* start, I32 len, I32* retlen));
 OP*    scope _((OP* o));
 char*  screaminstr _((SV* bigsv, SV* littlesv));
 #ifndef VMS
@@ -439,6 +417,7 @@ void        sv_clear _((SV* sv));
 I32    sv_cmp _((SV* sv1, SV* sv2));
 void   sv_dec _((SV* sv));
 void   sv_dump _((SV* sv));
+bool   sv_derived_from _((SV* sv, char* name));
 I32    sv_eq _((SV* sv1, SV* sv2));
 void   sv_free _((SV* sv));
 void   sv_free_arenas _((void));
@@ -464,6 +443,7 @@ void        sv_replace _((SV* sv, SV* nsv));
 void   sv_report_used _((void));
 void   sv_reset _((char* s, HV* stash));
 void   sv_setiv _((SV* sv, IV num));
+void   sv_setuv _((SV* sv, UV num));
 void   sv_setnv _((SV* sv, double num));
 SV*    sv_setref_iv _((SV *rv, char *classname, IV iv));
 SV*    sv_setref_nv _((SV *rv, char *classname, double nv));
@@ -491,3 +471,17 @@ int        yyerror _((char* s));
 int    yylex _((void));
 int    yyparse _((void));
 int    yywarn _((char* s));
+
+#if defined(MYMALLOC) || !defined(STANDARD_C)
+Malloc_t malloc _((MEM_SIZE nbytes));
+Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t   free _((Malloc_t where));
+#endif
+
+#ifdef LEAKTEST
+Malloc_t safexmalloc _((I32 x, MEM_SIZE size));
+Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size));
+Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size));
+void     safexfree _((Malloc_t where));
+#endif
diff --git a/regexec.c b/regexec.c

index 1ee1436..6e79d6b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -82,10 +82,10 @@ static CURCUR* regcc;
 
 typedef I32 CHECKPOINT;
 
-CHECKPOINT regcppush _((I32 parenfloor));
-char * regcppop _((void));
+static CHECKPOINT regcppush _((I32 parenfloor));
+static char * regcppop _((void));
 
-CHECKPOINT
+static CHECKPOINT
 regcppush(parenfloor)
 I32 parenfloor;
 {
@@ -107,7 +107,7 @@ I32 parenfloor;
     return retval;
 }
 
-char*
+static char *
 regcppop()
 {
     I32 i = SSPOPINT;
diff --git a/scope.c b/scope.c

index 03cdddd..d2dac1c 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -272,6 +272,16 @@ I32 *intp;
 }
 
 void
+save_I16(intp)
+I16 *intp;
+{
+    SSCHECK(3);
+    SSPUSHINT(*intp);
+    SSPUSHPTR(intp);
+    SSPUSHINT(SAVEt_I16);
+}
+
+void
 save_iv(ivp)
 IV *ivp;
 {
@@ -496,6 +506,10 @@ I32 base;
            ptr = SSPOPPTR;
            *(I32*)ptr = (I32)SSPOPINT;
            break;
+       case SAVEt_I16:                         /* I16 reference */
+           ptr = SSPOPPTR;
+           *(I16*)ptr = (I16)SSPOPINT;
+           break;
        case SAVEt_IV:                          /* IV reference */
            ptr = SSPOPPTR;
            *(IV*)ptr = (IV)SSPOPIV;
@@ -601,6 +615,12 @@ I32 base;
                savestack_ix -= delta;  /* regexp must have croaked */
            }
            break;
+       case SAVEt_STACK_POS:           /* Position on Perl stack */
+           {
+               I32 delta = SSPOPINT;
+               stack_sp = stack_base + delta;
+           }
+           break;
        default:
            croak("panic: leave_scope inconsistency");
        }
diff --git a/scope.h b/scope.h

index 0ea343a..53081a3 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -20,6 +20,8 @@
 #define SAVEt_DELETE   19
 #define SAVEt_DESTRUCTOR 20
 #define SAVEt_REGCONTEXT 21
+#define SAVEt_STACK_POS  22
+#define SAVEt_I16      23
 
 #define SSCHECK(need) if (savestack_ix + need > savestack_max) savestack_grow()
 #define SSPUSHINT(i) (savestack[savestack_ix++].any_i32 = (I32)(i))
@@ -43,16 +45,28 @@
 #define LEAVE pop_scope()
 #define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old)
 
-#define SAVEINT(i) save_int((int*)(&i));
-#define SAVEIV(i) save_iv((IV*)(&i));
-#define SAVEI32(i) save_I32((I32*)(&i));
-#define SAVELONG(l) save_long((long*)(&l));
-#define SAVESPTR(s) save_sptr((SV**)(&s))
-#define SAVEPPTR(s) save_pptr((char**)(&s))
-#define SAVEFREESV(s) save_freesv((SV*)(s))
-#define SAVEFREEOP(o) save_freeop((OP*)(o))
-#define SAVEFREEPV(p) save_freepv((char*)(p))
-#define SAVECLEARSV(sv) save_clearsv((SV**)(&sv))
-#define SAVEDELETE(h,k,l) save_delete((HV*)(h), (char*)(k), (I32)l)
-#define SAVEDESTRUCTOR(f,p) save_destructor((void(*)_((void*)))f,(void*)p)
+/*
+ * Not using SOFT_CAST on SAVEFREESV and SAVEFREESV
+ * because these are used for several kinds of pointer values
+ */
+#define SAVEI16(i)     save_I16(SOFT_CAST(I16*)&(i));
+#define SAVEI32(i)     save_I32(SOFT_CAST(I32*)&(i));
+#define SAVEINT(i)     save_int(SOFT_CAST(int*)&(i));
+#define SAVEIV(i)      save_iv(SOFT_CAST(IV*)&(i));
+#define SAVELONG(l)    save_long(SOFT_CAST(long*)&(l));
+#define SAVESPTR(s)    save_sptr((SV**)&(s))
+#define SAVEPPTR(s)    save_pptr(SOFT_CAST(char**)&(s))
+#define SAVEFREESV(s)  save_freesv((SV*)(s))
+#define SAVEFREEOP(o)  save_freeop(SOFT_CAST(OP*)(o))
+#define SAVEFREEPV(p)  save_freepv(SOFT_CAST(char*)(p))
+#define SAVECLEARSV(sv)        save_clearsv(SOFT_CAST(SV**)&(sv))
+#define SAVEDELETE(h,k,l) \
+         save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
+#define SAVEDESTRUCTOR(f,p) \
+         save_destructor(SOFT_CAST(void(*)_((void*)))(f),SOFT_CAST(void*)(p))
+#define SAVESTACK_POS() STMT_START {   \
+    SSCHECK(2);                                \
+    SSPUSHINT(stack_sp - stack_base);  \
+    SSPUSHINT(SAVEt_STACK_POS);                \
+ } STMT_END
 
diff --git a/sv.c b/sv.c

index 0af82f7..60d41b1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1045,12 +1045,12 @@ unsigned long newlen;
 {
     register char *s;
 
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen);
        my_exit(1);
     }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
     if (SvROK(sv))
        sv_unref(sv);
     if (SvTYPE(sv) < SVt_PV) {
@@ -1119,6 +1119,17 @@ IV i;
 }
 
 void
+sv_setuv(sv,u)
+register SV *sv;
+UV u;
+{
+    if (u <= IV_MAX)
+       sv_setiv(sv, u);
+    else
+       sv_setnv(sv, (double)u);
+}
+
+void
 sv_setnv(sv,num)
 register SV *sv;
 double num;
@@ -1283,7 +1294,6 @@ register SV *sv;
            warn(warn_uninit);
        return 0;
     }
-    (void)SvIOK_on(sv);
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
        (unsigned long)sv,(long)SvIVX(sv)));
     return SvIVX(sv);
@@ -2090,7 +2100,7 @@ I32 namlen;
 {
     MAGIC* mg;
     
-    if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
+    if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how))
        croak(no_modify);
     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
        if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
@@ -2142,6 +2152,9 @@ I32 namlen;
     case 'E':
        mg->mg_virtual = &vtbl_env;
        break;
+    case 'f':
+       mg->mg_virtual = &vtbl_fm;
+       break;
     case 'e':
        mg->mg_virtual = &vtbl_envelem;
        break;
@@ -2954,14 +2967,18 @@ register SV *sv;
     if (SvGMAGICAL(sv))
        mg_get(sv);
     flags = SvFLAGS(sv);
-    if (flags & SVp_IOK) {
-       (void)SvIOK_only(sv);
-       ++SvIVX(sv);
-       return;
-    }
     if (flags & SVp_NOK) {
-       SvNVX(sv) += 1.0;
        (void)SvNOK_only(sv);
+       SvNVX(sv) += 1.0;
+       return;
+    }
+    if (flags & SVp_IOK) {
+       if (SvIVX(sv) == IV_MAX)
+           sv_setnv(sv, (double)IV_MAX + 1.0);
+       else {
+           (void)SvIOK_only(sv);
+           ++SvIVX(sv);
+       }
        return;
     }
     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
@@ -3024,16 +3041,20 @@ register SV *sv;
     if (SvGMAGICAL(sv))
        mg_get(sv);
     flags = SvFLAGS(sv);
-    if (flags & SVp_IOK) {
-       (void)SvIOK_only(sv);
-       --SvIVX(sv);
-       return;
-    }
     if (flags & SVp_NOK) {
        SvNVX(sv) -= 1.0;
        (void)SvNOK_only(sv);
        return;
     }
+    if (flags & SVp_IOK) {
+       if (SvIVX(sv) == IV_MIN)
+           sv_setnv(sv, (double)IV_MIN - 1.0);
+       else {
+           (void)SvIOK_only(sv);
+           --SvIVX(sv);
+       }
+       return;
+    }
     if (!(flags & SVp_POK)) {
        if ((flags & SVTYPEMASK) < SVt_PVNV)
            sv_upgrade(sv, SVt_NV);
@@ -3052,7 +3073,7 @@ register SV *sv;
 static void
 sv_mortalgrow()
 {
-    tmps_max += 128;
+    tmps_max += (tmps_max < 512) ? 128 : 512;
     Renew(tmps_stack, tmps_max, SV*);
 }
 
@@ -3681,8 +3702,27 @@ SV* sv;
       if (CvCLONE(sv))  strcat(d, "CLONE,");
       if (CvCLONED(sv)) strcat(d, "CLONED,");
       break;
+    case SVt_PVHV:
+      if (HvSHAREKEYS(sv))     strcat(d, "SHAREKEYS,");
+      if (HvLAZYDEL(sv))       strcat(d, "LAZYDEL,");
+      break;
     case SVt_PVGV:
-      if (GvMULTI(sv)) strcat(d, "MULTI,");
+      if (GvINTRO(sv))         strcat(d, "INTRO,");
+      if (GvMULTI(sv))         strcat(d, "MULTI,");
+      if (GvASSUMECV(sv))      strcat(d, "ASSUMECV,");
+      if (GvIMPORTED(sv)) {
+         strcat(d, "IMPORT");
+         if (GvIMPORTED(sv) == GVf_IMPORTED)
+             strcat(d, "ALL,");
+         else {
+             strcat(d, "(");
+             if (GvIMPORTED_SV(sv))    strcat(d, " SV");
+             if (GvIMPORTED_AV(sv))    strcat(d, " AV");
+             if (GvIMPORTED_HV(sv))    strcat(d, " HV");
+             if (GvIMPORTED_CV(sv))    strcat(d, " CV");
+             strcat(d, " ),");
+         }
+      }
 #ifdef OVERLOAD
       if (flags & SVpgv_AM)    strcat(d, "withOVERLOAD,");
 #endif /* OVERLOAD */
@@ -3846,8 +3886,7 @@ SV* sv;
        PerlIO_printf(Perl_debug_log, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
        PerlIO_printf(Perl_debug_log, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
        PerlIO_printf(Perl_debug_log, "    LINE = %ld\n", (long)GvLINE(sv));
-       PerlIO_printf(Perl_debug_log, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
-       PerlIO_printf(Perl_debug_log, "    STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+       PerlIO_printf(Perl_debug_log, "    FILEGV = 0x%lx\n", (long)GvFILEGV(sv));
        PerlIO_printf(Perl_debug_log, "    EGV = 0x%lx\n", (long)GvEGV(sv));
        break;
     case SVt_PVIO:
diff --git a/sv.h b/sv.h

index 47a9fd3..1b86ed9 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -80,6 +80,8 @@ struct io {
                                    (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
 #define SvREFCNT_dec(sv)       sv_free((SV*)sv)
 #endif
+#define newRV_noinc(sv)        ((Sv = newRV(sv)), \
+                                   (--SvREFCNT(sv)), (SV*)Sv)
 
 #define SVTYPEMASK     0xff
 #define SvTYPE(sv)     ((sv)->sv_flags & SVTYPEMASK)
diff --git a/t/README b/t/README

index d714295..00bf561 100644 (file)
--- a/t/README
+++ b/t/README
@@ -8,4 +8,4 @@ If you put out extra lines with a '#' character on the front, you don't
 have to worry about removing the extra print statements later since TEST
 ignores lines beginning with '#'.
 
-If you come up with new tests, send them to lwall@sems.com.
+If you come up with new tests, send them to larry@wall.org.
diff --git a/t/TEST b/t/TEST

index 160e316..4ef50ea 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -41,7 +41,7 @@ while ($test = shift) {
     }
     $te = $test;
     chop($te);
-    print "$te" . '.' x (15 - length($te));
+    print "$te" . '.' x (18 - length($te));
     if ($sharpbang) {
        open(results,"./$test |") || (print "can't run.\n");
     } else {
@@ -50,6 +50,10 @@ while ($test = shift) {
        close(script);
        if (/#!..perl(.*)/) {
            $switch = $1;
+           if ($^O eq 'VMS') {
+               # Must protect uppercase switches with "" on command line
+               $switch =~ s/-([A-Z]\S*)/"-$1"/g;
+           }
        } else {
            $switch = '';
        }
diff --git a/t/io/read.t b/t/io/read.t

index 16d32b1..b27fde1 100755 (executable)
--- a/t/io/read.t
+++ b/t/io/read.t
@@ -15,8 +15,12 @@ read(A,$b,1,4);
 
 close(A);
 
+unlink("a");
+
 if ($b eq "\000\000\000\000_") {
        print "ok 1\n";
 } else { # Probably "\000bcd_"
        print "not ok 1\n";
 }
+
+unlink 'a';
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t

index 81d32c4..e20cfab 100755 (executable)
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -1,7 +1,7 @@
 #!./perl -w
 
 BEGIN {
-    @INC = '../lib';
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
        print "1..0\n";
@@ -23,6 +23,21 @@ sub ok
     print "ok $no\n" ;
 }
 
+sub lexical
+{
+    my(@a) = unpack ("C*", $a) ;
+    my(@b) = unpack ("C*", $b) ;
+
+    my $len = (@a > @b ? @b : @a) ;
+    my $i = 0 ;
+
+    foreach $i ( 0 .. $len -1) {
+        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
+    }
+
+    return @a - @b ;
+}
+
 $Dfile = "dbbtree.tmp";
 unlink $Dfile;
 
@@ -31,13 +46,13 @@ umask(0);
 # Check the interface to BTREEINFO
 
 my $dbh = new DB_File::BTREEINFO ;
+ok(1, $dbh->{flags} == 0) ;
+ok(2, $dbh->{cachesize} == 0) ;
+ok(3, $dbh->{psize} == 0) ;
+ok(4, $dbh->{lorder} == 0) ;
+ok(5, $dbh->{minkeypage} == 0) ;
+ok(6, $dbh->{maxkeypage} == 0) ;
 $^W = 0 ;
-ok(1, $dbh->{flags} == undef) ;
-ok(2, $dbh->{cachesize} == undef) ;
-ok(3, $dbh->{psize} == undef) ;
-ok(4, $dbh->{lorder} == undef) ;
-ok(5, $dbh->{minkeypage} == undef) ;
-ok(6, $dbh->{maxkeypage} == undef) ;
 ok(7, $dbh->{compare} == undef) ;
 ok(8, $dbh->{prefix} == undef) ;
 $^W = 1 ;
@@ -170,13 +185,9 @@ ok(28, $i == 30) ;
 ok(29, $#keys == 31) ;
 
 #Check that the keys can be retrieved in order
-$ok = 1 ;
-foreach (keys %h)
-{
-    ($ok = 0), last if defined $previous && $previous gt $_ ;
-    $previous = $_ ;
-}
-ok(30, $ok ) ;
+my @b = keys %h ;
+my @c = sort lexical @b ;
+ok(30, ArrayCompare(\@b, \@c)) ;
 
 $h{'foo'} = '';
 ok(31, $h{'foo'} eq '' ) ;
@@ -440,7 +451,9 @@ $^W = 1 ;
 @srt_3 = sort { length $a <=> length $b } @Keys ;
  
 foreach (@Keys) {
-    $^W = 0 ; $h{$_} = 1 ; $^W = 1 ;
+    $^W = 0 ; 
+    $h{$_} = 1 ; 
+    $^W = 1 ;
     $g{$_} = 1 ;
     $k{$_} = 1 ;
 }
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t

index 999ca60..9427a43 100755 (executable)
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -1,7 +1,7 @@
 #!./perl -w
 
 BEGIN {
-    @INC = '../lib';
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
        print "1..0\n";
@@ -33,15 +33,13 @@ umask(0);
 # Check the interface to RECNOINFO
 
 my $dbh = new DB_File::RECNOINFO ;
-$^W = 0 ;
-ok(1, $dbh->{bval} == undef ) ;
-ok(2, $dbh->{cachesize} == undef) ;
-ok(3, $dbh->{psize} == undef) ;
-ok(4, $dbh->{flags} == undef) ;
-ok(5, $dbh->{lorder} == undef);
-ok(6, $dbh->{reclen} == undef);
-ok(7, $dbh->{bfname} eq undef);
-$^W = 0 ;
+ok(1, $dbh->{bval} == 0 ) ;
+ok(2, $dbh->{cachesize} == 0) ;
+ok(3, $dbh->{psize} == 0) ;
+ok(4, $dbh->{flags} == 0) ;
+ok(5, $dbh->{lorder} == 0);
+ok(6, $dbh->{reclen} == 0);
+ok(7, $dbh->{bfname} eq "");
 
 $dbh->{bval} = 3000 ;
 ok(8, $dbh->{bval} == 3000 );
diff --git a/t/lib/findbin.t b/t/lib/findbin.t

index 8d5347c..3e742f9 100755 (executable)
--- a/t/lib/findbin.t
+++ b/t/lib/findbin.t
@@ -9,5 +9,5 @@ print "1..1\n";
 
 use FindBin qw($Bin);
 
-print "not " unless $Bin =~ m,t/lib$,;
+print "not " unless $Bin =~ m,t[/.]lib\]?$,;
 print "ok 1\n";
diff --git a/t/lib/getopt.t b/t/lib/getopt.t

index ec2ea49..fb70f10 100755 (executable)
--- a/t/lib/getopt.t
+++ b/t/lib/getopt.t
@@ -41,7 +41,6 @@ print "ok 7\n";
 # Try illegal options, but avoid printing of the error message
 
 open(STDERR, ">stderr") || die;
-unlink "stderr";
 
 @ARGV = qw(-h help);
 
@@ -69,3 +68,6 @@ print "ok 10\n";
 
 print "not " unless "@ARGV" eq "file";
 print "ok 11\n";
+
+close STDERR;
+unlink "stderr";
diff --git a/t/lib/searchdict.t b/t/lib/searchdict.t

index 69329d6..447c425 100755 (executable)
--- a/t/lib/searchdict.t
+++ b/t/lib/searchdict.t
@@ -41,7 +41,7 @@ EOT
 use Search::Dict;
 
 open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
-unlink "dict-$$";
+binmode DICT;                  # To make length expected one.
 print DICT $DICT;
 
 my $pos = look *DICT, "abash";
@@ -60,3 +60,6 @@ chomp($word = <DICT>);
 
 print "not " if $pos < 0 || $word ne "Aarhus";
 print "ok 3\n";
+
+close DICT or die "cannot close";
+unlink "dict-$$";
diff --git a/t/op/bop.t b/t/op/bop.t

index 8ebf8d3..7cf200f 100755 (executable)
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -1,24 +1,44 @@
 #!./perl
 
 #
-# test the bit operators '&', '|' and '^'
+# test the bit operators '&', '|', '^', '~', '<<', and '>>'
 #
 
-print "1..9\n";
+print "1..18\n";
 
 # numerics
 print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
 print ((0xdead | 0xbeef) == 0xfeef ? "ok 2\n" : "not ok 2\n");
 print ((0xdead ^ 0xbeef) == 0x6042 ? "ok 3\n" : "not ok 3\n");
+print ((~0xdead & 0xbeef) == 0x2042 ? "ok 4\n" : "not ok 4\n");
+
+# shifts
+print ((257 << 7) == 32896 ? "ok 5\n" : "not ok 5\n");
+print ((33023 >> 7) == 257 ? "ok 6\n" : "not ok 6\n");
+
+# signed vs. unsigned
+print ((~0 > 0 && do { use integer; ~0 } == -1)
+       ? "ok 7\n" : "not ok 7\n");
+print (((2147483648 & -1) > 0 && do { use integer; 2147483648 & -1 } < 0)
+       ? "ok 8\n" : "not ok 8\n");
+print (((2147483648 | 1) > 0 && do { use integer; 2147483648 | 1 } < 0)
+       ? "ok 9\n" : "not ok 9\n");
+print (((2147483648 ^ 1) > 0 && do { use integer; 2147483648 ^ 1 } < 0)
+       ? "ok 10\n" : "not ok 10\n");
+print (((1 << 31) == 2147483648 && do { use integer; 1 << 31 } == -2147483648)
+       ? "ok 11\n" : "not ok 11\n");
+print (((2147483648 >> 1) == 1073741824 &&
+       do { use integer; 2147483648 >> 1 } == -1073741824)
+       ? "ok 12\n" : "not ok 12\n");
 
 # short strings
-print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 4\n" : "not ok 4\n");
-print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 5\n" : "not ok 5\n");
-print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 6\n" : "not ok 6\n");
+print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 15\n" : "not ok 15\n");
 
 # long strings
 $foo = "A" x 150;
 $bar = "z" x 75;
-print (($foo & $bar) eq ('@'x75 ) ? "ok 7\n" : "not ok 7\n");
-print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 8\n" : "not ok 8\n");
-print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 9\n" : "not ok 9\n");
+print (($foo & $bar) eq ('@'x75 ) ? "ok 16\n" : "not ok 16\n");
+print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 17\n" : "not ok 17\n");
+print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 18\n" : "not ok 18\n");
diff --git a/t/op/pack.t b/t/op/pack.t

index f15a703..b11fe23 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
 
-print "1..16\n";
+print "1..25\n";
 
 $format = "c2x5CCxsdila6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -47,25 +47,26 @@ print +($x = unpack("I",pack("I", 0xFFFFFFFF))) == 0xFFFFFFFF
 
 # check 'w'
 my $test=10;
-my @x = (5,130,256,560,32000,3097152,268435455,2**30+20, 2**56+4711);
+my @x = (5,130,256,560,32000,3097152,268435455,1073741844,
+         '4503599627365785','23728385234614992549757750638446');
 my $x = pack('w*', @x);
-my $y = pack 'C*', 5,129,2,130,0,132,48,129,250,0,129,189,132,64,255,255,255,
-                   127,132,128,128,128,20,129,128,128,128,128,128,128,164,96;
+my $y = pack 'H*', '0581028200843081fa0081bd8440ffffff7f848080801487ffffffffffdb19caefe8e1eeeea0c2e1e3e8ede1ee6e';
 
 print $x eq $y ? "ok $test\n" : "not ok $test\n"; $test++;
 
 @y = unpack('w*', $y);
-my $a = join ':', @x;
-my $b = join ':', @y;
-
-print $a eq $b ? "ok $test\n" : "not ok $test\n"; $test++;
+my $a;
+while ($a = pop @x) {
+  my $b = pop @y;
+  print $a eq $b ? "ok $test\n" : "not ok $test\n$a\n$b\n"; $test++;
+}
 
 @y = unpack('w2', $x);
 
 print scalar(@y) == 2 ? "ok $test\n" : "not ok $test\n"; $test++;
 print $y[1] == 130 ? "ok $test\n" : "not ok $test\n"; $test++;
 
-# test exections
+# test exeptions
 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff};
 print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
 
diff --git a/t/op/tie.t b/t/op/tie.t

index cf11651..77e74db 100755 (executable)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -3,7 +3,7 @@
 # This test harness will (eventually) test the "tie" functionality
 # without the need for a *DBM* implementation.
 
-# Currently it only tests use strict "untie".
+# Currently it only tests the untie warning 
 
 chdir 't' if -d 't';
 @INC = "../lib";
@@ -11,6 +11,9 @@ $ENV{PERL5LIB} = "../lib";
 
 $|=1;
 
+# catch warnings into fatal errors
+$SIG{__WARN__} = sub { die "WARNING: @_" } ;
+
 undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
@@ -22,7 +25,7 @@ for (@prgs){
     $results = $@ ;
     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
-    if ( $status or $results !~ /^$expected/){
+    if ( $status or $results and $results !~ /^WARNING: $expected/){
        print STDERR "STATUS: $status\n";
        print STDERR "PROG: $prog\n";
        print STDERR "EXPECTED:\n$expected\n";
@@ -74,7 +77,8 @@ EXPECT
 ########
 
 # strict behaviour, without any extra references
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 untie %h;
@@ -82,26 +86,29 @@ EXPECT
 ########
 
 # strict behaviour, with 1 extra references generating an error
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 untie %h;
 EXPECT
-Can't untie: 1 inner references still exist at
+untie attempted while 1 inner references still exist
 ########
 
 # strict behaviour, with 1 extra references via tied generating an error
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
 untie %h;
 EXPECT
-Can't untie: 1 inner references still exist at
+untie attempted while 1 inner references still exist
 ########
 
 # strict behaviour, with 1 extra references which are destroyed
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $a = 0 ;
@@ -110,7 +117,8 @@ EXPECT
 ########
 
 # strict behaviour, with extra 1 references via tied which are destroyed
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 tie %h, Tie::StdHash;
 $a = tied %h;
@@ -120,22 +128,25 @@ EXPECT
 ########
 
 # strict error behaviour, with 2 extra references 
-use strict 'untie';
+#use warning 'untie';
+local $^W = 1 ;
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 $b = tied %h ;
 untie %h;
 EXPECT
-Can't untie: 2 inner references still exist at
+untie attempted while 2 inner references still exist
 ########
 
 # strict behaviour, check scope of strictness.
-no strict 'untie';
+#no warning 'untie';
+local $^W = 0 ;
 use Tie::Hash ;
 $A = tie %H, Tie::StdHash;
 $C = $B = tied %H ;
 {
-    use strict 'untie';
+    #use warning 'untie';
+    local $^W = 1 ;
     use Tie::Hash ;
     tie %h, Tie::StdHash;
     untie %h;
diff --git a/t/op/write.t b/t/op/write.t

index d14cef3..46ec813 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
 
-print "1..3\n";
+print "1..5\n";
 
 format OUT =
 the quick brown @<<
@@ -133,3 +133,35 @@ if (`cat Op_write.tmp` eq $right)
 else
     { print "not ok 3\n"; }
 
+# formline tests
+
+$mustbe = <<EOT;
+@ a
+@> ab
+@>> abc
+@>>>  abc
+@>>>>   abc
+@>>>>>    abc
+@>>>>>>     abc
+@>>>>>>>      abc
+@>>>>>>>>       abc
+@>>>>>>>>>        abc
+@>>>>>>>>>>         abc
+EOT
+
+$was1 = $was2 = '';
+for (0..10) {           
+  # lexical picture
+  $^A = '';
+  my $format1 = '@' . '>' x $_;
+  formline $format1, 'abc';
+  $was1 .= "$format1 $^A\n";
+  # global
+  $^A = '';
+  local $format2 = '@' . '>' x $_;
+  formline $format2, 'abc';
+  $was2 .= "$format2 $^A\n";
+}
+print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
+print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+
diff --git a/toke.c b/toke.c

index c6d56ed..0ce1749 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -40,6 +40,7 @@ static void missingterm _((char *s));
 static void no_op _((char *what, char *s));
 static void set_csh _((void));
 static I32 sublex_done _((void));
+static I32 sublex_push _((void));
 static I32 sublex_start _((void));
 #ifdef CRIPPLED_CC
 static int uni _((I32 f, char *s));
@@ -49,20 +50,27 @@ static void restore_rsfp _((void *f));
 
 static char *linestart;                /* beg. of most recently read line */
 
+static struct {
+    I32 super_state;   /* lexer state to save */
+    I32 sub_inwhat;    /* "lex_inwhat" to use */
+    OP *sub_op;                /* "lex_op" to use */
+} sublex_info;
+
 /* The following are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
  */
 
-#define LEX_NORMAL             9
-#define LEX_INTERPNORMAL       8
-#define LEX_INTERPCASEMOD      7
-#define LEX_INTERPSTART                6
-#define LEX_INTERPEND          5
-#define LEX_INTERPENDMAYBE     4
-#define LEX_INTERPCONCAT       3
-#define LEX_INTERPCONST                2
-#define LEX_FORMLINE           1
-#define LEX_KNOWNEXT           0
+#define LEX_NORMAL             10
+#define LEX_INTERPNORMAL        9
+#define LEX_INTERPCASEMOD       8
+#define LEX_INTERPPUSH          7
+#define LEX_INTERPSTART                 6
+#define LEX_INTERPEND           5
+#define LEX_INTERPENDMAYBE      4
+#define LEX_INTERPCONCAT        3
+#define LEX_INTERPCONST                 2
+#define LEX_FORMLINE            1
+#define LEX_KNOWNEXT            0
 
 #ifdef I_FCNTL
 #include <fcntl.h>
@@ -216,15 +224,15 @@ SV *line;
     char *s;
     STRLEN len;
 
-    SAVEINT(lex_dojoin);
-    SAVEINT(lex_brackets);
-    SAVEINT(lex_fakebrack);
-    SAVEINT(lex_casemods);
-    SAVEINT(lex_starts);
-    SAVEINT(lex_state);
+    SAVEI32(lex_dojoin);
+    SAVEI32(lex_brackets);
+    SAVEI32(lex_fakebrack);
+    SAVEI32(lex_casemods);
+    SAVEI32(lex_starts);
+    SAVEI32(lex_state);
     SAVESPTR(lex_inpat);
-    SAVEINT(lex_inwhat);
-    SAVEINT(curcop->cop_line);
+    SAVEI32(lex_inwhat);
+    SAVEI16(curcop->cop_line);
     SAVEPPTR(bufptr);
     SAVEPPTR(bufend);
     SAVEPPTR(oldbufptr);
@@ -517,7 +525,10 @@ int kind;
        force_next(WORD);
        if (kind) {
            op->op_private = OPpCONST_ENTERED;
-           gv_fetchpv(s, TRUE,
+           /* XXX see note in pp_entereval() for why we forgo typo
+              warnings if the symbol must be introduced in an eval.
+              GSAR 96-10-12 */
+           gv_fetchpv(s, in_eval ? GV_ADDMULTI : TRUE,
                kind == '$' ? SVt_PV :
                kind == '@' ? SVt_PVAV :
                kind == '%' ? SVt_PVHV :
@@ -540,7 +551,7 @@ char *s;
     if(isDIGIT(*s)) {
         char *d;
         int c;
-        for( d=s, c = 1; isDIGIT(*d) || (*d == '.' && c--); d++);
+        for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
         if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
             s = scan_num(s);
             /* real VERSION number -- GBARR */
@@ -605,16 +616,36 @@ sublex_start()
        return THING;
     }
 
+    sublex_info.super_state = lex_state;
+    sublex_info.sub_inwhat = op_type;
+    sublex_info.sub_op = lex_op;
+    lex_state = LEX_INTERPPUSH;
+
+    expect = XTERM;
+    if (lex_op) {
+       yylval.opval = lex_op;
+       lex_op = Nullop;
+       return PMFUNC;
+    }
+    else
+       return FUNC;
+}
+
+static I32
+sublex_push()
+{
     push_scope();
-    SAVEINT(lex_dojoin);
-    SAVEINT(lex_brackets);
-    SAVEINT(lex_fakebrack);
-    SAVEINT(lex_casemods);
-    SAVEINT(lex_starts);
-    SAVEINT(lex_state);
+
+    lex_state = sublex_info.super_state;
+    SAVEI32(lex_dojoin);
+    SAVEI32(lex_brackets);
+    SAVEI32(lex_fakebrack);
+    SAVEI32(lex_casemods);
+    SAVEI32(lex_starts);
+    SAVEI32(lex_state);
     SAVESPTR(lex_inpat);
-    SAVEINT(lex_inwhat);
-    SAVEINT(curcop->cop_line);
+    SAVEI32(lex_inwhat);
+    SAVEI16(curcop->cop_line);
     SAVEPPTR(bufptr);
     SAVEPPTR(oldbufptr);
     SAVEPPTR(oldoldbufptr);
@@ -643,21 +674,13 @@ sublex_start()
     lex_state = LEX_INTERPCONCAT;
     curcop->cop_line = multi_start;
 
-    lex_inwhat = op_type;
-    if (op_type == OP_MATCH || op_type == OP_SUBST)
-       lex_inpat = lex_op;
+    lex_inwhat = sublex_info.sub_inwhat;
+    if (lex_inwhat == OP_MATCH || lex_inwhat == OP_SUBST)
+       lex_inpat = sublex_info.sub_op;
     else
-       lex_inpat = 0;
+       lex_inpat = Nullop;
 
-    expect = XTERM;
-    force_next('(');
-    if (lex_op) {
-       yylval.opval = lex_op;
-       lex_op = Nullop;
-       return PMFUNC;
-    }
-    else
-       return FUNC;
+    return '(';
 }
 
 static I32
@@ -1008,6 +1031,8 @@ GV *gv;
        /* filehandle or package name makes it a method */
        if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
            s = skipspace(s);
+           if ((bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
+               return 0;       /* no assumptions -- "=>" quotes bearword */
            nextval[nexttoke].opval =
                (OP*)newSVOP(OP_CONST, 0,
                            newSVpv(tmpbuf,0));
@@ -1165,7 +1190,8 @@ STRLEN append;
 {
     if (rsfp_filters) {
 
-        SvCUR_set(sv, 0);      /* start with empty line        */
+       if (!append)
+            SvCUR_set(sv, 0);  /* start with empty line        */
         if (FILTER_READ(0, sv, 0) > 0)
             return ( SvPVX(sv) ) ;
         else
@@ -1275,6 +1301,9 @@ yylex()
                return yylex();
        }
 
+    case LEX_INTERPPUSH:
+        return sublex_push();
+
     case LEX_INTERPSTART:
        if (bufptr == bufend)
            return sublex_done();
@@ -1375,6 +1404,8 @@ yylex()
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
     case 0:
        if (!rsfp) {
+           last_uni = 0;
+           last_lop = 0;
            if (lex_brackets)
                yyerror("Missing right bracket");
            TOKEN(0);
@@ -2781,10 +2812,16 @@ yylex()
        case KEY_for:
        case KEY_foreach:
            yylval.ival = curcop->cop_line;
-           while (s < bufend && isSPACE(*s))
-               s++;
-           if (isIDFIRST(*s))
-               croak("Missing $ on loop variable");
+           s = skipspace(s);
+           if (isIDFIRST(*s)) {
+               char *p = s;
+               if ((bufend - p) >= 3 &&
+                   strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
+                   p += 2;
+               p = skipspace(p);
+               if (isIDFIRST(*p))
+                   croak("Missing $ on loop variable");
+           }
            OPERATOR(FOR);
 
        case KEY_formline:
@@ -2936,7 +2973,6 @@ yylex()
            UNI(OP_LCFIRST);
 
        case KEY_local:
-           yylval.ival = 0;
            OPERATOR(LOCAL);
 
        case KEY_length:
@@ -2987,8 +3023,7 @@ yylex()
 
        case KEY_my:
            in_my = TRUE;
-           yylval.ival = 1;
-           OPERATOR(LOCAL);
+           OPERATOR(MY);
 
        case KEY_next:
            s = force_word(s,WORD,TRUE,FALSE,FALSE);
@@ -3077,6 +3112,19 @@ yylex()
            s = scan_str(s);
            if (!s)
                missingterm((char*)0);
+           if (dowarn && SvLEN(lex_stuff)) {
+               d = SvPV_force(lex_stuff, len);
+               for (; len; --len, ++d) {
+                   if (*d == ',') {
+                       warn("Possible attempt to separate words with commas");
+                       break;
+                   }
+                   if (*d == '#') {
+                       warn("Possible attempt to put comments in qw() list");
+                       break;
+                   }
+               }
+           }
            force_next(')');
            nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
            lex_stuff = Nullsv;
@@ -4780,8 +4828,9 @@ char *start;
        croak("panic: scan_num");
     case '0':
        {
-           U32 i;
+           UV u;
            I32 shift;
+           bool overflowed = FALSE;
 
            if (s[1] == 'x') {
                shift = 4;
@@ -4791,8 +4840,10 @@ char *start;
                goto decimal;
            else
                shift = 3;
-           i = 0;
+           u = 0;
            for (;;) {
+               UV n, b;
+
                switch (*s) {
                default:
                    goto out;
@@ -4805,25 +4856,27 @@ char *start;
                    /* FALL THROUGH */
                case '0': case '1': case '2': case '3': case '4':
                case '5': case '6': case '7':
-                   i <<= shift;
-                   i += *s++ & 15;
-                   break;
+                   b = *s++ & 15;
+                   goto digit;
                case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
                case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
                    if (shift != 4)
                        goto out;
-                   i <<= 4;
-                   i += (*s++ & 7) + 9;
+                   b = (*s++ & 7) + 9;
+                 digit:
+                   n = u << shift;
+                   if (!overflowed && (n >> shift) != u) {
+                       warn("Integer overflow in %s number",
+                            (shift == 4) ? "hex" : "octal");
+                       overflowed = TRUE;
+                   }
+                   u = n | b;
                    break;
                }
            }
          out:
            sv = NEWSV(92,0);
-           tryi32 = i;
-           if (tryi32 == i && tryi32 >= 0)
-               sv_setiv(sv,tryi32);
-           else
-               sv_setnv(sv,(double)i);
+           sv_setuv(sv, u);
        }
        break;
     case '1': case '2': case '3': case '4': case '5':
@@ -4970,15 +5023,15 @@ start_subparse()
 #endif
     save_I32(&subline);
     save_item(subname);
-    SAVEINT(padix);
+    SAVEI32(padix);
     SAVESPTR(curpad);
     SAVESPTR(comppad);
     SAVESPTR(comppad_name);
     SAVESPTR(compcv);
-    SAVEINT(comppad_name_fill);
-    SAVEINT(min_intro_pending);
-    SAVEINT(max_intro_pending);
-    SAVEINT(pad_reset_pending);
+    SAVEI32(comppad_name_fill);
+    SAVEI32(min_intro_pending);
+    SAVEI32(max_intro_pending);
+    SAVEI32(pad_reset_pending);
 
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
diff --git a/universal.c b/universal.c

index 72087e6..ea797ae 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -74,36 +74,53 @@ int level;
     return &sv_no;
 }
 
+bool
+sv_derived_from(sv, name)
+SV * sv ;
+char * name ;
+{
+    SV *rv;
+    char *type;
+    HV *stash;
+  
+    stash = Nullhv;
+    type = Nullch;
+ 
+    if (SvGMAGICAL(sv))
+        mg_get(sv) ;
+
+    if (SvROK(sv)) {
+        sv = SvRV(sv);
+        type = sv_reftype(sv,0);
+        if(SvOBJECT(sv))
+            stash = SvSTASH(sv);
+    }
+    else {
+        stash = gv_stashsv(sv, FALSE);
+    }
+ 
+    return (type && strEQ(type,name)) ||
+            (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
+        ? TRUE
+        : FALSE ;
+ 
+}
+
+
 static
 XS(XS_UNIVERSAL_isa)
 {
     dXSARGS;
-    SV *sv, *rv;
-    char *name, *type;
-    HV *stash;
+    SV *sv;
+    char *name;
 
     if (items != 2)
        croak("Usage: UNIVERSAL::isa(reference, kind)");
 
-    stash = Nullhv;
-    type = Nullch;
     sv = ST(0);
     name = (char *)SvPV(ST(1),na);
 
-    if (SvROK(sv)) {
-       sv = SvRV(sv);
-       type = sv_reftype(sv,0);
-       if(SvOBJECT(sv))
-           stash = SvSTASH(sv);
-    }
-    else {
-       stash = gv_stashsv(sv, FALSE);
-    }
-
-    ST(0) = (type && strEQ(type,name)) ||
-           (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
-       ? &sv_yes
-       : &sv_no;
+    ST(0) = (sv_derived_from(sv, name) ? &sv_yes : &sv_no) ;
 
     XSRETURN(1);
 }
diff --git a/util.c b/util.c

index 1c93691..82e6d0f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -48,7 +48,7 @@
 static void xstat _((void));
 #endif
 
-#ifndef safemalloc
+#ifndef MYMALLOC
 
 /* paranoid version of malloc */
 
@@ -60,19 +60,15 @@ static void xstat _((void));
 
 Malloc_t
 safemalloc(size)
-#ifdef MSDOS
-unsigned long size;
-#else
 MEM_SIZE size;
-#endif /* MSDOS */
 {
     Malloc_t ptr;
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT
        if (size > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", size) FLUSH;
                my_exit(1);
        }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
     if ((long)size < 0)
        croak("panic: malloc");
@@ -99,23 +95,19 @@ MEM_SIZE size;
 Malloc_t
 saferealloc(where,size)
 Malloc_t where;
-#ifndef MSDOS
 MEM_SIZE size;
-#else
-unsigned long size;
-#endif /* MSDOS */
 {
     Malloc_t ptr;
 #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
     Malloc_t realloc();
 #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
 
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT 
        if (size > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Reallocation too large: %lx\n", size) FLUSH;
                my_exit(1);
        }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
     if (!where)
        croak("Null realloc");
 #ifdef DEBUGGING
@@ -173,12 +165,12 @@ MEM_SIZE size;
 {
     Malloc_t ptr;
 
-#ifdef MSDOS
+#ifdef HAS_64K_LIMIT
        if (size * count > 0xffff) {
                PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", size * count) FLUSH;
                my_exit(1);
        }
-#endif /* MSDOS */
+#endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
     if ((long)size < 0 || (long)count < 0)
        croak("panic: calloc");
@@ -203,7 +195,7 @@ MEM_SIZE size;
     /*NOTREACHED*/
 }
 
-#endif /* !safemalloc */
+#endif /* !MYMALLOC */
 
 #ifdef LEAKTEST
 
@@ -405,7 +397,7 @@ char *lend;
 }
 
 /* Initialize the fold[] array. */
-int
+void
 perl_init_fold()
 {
   int i;
@@ -1576,8 +1568,8 @@ VTOH(vtohs,short)
 VTOH(vtohl,long)
 #endif
 
-#if  (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS)  /* VMS' my_popen() is in
-                                          VMS.c, same with OS/2. */
+#if  (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \
+     && !defined(VMS)  /* VMS' my_popen() is in VMS.c, same with OS/2. */
 PerlIO *
 my_popen(cmd,mode)
 char   *cmd;
@@ -1587,7 +1579,12 @@ char     *mode;
     register I32 this, that;
     register I32 pid;
     SV *sv;
-    I32 doexec = strNE(cmd,"-");
+    I32 doexec =
+#ifdef AMIGAOS
+       1;
+#else
+       strNE(cmd,"-");
+#endif
 
 #ifdef OS2
     if (doexec) {
@@ -1659,7 +1656,7 @@ char      *mode;
     return PerlIO_fdopen(p[this], mode);
 }
 #else
-#if defined(atarist)
+#if defined(atarist) || defined(DJGPP)
 FILE *popen();
 PerlIO *
 my_popen(cmd,mode)
@@ -1667,7 +1664,8 @@ char      *cmd;
 char   *mode;
 {
     /* Needs work for PerlIO ! */
-    return popen(PerlIO_exportFILE(cmd), mode);
+    /* used 0 for 2nd parameter to PerlIO-exportFILE; apparently not used */
+    return popen(PerlIO_exportFILE(cmd, 0), mode);
 }
 #endif
 
@@ -1717,7 +1715,8 @@ int newfd;
 }
 #endif
 
-#if  (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
+#if  (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) \
+     && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
 I32
 my_pclose(ptr)
 PerlIO *ptr;
@@ -1827,7 +1826,7 @@ int status;
     return;
 }
 
-#if defined(atarist) || defined(OS2)
+#if defined(atarist) || defined(OS2) || defined(DJGPP)
 int pclose();
 #ifdef HAS_FORK
 int                                    /* Cannot prototype with I32
@@ -1988,18 +1987,23 @@ char *b;
 }
 #endif /* !HAS_RENAME */
 
-unsigned long
+UV
 scan_oct(start, len, retlen)
 char *start;
 I32 len;
 I32 *retlen;
 {
     register char *s = start;
-    register unsigned long retval = 0;
+    register UV retval = 0;
+    bool overflowed = FALSE;
 
     while (len && *s >= '0' && *s <= '7') {
-       retval <<= 3;
-       retval |= *s++ - '0';
+       register UV n = retval << 3;
+       if (!overflowed && (n >> 3) != retval) {
+           warn("Integer overflow in octal number");
+           overflowed = TRUE;
+       }
+       retval = n | (*s++ - '0');
        len--;
     }
     if (dowarn && len && (*s == '8' || *s == '9'))
@@ -2015,12 +2019,17 @@ I32 len;
 I32 *retlen;
 {
     register char *s = start;
-    register unsigned long retval = 0;
+    register UV retval = 0;
+    bool overflowed = FALSE;
     char *tmp;
 
     while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
-       retval <<= 4;
-       retval |= (tmp - hexdigit) & 15;
+       register UV n = retval << 4;
+       if (!overflowed && (n >> 4) != retval) {
+           warn("Integer overflow in hex number");
+           overflowed = TRUE;
+       }
+       retval = n | (tmp - hexdigit) & 15;
        s++;
     }
     *retlen = s - start;
diff --git a/utils/h2xs.PL b/utils/h2xs.PL

index 96f6421..81e27c9 100644 (file)
--- a/utils/h2xs.PL
+++ b/utils/h2xs.PL
@@ -873,6 +873,16 @@ if (!@files) {
   unless ($@) { @files = readdir(D); closedir(D); }
 }
 if (!@files) { @files = map {chomp && $_} `ls`; }
+if ($^O eq 'VMS') {
+  foreach (@files) {
+    # Clip trailing '.' for portability -- non-VMS OSs don't expect it
+    s%\.$%%;
+    # Fix up for case-sensitive file systems
+    s/$modfname/$modfname/i && next;
+    $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
+    $_ = 'Makefile.PL' if $_ = 'makefile.pl';
+  }
+}
 print MANI join("\n",@files);
 close MANI;
 !NO!SUBS!
diff --git a/utils/perldoc.PL b/utils/perldoc.PL

index 07540c5..b364405 100644 (file)
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -28,13 +28,14 @@ print OUT <<"!GROK!THIS!";
 $Config{'startperl'}
     eval 'exec perl -S \$0 "\$@"'
        if 0;
+
+\@pagers = ();
+push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
 !GROK!THIS!
 
 # In the following, perl variables are not expanded during extraction.
 
 print OUT <<'!NO!SUBS!';
-    eval 'exec perl -S $0 "$@"'
-       if 0;
 
 #
 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
@@ -218,14 +219,13 @@ if( ! -t STDOUT ) { $opt_f = 1 }
 
 unless($Is_VMS) {
        $tmp = "/tmp/perldoc1.$$";
+       push @pagers, qw( more less pg view cat );
+       unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
        $goodresult = 0;
-       @pagers = qw( more less pg view cat );
-       unshift(@pagers,$ENV{PAGER}) if $ENV{PAGER};
 } else {
-       require Config;
        $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
-       @pagers = ($Config::Config{'pager'},qw( most more less type/page ));
-       unshift(@pagers,$ENV{PERLDOC_PAGER}) if $ENV{PERLDOC_PAGER};
+       push @pagers, qw( most more less type/page );
+       unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
        $goodresult = 1;
 }
 
diff --git a/utils/pl2pm.PL b/utils/pl2pm.PL

index e8277bb..60e66f8 100644 (file)
--- a/utils/pl2pm.PL
+++ b/utils/pl2pm.PL
@@ -56,7 +56,7 @@ It's just a first step, but it's usually a good first step.
 
 =head1 AUTHOR
 
-Larry Wall <lwall@sems.com>
+Larry Wall <larry@wall.org>
 
 =cut
 
diff --git a/vms/Makefile b/vms/Makefile

index 98c0747..7b9d2b5 100644 (file)
--- a/vms/Makefile
+++ b/vms/Makefile
@@ -32,7 +32,7 @@ ARCH = VMS_VAX
 OBJVAL = $@
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00304#
+PERL_VERSION = 5_00307#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
diff --git a/vms/config.vms b/vms/config.vms

index b9e51c7..792c893 100644 (file)
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -8,7 +8,7 @@
  * GenConfig.pl when producing Config.pm.
  *
  * config.h for VMS
- * Version: 5.002_01
+ * Version: 5.003_07
  */                 
 
 /* Configuration time: 22-Mar-1996 14:45
@@ -76,7 +76,7 @@
  * when Perl is built.  Please do not change it by hand; make
  * any changes to FndVers.Com instead.
  */
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00305"  /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00307"  /**/
 #define ARCHLIB ARCHLIB_EXP    /*config-skip*/
 
 /* CPPSTDIN:
diff --git a/vms/descrip.mms b/vms/descrip.mms

index b628c2c..a162ad0 100644 (file)
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O)
 .endif
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00305#
+PERL_VERSION = 5_00307#
 
 
 ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
@@ -94,6 +94,7 @@ XTRADEF = ,GNUC_ATTRIBUTE_CHECK
 XTRAOBJS =
 LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library
 LIBS2 = Sys$Share:VAXCRTL/Shareable
+POSIX =
 .else
 XTRAOBJS = 
 LIBS1 = $(XTRAOBJS)
@@ -117,6 +118,7 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion)
 LIBS2 = 
 XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(OBJVAL)
 XTRADEF =
+POSIX = POSIX
 .else # VAXC
 .first
        @ @[.vms]fndvers.com "" "" "[.vms]descrip.mms"
@@ -126,6 +128,7 @@ XTRADEF =
 XTRACCFLAGS = /Include=[]/Object=$(O)
 XTRADEF =
 LIBS2 = Sys$Share:VAXCRTL/Shareable
+POSIX =
 .endif
 .endif
 
@@ -267,7 +270,7 @@ all : base extras libmods utils podxform archcorefiles preplibrary perlpods
        @ $(NOOP)
 base : miniperl perl
        @ $(NOOP)
-extras : Fcntl FileHandle IO Opcode libmods utils podxform
+extras : Fcntl FileHandle IO Opcode $(POSIX) libmods utils podxform
        @ $(NOOP)
 libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm 
        @ $(NOOP)
@@ -439,6 +442,25 @@ Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E)
 [.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E)
        $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
 
+POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E)
+       @ $(NOOP)
+
+[.lib]POSIX.pm : [.ext.POSIX]Descrip.MMS
+       @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+       @ Set Default [.ext.POSIX]
+       $(MMS)
+       @ Set Default [--]
+
+[.lib.auto.POSIX]POSIX$(E) : [.ext.POSIX]Descrip.MMS
+       @ Set Default [.ext.POSIX]
+       $(MMS)
+       @ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.POSIX]Descrip.MMS : [.ext.POSIX]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm $(DBG)perlshr$(E)
+       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.POSIX]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
 IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]Seekable.pm [.lib.IO]Socket.pm [.lib.auto.IO]IO$(E)
        @ $(NOOP)
 
@@ -1585,6 +1607,11 @@ clean : tidy
        Set Default [.ext.Opcode]
        - $(MMS) clean
        Set Default [--]
+.ifdef DECC
+       Set Default [.ext.POSIX]
+       - $(MMS) clean
+       Set Default [--]
+.endif
        - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
        - If F$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);*
        - If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
@@ -1618,6 +1645,11 @@ realclean : clean
        Set Default [.ext.Opcode]
        - $(MMS) realclean
        Set Default [--]
+.ifdef DECC
+       Set Default [.ext.POSIX]
+       - $(MMS) realclean
+       Set Default [--]
+.endif
        - If F$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);*
        - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
        - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);"
diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm

index 2750813..af71f0b 100644 (file)
--- a/vms/ext/Stdio/Stdio.pm
+++ b/vms/ext/Stdio/Stdio.pm
@@ -32,13 +32,15 @@ sub AUTOLOAD {
     if ($constname =~ /^O_/) {
       my($val) = constant($constname);
       defined $val or croak("Unknown VMS::Stdio constant $constname");
-      *$AUTOLOAD = sub { $val };
     }
     else { # We don't know about it; hand off to IO::File
       require IO::File;
       my($obj) = shift(@_);
-      $obj->IO::File::$constname(@_);
+
+      my($val) = eval "\$obj->IO::File::$constname(@_)";
+      croak "Error autoloading $constname: $@" if $@;
     }
+    *$AUTOLOAD = sub { $val };
     goto &$AUTOLOAD;
 }
 
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs

index 79eb953..a1ec91f 100644 (file)
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -79,8 +79,8 @@ IV *pval;
 
 static SV *
 newFH(FILE *fp, char type) {
-    SV *rv, *gv = NEWSV(0,0);
-    GV **stashp;
+    SV *rv;
+    GV **stashp, *gv = (GV *)NEWSV(0,0);
     HV *stash;
     IO *io;
 
@@ -102,7 +102,7 @@ newFH(FILE *fp, char type) {
     IoIFP(io) = fp;
     if (type != '>') IoOFP(io) = fp;
     IoTYPE(io) = type;
-    rv = newRV(gv);
+    rv = newRV((SV *)gv);
     SvREFCNT_dec(gv);
     return sv_bless(rv,stash);
 }
diff --git a/vms/genconfig.pl b/vms/genconfig.pl

index 17ff204..d2ab577 100644 (file)
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -266,7 +266,7 @@ while (<IN>) {
   elsif (not length $val and not $had_val) {
     # Wups -- should have been shell var for C preprocessor directive
     warn "Constant $token not found in config_h.SH\n";
-    $token =~ tr/A-Z/a-z/;
+    $token = lc $token;
     $token = "d_$token" unless $token =~ /^i_/;
     print OUT "$token='$state'\n";
   }
@@ -282,7 +282,7 @@ while (<IN>) {
   }
   elsif (!$pp_vars{$token}) {  # Haven't seen it previously, either
     warn "Constant $token not found in config_h.SH (val=|$val|)\n";
-    $token =~ tr/A-Z/a-z/;
+    $token = lc $token;
     print OUT "$token='$val'\n";
     if ($token =~ s/exp$//) {print OUT "$token='$val'\n";}
   }
diff --git a/vms/perlvms.pod b/vms/perlvms.pod

index f15bd77..b56d202 100644 (file)
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -238,6 +238,7 @@ directory specifications may use either VMS or Unix syntax.
 
 Perl for VMS supports redirection of input and output on the 
 command line, using a subset of Bourne shell syntax:
+
     <F<file> reads stdin from F<file>,
     >F<file> writes stdout to F<file>,
     >>F<file> appends stdout to F<file>,
@@ -261,6 +262,8 @@ to pass uppercase switches to Perl, you need to enclose
 them in double-quotes on the command line, since the CRTL
 downcases all unquoted strings.
 
+=over 4
+
 =item -i
 
 If the C<-i> switch is present but no extension for a backup
@@ -286,6 +289,8 @@ The C<-u> switch causes the VMS debugger to be invoked
 after the Perl program is compiled, but before it has
 run.  It does not create a core dump file.
 
+=back
+
 =head1 Perl functions
 
 As of the time this document was last revised, the following 
@@ -337,6 +342,7 @@ your copy of Perl:
     getsockopt, listen, recv, select(system call)*,
     send, setsockopt, shutdown, socket
 
+=over 4
 
 =item File tests
 
@@ -605,8 +611,17 @@ and you invoked Perl with the C<-w> switch, a warning will be issued.)
 
 The FLAGS argument is ignored in all cases.
 
+=back
+
 =head1 Perl variables
 
+The following VMS-specific information applies to the indicated
+"special" Perl variables, in addition to the general information
+in L<perlvar>.  Where there is a conflict, this infrmation
+takes precedence.
+
+=over 4
+
 =item %ENV 
 
 Reading the elements of the %ENV array returns the 
@@ -699,6 +714,8 @@ all the way to disk on each write (I<i.e.> not just to
 the underlying RMS buffers for a file).  In other words,
 it's equivalent to calling fflush() and fsync() from C.
 
+=back
+
 =head1 Revision date
 
 This document was last updated on 28-Feb-1996, for Perl 5, 
diff --git a/vms/test.com b/vms/test.com

index 156b2dc..2afe93c 100644 (file)
--- a/vms/test.com
+++ b/vms/test.com
@@ -137,6 +137,8 @@ while ($test = shift) {
        close(script);
        if (/#!..perl(.*)/) {
            $switch = $1;
+           # Add "" to protect uppercase switches on command line
+           $switch =~ s/-([A-Z]\S*)/"-$1"/g;
        } else {
            $switch = '';
        }
diff --git a/vms/vms.c b/vms/vms.c

index d76977f..9a4b55e 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -2,8 +2,8 @@
  *
  * VMS-specific routines for perl5
  *
- * Last revised: 18-Jul-1996 by Charles Bailey  bailey@genetics.upenn.edu
- * Version: 5.3.1
+ * Last revised: 14-Oct-1996 by Charles Bailey  bailey@genetics.upenn.edu
+ * Version: 5.3.7
  */
 
 #include <acedef.h>
@@ -119,7 +119,7 @@ char *
 my_getenv(char *lnm)
 {
     static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
-    char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
     unsigned long int idx = 0;
     int trnsuccess;
 
@@ -3020,7 +3020,7 @@ struct tm *
 my_gmtime(const time_t *time)
 {
   static int gmtime_emulation_type;
-  static time_t utc_offset_secs;
+  static long int utc_offset_secs;
   char *p;
   time_t when;
 
@@ -3032,7 +3032,7 @@ my_gmtime(const time_t *time)
       if ((p = my_getenv("SYS$TIMEZONE_DIFFERENTIAL")) == NULL)
         gmtime_emulation_type++;
       else
-        utc_offset_secs = (time_t) atol(p);
+        utc_offset_secs = atol(p);
     }
   }
 
diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH

index ac36250..27345f0 100755 (executable)
--- a/x2p/Makefile.SH
+++ b/x2p/Makefile.SH
@@ -80,7 +80,7 @@ plextract = find2perl s2p
 
 addedbyconf = $(shextract) $(plextract)
 
-h = EXTERN.h INTERN.h ../config.h handy.h hash.h a2p.h str.h util.h
+h = EXTERN.h INTERN.h ../config.h ../handy.h hash.h a2p.h str.h util.h
 
 c = hash.c $(mallocsrc) str.c util.c walk.c
 
@@ -112,7 +112,8 @@ run_byacc:  FORCE
 a2p.c: a2p.y
        -@touch a2p.c
 
-a2p$(OBJ_EXT): a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
+a2p$(OBJ_EXT): a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h \
+               ../handy.h ../config.h str.h hash.h
        $(CCCMD) $(LARGE) a2p.c
 
 clean:
diff --git a/x2p/a2p.h b/x2p/a2p.h

index a51db47..a6dfd1d 100644 (file)
--- a/x2p/a2p.h
+++ b/x2p/a2p.h
@@ -8,7 +8,6 @@
  * $Log:       a2p.h,v $
  */
 
-#include "../embed.h"
 #define VOIDUSED 1
 #include "../config.h"
 
@@ -31,7 +30,6 @@
 #  include <sys/types.h>
 #endif
 
-
 #ifdef USE_NEXT_CTYPE
 
 #if NX_CURRENT_COMPILER_RELEASE >= 400
@@ -46,6 +44,15 @@
 
 #define MEM_SIZE Size_t
 
+#ifdef STANDARD_C
+#   include <stdlib.h>
+#else
+    Malloc_t malloc _((MEM_SIZE nbytes));
+    Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size));
+    Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
+    Free_t   free _((Malloc_t where));
+#endif
+
 #if defined(I_STRING) || defined(__cplusplus)
 #   include <string.h>
 #else
@@ -105,7 +112,11 @@ char *strchr(), *strrchr();
 char *strcpy(), *strcat();
 #endif /* ! STANDARD_C */
 
-#include "handy.h"
+#include "../handy.h"
+
+#undef Nullfp
+#define Nullfp Null(FILE*)
+
 #define Nullop 0
 
 #define OPROG          1
diff --git a/x2p/a2p.pod b/x2p/a2p.pod

index 3976aba..4e61fd6 100644 (file)
--- a/x2p/a2p.pod
+++ b/x2p/a2p.pod
@@ -134,7 +134,7 @@ A2p uses no environment variables.
 
 =head1 AUTHOR
 
-Larry Wall E<lt>F<lwall@jpl-devvax.Jpl.Nasa.Gov>E<gt>
+Larry Wall E<lt>F<larry@wall.org>E<gt>
 
 =head1 FILES
 
diff --git a/x2p/s2p.PL b/x2p/s2p.PL

index 6664dcd..9d7297b 100644 (file)
--- a/x2p/s2p.PL
+++ b/x2p/s2p.PL
@@ -95,7 +95,7 @@ S2p uses no environment variables.
 
 =head1 AUTHOR
 
-Larry Wall E<lt>F<lwall@jpl-devvax.Jpl.Nasa.Gov>E<gt>
+Larry Wall E<lt>F<larry@wall.org>E<gt>
 
 =head1 FILES
 
diff --git a/x2p/util.c b/x2p/util.c

index 5c3554b..6c81732 100644 (file)
--- a/x2p/util.c
+++ b/x2p/util.c
@@ -13,6 +13,9 @@
 #include "INTERN.h"
 #include "util.h"
 
+#ifdef I_STDARG
+#  include <stdarg.h>
+#endif
 #define FLUSH
 
 static char nomem[] = "Out of memory!\n";
@@ -189,32 +192,65 @@ int newlen;
     }
 }
 
-/*VARARGS1*/
 void
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+croak(char *pat,...)
+#else /* I_STDARG */
+/*VARARGS1*/
 croak(pat,a1,a2,a3,a4)
-char *pat;
-int a1,a2,a3,a4;
+    char *pat;
+    int a1,a2,a3,a4;
+#endif /* I_STDARG */
 {
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+    va_list args;
+
+    va_start(args, pat);
+    vfprintf(stderr,pat,args);
+#else
     fprintf(stderr,pat,a1,a2,a3,a4);
+#endif
     exit(1);
 }
 
-/*VARARGS1*/
 void
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+fatal(char *pat,...)
+#else /* I_STDARG */
+/*VARARGS1*/
 fatal(pat,a1,a2,a3,a4)
-char *pat;
-int a1,a2,a3,a4;
+    char *pat;
+    int a1,a2,a3,a4;
+#endif /* I_STDARG */
 {
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+    va_list args;
+
+    va_start(args, pat);
+    vfprintf(stderr,pat,args);
+#else
     fprintf(stderr,pat,a1,a2,a3,a4);
+#endif
     exit(1);
 }
 
-/*VARARGS1*/
 void
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+warn(char *pat,...)
+#else /* I_STDARG */
+/*VARARGS1*/
 warn(pat,a1,a2,a3,a4)
-char *pat;
-int a1,a2,a3,a4;
+    char *pat;
+    int a1,a2,a3,a4;
+#endif /* I_STDARG */
 {
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+    va_list args;
+
+    va_start(args, pat);
+    vfprintf(stderr,pat,args);
+#else
     fprintf(stderr,pat,a1,a2,a3,a4);
+#endif
 }
 
diff --git a/x2p/util.h b/x2p/util.h

index 35f7961..bdd85c1 100644 (file)
--- a/x2p/util.h
+++ b/x2p/util.h
@@ -24,10 +24,22 @@ int makedir();
 
 char * cpy2 _(( char *to, char *from, int delim ));
 char * cpytill _(( char *to, char *from, int delim ));
-void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
 void growstr _(( char **strptr, int *curlen, int newlen ));
 char * instr _(( char *big, char *little ));
-void Myfatal ();
 char * safecpy _(( char *to, char *from, int len ));
 char * savestr _(( char *str ));
+#if defined(I_STDARG) && defined(HAS_VPRINTF)
+void croak _(( char *pat, ... ));
+void fatal _(( char *pat, ... ));
+void warn  _(( char *pat, ... ));
+#else /* defined(I_STDARG) && defined(HAS_VPRINTF) */
+void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
+void Myfatal ();
 void warn ();
+#endif /* defined(I_STDARG) && defined(HAS_VPRINTF) */
+int prewalk _(( int numit, int level, int node, int *numericptr ));
+
+Malloc_t safemalloc _((MEM_SIZE nbytes));
+Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t   safefree _((Malloc_t where));
Changes		patch \| blob \| blame \| history
MANIFEST		patch \| blob \| blame \| history
Makefile.SH		patch \| blob \| blame \| history
README.os2		patch \| blob \| blame \| history
config_H		patch \| blob \| blame \| history
configure		patch \| blob \| blame \| history
doio.c		patch \| blob \| blame \| history
dosish.h		patch \| blob \| blame \| history
emacs/cperl-mode.el		patch \| blob \| blame \| history
embed.h		patch \| blob \| blame \| history
embed.pl		patch \| blob \| blame \| history
ext/DynaLoader/dlutils.c		patch \| blob \| blame \| history
ext/IO/lib/IO/File.pm		patch \| blob \| blame \| history
ext/IO/lib/IO/Handle.pm		patch \| blob \| blame \| history
ext/SDBM_File/sdbm/sdbm.c		patch \| blob \| blame \| history
ext/SDBM_File/sdbm/sdbm.h		patch \| blob \| blame \| history
global.sym		patch \| blob \| blame \| history
handy.h		patch \| blob \| blame \| history
hints/amigaos.sh	[new file with mode: 0644]	patch \| blob
hints/freebsd.sh		patch \| blob \| blame \| history
hints/machten.sh		patch \| blob \| blame \| history
installman		patch \| blob \| blame \| history
installperl		patch \| blob \| blame \| history
lib/AutoLoader.pm		patch \| blob \| blame \| history
lib/AutoSplit.pm		patch \| blob \| blame \| history
lib/Carp.pm		patch \| blob \| blame \| history
lib/Cwd.pm		patch \| blob \| blame \| history
lib/ExtUtils/Liblist.pm		patch \| blob \| blame \| history
lib/ExtUtils/MM_Unix.pm		patch \| blob \| blame \| history
lib/ExtUtils/MM_VMS.pm		patch \| blob \| blame \| history
lib/ExtUtils/typemap		patch \| blob \| blame \| history
lib/ExtUtils/xsubpp		patch \| blob \| blame \| history
lib/File/Basename.pm		patch \| blob \| blame \| history
lib/File/Copy.pm		patch \| blob \| blame \| history
lib/File/Find.pm		patch \| blob \| blame \| history
lib/FindBin.pm		patch \| blob \| blame \| history
lib/Getopt/Long.pm		patch \| blob \| blame \| history
lib/Math/BigInt.pm		patch \| blob \| blame \| history
lib/Math/Complex.pm		patch \| blob \| blame \| history
lib/Pod/Text.pm		patch \| blob \| blame \| history
lib/Sys/Syslog.pm		patch \| blob \| blame \| history
lib/Term/Cap.pm		patch \| blob \| blame \| history
lib/Term/Complete.pm		patch \| blob \| blame \| history
lib/Text/ParseWords.pm		patch \| blob \| blame \| history
lib/Text/Soundex.pm		patch \| blob \| blame \| history
lib/Time/Local.pm		patch \| blob \| blame \| history
lib/abbrev.pl		patch \| blob \| blame \| history
lib/bigint.pl		patch \| blob \| blame \| history
lib/complete.pl		patch \| blob \| blame \| history
lib/diagnostics.pm		patch \| blob \| blame \| history
lib/getcwd.pl		patch \| blob \| blame \| history
lib/getopts.pl		patch \| blob \| blame \| history
lib/look.pl		patch \| blob \| blame \| history
lib/perl5db.pl		patch \| blob \| blame \| history
lib/sigtrap.pm		patch \| blob \| blame \| history
lib/strict.pm		patch \| blob \| blame \| history
lib/subs.pm		patch \| blob \| blame \| history
lib/syslog.pl		patch \| blob \| blame \| history
lib/termcap.pl		patch \| blob \| blame \| history
lib/timelocal.pl		patch \| blob \| blame \| history
lib/vars.pm		patch \| blob \| blame \| history
malloc.c		patch \| blob \| blame \| history
mg.c		patch \| blob \| blame \| history
old_embed.pl		patch \| blob \| blame \| history
old_global.sym	[new file with mode: 0644]	patch \| blob
op.c		patch \| blob \| blame \| history
opcode.h		patch \| blob \| blame \| history
opcode.pl		patch \| blob \| blame \| history
os2/Changes		patch \| blob \| blame \| history
os2/Makefile.SHs		patch \| blob \| blame \| history
os2/os2.c		patch \| blob \| blame \| history
os2/os2ish.h		patch \| blob \| blame \| history
patchlevel.h		patch \| blob \| blame \| history
perl.c		patch \| blob \| blame \| history
perl.h		patch \| blob \| blame \| history
perl_exp.SH		patch \| blob \| blame \| history
perly.c		patch \| blob \| blame \| history
perly.c.diff		patch \| blob \| blame \| history
perly.h		patch \| blob \| blame \| history
perly.y		patch \| blob \| blame \| history
pod/buildtoc		patch \| blob \| blame \| history
pod/perldata.pod		patch \| blob \| blame \| history
pod/perldiag.pod		patch \| blob \| blame \| history
pod/perlembed.pod		patch \| blob \| blame \| history
pod/perlfunc.pod		patch \| blob \| blame \| history
pod/perlguts.pod		patch \| blob \| blame \| history
pod/perlmod.pod		patch \| blob \| blame \| history
pod/perlobj.pod		patch \| blob \| blame \| history
pod/perlop.pod		patch \| blob \| blame \| history
pod/perlre.pod		patch \| blob \| blame \| history
pod/perlref.pod		patch \| blob \| blame \| history
pod/perlrun.pod		patch \| blob \| blame \| history
pod/perlsub.pod		patch \| blob \| blame \| history
pod/perlsyn.pod		patch \| blob \| blame \| history
pod/perltoc.pod		patch \| blob \| blame \| history
pod/perltrap.pod		patch \| blob \| blame \| history
pod/pod2man.PL		patch \| blob \| blame \| history
pp.c		patch \| blob \| blame \| history
pp.h		patch \| blob \| blame \| history
pp_ctl.c		patch \| blob \| blame \| history
pp_hot.c		patch \| blob \| blame \| history
pp_sys.c		patch \| blob \| blame \| history
proto.h		patch \| blob \| blame \| history
regexec.c		patch \| blob \| blame \| history
scope.c		patch \| blob \| blame \| history
scope.h		patch \| blob \| blame \| history
sv.c		patch \| blob \| blame \| history
sv.h		patch \| blob \| blame \| history
t/README		patch \| blob \| blame \| history
t/TEST		patch \| blob \| blame \| history
t/io/read.t		patch \| blob \| blame \| history
t/lib/db-btree.t		patch \| blob \| blame \| history
t/lib/db-recno.t		patch \| blob \| blame \| history
t/lib/findbin.t		patch \| blob \| blame \| history
t/lib/getopt.t		patch \| blob \| blame \| history
t/lib/searchdict.t		patch \| blob \| blame \| history
t/op/bop.t		patch \| blob \| blame \| history
t/op/pack.t		patch \| blob \| blame \| history
t/op/tie.t		patch \| blob \| blame \| history
t/op/write.t		patch \| blob \| blame \| history
toke.c		patch \| blob \| blame \| history
universal.c		patch \| blob \| blame \| history
util.c		patch \| blob \| blame \| history
utils/h2xs.PL		patch \| blob \| blame \| history
utils/perldoc.PL		patch \| blob \| blame \| history
utils/pl2pm.PL		patch \| blob \| blame \| history
vms/Makefile		patch \| blob \| blame \| history
vms/config.vms		patch \| blob \| blame \| history
vms/descrip.mms		patch \| blob \| blame \| history
vms/ext/Stdio/Stdio.pm		patch \| blob \| blame \| history
vms/ext/Stdio/Stdio.xs		patch \| blob \| blame \| history
vms/genconfig.pl		patch \| blob \| blame \| history
vms/perlvms.pod		patch \| blob \| blame \| history
vms/test.com		patch \| blob \| blame \| history
vms/vms.c		patch \| blob \| blame \| history
x2p/Makefile.SH		patch \| blob \| blame \| history
x2p/a2p.h		patch \| blob \| blame \| history
x2p/a2p.pod		patch \| blob \| blame \| history
x2p/s2p.PL		patch \| blob \| blame \| history
x2p/util.c		patch \| blob \| blame \| history
x2p/util.h		patch \| blob \| blame \| history