diff options
165 files changed, 12167 insertions, 10586 deletions
diff --git a/Changes.Conf b/Changes.Conf index a19185f8be..a956fd77da 100644 --- a/Changes.Conf +++ b/Changes.Conf @@ -50,6 +50,1815 @@ in the following: This, and much more, is described in the new INSTALL file. +Here are the detailed changes from 5.002beta1 to 5.002b2 in +reverse chronolgical order: + +=item 5.002beta2 + +This is patch.2b2 to perl5.002beta1. +This takes you from 5.002beta1h to 5.002beta2. + +Renaming this as beta2 reflects _my_ feeling that it's time to +wrap up things for the release of 5.002. + +Index: Changes.Conf + + Include changes from patches 2b1a .. 2b1h, as well as this + patch. + +Index: Configure + + Use nm -D on Linux with shared libraries, if the system + supports nm -D. + +Prereq: 3.0.1.8 +*** perl5.002b1h/Configure Thu Jan 4 11:14:37 1996 +--- perl5.002b2/Configure Thu Jan 11 17:09:13 1996 + +Index: MANIFEST + + Include Stub Readline library as part of new debugger. + + Include hints file dec_osf for ODBM_File extension. + +*** perl5.002b1h/MANIFEST Wed Jan 3 14:37:54 1996 +--- perl5.002b2/MANIFEST Sat Jan 13 16:30:43 1996 + +Index: configpm + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/configpm Tue Oct 31 11:51:52 1995 +--- perl5.002b2/configpm Fri Jan 12 10:53:34 1996 + +Index: doop.c + + Chip's patch to use STDCHAR and U8 nearly everywhere instead of + assuming 8-bit chars or ~(char) 0 == 0xff. + +*** perl5.002b1h/doop.c Wed Nov 15 15:08:01 1995 +--- perl5.002b2/doop.c Fri Jan 12 15:05:04 1996 + +Index: embed.h + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/embed.h Thu Jan 4 13:28:08 1996 +--- perl5.002b2/embed.h Fri Jan 12 15:09:11 1996 + +Index: ext/DB_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 +--- perl5.002b2/ext/DB_File/Makefile.PL Tue Jan 9 16:54:17 1996 + +*** perl5.002b1h/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 +--- perl5.002b2/ext/DB_File/Makefile.PL Sat Jan 13 17:07:11 1996 + +Index: ext/DynaLoader/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/DynaLoader/Makefile.PL Tue Jun 6 12:24:37 1995 +--- perl5.002b2/ext/DynaLoader/Makefile.PL Sat Jan 13 17:16:34 1996 + +Index: ext/Fcntl/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Fcntl/Makefile.PL Thu Jan 19 18:58:52 1995 +--- perl5.002b2/ext/Fcntl/Makefile.PL Sat Jan 13 17:16:38 1996 + +Index: ext/GDBM_File/GDBM_File.pm + + Make the NAME section a legal paragraph. + +*** perl5.002b1h/ext/GDBM_File/GDBM_File.pm Mon Nov 20 10:22:26 1995 +--- perl5.002b2/ext/GDBM_File/GDBM_File.pm Fri Jan 12 16:11:38 1996 + +Index: ext/GDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/GDBM_File/Makefile.PL Wed Feb 22 14:36:36 1995 +--- perl5.002b2/ext/GDBM_File/Makefile.PL Sat Jan 13 17:08:02 1996 + +Index: ext/NDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/NDBM_File/Makefile.PL Wed Feb 22 14:36:39 1995 +--- perl5.002b2/ext/NDBM_File/Makefile.PL Sat Jan 13 17:08:13 1996 + +Index: ext/ODBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/ODBM_File/Makefile.PL Mon Jun 5 15:03:44 1995 +--- perl5.002b2/ext/ODBM_File/Makefile.PL Sat Jan 13 17:08:22 1996 + +Index: ext/ODBM_File/hints/dec_osf.pl + + New file. + +*** /dev/null Sat Jan 13 16:48:01 1996 +--- perl5.002b2/ext/ODBM_File/hints/dec_osf.pl Sat Jan 13 16:30:01 1996 + +Index: ext/POSIX/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/POSIX/Makefile.PL Thu Jan 19 18:59:00 1995 +--- perl5.002b2/ext/POSIX/Makefile.PL Sat Jan 13 17:08:27 1996 + +Index: ext/SDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/SDBM_File/Makefile.PL Tue Nov 14 11:16:43 1995 +--- perl5.002b2/ext/SDBM_File/Makefile.PL Sat Jan 13 17:16:49 1996 + +Index: ext/SDBM_File/sdbm/sdbm.c + + Give correct prototype for free. + +Prereq: 1.16 +*** perl5.002b1h/ext/SDBM_File/sdbm/sdbm.c Mon Nov 13 23:01:41 1995 +--- perl5.002b2/ext/SDBM_File/sdbm/sdbm.c Fri Jan 12 10:33:32 1996 + +Index: ext/Safe/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Safe/Makefile.PL Tue Jan 2 15:43:53 1996 +--- perl5.002b2/ext/Safe/Makefile.PL Sat Jan 13 17:08:45 1996 + +Index: ext/Safe/Safe.pm + + Patch from Andreas. + +*** perl5.002b1h/ext/Safe/Safe.pm Tue Jan 2 15:45:27 1996 +--- perl5.002b2/ext/Safe/Safe.pm Fri Jan 12 10:52:33 1996 + +Index: ext/Safe/Safe.xs + + Patch for older compilers which had namespace confusion. + +*** perl5.002b1h/ext/Safe/Safe.xs Tue Jan 2 15:45:27 1996 +--- perl5.002b2/ext/Safe/Safe.xs Fri Jan 5 14:27:47 1996 + +Index: ext/Socket/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Socket/Makefile.PL Sat Dec 2 16:23:52 1995 +--- perl5.002b2/ext/Socket/Makefile.PL Sat Jan 13 17:08:52 1996 + +Index: ext/Socket/Socket.xs + + Use unsigned shorts for ports. + +*** perl5.002b1h/ext/Socket/Socket.xs Sat Dec 2 15:46:20 1995 +--- perl5.002b2/ext/Socket/Socket.xs Mon Jan 8 21:59:52 1996 + +Index: global.sym + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/global.sym Wed Jan 3 12:01:59 1996 +--- perl5.002b2/global.sym Fri Jan 12 10:53:34 1996 + +Index: gv.c + + Avoid VMS sprintf bug with buffers >1024. + +*** perl5.002b1h/gv.c Fri Dec 8 10:37:22 1995 +--- perl5.002b2/gv.c Fri Jan 12 15:27:27 1996 + +Index: hints/aix.sh + + Updated + +*** perl5.002b1h/hints/aix.sh Mon Nov 13 23:03:33 1995 +--- perl5.002b2/hints/aix.sh Fri Jan 12 12:09:48 1996 + +Index: hints/irix_5.sh + + Updated + +*** perl5.002b1h/hints/irix_5.sh Tue Jan 2 14:53:52 1996 +--- perl5.002b2/hints/irix_5.sh Tue Jan 9 16:05:11 1996 + +Index: hints/linux.sh + + Updated + +*** perl5.002b1h/hints/linux.sh Fri Jun 2 10:20:55 1995 +--- perl5.002b2/hints/linux.sh Fri Jan 12 11:43:52 1996 + +Index: hints/machten.sh + + Updated + +*** perl5.002b1h/hints/machten.sh Sun Mar 12 02:36:04 1995 +--- perl5.002b2/hints/machten.sh Wed Jan 10 14:53:32 1996 + +Index: installman + + Use File::Path::mkpath instead of our own makedir(). + ./perl installman --man1dir=man1 could lead to infinte recursion + in old makedir() routine. Use the standard library instead. + +*** perl5.002b1h/installman Thu Dec 28 16:06:11 1995 +--- perl5.002b2/installman Thu Jan 11 16:12:30 1996 + +Index: installperl + + Use File::Path::mkpath instead of our own makedir(). + +*** perl5.002b1h/installperl Wed Jan 3 14:33:57 1996 +--- perl5.002b2/installperl Thu Jan 11 16:12:16 1996 + +Index: interp.sym + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/interp.sym Fri Nov 10 17:17:32 1995 +--- perl5.002b2/interp.sym Fri Jan 12 15:05:04 1996 + +Index: lib/AutoLoader.pm + + Undo Tim's tainting patch from beta1h. + +*** perl5.002b1h/lib/AutoLoader.pm Tue Jan 2 16:10:36 1996 +--- perl5.002b2/lib/AutoLoader.pm Fri Jan 5 16:02:28 1996 + +Index: lib/Carp.pm +*** perl5.002b1h/lib/Carp.pm Tue Jan 2 12:10:38 1996 +--- perl5.002b2/lib/Carp.pm Fri Jan 12 11:23:31 1996 + +Index: lib/ExtUtils/MM_VMS.pm + + Updated to MakeMaker-5.16. + +*** perl5.002b1h/lib/ExtUtils/MM_VMS.pm Tue Jan 2 14:07:10 1996 +--- perl5.002b2/lib/ExtUtils/MM_VMS.pm Thu Jan 4 21:00:46 1996 + +Index: lib/ExtUtils/MakeMaker.pm + + Updated to MakeMaker-5.16. + +Prereq: 1.129 +*** perl5.002b1h/lib/ExtUtils/MakeMaker.pm Tue Jan 2 14:07:10 1996 +--- perl5.002b2/lib/ExtUtils/MakeMaker.pm Wed Jan 10 16:13:05 1996 + +Index: lib/File/Find.pm + + Fixed exporting of symbols to work. + +*** perl5.002b1h/lib/File/Find.pm Wed Nov 15 15:20:03 1995 +--- perl5.002b2/lib/File/Find.pm Wed Jan 10 14:46:24 1996 + +Index: lib/I18N/Collate.pm + + Updated documentation to match program. + +*** perl5.002b1h/lib/I18N/Collate.pm Fri Jun 2 11:30:49 1995 +--- perl5.002b2/lib/I18N/Collate.pm Fri Jan 5 16:05:26 1996 + +Index: lib/Term/ReadLine.pm + + Stub new file to interface to various readline packages, or + give stub functions if none are found. + +*** /dev/null Sat Jan 13 16:48:01 1996 +--- perl5.002b2/lib/Term/ReadLine.pm Fri Jan 12 11:23:31 1996 + +Index: lib/dumpvar.pl + + Ilya's new debugger. + +*** perl5.002b1h/lib/dumpvar.pl Tue Oct 18 12:36:00 1994 +--- perl5.002b2/lib/dumpvar.pl Fri Jan 12 11:23:31 1996 + +Index: lib/perl5db.pl + + Ilya's new debugger. + +*** perl5.002b1h/lib/perl5db.pl Tue Jan 2 16:30:33 1996 +--- perl5.002b2/lib/perl5db.pl Fri Jan 12 11:23:31 1996 + +Index: lib/sigtrap.pm + + Ilya's new debugger. + +*** perl5.002b1h/lib/sigtrap.pm Thu May 25 11:20:13 1995 +--- perl5.002b2/lib/sigtrap.pm Fri Jan 12 11:23:31 1996 + +Index: miniperlmain.c + + More robust i18nl14n() function from jhi. + +*** perl5.002b1h/miniperlmain.c Thu Jan 4 12:03:37 1996 +--- perl5.002b2/miniperlmain.c Mon Jan 8 22:00:19 1996 + +Index: myconfig + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/myconfig Tue Apr 4 12:13:21 1995 +--- perl5.002b2/myconfig Fri Jan 12 10:53:35 1996 + +Index: op.c + + Chip's U8/STDCHAR patch. + +*** perl5.002b1h/op.c Wed Jan 3 14:17:01 1996 +--- perl5.002b2/op.c Fri Jan 12 15:05:05 1996 + +Index: perl.c + + Change Copyright date to include 1996. Hope you don't mind. + + Presumptively call this beta2. + +*** perl5.002b1h/perl.c Thu Jan 4 15:13:53 1996 +--- perl5.002b2/perl.c Fri Jan 12 15:05:05 1996 + +Index: perl.h + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/perl.h Wed Jan 3 12:21:55 1996 +--- perl5.002b2/perl.h Fri Jan 12 15:05:04 1996 + +Index: pod/Makefile + + Use PERL=../miniperl + +*** perl5.002b1h/pod/Makefile Wed Jan 3 15:06:41 1996 +--- perl5.002b2/pod/Makefile Fri Jan 5 14:14:30 1996 + +Index: pod/perlembed.pod + + Give correct usage for the 5th arg to perl_parse (don't pass + env). + +*** perl5.002b1h/pod/perlembed.pod Thu Dec 28 16:34:07 1995 +--- perl5.002b2/pod/perlembed.pod Tue Jan 9 16:02:51 1996 + +Index: pod/perlfunc.pod + + Work around a pod2man complaint about the -X function. + +*** perl5.002b1h/pod/perlfunc.pod Tue Jan 2 15:39:26 1996 +--- perl5.002b2/pod/perlfunc.pod Fri Jan 12 11:04:15 1996 + +*** perl5.002b1h/pod/perlfunc.pod Tue Jan 2 15:39:26 1996 +--- perl5.002b2/pod/perlfunc.pod Fri Jan 12 11:04:15 1996 + +Index: pod/perlovl.pod + + Add DESCRIPTION to head1 line. + +*** perl5.002b1h/pod/perlovl.pod Thu Dec 28 16:34:13 1995 +--- perl5.002b2/pod/perlovl.pod Thu Jan 11 17:11:16 1996 + +Index: pod/perlrun.pod + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/pod/perlrun.pod Thu Dec 28 16:34:15 1995 +--- perl5.002b2/pod/perlrun.pod Fri Jan 12 10:53:35 1996 + +Index: pp_ctl.c + + Debugger patch. + +*** perl5.002b1h/pp_ctl.c Wed Jan 3 12:23:13 1996 +--- perl5.002b2/pp_ctl.c Fri Jan 12 15:05:05 1996 + +Index: t/lib/posix.t + + Not having POSIX shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/posix.t Mon Jan 16 22:27:33 1995 +--- perl5.002b2/t/lib/posix.t Tue Jan 9 15:33:14 1996 + +Index: t/lib/safe.t + + Not having Safe shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/safe.t Tue Jan 2 15:43:53 1996 +--- perl5.002b2/t/lib/safe.t Tue Jan 9 15:35:43 1996 + +Index: t/lib/socket.t + + Not having Socket shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/socket.t Fri Dec 8 11:16:01 1995 +--- perl5.002b2/t/lib/socket.t Tue Jan 9 15:35:51 1996 + +Index: t/op/time.t + + Test missed year-end wrap-around by one day. + +*** perl5.002b1h/t/op/time.t Tue Oct 18 12:46:31 1994 +--- perl5.002b2/t/op/time.t Wed Jan 10 16:04:41 1996 + +Index: toke.c + + Chip's U8/STDCHAR patch. + + Tim's "add a ; after PERL5DB" patch. + +*** perl5.002b1h/toke.c Wed Dec 6 13:24:19 1995 +--- perl5.002b2/toke.c Fri Jan 12 15:05:06 1996 + +Index: utils/h2xs.PL + + Updated to 1.13. Include Changes template file. + +*** perl5.002b1h/utils/h2xs.PL Tue Jan 2 13:50:55 1996 +--- perl5.002b2/utils/h2xs.PL Thu Jan 11 16:59:48 1996 + +Index: writemain.SH + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/writemain.SH Sat Nov 18 15:51:55 1995 +--- perl5.002b2/writemain.SH Fri Jan 12 10:53:35 1996 + +=item patch.2b1h + +This is patch.2b1h to perl5.002beta1. This is mainly a clean-up +patch. No progress is made dealing with memory leaks or +optimizations, though I have used #define STRANGE_MALLOC to +work around at least some problems. + +Index: Configure + + Upgraded to metaconfig patchlevel 60. + + Add in usesafe variable to include or exclude the Safe extension. + + Test for sigaction(). + + Check for pager. This was actually accidental since perldoc.PL + mentions $pager and metaconfig has a unit to check for the + user's pager. In retrospect, I decided the Configure check + didn't do any harm and some extension writers might decide to + use it. + + Always put man1dir under $prefix unless a command line + override is used. + + Allow command-line overrides of $man1ext and $man3ext. + + + Allow man1dir and man3dir names like .../man.1 instead of + just .../man1. + + Lots of rearrangements of various pieces of Configure. + This might be because I ran metaconfig on a different + architecture. + + libc searching now honors $libpth. Previously, it (almost) + always looked in /usr/lib before checking /lib. + + Only prompt user if voidflags is not 15. If voidflags is 15, then + we presume all is well. + + +Prereq: 3.0.1.8 +*** perl5.002b1g/Configure Fri Dec 8 11:23:56 1995 +--- perl5.002b1h/Configure Thu Jan 4 11:14:37 1996 + +Index: INSTALL + + Document how to skip various extensions. + + Indicate that site_perl is typically under (not beside) + /usr/local/lib/perl5. + + Mention how to avoid nm extraction. + + +*** perl5.002b1g/INSTALL Tue Nov 21 22:54:28 1995 +--- perl5.002b1h/INSTALL Thu Jan 4 11:06:28 1996 + +Index: MANIFEST + + Rearrange files some. Try to move .PL utilities to a separate + utils/ subdirectory. + + Merge c2ph.PL and c2ph.doc. + + Add the Safe extension. + +*** perl5.002b1g/MANIFEST Fri Jan 5 11:41:50 1996 +--- perl5.002b1h/MANIFEST Wed Jan 3 14:37:54 1996 + +Index: Makefile.SH + + Now builds .PL utilities in the utils/ subdirectory. + +*** perl5.002b1g/Makefile.SH Fri Dec 8 10:36:33 1995 +--- perl5.002b1h/Makefile.SH Wed Jan 3 14:28:30 1996 + +Index: README.vms + + Updated. + +*** perl5.002b1g/README.vms Wed Nov 15 14:23:10 1995 +--- perl5.002b1h/README.vms Tue Jan 2 16:33:02 1996 + +Index: XSUB.h + + Updated to match xsubpp-1.929. + +*** perl5.002b1g/XSUB.h Wed Dec 6 13:25:26 1995 +--- perl5.002b1h/XSUB.h Tue Jan 2 11:57:57 1996 + +Index: config_h.SH + + Check for HAS_SIGACCTION + + Add STARTPERL define for C code (specifically, a2p). + +Prereq: 3.0.1.4 +*** perl5.002b1g/config_h.SH Fri Dec 8 11:23:56 1995 +--- perl5.002b1h/config_h.SH Thu Jan 4 11:14:37 1996 + +Index: doio.c + + VMS changes for kill. + +*** perl5.002b1g/doio.c Wed Nov 15 14:36:12 1995 +--- perl5.002b1h/doio.c Tue Jan 2 16:27:07 1996 + +Index: embed.h + + Auto-generated from global.sym and interp.sym. + +*** perl5.002b1g/embed.h Wed Nov 15 14:48:47 1995 +--- perl5.002b1h/embed.h Thu Jan 4 13:28:08 1996 + +Index: ext/DynaLoader/DynaLoader.pm + + VMS-specific updates. + +*** perl5.002b1g/ext/DynaLoader/DynaLoader.pm Fri Nov 10 11:49:00 1995 +--- perl5.002b1h/ext/DynaLoader/DynaLoader.pm Tue Jan 2 16:28:02 1996 + +Index: ext/DynaLoader/dl_vms.xs + + Updated to Oct 31, 1995 version. + +*** perl5.002b1g/ext/DynaLoader/dl_vms.xs Tue Oct 31 11:06:06 1995 +--- perl5.002b1h/ext/DynaLoader/dl_vms.xs Tue Jan 2 16:27:32 1996 + +Index: global.sym + + Added maxo and save_pptr items. + +*** perl5.002b1g/global.sym Wed Nov 15 14:58:14 1995 +--- perl5.002b1h/global.sym Wed Jan 3 12:01:59 1996 + +Index: hints/README.hints + + List of tested systems updated a little. + +*** perl5.002b1g/hints/README.hints Fri May 5 14:12:06 1995 +--- perl5.002b1h/hints/README.hints Tue Dec 12 20:03:36 1995 + +Index: hints/irix_5.sh + + Note SGI stdio/malloc related problem. + +*** perl5.002b1g/hints/irix_5.sh Fri May 5 14:07:52 1995 +--- perl5.002b1h/hints/irix_5.sh Tue Jan 2 14:53:52 1996 + +Index: hints/irix_6.sh + + Address change. + + Note SGI stdio/malloc related problem. + +*** perl5.002b1g/hints/irix_6.sh Fri May 5 14:08:41 1995 +--- perl5.002b1h/hints/irix_6.sh Tue Jan 2 14:54:04 1996 + +Index: hints/irix_6_2.sh + + Address change. + +*** perl5.002b1g/hints/irix_6_2.sh Mon Nov 20 11:16:55 1995 +--- perl5.002b1h/hints/irix_6_2.sh Tue Jan 2 14:49:45 1996 + +Index: hints/os2.sh + + Updated. + +*** perl5.002b1g/hints/os2.sh Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/hints/os2.sh Tue Dec 26 17:51:16 1995 + +Index: installman + + Use fork if available. + +*** perl5.002b1g/installman Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/installman Thu Dec 28 16:06:11 1995 + +Index: installperl + + Use new location of utility scripts. + + Eliminate double '//' and extra "". + +*** perl5.002b1g/installperl Mon Nov 20 12:55:03 1995 +--- perl5.002b1h/installperl Wed Jan 3 14:33:57 1996 + +Index: lib/AutoLoader.pm + + Avoid tainting problems. + +*** perl5.002b1g/lib/AutoLoader.pm Wed Nov 15 15:04:59 1995 +--- perl5.002b1h/lib/AutoLoader.pm Tue Jan 2 16:10:36 1996 + +Index: lib/Carp.pm + + Honor trailing \n in messages, as is done for warn(). + +*** perl5.002b1g/lib/Carp.pm Thu May 25 11:16:07 1995 +--- perl5.002b1h/lib/Carp.pm Tue Jan 2 12:10:38 1996 + +Index: lib/Cwd.pm + + VMS patches. + +*** perl5.002b1g/lib/Cwd.pm Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/lib/Cwd.pm Tue Jan 2 16:28:57 1996 + +Index: lib/Exporter.pm + + Include Tim Bunce's enhanced Exporter. I also tried to + resolve the two copies of documentation that I had. + +*** perl5.002b1g/lib/Exporter.pm Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/lib/Exporter.pm Thu Jan 4 14:02:08 1996 + +Index: lib/ExtUtils/MM_VMS.pm + + New file. Incorporates VMS-specific items into MakeMaker. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/lib/ExtUtils/MM_VMS.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.116 + + Updated from 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/MakeMaker.pm Fri Jan 5 11:41:53 1996 +--- perl5.002b1h/lib/ExtUtils/MakeMaker.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/Manifest.pm + + Updated from MakeMaker 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/Manifest.pm Fri Jan 5 11:41:54 1996 +--- perl5.002b1h/lib/ExtUtils/Manifest.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/Mkbootstrap.pm + + Updated from MakeMaker 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm Fri Jan 5 11:41:54 1996 +--- perl5.002b1h/lib/ExtUtils/Mkbootstrap.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/xsubpp + + Updated from xsubpp-1.924 to 1.929. + +*** perl5.002b1g/lib/ExtUtils/xsubpp Sun Nov 26 16:04:50 1995 +--- perl5.002b1h/lib/ExtUtils/xsubpp Tue Jan 2 16:29:59 1996 + +Index: lib/File/Path.pm + + VMS-specific changes. + +*** perl5.002b1g/lib/File/Path.pm Wed Nov 15 15:20:31 1995 +--- perl5.002b1h/lib/File/Path.pm Tue Jan 2 16:30:21 1996 + +Index: lib/Pod/Text.pm + + New file. This was created by Dov (???) and enhanced + by Kenneth Albanowski, but all based on Tom C.'s pod2text. + Unfortunately, they used a version of pod2text earlier than + the one in patch.2b1g. I've tried to straighten this all out. + + Equally unfortunately, we've all left Tom as the AUTHOR, even + though we can't hold him responsible for errors he didn't + introduce. Oh well. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/lib/Pod/Text.pm Thu Jan 4 14:16:50 1996 + +Index: lib/Sys/Hostname.pm + + VMS-specific changes. + +*** perl5.002b1g/lib/Sys/Hostname.pm Fri Jan 5 11:41:55 1996 +--- perl5.002b1h/lib/Sys/Hostname.pm Tue Jan 2 16:30:49 1996 + +Index: lib/diagnostics.pm + + A patch from Tim Bunce (?) + +*** perl5.002b1g/lib/diagnostics.pm Wed Dec 6 13:58:42 1995 +--- perl5.002b1h/lib/diagnostics.pm Tue Jan 2 12:10:37 1996 + +Index: lib/perl5db.pl + + VMS-specific changes. + +*** perl5.002b1g/lib/perl5db.pl Wed Nov 15 22:37:45 1995 +--- perl5.002b1h/lib/perl5db.pl Tue Jan 2 16:30:33 1996 + +Index: lib/splain + + Fix some old typos. + +*** perl5.002b1g/lib/splain Tue Nov 14 16:16:36 1995 +--- perl5.002b1h/lib/splain Tue Jan 2 12:10:37 1996 + +Index: makeaperl.SH + + Use the 'new' startperl variable. + +*** perl5.002b1g/makeaperl.SH Thu Jun 1 11:20:52 1995 +--- perl5.002b1h/makeaperl.SH Tue Jan 2 12:11:28 1996 + +Index: mg.c + + Set up a reliable signal handler, courtesy of Kenneth Albanowski. + This needs to be documented still. The idea is that even on + System V systems, you won't have to reset the signal handler as + the first action inside your signal handler. + +*** perl5.002b1g/mg.c Wed Nov 15 15:44:10 1995 +--- perl5.002b1h/mg.c Thu Jan 4 13:49:12 1996 + +Index: minimod.pl + + Give a proper NAME description. + +*** perl5.002b1g/minimod.pl Sun Nov 26 16:19:55 1995 +--- perl5.002b1h/minimod.pl Tue Jan 2 14:30:24 1996 + +Index: miniperlmain.c + + Better locale handling, courtesy of jhi. + + Include a proper cast of NULL for non-prototyping compilers. + +*** perl5.002b1g/miniperlmain.c Sat Nov 18 15:48:10 1995 +--- perl5.002b1h/miniperlmain.c Thu Jan 4 12:03:37 1996 + +Index: op.c + + Turn on USE_OP_MASK by default for the Safe extension. I'll be + interested in benchmark results with this on and off. + +*** perl5.002b1g/op.c Wed Nov 15 22:10:36 1995 +--- perl5.002b1h/op.c Wed Jan 3 14:17:01 1996 + +Index: os2/Makefile.SHs + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/Makefile.SHs Sun Dec 24 13:55:22 1995 + +Index: os2/README + + Updated. + +*** perl5.002b1g/os2/README Tue Nov 14 14:42:13 1995 +--- perl5.002b1h/os2/README Tue Dec 26 18:31:32 1995 + +Index: os2/diff.MANIFEST + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.MANIFEST Tue Dec 26 19:54:12 1995 + +Index: os2/diff.Makefile + + Updated + +*** perl5.002b1g/os2/diff.Makefile Tue Nov 14 11:09:29 1995 +--- perl5.002b1h/os2/diff.Makefile Fri Dec 8 00:09:56 1995 + +Index: os2/diff.c2ph + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.c2ph Thu Dec 7 15:25:52 1995 + +Index: os2/diff.configure + + Updated. + +*** perl5.002b1g/os2/diff.configure Sun Nov 12 01:31:34 1995 +--- perl5.002b1h/os2/diff.configure Tue Dec 26 19:57:08 1995 + +Index: os2/diff.db_file + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.db_file Tue Dec 19 02:14:54 1995 + +Index: os2/diff.init + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.init Sun Nov 26 15:05:48 1995 + +Index: os2/diff.installman + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.installman Wed Nov 22 03:50:26 1995 + +Index: os2/diff.installperl + + Updated. + +*** perl5.002b1g/os2/diff.installperl Tue Nov 14 11:09:28 1995 +--- perl5.002b1h/os2/diff.installperl Wed Nov 22 02:59:58 1995 + +Index: os2/diff.mkdep + + Updated. + +*** perl5.002b1g/os2/diff.mkdep Tue Nov 14 11:09:28 1995 +--- perl5.002b1h/os2/diff.mkdep Sun Nov 26 15:00:24 1995 + +Index: os2/diff.rest + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.rest Thu Dec 7 16:03:26 1995 + +Index: os2/diff.x2pMakefile + + Updated. + +*** perl5.002b1g/os2/diff.x2pMakefile Tue Nov 14 11:09:29 1995 +--- perl5.002b1h/os2/diff.x2pMakefile Wed Nov 22 21:55:42 1995 + +Index: os2/notes + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/notes Tue Dec 26 19:55:30 1995 + +Index: os2/os2.c + + Updated. + +*** perl5.002b1g/os2/os2.c Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/os2/os2.c Sun Dec 24 13:43:02 1995 + +Index: os2/os2ish.h + + Updated. + +*** perl5.002b1g/os2/os2ish.h Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/os2/os2ish.h Mon Dec 18 16:17:38 1995 + +Index: os2/perl2cmd.pl + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/perl2cmd.pl Tue Dec 19 11:20:42 1995 + +Index: perl.c + + Updated to say beta1h. + + Move VMS env code. + +*** perl5.002b1g/perl.c Fri Jan 5 11:41:56 1996 +--- perl5.002b1h/perl.c Thu Jan 4 15:13:53 1996 + +Index: perl.h + + 5.002beta1 attempted some memory optimizations, but unfortunately + they can result in a memory leak problem. This can be + avoided by #define STRANGE_MALLOC. I do that here until + consensus is reached on a better strategy for handling the + memory optimizations. + + Include maxo for the maximum number of operations (needed + for the Safe extension). + +*** perl5.002b1g/perl.h Wed Nov 15 17:13:16 1995 +--- perl5.002b1h/perl.h Wed Jan 3 12:21:55 1996 + +Index: pod/Makefile + + Include -I../lib so that pod2* can find the appropriate libraries. + + The pod names are once again sorted. + + The PERL line is wrong. It should read + PERL = ../miniperl + This file is automatically generated, but I happened to do it on + a system without miniperl avaialable, so my script fell back on + the perl default. + +*** perl5.002b1g/pod/Makefile Fri Jan 5 11:41:56 1996 +--- perl5.002b1h/pod/Makefile Wed Jan 3 15:06:41 1996 + +Index: pod/perlmod.pod + + Mention the Safe extension. + +*** perl5.002b1g/pod/perlmod.pod Fri Jan 5 11:41:59 1996 +--- perl5.002b1h/pod/perlmod.pod Thu Jan 4 13:52:14 1996 + +Index: pod/perltoc.pod + + Rebuilt using pod/buildtoc and fmt. + +*** perl5.002b1g/pod/perltoc.pod Fri Jan 5 11:42:00 1996 +--- perl5.002b1h/pod/perltoc.pod Thu Jan 4 14:04:20 1996 + +Index: pod/pod2text.PL +*** perl5.002b1g/pod/pod2text.PL Fri Jan 5 11:42:01 1996 +--- perl5.002b1h/pod/pod2text.PL Tue Jan 2 14:28:24 1996 + +Index: pp_sys.c + + VMS changes ? + +*** perl5.002b1g/pp_sys.c Wed Nov 15 21:51:33 1995 +--- perl5.002b1h/pp_sys.c Tue Jan 2 16:32:50 1996 + +Index: t/lib/safe.t + + New test. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/t/lib/safe.t Tue Jan 2 15:43:53 1996 + +Index: utils/Makefile + + New file to build the utilities. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/utils/Makefile Wed Jan 3 14:06:18 1996 + +Index: utils/c2ph.PL + + Ungracefully merge the old c2ph.doc in as an embedded pod. + + Delete lots of trailing spaces and tabs that have crept in. + +Prereq: 1.7 +*** perl5.002b1g/utils/c2ph.PL Mon Nov 20 12:36:17 1995 +--- perl5.002b1h/utils/c2ph.PL Wed Jan 3 14:05:41 1996 + +Index: utils/h2ph.PL + + Add patch for AIX files which sometimes have #include<foo.h>, + i.e., no spaces after the word 'include'. + +*** perl5.002b1g/utils/h2ph.PL Mon Nov 27 10:14:50 1995 +--- perl5.002b1h/utils/h2ph.PL Tue Jan 2 16:13:31 1996 + +Index: utils/h2xs.PL + + Add version stuff. + + The old version didn't have a number. This one's called 1.12. + +*** perl5.002b1g/utils/h2xs.PL Sun Nov 19 22:37:58 1995 +--- perl5.002b1h/utils/h2xs.PL Tue Jan 2 13:50:55 1996 + +Index: utils/perlbug.PL + + New utility. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/utils/perlbug.PL Sat Nov 18 16:15:13 1995 + +Index: utils/perldoc.PL + + Better error handling. + + Updated to use Pod::Text, if available. + + More VMS friendly. + + New -u option . + +*** perl5.002b1g/utils/perldoc.PL Tue Nov 14 14:57:57 1995 +--- perl5.002b1h/utils/perldoc.PL Tue Jan 2 14:28:08 1996 + +Index: utils/pl2pm.PL + + Changed into a .PL extract file for proper setting of + $startperl. + + Add _minimal_ pod documentation. + +*** perl5.002b1g/utils/pl2pm.PL Mon Jan 16 23:45:07 1995 +--- perl5.002b1h/utils/pl2pm.PL Wed Jan 3 14:14:57 1996 + +Index: vms/Makefile + + Updated for VMS. + +*** perl5.002b1g/vms/Makefile Wed Nov 15 22:05:15 1995 +--- perl5.002b1h/vms/Makefile Tue Jan 2 16:33:53 1996 + +Index: vms/config.vms + + Updated for VMS. + +*** perl5.002b1g/vms/config.vms Wed Nov 15 22:05:26 1995 +--- perl5.002b1h/vms/config.vms Tue Jan 2 16:33:09 1996 + +Index: vms/descrip.mms + + Updated for VMS. + +*** perl5.002b1g/vms/descrip.mms Wed Nov 15 22:05:38 1995 +--- perl5.002b1h/vms/descrip.mms Tue Jan 2 16:33:18 1996 + +Index: vms/ext/Filespec.pm + + Updated for VMS. + +*** perl5.002b1g/vms/ext/Filespec.pm Sun Mar 12 03:14:26 1995 +--- perl5.002b1h/vms/ext/Filespec.pm Tue Jan 2 16:33:25 1996 + +Index: vms/ext/MM_VMS.pm + + Updated for VMS. This might be obsolete now that we have + lib/ExtUtils/MM_VMS.pm. + +*** perl5.002b1g/vms/ext/MM_VMS.pm Wed Nov 15 22:05:48 1995 +--- perl5.002b1h/vms/ext/MM_VMS.pm Tue Jan 2 16:33:32 1996 + +Index: vms/gen_shrfls.pl + + Updated for VMS. + +*** perl5.002b1g/vms/gen_shrfls.pl Wed Nov 15 22:06:27 1995 +--- perl5.002b1h/vms/gen_shrfls.pl Tue Jan 2 16:33:47 1996 + +Index: vms/genconfig.pl + + Updated for VMS. + +*** perl5.002b1g/vms/genconfig.pl Sun Mar 12 03:14:36 1995 +--- perl5.002b1h/vms/genconfig.pl Tue Jan 2 16:33:39 1996 + +Index: vms/perlvms.pod + + Updated for VMS. + +*** perl5.002b1g/vms/perlvms.pod Wed Nov 15 22:06:32 1995 +--- perl5.002b1h/vms/perlvms.pod Tue Jan 2 16:33:59 1996 + +Index: vms/test.com + + Updated for VMS. + +*** perl5.002b1g/vms/test.com Wed Nov 15 22:06:59 1995 +--- perl5.002b1h/vms/test.com Tue Jan 2 16:34:07 1996 + +Index: vms/vms.c + + Updated for VMS. + +Prereq: 2.2 +*** perl5.002b1g/vms/vms.c Wed Nov 15 22:07:10 1995 +--- perl5.002b1h/vms/vms.c Tue Jan 2 16:34:13 1996 + +Index: vms/vmsish.h + + Updated for VMS. + +*** perl5.002b1g/vms/vmsish.h Wed Nov 15 22:07:24 1995 +--- perl5.002b1h/vms/vmsish.h Tue Jan 2 16:34:20 1996 + +Index: vms/writemain.pl + + Updated for VMS. + +*** perl5.002b1g/vms/writemain.pl Mon Mar 6 20:00:18 1995 +--- perl5.002b1h/vms/writemain.pl Tue Jan 2 16:34:26 1996 + +Index: x2p/a2py.c + + Use new config_h.SH STARTPERL #define. + +*** perl5.002b1g/x2p/a2py.c Tue Mar 7 11:53:10 1995 +--- perl5.002b1h/x2p/a2py.c Tue Jan 2 12:11:28 1996 + +Index: x2p/find2perl.PL + + Add missing "" around $Config{startperl}. + +*** perl5.002b1g/x2p/find2perl.PL Sun Nov 19 23:11:58 1995 +--- perl5.002b1h/x2p/find2perl.PL Tue Jan 2 12:11:27 1996 + +Index: x2p/s2p.PL + + Add missing "" around $Config{startperl}. + +*** perl5.002b1g/x2p/s2p.PL Sun Nov 19 23:14:59 1995 +--- perl5.002b1h/x2p/s2p.PL Tue Jan 2 12:11:27 1996 + + +=item patch.2b1g + +This is patch.2b1g to perl5.002beta1. + +This patch is just my packaging of Tom's documentation patches +he released as patch.2b1g. + +Index: MANIFEST +*** perl5.002b1f/MANIFEST Fri Dec 8 13:34:53 1995 +--- perl5.002b1g/MANIFEST Thu Dec 21 13:00:58 1995 + +Index: ext/DB_File/DB_File.pm +*** perl5.002b1f/ext/DB_File/DB_File.pm Tue Nov 14 14:14:25 1995 +--- perl5.002b1g/ext/DB_File/DB_File.pm Thu Dec 21 13:00:58 1995 + +Index: ext/POSIX/POSIX.pm +*** perl5.002b1f/ext/POSIX/POSIX.pm Fri Dec 8 10:23:54 1995 +--- perl5.002b1g/ext/POSIX/POSIX.pm Thu Dec 21 13:00:58 1995 + +Index: ext/POSIX/POSIX.pod +*** perl5.002b1f/ext/POSIX/POSIX.pod Fri Dec 8 10:30:40 1995 +--- perl5.002b1g/ext/POSIX/POSIX.pod Thu Dec 21 13:00:59 1995 + +Index: ext/Safe/Makefile.PL +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Makefile.PL Thu Dec 21 13:01:00 1995 + +Index: ext/Safe/Safe.pm +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Safe.pm Thu Dec 21 13:01:00 1995 + +Index: ext/Safe/Safe.xs +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Safe.xs Thu Dec 21 13:01:00 1995 + +Index: ext/Socket/Socket.pm +*** perl5.002b1f/ext/Socket/Socket.pm Wed Dec 6 13:58:41 1995 +--- perl5.002b1g/ext/Socket/Socket.pm Thu Dec 21 13:01:00 1995 + +Index: installman +*** perl5.002b1f/installman Mon Nov 6 11:16:43 1995 +--- perl5.002b1g/installman Thu Dec 21 13:01:00 1995 + +Index: lib/AutoSplit.pm +*** perl5.002b1f/lib/AutoSplit.pm Wed Nov 15 15:06:19 1995 +--- perl5.002b1g/lib/AutoSplit.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Cwd.pm +*** perl5.002b1f/lib/Cwd.pm Fri Dec 8 10:42:46 1995 +--- perl5.002b1g/lib/Cwd.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Devel/SelfStubber.pm +*** perl5.002b1f/lib/Devel/SelfStubber.pm Sun Nov 26 16:59:51 1995 +--- perl5.002b1g/lib/Devel/SelfStubber.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Env.pm +*** perl5.002b1f/lib/Env.pm Tue Oct 18 12:34:43 1994 +--- perl5.002b1g/lib/Env.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Exporter.pm +*** perl5.002b1f/lib/Exporter.pm Wed Nov 15 15:19:33 1995 +--- perl5.002b1g/lib/Exporter.pm Thu Dec 21 13:01:01 1995 + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1f/lib/ExtUtils/Liblist.pm Tue Dec 5 07:56:53 1995 +--- perl5.002b1g/lib/ExtUtils/Liblist.pm Thu Dec 21 13:01:01 1995 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.115 +*** perl5.002b1f/lib/ExtUtils/MakeMaker.pm Tue Dec 5 13:20:56 1995 +--- perl5.002b1g/lib/ExtUtils/MakeMaker.pm Thu Dec 21 13:01:02 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1f/lib/ExtUtils/Manifest.pm Tue Dec 5 13:21:00 1995 +--- perl5.002b1g/lib/ExtUtils/Manifest.pm Thu Dec 21 13:01:02 1995 + +Index: lib/ExtUtils/Mkbootstrap.pm +*** perl5.002b1f/lib/ExtUtils/Mkbootstrap.pm Thu Oct 19 05:58:34 1995 +--- perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm Thu Dec 21 13:01:02 1995 + +Index: lib/FileHandle.pm +*** perl5.002b1f/lib/FileHandle.pm Thu May 25 11:18:20 1995 +--- perl5.002b1g/lib/FileHandle.pm Thu Dec 21 13:01:02 1995 + +Index: lib/IPC/Open2.pm +*** perl5.002b1f/lib/IPC/Open2.pm Thu May 25 11:31:07 1995 +--- perl5.002b1g/lib/IPC/Open2.pm Thu Dec 21 13:01:03 1995 + +Index: lib/IPC/Open3.pm +Prereq: 1.1 +*** perl5.002b1f/lib/IPC/Open3.pm Wed Nov 15 15:21:11 1995 +--- perl5.002b1g/lib/IPC/Open3.pm Thu Dec 21 13:01:03 1995 + +Index: lib/SelfLoader.pm +*** perl5.002b1f/lib/SelfLoader.pm Sun Nov 26 16:59:51 1995 +--- perl5.002b1g/lib/SelfLoader.pm Thu Dec 21 13:01:03 1995 + +Index: lib/Sys/Hostname.pm +*** perl5.002b1f/lib/Sys/Hostname.pm Tue Oct 18 12:38:25 1994 +--- perl5.002b1g/lib/Sys/Hostname.pm Thu Dec 21 13:01:03 1995 + +Index: lib/Sys/Syslog.pm +*** perl5.002b1f/lib/Sys/Syslog.pm Wed Dec 6 14:07:54 1995 +--- perl5.002b1g/lib/Sys/Syslog.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Term/Cap.pm +*** perl5.002b1f/lib/Term/Cap.pm Sun Mar 12 00:14:42 1995 +--- perl5.002b1g/lib/Term/Cap.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Term/Complete.pm +*** perl5.002b1f/lib/Term/Complete.pm Wed May 24 12:09:48 1995 +--- perl5.002b1g/lib/Term/Complete.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Test/Harness.pm +*** perl5.002b1f/lib/Test/Harness.pm Mon Nov 13 23:01:40 1995 +--- perl5.002b1g/lib/Test/Harness.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Soundex.pm +Prereq: 1.2 +*** perl5.002b1f/lib/Text/Soundex.pm Tue Oct 18 12:38:42 1994 +--- perl5.002b1g/lib/Text/Soundex.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Tabs.pm +*** perl5.002b1f/lib/Text/Tabs.pm Sat Nov 18 16:08:55 1995 +--- perl5.002b1g/lib/Text/Tabs.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Wrap.pm +*** perl5.002b1f/lib/Text/Wrap.pm Sat Nov 18 16:08:56 1995 +--- perl5.002b1g/lib/Text/Wrap.pm Thu Dec 21 13:01:05 1995 + +Index: lib/TieHash.pm +*** perl5.002b1f/lib/TieHash.pm Wed Nov 15 15:27:47 1995 +--- perl5.002b1g/lib/TieHash.pm Thu Dec 21 13:01:05 1995 + +Index: lib/Time/Local.pm +*** perl5.002b1f/lib/Time/Local.pm Tue Oct 18 12:38:47 1994 +--- perl5.002b1g/lib/Time/Local.pm Thu Dec 21 13:01:05 1995 + +Index: lib/less.pm +*** perl5.002b1f/lib/less.pm Thu May 25 11:19:59 1995 +--- perl5.002b1g/lib/less.pm Thu Dec 21 13:01:05 1995 + +Index: lib/overload.pm +*** perl5.002b1f/lib/overload.pm Sat Nov 18 16:03:33 1995 +--- perl5.002b1g/lib/overload.pm Thu Dec 21 13:01:05 1995 + +Index: lib/strict.pm +*** perl5.002b1f/lib/strict.pm Thu May 25 11:20:27 1995 +--- perl5.002b1g/lib/strict.pm Thu Dec 21 13:01:05 1995 + +Index: lib/syslog.pl +*** perl5.002b1f/lib/syslog.pl Tue Oct 18 12:37:13 1994 +--- perl5.002b1g/lib/syslog.pl Thu Dec 21 13:01:05 1995 + +Index: perl.c +*** perl5.002b1f/perl.c Sun Nov 19 16:11:29 1995 +--- perl5.002b1g/perl.c Thu Dec 21 13:01:06 1995 + +Index: pod/Makefile +*** perl5.002b1f/pod/Makefile Mon Nov 20 13:00:50 1995 +--- perl5.002b1g/pod/Makefile Thu Dec 21 13:01:06 1995 + +Index: pod/PerlDoc/Functions.pm +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/PerlDoc/Functions.pm Thu Dec 21 13:01:07 1995 + +Index: pod/PerlDoc/Functions.pm.POSIX +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/PerlDoc/Functions.pm.POSIX Thu Dec 21 13:01:07 1995 + +Index: pod/buildtoc +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/buildtoc Thu Dec 21 13:01:07 1995 + +Index: pod/perl.pod +*** perl5.002b1f/pod/perl.pod Sat Nov 18 17:23:58 1995 +--- perl5.002b1g/pod/perl.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perlbot.pod +*** perl5.002b1f/pod/perlbot.pod Fri Nov 10 17:27:33 1995 +--- perl5.002b1g/pod/perlbot.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perldata.pod +*** perl5.002b1f/pod/perldata.pod Sat Nov 18 17:23:59 1995 +--- perl5.002b1g/pod/perldata.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perldiag.pod +*** perl5.002b1f/pod/perldiag.pod Sun Nov 19 22:10:58 1995 +--- perl5.002b1g/pod/perldiag.pod Thu Dec 21 13:01:08 1995 + +Index: pod/perldsc.pod +*** perl5.002b1f/pod/perldsc.pod Sat Nov 18 17:24:22 1995 +--- perl5.002b1g/pod/perldsc.pod Thu Dec 21 13:01:08 1995 + +Index: pod/perlembed.pod +*** perl5.002b1f/pod/perlembed.pod Tue Oct 18 12:39:24 1994 +--- perl5.002b1g/pod/perlembed.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlform.pod +*** perl5.002b1f/pod/perlform.pod Sat Nov 18 17:23:59 1995 +--- perl5.002b1g/pod/perlform.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlfunc.pod +*** perl5.002b1f/pod/perlfunc.pod Sat Nov 18 17:24:01 1995 +--- perl5.002b1g/pod/perlfunc.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlguts.pod +*** perl5.002b1f/pod/perlguts.pod Tue Oct 31 15:38:18 1995 +--- perl5.002b1g/pod/perlguts.pod Thu Dec 21 13:01:10 1995 + +Index: pod/perlipc.pod +*** perl5.002b1f/pod/perlipc.pod Sat Nov 18 17:24:02 1995 +--- perl5.002b1g/pod/perlipc.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perllol.pod +*** perl5.002b1f/pod/perllol.pod Sat Nov 18 17:24:22 1995 +--- perl5.002b1g/pod/perllol.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlmod.pod +*** perl5.002b1f/pod/perlmod.pod Sat Nov 18 17:24:03 1995 +--- perl5.002b1g/pod/perlmod.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlobj.pod +*** perl5.002b1f/pod/perlobj.pod Sun Mar 12 00:48:38 1995 +--- perl5.002b1g/pod/perlobj.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlop.pod +*** perl5.002b1f/pod/perlop.pod Sat Nov 18 17:24:03 1995 +--- perl5.002b1g/pod/perlop.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlovl.pod +*** perl5.002b1f/pod/perlovl.pod Mon Jan 23 13:25:35 1995 +--- perl5.002b1g/pod/perlovl.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlpod.pod +*** perl5.002b1f/pod/perlpod.pod Sun Nov 19 22:22:59 1995 +--- perl5.002b1g/pod/perlpod.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlre.pod +*** perl5.002b1f/pod/perlre.pod Sun Nov 26 16:57:20 1995 +--- perl5.002b1g/pod/perlre.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlref.pod +*** perl5.002b1f/pod/perlref.pod Sat Nov 18 17:24:04 1995 +--- perl5.002b1g/pod/perlref.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlrun.pod +*** perl5.002b1f/pod/perlrun.pod Wed Feb 22 18:32:59 1995 +--- perl5.002b1g/pod/perlrun.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlsec.pod +*** perl5.002b1f/pod/perlsec.pod Wed Feb 22 18:33:02 1995 +--- perl5.002b1g/pod/perlsec.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlstyle.pod +*** perl5.002b1f/pod/perlstyle.pod Tue Oct 18 12:40:13 1994 +--- perl5.002b1g/pod/perlstyle.pod Thu Dec 21 13:01:13 1995 + +Index: pod/perlsub.pod +*** perl5.002b1f/pod/perlsub.pod Sun Mar 12 22:42:58 1995 +--- perl5.002b1g/pod/perlsub.pod Thu Dec 21 13:01:13 1995 + +Index: pod/perlsyn.pod +*** perl5.002b1f/pod/perlsyn.pod Sat Nov 18 17:24:04 1995 +--- perl5.002b1g/pod/perlsyn.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltie.pod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/perltie.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltoc.pod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/perltoc.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltrap.pod +*** perl5.002b1f/pod/perltrap.pod Wed Nov 15 21:36:11 1995 +--- perl5.002b1g/pod/perltrap.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perlvar.pod +*** perl5.002b1f/pod/perlvar.pod Wed Nov 15 21:36:59 1995 +--- perl5.002b1g/pod/perlvar.pod Thu Dec 21 13:01:15 1995 + +Index: pod/perlxs.pod +*** perl5.002b1f/pod/perlxs.pod Sun Nov 19 22:12:44 1995 +--- perl5.002b1g/pod/perlxs.pod Thu Dec 21 13:01:15 1995 + +Index: pod/perlxstut.pod +*** perl5.002b1f/pod/perlxstut.pod Mon Nov 20 13:02:12 1995 +--- perl5.002b1g/pod/perlxstut.pod Thu Dec 21 13:01:15 1995 + +Index: pod/pod2man.PL +Prereq: 1.5 +*** perl5.002b1f/pod/pod2man.PL Wed Nov 15 22:32:51 1995 +--- perl5.002b1g/pod/pod2man.PL Thu Dec 21 13:01:15 1995 + +Index: pod/pod2text +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/pod2text Thu Dec 21 13:01:16 1995 + +Index: pod/roffitall +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/roffitall Thu Dec 21 13:01:16 1995 + +Index: pod/splitpod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/splitpod Thu Dec 21 13:01:16 1995 + +=item patch.2b1f + +This is patch.2b1f to perl5.002beta1. + +Index: Changes.Conf + +Include 5.001m -> 5.002beta1 changes. + +*** perl5.002b1e/Changes.Conf Mon Nov 20 10:08:05 1995 +--- perl5.002b1f/Changes.Conf Wed Dec 6 15:29:48 1995 + +Index: Configure + + Include Jeff Okamoto's patch to allow arbitrary specification + of $startperl. + + As requested, I have moved site_perl to be under + $privlib, by default. The default will now be + /usr/local/lib/perl5/site_perl. This is in accord with the way + emacs used to do it :-). + + +Prereq: 3.0.1.8 +*** perl5.002b1e/Configure Fri Dec 8 14:55:26 1995 +--- perl5.002b1f/Configure Fri Dec 8 11:23:56 1995 + +Index: MANIFEST + Add in POSIX.pod. I didn't include Dean's mkposixman tool because + it seemed to confuse MakeMaker, and I didn't want to manually fix + the POSIX/Makefile.PL file today. + + Renamed minimod.PL. The idea is as follows: I'd like to reserve + the .PL suffix for files that are extracted during build time, and + then can be deleted after installation. That is, it will be + analogous to the .SH suffix. For example, h2xs.PL creates + h2xs, and a 'make realclean' will remove the h2xs. Minimod.PL + was an exception to this pattern. Eventually, the .PL dependencies + will be generated automatically, just as the .SH dependencies are + now. + + Add in socket test. + +*** perl5.002b1e/MANIFEST Fri Dec 8 14:55:27 1995 +--- perl5.002b1f/MANIFEST Fri Dec 8 13:34:53 1995 + +Index: Makefile.SH + + Renamed minimod.PL to minimod.pl + +*** perl5.002b1e/Makefile.SH Mon Nov 20 15:56:12 1995 +--- perl5.002b1f/Makefile.SH Fri Dec 8 10:36:33 1995 + +Index: XSUB.h + + Include (SV*) cast in the newXSproto #define. + +*** perl5.002b1e/XSUB.h Fri Dec 8 14:55:14 1995 +--- perl5.002b1f/XSUB.h Wed Dec 6 13:25:26 1995 + +Index: ext/POSIX/POSIX.pm + + I have included Dean's patch and the .pod generated by mkposixman. + +*** perl5.002b1e/ext/POSIX/POSIX.pm Wed Nov 15 14:54:09 1995 +--- perl5.002b1f/ext/POSIX/POSIX.pm Fri Dec 8 10:23:54 1995 + +Index: ext/POSIX/POSIX.pod + + I have included Dean's patch and the .pod generated by mkposixman. + +*** /dev/null Fri Dec 8 13:36:14 1995 +--- perl5.002b1f/ext/POSIX/POSIX.pod Fri Dec 8 10:30:40 1995 + +Index: ext/POSIX/POSIX.xs + + I have included Dean's patch and the .pod generated by mkposixman. + +*** perl5.002b1e/ext/POSIX/POSIX.xs Wed Nov 15 14:56:22 1995 +--- perl5.002b1f/ext/POSIX/POSIX.xs Fri Dec 8 10:23:54 1995 + +Index: ext/Socket/Socket.pm + + Replace errant sockaddr_in by correct sockaddr_un. + Remove an extra ')'. -- from Tom C. + +*** perl5.002b1e/ext/Socket/Socket.pm Fri Dec 8 14:55:28 1995 +--- perl5.002b1f/ext/Socket/Socket.pm Wed Dec 6 13:58:41 1995 + +Index: gv.c + + Fix from Nick Ing-Simmons to get HvNAME(stash) from caller's + package. + +*** perl5.002b1e/gv.c Wed Nov 15 14:58:39 1995 +--- perl5.002b1f/gv.c Fri Dec 8 10:37:22 1995 + +Index: lib/Cwd.pm + + Fix a long-standing problem where insufficient permissions higher + up in the directory tree caused getcwd to fail. This often showed + up on AFS. + +*** perl5.002b1e/lib/Cwd.pm Mon Nov 13 23:01:38 1995 +--- perl5.002b1f/lib/Cwd.pm Fri Dec 8 10:42:46 1995 + +Index: lib/Sys/Syslog.pm + + Modernize Syslog.pm to 'use Socket;' and 'use Sys::Hostname'. + Alas, I've lost the attribution for this patch. Sorry about + that. + +*** perl5.002b1e/lib/Sys/Syslog.pm Thu Feb 9 20:05:36 1995 +--- perl5.002b1f/lib/Sys/Syslog.pm Wed Dec 6 14:07:54 1995 + +Index: lib/diagnostics.pm + + Fixes from Tom. + +*** perl5.002b1e/lib/diagnostics.pm Tue Nov 14 16:16:36 1995 +--- perl5.002b1f/lib/diagnostics.pm Wed Dec 6 13:58:42 1995 + +Index: t/lib/socket.t + + New test from Tom. I've allowed it to fail if the echo service is + disabled, as is apparently the case on some systems. + +*** /dev/null Fri Dec 8 13:36:14 1995 +--- perl5.002b1f/t/lib/socket.t Fri Dec 8 11:16:01 1995 + +Index: toke.c + + A patch from Paul Marquess "purely for source filters". + +*** perl5.002b1e/toke.c Wed Nov 15 22:08:23 1995 +--- perl5.002b1f/toke.c Wed Dec 6 13:24:19 1995 + +=item patch.2b1e + +This is patch.2b1e to perl5.002beta1. This is simply +an upgrade from MakeMaker-5.10 to MakeMaker-5.11. + + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1d/lib/ExtUtils/Liblist.pm Sat Dec 2 16:50:47 1995 +--- perl5.002b1e/lib/ExtUtils/Liblist.pm Wed Dec 6 11:52:22 1995 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.114 +*** perl5.002b1d/lib/ExtUtils/MakeMaker.pm Sat Dec 2 16:50:48 1995 +--- perl5.002b1e/lib/ExtUtils/MakeMaker.pm Wed Dec 6 11:52:22 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1d/lib/ExtUtils/Manifest.pm Sat Dec 2 16:50:48 1995 +--- perl5.002b1e/lib/ExtUtils/Manifest.pm Wed Dec 6 11:52:22 1995 + +=item patch.2b1d + +This is patch.2b1d to perl5.002beta1. + +This patch includes patches for the following items: + + NETaa14710: Included bsdi_bsdos.sh hint file. + + pod/perlre.pod: Mention 32bit limit. + + Configure Updates. + + Update Socket.xs to version 1.5. This handles + systems that might not have <sys/un.h>. + + Fix missing quotes in h2ph.PL + +These are each described in detail below, after the corresponding +index line. + +Index: Configure + + locincpth should now work as documented in INSTALL + + Improved guessing of man1dir + + Remove spurious semicolon in NONBLOCK testing. + + Send failed './loc' message to fd 4. + + Check for <sys/un.h> + + Allow 'unixisms' to be overridden by hint files. + + Remove -r test from './loc' since some executables are + not readable. + + Remove spurious doublings of -L/usr/local/lib when reusing old + config.sh. + + Improved domain name guessing, from + Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + + Include sitelib (architecture-independent directory). + + +Prereq: 3.0.1.8 +*** perl5.002b1c/Configure Mon Nov 20 10:00:33 1995 +--- perl5.002b1d/Configure Sat Dec 2 15:35:13 1995 + +Index: INSTALL + + Consistently use "sh Configure" in examples. + + Add reminder that interactive use may be helpful. + +*** perl5.002b1c/INSTALL Mon Nov 20 10:46:48 1995 +--- perl5.002b1d/INSTALL Tue Nov 21 22:54:28 1995 + +Index: MANIFEST + + Include renamed hint file. + +*** perl5.002b1c/MANIFEST Sat Dec 2 16:20:21 1995 +--- perl5.002b1d/MANIFEST Sun Nov 26 17:03:31 1995 + +Index: config_h.SH + + Include check for <sys/un.h>. + + Include SITELIB_EXP definition for architecture-independent + site-specific modules. Usually, this will be + /usr/local/lib/site_perl. + +Prereq: 3.0.1.4 +*** perl5.002b1c/config_h.SH Mon Nov 20 10:00:33 1995 +--- perl5.002b1d/config_h.SH Sat Dec 2 15:35:13 1995 + +Index: ext/Socket/Makefile.PL + + Update version number to 1.5. + +*** perl5.002b1c/ext/Socket/Makefile.PL Sat Nov 18 15:36:56 1995 +--- perl5.002b1d/ext/Socket/Makefile.PL Sat Dec 2 16:23:52 1995 + +Index: ext/Socket/Socket.pm + + Update to version 1.5. + +*** perl5.002b1c/ext/Socket/Socket.pm Sat Nov 18 15:37:03 1995 +--- perl5.002b1d/ext/Socket/Socket.pm Sat Dec 2 16:25:17 1995 + +Index: ext/Socket/Socket.xs + + Update to version 1.5. + This only supports the sockaddr_un -related functions if your + system has <sys/un.h>. SVR3 systems generally don't. + +*** perl5.002b1c/ext/Socket/Socket.xs Sat Nov 18 15:36:57 1995 +--- perl5.002b1d/ext/Socket/Socket.xs Sat Dec 2 15:46:20 1995 + +Index: h2ph.PL + + Add missing quotes. + +*** perl5.002b1c/h2ph.PL Sun Nov 19 23:00:39 1995 +--- perl5.002b1d/h2ph.PL Mon Nov 27 10:14:50 1995 + +Index: hints/bsdi_bsdos.sh + + Updated and renamed file. + +*** perl5.002b1c/hints/bsdi_bsdos.sh Thu Jan 19 19:08:34 1995 +--- perl5.002b1d/hints/bsdi_bsdos.sh Sun Nov 26 16:50:26 1995 + +Index: pod/perlre.pod + + Mention 65536 limit explicitly. + +*** perl5.002b1c/pod/perlre.pod Wed Nov 15 21:35:31 1995 +--- perl5.002b1d/pod/perlre.pod Sun Nov 26 16:57:20 1995 + +=item patch.2b1c + +This is patch.2b1c to perl5.002beta1. This patch includes + lib/SelfLoader, version 1.06, and + lib/Devel/SelfStubber, version 1.01. +These versions include prototype support. + +This is simply re-posting these library modules. +I have also updated MANIFEST to include them. + + +Index: MANIFEST +*** perl5.002b1b/MANIFEST Sat Dec 2 16:13:24 1995 +--- perl5.002b1c/MANIFEST Sat Dec 2 16:12:54 1995 + +Index: lib/Devel/SelfStubber.pm +*** /dev/null Fri Dec 1 16:03:22 1995 +--- perl5.002b1c/lib/Devel/SelfStubber.pm Sun Nov 26 16:14:19 1995 + +Index: lib/SelfLoader.pm +*** /dev/null Fri Dec 1 16:03:22 1995 +--- perl5.002b1c/lib/SelfLoader.pm Sun Nov 26 16:14:50 1995 + +=item patch.2b1b + +This is patch.2b1b to perl5.002beta1. This is simply +MakeMaker-5.10. Nothing else is included. + +It contains: + +Upgrade to MakeMaker-5.10 +and a revised minimod.PL that now writes a pod section into ExtUtils::Miniperl. + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1a/lib/ExtUtils/Liblist.pm Mon Nov 13 22:03:29 1995 +--- perl5.002b1b/lib/ExtUtils/Liblist.pm Sat Dec 2 15:58:00 1995 + +Index: lib/ExtUtils/MakeMaker.pm +*** perl5.002b1a/lib/ExtUtils/MakeMaker.pm Sat Nov 18 16:01:05 1995 +--- perl5.002b1b/lib/ExtUtils/MakeMaker.pm Sat Dec 2 15:58:01 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1a/lib/ExtUtils/Manifest.pm Mon Nov 13 22:03:30 1995 +--- perl5.002b1b/lib/ExtUtils/Manifest.pm Sat Dec 2 15:58:02 1995 + +Index: minimod.PL +*** perl5.002b1a/minimod.PL Sun Nov 19 23:01:02 1995 +--- perl5.002b1b/minimod.PL Sat Dec 2 15:58:02 1995 + +=item patch.2b1a + +This is patch.2b1a to perl5.002beta1. This is simply +xsubpp-1.944. It includes perl prototype support. + +Index: XSUB.h + +Updated to match xsubpp-1.944. Includes perl prototype support. + +*** perl5.002beta1/XSUB.h Fri Nov 10 13:11:02 1995 +--- perl5.002b1a/XSUB.h Sat Dec 2 15:43:54 1995 + +Index: lib/ExtUtils/xsubpp + +Updated to xsubpp-1.944. Includes perl prototype support. + +*** perl5.002beta1/lib/ExtUtils/xsubpp Mon Nov 20 11:03:49 1995 +--- perl5.002b1a/lib/ExtUtils/xsubpp Sat Dec 2 15:43:55 1995 + + + Here are the detailed changes from 5.001m to 5.002beta1: # rm -f Doc/perl5-notes # Obsolete @@ -77,20 +1886,17 @@ Index: patchlevel.h Incremented to 2! *** perl5.001.lwall/patchlevel.h Sun Mar 12 22:29:12 1995 --- perl5.002beta1/patchlevel.h Sat Nov 18 15:41:15 1995 -*************** Index: Changes This includes the Changes file Larry sent me. I added the first paragraph. *** perl5.001.lwall/Changes Mon Mar 13 00:44:07 1995 --- perl5.002beta1/Changes Sat Nov 18 15:43:29 1995 -*************** Index: Changes.Conf An all too brief summary. *** perl5.001.lwall/Changes.Conf Thu Oct 19 21:00:06 1995 --- perl5.002beta1/Changes.Conf Mon Nov 20 10:08:05 1995 -*************** Index: Configure @@ -116,7 +1922,6 @@ represents the actual signal number. Prereq: 3.0.1.8 *** perl5.001.lwall/Configure Mon Oct 23 14:08:59 1995 --- perl5.002beta1/Configure Mon Nov 20 10:00:33 1995 -*************** Index: INSTALL @@ -133,7 +1938,6 @@ Mention how to override old config.sh with Configure -D and -O. *** perl5.001.lwall/INSTALL Mon Oct 23 14:10:26 1995 --- perl5.002beta1/INSTALL Mon Nov 20 10:46:48 1995 -*************** Index: MANIFEST @@ -148,7 +1952,6 @@ but included a current cperl-mode.el *** perl5.001.lwall/MANIFEST Tue Nov 14 15:21:03 1995 --- perl5.002beta1/MANIFEST Mon Nov 20 12:40:41 1995 -*************** Index: Makefile.SH @@ -158,7 +1961,6 @@ Add .PL file extraction logic. *** perl5.001.lwall/Makefile.SH Tue Nov 14 20:25:48 1995 --- perl5.002beta1/Makefile.SH Mon Nov 20 15:56:12 1995 -*************** Index: XSUB.h @@ -166,39 +1968,33 @@ Protect arguments of macros with (). *** perl5.001.lwall/XSUB.h Tue Mar 7 14:10:00 1995 --- perl5.002beta1/XSUB.h Fri Nov 10 13:11:02 1995 -*************** Index: c2ph.PL Replaces c2ph.SH. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/c2ph.PL Mon Nov 20 12:36:17 1995 -*************** Index: cflags.SH Allow for .o or .obj in file names. *** perl5.001.lwall/cflags.SH Thu Jan 19 19:06:13 1995 --- perl5.002beta1/cflags.SH Tue Nov 14 15:18:41 1995 -*************** Index: config_H Updated. Prereq: 3.0.1.3 *** perl5.001.lwall/config_H Thu Oct 19 21:01:14 1995 --- perl5.002beta1/config_H Mon Nov 20 15:41:49 1995 -*************** Index: config_h.SH Updated to match new Configure. Prereq: 3.0.1.3 *** perl5.001.lwall/config_h.SH Mon Oct 23 14:10:38 1995 --- perl5.002beta1/config_h.SH Mon Nov 20 10:00:33 1995 -*************** Index: configpm Add in routine to print out full config.sh file. *** perl5.001.lwall/configpm Wed Jun 7 19:46:01 1995 --- perl5.002beta1/configpm Tue Oct 31 11:51:52 1995 -*************** Index: doop.c Check for sprintf memory overflow that can arise from things @@ -206,136 +2002,114 @@ like %999999s. *** perl5.001.lwall/doop.c Sun Jul 2 23:33:44 1995 --- perl5.002beta1/doop.c Wed Nov 15 15:08:01 1995 -*************** Index: emacs/cperl-mode.el New version. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/emacs/cperl-mode.el Sat Nov 11 16:29:33 1995 -*************** Index: embed.h Remove unnecessary whichsigname introduced in patch.1n. *** perl5.001.lwall/embed.h Tue Nov 14 15:21:08 1995 --- perl5.002beta1/embed.h Wed Nov 15 14:48:47 1995 -*************** Index: ext/DB_File/DB_File.pm Updated to version 1.01. *** perl5.001.lwall/ext/DB_File/DB_File.pm Wed Jun 7 19:46:14 1995 --- perl5.002beta1/ext/DB_File/DB_File.pm Tue Nov 14 14:14:25 1995 -*************** Index: ext/DB_File/DB_File.xs Updated to version 1.01. *** perl5.001.lwall/ext/DB_File/DB_File.xs Wed Jun 7 19:46:17 1995 --- perl5.002beta1/ext/DB_File/DB_File.xs Tue Nov 14 14:14:37 1995 -*************** Index: ext/DB_File/Makefile.PL Updated to version 1.01. *** perl5.001.lwall/ext/DB_File/Makefile.PL Wed Feb 22 14:36:32 1995 --- perl5.002beta1/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 -*************** Index: ext/DB_File/typemap Fix typemap to avoid core dump. *** perl5.001.lwall/ext/DB_File/typemap Tue Oct 18 12:27:52 1994 --- perl5.002beta1/ext/DB_File/typemap Tue Oct 31 11:53:28 1995 -*************** Index: ext/DynaLoader/DynaLoader.pm Add parentheses to Carp::confess call. *** perl5.001.lwall/ext/DynaLoader/DynaLoader.pm Thu Oct 19 20:13:25 1995 --- perl5.002beta1/ext/DynaLoader/DynaLoader.pm Fri Nov 10 11:49:00 1995 -*************** Index: ext/DynaLoader/dl_os2.xs New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/ext/DynaLoader/dl_os2.xs Mon Nov 13 22:58:42 1995 -*************** Index: ext/Fcntl/Fcntl.xs Add O_BINARY define for OS/2. *** perl5.001.lwall/ext/Fcntl/Fcntl.xs Mon Oct 23 14:10:54 1995 --- perl5.002beta1/ext/Fcntl/Fcntl.xs Mon Nov 13 23:01:40 1995 -*************** Index: ext/GDBM_File/GDBM_File.pm Added a tiny bit of documentation, including how to get gdbm. Shamelessly stolen from the DB_File.pm documentation. *** perl5.001.lwall/ext/GDBM_File/GDBM_File.pm Wed Jun 7 19:46:34 1995 --- perl5.002beta1/ext/GDBM_File/GDBM_File.pm Mon Nov 20 10:22:26 1995 -*************** Index: ext/GDBM_File/GDBM_File.xs Add gdbm_EXISTS #define. *** perl5.001.lwall/ext/GDBM_File/GDBM_File.xs Sat Jul 1 18:44:02 1995 --- perl5.002beta1/ext/GDBM_File/GDBM_File.xs Sat Nov 11 14:25:50 1995 -*************** Index: ext/NDBM_File/hints/solaris.pl Updated for MakeMaker 5.0x. *** perl5.001.lwall/ext/NDBM_File/hints/solaris.pl Wed Jun 7 19:46:39 1995 --- perl5.002beta1/ext/NDBM_File/hints/solaris.pl Fri Nov 10 10:39:23 1995 -*************** Index: ext/ODBM_File/hints/sco.pl Updated for MakeMaker 5.0x. *** perl5.001.lwall/ext/ODBM_File/hints/sco.pl Wed Jun 7 19:46:44 1995 --- perl5.002beta1/ext/ODBM_File/hints/sco.pl Fri Nov 10 10:39:32 1995 -*************** Index: ext/ODBM_File/hints/solaris.pl Updated for MakeMaker 5.0x. *** perl5.001.lwall/ext/ODBM_File/hints/solaris.pl Wed Jun 7 19:46:46 1995 --- perl5.002beta1/ext/ODBM_File/hints/solaris.pl Fri Nov 10 10:39:44 1995 -*************** Index: ext/ODBM_File/hints/svr4.pl Updated for MakeMaker 5.0x. *** perl5.001.lwall/ext/ODBM_File/hints/svr4.pl Wed Jun 7 19:46:48 1995 --- perl5.002beta1/ext/ODBM_File/hints/svr4.pl Fri Nov 10 10:39:54 1995 -*************** Index: ext/POSIX/POSIX.pm Remove POSIX_loadlibs relics from perl5alpha days. *** perl5.001.lwall/ext/POSIX/POSIX.pm Thu Sep 21 19:14:19 1995 --- perl5.002beta1/ext/POSIX/POSIX.pm Wed Nov 15 14:54:09 1995 -*************** Index: ext/POSIX/POSIX.xs Change whichsigname(sig) back to sig_name[sig]. *** perl5.001.lwall/ext/POSIX/POSIX.xs Mon Oct 23 14:11:01 1995 --- perl5.002beta1/ext/POSIX/POSIX.xs Wed Nov 15 14:56:22 1995 -*************** Index: ext/SDBM_File/Makefile.PL Updated for MakeMaker 5.0x to allow compilation on non-unix systems. *** perl5.001.lwall/ext/SDBM_File/Makefile.PL Thu Jan 19 18:59:02 1995 --- perl5.002beta1/ext/SDBM_File/Makefile.PL Tue Nov 14 11:16:43 1995 -*************** Index: ext/SDBM_File/sdbm/Makefile.PL Updated for MakeMaker 5.0x to allow compilation on non-unix systems. *** perl5.001.lwall/ext/SDBM_File/sdbm/Makefile.PL Wed Feb 22 14:36:47 1995 --- perl5.002beta1/ext/SDBM_File/sdbm/Makefile.PL Tue Nov 14 11:17:16 1995 -*************** Index: ext/SDBM_File/sdbm/sdbm.c Include OS/2 O_BINARY flag. Prereq: 1.16 *** perl5.001.lwall/ext/SDBM_File/sdbm/sdbm.c Wed Jun 7 19:46:57 1995 --- perl5.002beta1/ext/SDBM_File/sdbm/sdbm.c Mon Nov 13 23:01:41 1995 -*************** Index: ext/Socket/Makefile.PL Updated to 1.3. Actually we're up to 1.4, but I forgot to update the Makefile.PL. *** perl5.001.lwall/ext/Socket/Makefile.PL Thu Jan 19 18:59:06 1995 --- perl5.002beta1/ext/Socket/Makefile.PL Sat Nov 18 15:36:56 1995 -*************** Index: ext/Socket/Socket.pm Updated to 1.3. Actually we're up to 1.4, but I forgot to update @@ -345,7 +2119,6 @@ patch. *** perl5.001.lwall/ext/Socket/Socket.pm Sat Jul 1 15:51:54 1995 --- perl5.002beta1/ext/Socket/Socket.pm Sat Nov 18 15:37:03 1995 -*************** Index: ext/Socket/Socket.xs Updated to 1.3. Actually we're up to 1.4, but I forgot to update @@ -355,91 +2128,76 @@ patch. *** perl5.001.lwall/ext/Socket/Socket.xs Sat Jul 1 15:51:56 1995 --- perl5.002beta1/ext/Socket/Socket.xs Sat Nov 18 15:36:57 1995 -*************** Index: global.sym Remove unnecessary whichsigname that was added in patch.1n. *** perl5.001.lwall/global.sym Tue Nov 14 15:21:11 1995 --- perl5.002beta1/global.sym Wed Nov 15 14:58:14 1995 -*************** Index: h2ph.PL Converted from h2ph.SH. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/h2ph.PL Sun Nov 19 23:00:39 1995 -*************** Index: h2xs.PL Converted from h2xs.SH. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/h2xs.PL Sun Nov 19 22:37:58 1995 -*************** Index: hints/aix.sh Add gcc-specific -Xlinker, if you're using gcc. *** perl5.001.lwall/hints/aix.sh Thu Oct 19 21:02:08 1995 --- perl5.002beta1/hints/aix.sh Mon Nov 13 23:03:33 1995 -*************** Index: hints/freebsd.sh Warn about possible here-document problem. *** perl5.001.lwall/hints/freebsd.sh Sat Jul 1 18:44:07 1995 --- perl5.002beta1/hints/freebsd.sh Sat Nov 18 16:21:20 1995 -*************** Index: hints/hpux.sh Replace old hpux_9.sh, since this works for 9 and 10. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/hints/hpux.sh Mon Nov 20 09:53:28 1995 -*************** Index: hints/irix_6_2.sh New hint file. This should be merged with irix_6.sh, since it's almost identical. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/hints/irix_6_2.sh Mon Nov 20 11:16:55 1995 -*************** Index: hints/ncr_tower.sh Give pointers about directory functions. *** perl5.001.lwall/hints/ncr_tower.sh Tue Oct 18 12:33:25 1994 --- perl5.002beta1/hints/ncr_tower.sh Tue Oct 31 11:57:51 1995 -*************** Index: hints/netbsd.sh Updated. *** perl5.001.lwall/hints/netbsd.sh Wed Jun 7 19:47:45 1995 --- perl5.002beta1/hints/netbsd.sh Mon Nov 13 23:04:17 1995 -*************** Index: hints/os2.sh *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/hints/os2.sh Tue Nov 14 11:07:33 1995 -*************** Index: hints/sco.sh Renamed from sco_3, since it should apply to most recent versions. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/hints/sco.sh Mon Jun 5 11:50:11 1995 -*************** Index: hints/solaris_2.sh Remove temporary file try.c. *** perl5.001.lwall/hints/solaris_2.sh Thu Oct 19 21:02:37 1995 --- perl5.002beta1/hints/solaris_2.sh Mon Nov 20 16:01:50 1995 -*************** Index: hints/ultrix_4.sh Note that you can substitute sh5 for sh to get a big speed up. *** perl5.001.lwall/hints/ultrix_4.sh Mon Feb 13 20:15:05 1995 --- perl5.002beta1/hints/ultrix_4.sh Sat Nov 11 17:11:41 1995 -*************** Index: installman Quit if they just asked for help with -h. *** perl5.001.lwall/installman Sat Jul 1 18:44:09 1995 --- perl5.002beta1/installman Mon Nov 6 11:16:43 1995 -*************** Index: installperl Updated to use Config rather than hand-reading config.sh again. @@ -450,7 +2208,6 @@ Create site_perl and site_perl/archname directories. *** perl5.001.lwall/installperl Sat Jul 1 18:44:12 1995 --- perl5.002beta1/installperl Mon Nov 20 12:55:08 1995 -*************** Index: lib/AutoSplit.pm Handle OS/2 backslashes. @@ -461,188 +2218,157 @@ Less enthusiastic checking of autoloader_seen. *** perl5.001.lwall/lib/AutoSplit.pm Sat Jul 1 15:52:03 1995 --- perl5.002beta1/lib/AutoSplit.pm Wed Nov 15 15:06:19 1995 -*************** Index: lib/Cwd.pm Updated for Unix, NT, and OS/2. *** perl5.001.lwall/lib/Cwd.pm Wed Jun 7 19:48:18 1995 --- perl5.002beta1/lib/Cwd.pm Mon Nov 13 23:01:38 1995 -*************** Index: lib/ExtUtils/Liblist.pm Updated to MakeMaker 5.06. *** perl5.001.lwall/lib/ExtUtils/Liblist.pm Wed Jun 7 19:48:27 1995 --- perl5.002beta1/lib/ExtUtils/Liblist.pm Mon Nov 13 22:03:29 1995 -*************** Index: lib/ExtUtils/MakeMaker.pm Updated to MakeMaker 5.06. Prereq: 1.21 *** perl5.001.lwall/lib/ExtUtils/MakeMaker.pm Thu Oct 19 21:02:57 1995 --- perl5.002beta1/lib/ExtUtils/MakeMaker.pm Sat Nov 18 16:01:05 1995 -*************** Index: lib/ExtUtils/Manifest.pm Updated to MakeMaker 5.06. *** perl5.001.lwall/lib/ExtUtils/Manifest.pm Sat Jul 1 15:52:11 1995 --- perl5.002beta1/lib/ExtUtils/Manifest.pm Mon Nov 13 22:03:30 1995 -*************** Index: lib/ExtUtils/xsubpp Updated to xsubpp-1.923. *** perl5.001.lwall/lib/ExtUtils/xsubpp Sat Jul 1 20:08:00 1995 --- perl5.002beta1/lib/ExtUtils/xsubpp Mon Nov 20 11:03:49 1995 -*************** Index: lib/File/Find.pm OS/2 patch for nlink. *** perl5.001.lwall/lib/File/Find.pm Sat Jul 1 15:52:13 1995 --- perl5.002beta1/lib/File/Find.pm Wed Nov 15 15:20:03 1995 -*************** Index: lib/Net/Ping.pm Updated to Net::Ping 1.00. *** perl5.001.lwall/lib/Net/Ping.pm Wed Jun 7 19:49:13 1995 --- perl5.002beta1/lib/Net/Ping.pm Tue Oct 31 11:15:55 1995 -*************** Index: lib/Shell.pm Updated for OS/2 or Unix. *** perl5.001.lwall/lib/Shell.pm Tue Oct 18 12:34:59 1994 --- perl5.002beta1/lib/Shell.pm Mon Nov 13 23:01:40 1995 -*************** Index: lib/Test/Harness.pm Updated for OS/2 or Unix. *** perl5.001.lwall/lib/Test/Harness.pm Tue Oct 18 12:38:35 1994 --- perl5.002beta1/lib/Test/Harness.pm Mon Nov 13 23:01:40 1995 -*************** Index: lib/Text/Tabs.pm Updated. *** perl5.001.lwall/lib/Text/Tabs.pm Wed Jun 7 19:49:20 1995 --- perl5.002beta1/lib/Text/Tabs.pm Sat Nov 18 16:08:55 1995 -*************** Index: lib/Text/Wrap.pm New module. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/lib/Text/Wrap.pm Sat Nov 18 16:08:56 1995 -*************** Index: lib/diagnostics.pm New module. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/lib/diagnostics.pm Tue Nov 14 16:16:36 1995 -*************** Index: lib/lib.pm Automatically try to load an architecture-dependent library too. *** perl5.001.lwall/lib/lib.pm Sat Jul 1 15:51:37 1995 --- perl5.002beta1/lib/lib.pm Fri Nov 10 16:50:43 1995 -*************** Index: lib/overload.pm New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/lib/overload.pm Sat Nov 18 16:03:33 1995 -*************** Index: lib/perl5db.pl Emacs and OS/2 fixes. *** perl5.001.lwall/lib/perl5db.pl Sun Mar 12 22:34:53 1995 --- perl5.002beta1/lib/perl5db.pl Wed Nov 15 22:37:45 1995 -*************** Index: lib/splain New file -- same as diagnostics.pm. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/lib/splain Tue Nov 14 16:16:36 1995 -*************** Index: mg.c Remove unnecessary whichsigname introduced in 5.001n. *** perl5.001.lwall/mg.c Tue Nov 14 15:31:03 1995 --- perl5.002beta1/mg.c Wed Nov 15 15:44:10 1995 -*************** Index: minimod.PL Made c++ friendly. *** perl5.001.lwall/minimod.PL Mon Feb 13 20:15:47 1995 --- perl5.002beta1/minimod.PL Sun Nov 19 23:01:02 1995 -*************** Index: miniperlmain.c Made c++ friendly. *** perl5.001.lwall/miniperlmain.c Mon Feb 13 21:48:50 1995 --- perl5.002beta1/miniperlmain.c Sat Nov 18 15:48:10 1995 -*************** Index: op.c Larry's post 5.001mx prototype patch. *** perl5.001.lwall/op.c Tue Nov 14 20:36:08 1995 --- perl5.002beta1/op.c Wed Nov 15 22:10:36 1995 -*************** Index: os2/Makefile.SH New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/Makefile.SH Tue Nov 14 11:07:32 1995 -*************** Index: os2/POSIX.mkfifo New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/POSIX.mkfifo Tue Nov 14 10:48:16 1995 -*************** Index: os2/README New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/README Tue Nov 14 14:42:13 1995 -*************** Index: os2/diff.Makefile New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/diff.Makefile Tue Nov 14 11:09:29 1995 -*************** Index: os2/diff.configure New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/diff.configure Sun Nov 12 01:31:34 1995 -*************** Index: os2/diff.installperl New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/diff.installperl Tue Nov 14 11:09:28 1995 -*************** Index: os2/diff.mkdep New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/diff.mkdep Tue Nov 14 11:09:28 1995 -*************** Index: os2/diff.x2pMakefile New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/diff.x2pMakefile Tue Nov 14 11:09:29 1995 -*************** Index: os2/os2.c New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/os2.c Tue Nov 14 11:07:33 1995 -*************** Index: os2/os2ish.h New file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/os2/os2ish.h Tue Nov 14 11:07:33 1995 -*************** Index: perl.c Add -h option to print out usage. @@ -653,7 +2379,6 @@ Add new library hierarchy. See INSTALL. *** perl5.001.lwall/perl.c Tue Nov 14 20:09:28 1995 --- perl5.002beta1/perl.c Sun Nov 19 16:11:29 1995 -*************** Index: perl.h @@ -663,243 +2388,203 @@ Check for <locale.h> *** perl5.001.lwall/perl.h Thu Nov 9 19:50:43 1995 --- perl5.002beta1/perl.h Wed Nov 15 17:13:16 1995 -*************** Index: perldoc.PL Moved from perldoc.SH. Updated to handle no nroff. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/perldoc.PL Tue Nov 14 14:57:57 1995 -*************** Index: pod/Makefile Updated for new pods and for new .PL format. *** perl5.001.lwall/pod/Makefile Wed Jun 7 19:50:02 1995 --- perl5.002beta1/pod/Makefile Mon Nov 20 13:00:50 1995 -*************** Index: pod/perl.pod Updated to refer to new pods. *** perl5.001.lwall/pod/perl.pod Thu Oct 5 19:54:43 1995 --- perl5.002beta1/pod/perl.pod Sat Nov 18 17:23:58 1995 -*************** Index: pod/perlbook.pod Updated info. *** perl5.001.lwall/pod/perlbook.pod Wed Feb 22 18:32:35 1995 --- perl5.002beta1/pod/perlbook.pod Sat Nov 11 17:17:23 1995 -*************** Index: pod/perlbot.pod Include SUPER stuff. *** perl5.001.lwall/pod/perlbot.pod Wed Jun 7 19:50:14 1995 --- perl5.002beta1/pod/perlbot.pod Fri Nov 10 17:27:33 1995 -*************** Index: pod/perlcall.pod Change perlapi to perlxs. *** perl5.001.lwall/pod/perlcall.pod Wed Jun 7 19:50:17 1995 --- perl5.002beta1/pod/perlcall.pod Tue Oct 31 15:37:57 1995 -*************** Index: pod/perldata.pod Tom's updates. *** perl5.001.lwall/pod/perldata.pod Sun Mar 12 22:35:14 1995 --- perl5.002beta1/pod/perldata.pod Sat Nov 18 17:23:59 1995 -*************** Index: pod/perldiag.pod Tom's updates. *** perl5.001.lwall/pod/perldiag.pod Tue Nov 14 22:04:11 1995 --- perl5.002beta1/pod/perldiag.pod Sun Nov 19 22:10:58 1995 -*************** Index: pod/perldsc.pod Tom's updates. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/perldsc.pod Sat Nov 18 17:24:22 1995 -*************** Index: pod/perlform.pod Tom's updates. *** perl5.001.lwall/pod/perlform.pod Wed Feb 22 18:32:41 1995 --- perl5.002beta1/pod/perlform.pod Sat Nov 18 17:23:59 1995 -*************** Index: pod/perlfunc.pod Tom's updates. *** perl5.001.lwall/pod/perlfunc.pod Tue Nov 14 15:31:33 1995 --- perl5.002beta1/pod/perlfunc.pod Sat Nov 18 17:24:01 1995 -*************** Index: pod/perlguts.pod Change perlapi to perlxs. *** perl5.001.lwall/pod/perlguts.pod Wed Jun 7 19:50:25 1995 --- perl5.002beta1/pod/perlguts.pod Tue Oct 31 15:38:18 1995 -*************** Index: pod/perlipc.pod New file from Tom. *** perl5.001.lwall/pod/perlipc.pod Wed Feb 22 18:32:48 1995 --- perl5.002beta1/pod/perlipc.pod Sat Nov 18 17:24:02 1995 -*************** Index: pod/perllol.pod New file from Tom. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/perllol.pod Sat Nov 18 17:24:22 1995 -*************** Index: pod/perlmod.pod Updates from Tom. *** perl5.001.lwall/pod/perlmod.pod Wed Feb 22 18:32:51 1995 --- perl5.002beta1/pod/perlmod.pod Sat Nov 18 17:24:03 1995 -*************** Index: pod/perlop.pod Add missing '>'. *** perl5.001.lwall/pod/perlop.pod Tue Nov 14 15:31:37 1995 --- perl5.002beta1/pod/perlop.pod Sat Nov 18 17:24:03 1995 -*************** Index: pod/perlpod.pod Add note about =cut operator. *** perl5.001.lwall/pod/perlpod.pod Tue Oct 18 12:39:53 1994 --- perl5.002beta1/pod/perlpod.pod Sun Nov 19 22:22:59 1995 -*************** Index: pod/perlref.pod Updates from Tom. *** perl5.001.lwall/pod/perlref.pod Tue Mar 7 00:56:46 1995 --- perl5.002beta1/pod/perlref.pod Sat Nov 18 17:24:04 1995 -*************** Index: pod/perlsyn.pod Updates from Tom. *** perl5.001.lwall/pod/perlsyn.pod Sat Mar 11 14:13:48 1995 --- perl5.002beta1/pod/perlsyn.pod Sat Nov 18 17:24:04 1995 -*************** Index: pod/perlxs.pod Updated. *** perl5.001.lwall/pod/perlxs.pod Tue Nov 14 15:31:42 1995 --- perl5.002beta1/pod/perlxs.pod Sun Nov 19 22:12:44 1995 -*************** Index: pod/perlxstut.pod New file from Jeff. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/perlxstut.pod Mon Nov 20 13:02:12 1995 -*************** Index: pod/pod2html.PL Updated -- version 1.15 merges Tom's suggestions and ideas from pod2fm. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/pod2html.PL Sun Nov 19 22:11:59 1995 -*************** Index: pod/pod2latex.PL Changed to a .PL file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/pod2latex.PL Wed Nov 15 22:32:39 1995 -*************** Index: pod/pod2man.PL Changed to a .PL file. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/pod/pod2man.PL Wed Nov 15 22:32:51 1995 -*************** Index: pp_ctl.c Add OS/2 stuff. *** perl5.001.lwall/pp_ctl.c Wed Nov 15 00:37:25 1995 --- perl5.002beta1/pp_ctl.c Wed Nov 15 21:46:37 1995 -*************** Index: pp_sys.c Add OS/2 stuff. *** perl5.001.lwall/pp_sys.c Tue Nov 14 21:03:06 1995 --- perl5.002beta1/pp_sys.c Wed Nov 15 21:51:33 1995 -*************** Index: proto.h Add OS/2 stuff to better protect MYMALLOC. *** perl5.001.lwall/proto.h Tue Nov 14 21:01:28 1995 --- perl5.002beta1/proto.h Wed Nov 15 21:55:23 1995 -*************** Index: t/TEST Add OS/2 check for perl.exe. *** perl5.001.lwall/t/TEST Sat Jan 14 19:35:33 1995 --- perl5.002beta1/t/TEST Tue Nov 14 11:22:08 1995 -*************** Index: t/lib/db-btree.t Updated. *** perl5.001.lwall/t/lib/db-btree.t Tue Oct 18 12:44:05 1994 --- perl5.002beta1/t/lib/db-btree.t Tue Oct 31 11:53:29 1995 -*************** Index: t/op/overload.t Updated. *** perl5.001.lwall/t/op/overload.t Tue Nov 14 20:56:57 1995 --- perl5.002beta1/t/op/overload.t Mon Nov 20 15:48:56 1995 -*************** Index: t/op/stat.t Add note about tmpfs failures. *** perl5.001.lwall/t/op/stat.t Tue Oct 18 12:46:23 1994 --- perl5.002beta1/t/op/stat.t Wed Nov 15 22:00:50 1995 -*************** Index: toke.c Patch from Paul M. for source filters. *** perl5.001.lwall/toke.c Tue Nov 14 21:59:50 1995 --- perl5.002beta1/toke.c Wed Nov 15 22:08:23 1995 -*************** Index: util.c Varargs fixes. *** perl5.001.lwall/util.c Wed Jun 7 19:51:19 1995 --- perl5.002beta1/util.c Tue Nov 14 10:46:37 1995 -*************** Index: writemain.SH Make c++ friendly. *** perl5.001.lwall/writemain.SH Wed Feb 8 19:44:20 1995 --- perl5.002beta1/writemain.SH Sat Nov 18 15:51:55 1995 -*************** Index: x2p/Makefile.SH Updated for .PL extraction. *** perl5.001.lwall/x2p/Makefile.SH Wed Jun 7 19:51:37 1995 --- perl5.002beta1/x2p/Makefile.SH Sun Nov 19 23:17:39 1995 -*************** Index: x2p/a2p.h Add OS/2 stuff. *** perl5.001.lwall/x2p/a2p.h Thu Oct 19 21:03:58 1995 --- perl5.002beta1/x2p/a2p.h Tue Nov 14 10:46:57 1995 -*************** Index: x2p/cflags.SH Add .obj for OS/2. *** perl5.001.lwall/x2p/cflags.SH Tue Oct 18 12:47:34 1994 --- perl5.002beta1/x2p/cflags.SH Tue Nov 14 15:18:27 1995 -*************** Index: x2p/find2perl.PL Changed from .SH to .PL. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/x2p/find2perl.PL Sun Nov 19 23:11:58 1995 -*************** Index: x2p/s2p.PL Changed from .SH to .PL extraction. *** /dev/null Mon Nov 20 17:28:51 1995 --- perl5.002beta1/x2p/s2p.PL Sun Nov 19 23:14:59 1995 -*************** ------------- Version 5.001 @@ -122,7 +122,8 @@ static_ext='' useposix='' usesafe='' d_bsd='' -d_eunice='' +d_unlnkallvers='' +d_vms='' d_xenix='' eunicefix='' Mcc='' @@ -1010,7 +1011,7 @@ THIS PACKAGE SEEMS TO BE INCOMPLETE. You have the option of continuing the configuration process, despite the distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o -and contact the author (lwall@netlabs.com). +and contact the author (lwall@sems.com). EOM echo $n "Continue? [n] $c" >&4 @@ -1207,7 +1208,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (lwall@netlabs.com) know how I blew it. +have, let me (lwall@sems.com) know how I blew it. This installation script affects things in two ways: @@ -1550,7 +1551,7 @@ EOM cd hints; ls -C *.sh | $sed 's/\.sh/ /g' >&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to lwall@netlabs.com + : tests or hints, please send them to lwall@sems.com : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -4309,7 +4310,7 @@ echo " " $echo $n "This may take a while...$c" >&4 : Linux may need the special Dynamic option to nm for shared libraries. -if test -f /vmlinuz && $nm -D $nm_opt $libc > /dev/null 2>&1; then +if test -f /vmlinuz && nm -D $nm_opt $libc > /dev/null 2>&1; then cat /dev/null >libc.tmp for nm_libs_ext in $*; do case $nm_libs_ext in *.so*) nm_opt_here=-D ;; *) nm_opt_here='' ;; esac @@ -8935,8 +8936,9 @@ d_dlopen='$d_dlopen' d_dlsymun='$d_dlsymun' d_dosuid='$d_dosuid' d_dup2='$d_dup2' +d_unlnkallvers='$d_unlnkallvers' +d_vms='$d_vms' d_eofnblk='$d_eofnblk' -d_eunice='$d_eunice' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_fcntl='$d_fcntl' @@ -522,6 +522,21 @@ If individual tests bomb, you can run them by hand, e.g., ./perl op/groups.t +B<NOTE>: one possible reason for errors is that some external programs +may be broken due to the combination of your environment and the way +C<make test> exercises them. This may happen for example if you have +one or more of these environment variables set: +C<LC_ALL LC_CTYPE LANG>. In certain UNIXes especially the non-English +locales are known to cause programs to exhibit mysterious errors. +If you have any of the above environment variables set, please try +C<setenv LC_ALL C> or <LC_ALL=C;export LC_ALL>, for C<csh>-style and +C<Bourne>-style shells, respectively, from the command line and then +retry C<make test>. If the tests then succeed, you may have a broken +program that is confusing the testing. Please run the troublesome test +by hand as shown above and see whether you can locate the program. +Look for things like: +C<exec, `backquoted command`, system, open("|...")> or C<open("...|")>. +All these mean that Perl is trying to run some external program. =head1 INSTALLING PERL5 =head1 make install @@ -93,6 +93,9 @@ ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files ext/Fcntl/Fcntl.pm Fcntl extension Perl module ext/Fcntl/Fcntl.xs Fcntl extension external subroutines ext/Fcntl/Makefile.PL Fcntl extension makefile writer +ext/FileHandle/FileHandle.pm FileHandle extension Perl module +ext/FileHandle/FileHandle.xs FileHandle extension external subroutines +ext/FileHandle/Makefile.PL FileHandle extension makefile writer ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/Makefile.PL GDBM extension makefile writer @@ -211,7 +214,7 @@ hints/next_3.sh Hints for named architecture hints/next_3_0.sh Hints for named architecture hints/opus.sh Hints for named architecture hints/os2.sh Hints for named architecture -hints/powerunix.sh Hints for named architecture +hints/powerux.sh Hints for named architecture hints/sco.sh Hints for named architecture hints/sco_2_3_0.sh Hints for named architecture hints/sco_2_3_1.sh Hints for named architecture @@ -244,6 +247,7 @@ lib/Benchmark.pm A module to time pieces of code and such lib/Carp.pm Error message base class lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm +lib/DirHandle.pm like FileHandle only for directories lib/English.pm Readable aliases for short variables lib/Env.pm Map environment into ordinary variables lib/Exporter.pm Exporter base class @@ -252,12 +256,14 @@ lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS. lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files lib/ExtUtils/Mkbootstrap.pm Writes a bootstrap file (see MakeMaker) +lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions lib/ExtUtils/typemap Extension interface types lib/ExtUtils/xsubpp External subroutine preprocessor lib/File/Basename.pm A module to emulate the basename program lib/File/CheckTree.pm Perl module supporting wholesale file mode validation lib/File/Find.pm Routines to do a find lib/File/Path.pm A module to do things like `mkdir -p' and `rm -r' +lib/FileCache.pm Keep more files open than the system permits lib/FileHandle.pm FileHandle methods lib/Getopt/Long.pm A module to fetch command options (GetOptions) lib/Getopt/Std.pm A module to fetch command options (getopt, getopts) @@ -270,9 +276,11 @@ lib/Math/Complex.pm A Complex package lib/Net/Ping.pm Ping methods lib/Pod/Text.pm Convert POD data to formatted ASCII text lib/Search/Dict.pm A module to do binary search on dictionaries +lib/SelectSaver.pm A module to enforce proper select scoping lib/SelfLoader.pm A module to load functions only on demand. lib/Shell.pm A module to make AUTOLOADEed system() calls lib/SubstrHash.pm Compact hash for known key, value and table size +lib/Symbol.pm Symbol table manipulation routines lib/Sys/Hostname.pm Hostname methods lib/Sys/Syslog.pm Perl module supporting syslogging lib/Term/Cap.pm Perl module supporting termcap usage @@ -331,6 +339,7 @@ lib/tainted.pl Old code for tainting lib/termcap.pl Perl library supporting termcap usage lib/timelocal.pl Perl library supporting inverse of localtime, gmtime lib/validate.pl Perl library supporting wholesale file mode validation +lib/vars.pm Declare pseudo-imported global variables makeaperl.SH perl script that produces a new perl binary makedepend.SH Precursor to makedepend makedir.SH Precursor to makedir @@ -464,7 +473,9 @@ t/lib/bigintpm.t See if BigInt.pm works t/lib/db-btree.t See if DB_File works t/lib/db-hash.t See if DB_File works t/lib/db-recno.t See if DB_File works +t/lib/dirhand.t See if DirHandle works t/lib/english.t See if English works +t/lib/filehand.t See if FileHandle works t/lib/gdbm.t See if GDBM_File works t/lib/ndbm.t See if NDBM_File works t/lib/odbm.t See if ODBM_File works @@ -544,13 +555,15 @@ vms/config.vms default config.h for VMS vms/descrip.mms MM[SK] description file for build vms/ext/Filespec.pm VMS-Unix file syntax interconversion vms/ext/MM_VMS.pm VMS-specific methods for MakeMaker -vms/ext/VMS/stdio/Makefile.PL MakeMaker driver for VMS::stdio -vms/ext/VMS/stdio/stdio.pm VMS options to stdio routines -vms/ext/VMS/stdio/stdio.xs VMS options to stdio routines +vms/ext/stdio/Makefile.PL MakeMaker driver for VMS::stdio +vms/ext/stdio/stdio.pm VMS options to stdio routines +vms/ext/stdio/stdio.xs VMS options to stdio routines vms/gen_shrfls.pl generate options files and glue for shareable image vms/genconfig.pl retcon config.sh from config.h vms/genopt.com hack to write options files in case of broken makes vms/mms2make.pl convert descrip.mms to make syntax +vms/make_command.com record MM[SK] command used to build Perl +vms/myconfig.com record local configuration info for bug report vms/perlvms.pod VMS-specific additions to Perl documentation vms/perly_c.vms perly.c with fixed declarations for global syms vms/perly_h.vms perly.h with fixed declarations for global syms diff --git a/Makefile.SH b/Makefile.SH index e36cf10746..0560bebd8b 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -224,9 +224,15 @@ FORCE: # The $& notation tells Sequent machines that it can do a parallel make, # and is harmless otherwise. +# The miniperl -w -MExporter line is a basic cheap test to catch errors +# before make goes on to run preplibrary and then MakeMaker on extensions. +# This is very handy because later errors are often caused by miniperl +# build problems but that's not obvious to the novice. +# The Module used here must not depend on Config or any extensions. miniperl: $& miniperlmain.o $(perllib) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o $(perllib) $(libs) + @miniperl -w -MExporter -e 0 || $(MAKE) minitest miniperlmain.o: miniperlmain.c $(CCCMD) $(PLDLFLAGS) $*.c @@ -327,7 +333,7 @@ install.man: all # normally shouldn't remake perly.[ch]. run_byacc: FORCE - @ echo 'Expect' 129 shift/reduce and 1 reduce/reduce conflict + @ echo 'Expect' 130 shift/reduce and 1 reduce/reduce conflict $(BYACC) -d perly.y sh $(shellflags) ./perly.fixer y.tab.c perly.c mv y.tab.h perly.h @@ -1,7 +1,7 @@ Perl Kit, Version 5.0 - Copyright (c) 1989,1990,1991,1992,1993,1994 Larry Wall + Copyright 1989-1996, Larry Wall All rights reserved. This program is free software; you can redistribute it and/or modify @@ -75,12 +75,15 @@ defaults. 2) Read the manual entries before running perl. 3) IMPORTANT! Help save the world! Communicate any problems and suggested -patches to me, lwall@netlabs.com (Larry Wall), so we can +patches to me, lwall@sems.com (Larry Wall), so we can keep the world in sync. If you have a problem, there's someone else out there who either has had or will have the same problem. It's usually helpful if you send the output of the "myconfig" script in the main perl directory. +If you've succeeded in compiling perl, the perlbug script in the utils/ +subdirectory can be used to help mail in a bug report. + If possible, send in patches such that the patch program will apply them. Context diffs are the best, then normal diffs. Don't send ed scripts-- I've probably changed my copy since the version you have. diff --git a/README.vms b/README.vms index c811a7140e..a530103f09 100644 --- a/README.vms +++ b/README.vms @@ -1,4 +1,4 @@ -Last revised: 14-Dec-1995 by Charles Bailey bailey@genetics.upenn.edu +Last revised: 19-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu The VMS port of Perl is still under development. At this time, the Perl binaries built under VMS handle internal operations properly, for the most @@ -12,8 +12,8 @@ you'd like to add something yourself, or join the porting team, we'd love to have you! The current sources and build procedures have been tested on a VAX using VAXC -and on an AXP using DECC. If you run into problems with other compilers, -please let us know. +and DECC, and on an AXP using DECC. If you run into problems with other +compilers, please let us know. Note to DECC users: Some early versions of the DECCRTL contained a few bugs which affect Perl performance: @@ -49,7 +49,7 @@ stacks available, so it's difficult to automate the process of building Perl with socket support in a way which will work on all systems. By default, Perl is built without IP socket support. If you define the macro -SOCKET when invoking MMS, however, socket support will be included. As +SOCKET when invoking MMK, however, socket support will be included. As distributed, Perl for VMS includes support for the SOCKETSHR socket library, which is layered on MadGoat software's vendor-independent NETLIB interface. This provides support for all socket calls used by Perl except the @@ -114,7 +114,10 @@ subdirectory contains several files, among which are the following: WriteMain.Pl - Perl script to generate Perlmain.C The [.Ext...] directories contain VMS-specific extensions distributed with Perl. There may also be other files in [.VMS...] pertaining to features under -development; for the most part, you can ignore them. +development; for the most part, you can ignore them. Note that packages in +[.ext.*] are not built with Perl by default; you build the ones you want +once the basic Perl build is complete (see the perlvms docs for instructions +on building extensions.) Config.VMS and Decrip.MMS/Makefile are set up to build a version of Perl which includes all features known to work when this release was assembled. If you @@ -141,7 +144,7 @@ it specifically from Config. Examine the information at the beginning of Descrip.MMS for information about specifying alternate C compilers or building a version of Perl with debugging support. For instance, if you want to use DECC, you'll need to include the -/macro="decc=1" qualifier to MMS (If you're using make, these options are not +/macro="decc=1" qualifier to MMK (If you're using make, these options are not supported.) If you're on an AXP system, define the macro __AXP__ (MMK does this for you), and DECC will automatically be selected. @@ -160,7 +163,14 @@ set up to use VAXC on a VAX, and does not include socket support. You can either edit the Makefile by hand, using Descrip.MMS as a guide, or use the Makefile to build Miniperl.Exe, and then run the Perl script MMS2Make.pl, found in the [.VMS] subdirectory, to generate a new Makefile with the options -appropriate to your site. +appropriate to your site. If you are using MM[SK], and you decide to rebuild +Perl with a different set of parameters (e.g. changing the C compiler, or +adding socket support), be sure to say +$ MMK/Descrip=[.VMS] realclean +first, in order to remove files generated during the previous build. If +you omit this step, you risk ending up with a copy of Perl which +composed partially of old files and partially of new ones, which may lead +to strange effects when you try to run Perl. Note for sites using DECC: A bug in some early versions of the DECC RTL on the AXP causes newlines to be lost when writing to a pipe. This causes @@ -191,6 +201,17 @@ This will build the following files: used to build PerlShr.Exe. It should be used when rebuilding PerlShr.Exe via MakeMaker-produced Descrip.MMS files for static extensions. + c2ph - Perl program which generates template code to access + C struct members from Perl. + h2ph - Perl program which generates template code to access + #defined constants in a C header file from Perl, + using the "old-style" interface. (Largely supplanted + by h2xs.) + h2xs - Perl program which generates template files for creating + XSUB extensions, optionally beginning with the #defined + constants in a C header file. + [.pod]perldoc - A Perl program which locates and displays documentation + for Perl and its extensions. [.Lib]Config.pm - the Perl extension which saves configuration information about Perl and your system. [.Lib]DynaLoader.pm - The Perl extension which performs dynamic linking of @@ -201,6 +222,30 @@ There are, of course, a number of other files created for use during the build. Once you've got the binaries built, you may wish to `build' the `tidy' or `clean' targets to remove extra files. +If you run into problems during the build, you can get help from the VMSPerl +or perl5-porters mailing lists (see below). When you report the problem, +please include the following information: + - The version of Perl you're trying to build. Please include any + "letter" patchlevel, in addition to the version number. If the + build successfully created Miniperl.Exe, you can check this by + saying '$ MCR Sys$Disk:[]Miniperl -v'. Also, please mention + where you obtained the distribution kit; in particular, note + whether you were using a basic Perl kit or the VMS test kit + (see below). + - The exact command you issued to build Perl. + - A copy of all error messages which were generated during the build. + Please include enough of the build log to establish the context of + the error messages. + - A summary of your configuration. If the build progressed far enough + to generate Miniperl.Exe and [.Lib]Config.pm, you can obtain this + by saying '$ MCR Sys$Disk:[]Miniperl "-V"' (note the "" around -V). + If not, then you can say '$ MMK/Descrip=[.VMS] printconfig' to + produce the summary. +This may sound like a lot of information to send, but it'll often make +it easier for someone to spot the problem, instead of having to give +a spectrum of possibilities. + + * Installing Perl once it's built @@ -227,12 +272,17 @@ Once the build is complete, you'll need to do the following: is written in a simple markup format which can be easily read. In this directory as well are pod2man and pod2html translators to reformat the docs for common display engines; a pod2hlp translator is under development. - Information on Perl can also be gleaned from the files in the [.doc] - subdirectory (internals documents and summaries of changes), and from - the test scripts in the [.t...] subdirectories. For this reason, - you may wish to copy these subtrees into directories under Perl_Root. + These files are copied to [.lib.pod] during the installation. + - Define a foreign command to execute perldoc, such as + $ Perldoc == "''Perl' Perl_Root:[lib.pod]Perldoc -t" + This will allow users to retrieve documentation using Perldoc. For + more details, say "perldoc perldoc". That's it. +If you run into a bug in Perl, please submit a bug report. The PerlBug +program, found in the [.lib] directory, will walk you through the process +of assembling the necessary information into a bug report, and sending +of to the Perl bug reporting address, perlbug@perl.com. * For more information @@ -294,7 +344,7 @@ and to the entire VMSperl group for useful advice and suggestions. In addition the perl5-porters, especially Andy Dougherty <doughera@lafcol.lafayette.edu> and Tim Bunce <Tim.Bunce@ig.co.uk>, deserve credit for their creativity and willingness to work with the VMS newcomers. Finally, the greatest debt of -gratitude is due to Larry Wall <lwall@netlabs.com>, for having the ideas which +gratitude is due to Larry Wall <lwall@sems.com>, for having the ideas which have made our sleepless nights possible. Thanks, @@ -64,7 +64,9 @@ I32 key; } else { if (AvALLOC(av)) { +#ifndef STRANGE_MALLOC U32 bytes; +#endif newmax = key + AvMAX(av) / 5; resize: @@ -82,8 +84,10 @@ I32 key; newmax = tmp - 1; New(2,ary, newmax+1, SV*); Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); - if (AvMAX(av) > 64 && !AvREUSED(av)) - sv_add_arena((char*)AvALLOC(av), AvMAX(av) * sizeof(SV*),0); + if (AvMAX(av) > 64 && !nice_chunk) { + nice_chunk = (char*)AvALLOC(av); + nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*); + } else Safefree(AvALLOC(av)); AvALLOC(av) = ary; @@ -326,7 +330,6 @@ register AV *av; AvALLOC(av) = 0; SvPVX(av) = 0; AvMAX(av) = AvFILL(av) = -1; - AvREUSED_on(av); /* Avoid leak of making SVs out of old memory again. */ if (AvARYLEN(av)) { SvREFCNT_dec(AvARYLEN(av)); AvARYLEN(av) = 0; diff --git a/config_h.SH b/config_h.SH index d4e039ca80..c67783cefb 100644 --- a/config_h.SH +++ b/config_h.SH @@ -1373,11 +1373,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define Uid_t $uidtype /* UID type */ +/* UNLINK_ALL_VERSIONS: + * This symbol, if defined, indicates that the program should arrange + * ro remove all versions of a file if unlink() is called. + */ +#$d_unlnkallvers UNLINK_ALL_VERSIONS /**/ + /* VMS: * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. + * VMS. It is currently automatically set by cpps running under VMS, + * and is included here for completeness only. */ -#$d_eunice VMS /**/ +#$d_vms VMS /**/ /* LOC_SED: * This symbol holds the complete pathname to the sed program. @@ -180,6 +180,7 @@ struct subst { char * sbu_m; char * sbu_strend; char * sbu_subbase; + REGEXP * sbu_rx; }; #define sb_iters cx_u.cx_subst.sbu_iters #define sb_maxiters cx_u.cx_subst.sbu_maxiters @@ -193,6 +194,7 @@ struct subst { #define sb_m cx_u.cx_subst.sbu_m #define sb_strend cx_u.cx_subst.sbu_strend #define sb_subbase cx_u.cx_subst.sbu_subbase +#define sb_rx cx_u.cx_subst.sbu_rx #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \ cx->sb_iters = iters, \ @@ -206,6 +208,7 @@ struct subst { cx->sb_s = s, \ cx->sb_m = m, \ cx->sb_strend = strend, \ + cx->sb_rx = rx, \ cx->cx_type = CXt_SUBST #define POPSUBST(cx) cxstack_ix-- @@ -54,30 +54,25 @@ #endif bool -do_open(gv,name,len,supplied_fp) +do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) GV *gv; register char *name; I32 len; +int as_raw; +int rawmode, rawperm; FILE *supplied_fp; { - FILE *fp; register IO *io = GvIOn(gv); - char *myname = savepv(name); - int result; - int fd; - int writing = 0; - int dodup; - char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ FILE *saveifp = Nullfp; FILE *saveofp = Nullfp; char savetype = ' '; + int writing = 0; + FILE *fp; + int fd; + int result; - SAVEFREEPV(myname); - mode[0] = mode[1] = mode[2] = '\0'; - name = myname; forkprocess = 1; /* assume true if no fork */ - while (len && isSPACE(name[len-1])) - name[--len] = '\0'; + if (IoIFP(io)) { fd = fileno(IoIFP(io)); if (IoTYPE(io) == '-') @@ -105,95 +100,119 @@ FILE *supplied_fp; GvENAME(gv)); IoOFP(io) = IoIFP(io) = Nullfp; } - if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ - mode[1] = *name++; - mode[2] = '\0'; - --len; - writing = 1; - } - else { - mode[1] = '\0'; - } - IoTYPE(io) = *name; - if (*name == '|') { - /*SUPPRESS 530*/ - for (name++; isSPACE(*name); name++) ; - if (strNE(name,"-")) - TAINT_ENV(); - TAINT_PROPER("piped open"); - if (dowarn && name[strlen(name)-1] == '|') - warn("Can't do bidirectional pipe"); - fp = my_popen(name,"w"); - writing = 1; + + if (as_raw) { + result = rawmode & 3; + IoTYPE(io) = "<>++"[result]; + writing = (result > 0); + fd = open(name, rawmode, rawperm); + if (fd == -1) + fp = NULL; + else { + fp = fdopen(fd, ((result == 0) ? "r" + : (result == 1) ? "w" + : "r+")); + if (!fp) + close(fd); + } } - else if (*name == '>') { - TAINT_PROPER("open"); - name++; - if (*name == '>') { - mode[0] = IoTYPE(io) = 'a'; - name++; + else { + char *myname; + char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ + int dodup; + + myname = savepvn(name, len); + SAVEFREEPV(myname); + name = myname; + while (len && isSPACE(name[len-1])) + name[--len] = '\0'; + + mode[0] = mode[1] = mode[2] = '\0'; + IoTYPE(io) = *name; + if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ + mode[1] = *name++; + --len; + writing = 1; } - else - mode[0] = 'w'; - writing = 1; - if (*name == '&') { - duplicity: - dodup = 1; + + if (*name == '|') { + /*SUPPRESS 530*/ + for (name++; isSPACE(*name); name++) ; + if (strNE(name,"-")) + TAINT_ENV(); + TAINT_PROPER("piped open"); + if (dowarn && name[strlen(name)-1] == '|') + warn("Can't do bidirectional pipe"); + fp = my_popen(name,"w"); + writing = 1; + } + else if (*name == '>') { + TAINT_PROPER("open"); name++; - if (*name == '=') { - dodup = 0; + if (*name == '>') { + mode[0] = IoTYPE(io) = 'a'; name++; } - if (!*name && supplied_fp) - fp = supplied_fp; - else { - while (isSPACE(*name)) + else + mode[0] = 'w'; + writing = 1; + + if (*name == '&') { + duplicity: + dodup = 1; + name++; + if (*name == '=') { + dodup = 0; name++; - if (isDIGIT(*name)) - fd = atoi(name); + } + if (!*name && supplied_fp) + fp = supplied_fp; else { - IO* thatio; - gv = gv_fetchpv(name,FALSE,SVt_PVIO); - thatio = GvIO(gv); - if (!thatio) { + /*SUPPRESS 530*/ + for (; isSPACE(*name); name++) ; + if (isDIGIT(*name)) + fd = atoi(name); + else { + IO* thatio; + gv = gv_fetchpv(name,FALSE,SVt_PVIO); + thatio = GvIO(gv); + if (!thatio) { #ifdef EINVAL - SETERRNO(EINVAL,SS$_IVCHAN); + SETERRNO(EINVAL,SS$_IVCHAN); #endif - goto say_false; + goto say_false; + } + if (IoIFP(thatio)) { + fd = fileno(IoIFP(thatio)); + if (IoTYPE(thatio) == 's') + IoTYPE(io) = 's'; + } + else + fd = -1; } - if (IoIFP(thatio)) { - fd = fileno(IoIFP(thatio)); - if (IoTYPE(thatio) == 's') - IoTYPE(io) = 's'; - } - else - fd = -1; - } - if (dodup) - fd = dup(fd); - if (!(fp = fdopen(fd,mode))) if (dodup) - close(fd); - } - } - else { - while (isSPACE(*name)) - name++; - if (strEQ(name,"-")) { - fp = stdout; - IoTYPE(io) = '-'; + fd = dup(fd); + if (!(fp = fdopen(fd,mode))) + if (dodup) + close(fd); + } } - else { - fp = fopen(name,mode); + else { + /*SUPPRESS 530*/ + for (; isSPACE(*name); name++) ; + if (strEQ(name,"-")) { + fp = stdout; + IoTYPE(io) = '-'; + } + else { + fp = fopen(name,mode); + } } } - } - else { - if (*name == '<') { + else if (*name == '<') { + /*SUPPRESS 530*/ + for (name++; isSPACE(*name); name++) ; mode[0] = 'r'; - name++; - while (isSPACE(*name)) - name++; if (*name == '&') goto duplicity; if (strEQ(name,"-")) { @@ -340,7 +359,7 @@ register GV *gv; sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); oldname = SvPVx(GvSV(gv), len); - if (do_open(gv,oldname,len,Nullfp)) { + if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) { if (inplace) { TAINT_PROPER("inplace open"); if (strEQ(oldname,"-")) { @@ -388,7 +407,7 @@ register GV *gv; do_close(gv,FALSE); (void)unlink(SvPVX(sv)); (void)rename(oldname,SvPVX(sv)); - do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp); + do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),FALSE,0,0,Nullfp); #endif /* MSDOS */ #else (void)UNLINK(SvPVX(sv)); @@ -417,7 +436,7 @@ register GV *gv; sv_setpvn(sv,">",1); sv_catpv(sv,oldname); SETERRNO(0,0); /* in case sprintf set errno */ - if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) { + if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) { warn("Can't do inplace edit on %s: %s", oldname, Strerror(errno) ); do_close(gv,FALSE); @@ -1286,7 +1305,7 @@ SV **sp; #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: - croak("%s not implemented", op_name[optype]); + croak("%s not implemented", op_desc[optype]); #endif } return -1; /* should never happen */ @@ -1342,7 +1361,7 @@ SV **sp; #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: - croak("%s not implemented", op_name[optype]); + croak("%s not implemented", op_desc[optype]); #endif } @@ -1359,7 +1378,7 @@ SV **sp; a = SvPV(astr, len); if (len != infosize) croak("Bad arg length for %s, is %d, should be %d", - op_name[optype], len, infosize); + op_desc[optype], len, infosize); } } else @@ -442,10 +442,13 @@ I32 do_chomp(sv) register SV *sv; { - register I32 count = 0; + register I32 count; STRLEN len; char *s; - + + if (RsSNARF(rs)) + return 0; + count = 0; if (SvTYPE(sv) == SVt_PVAV) { register I32 i; I32 max; @@ -472,7 +475,7 @@ register SV *sv; s = SvPV_force(sv, len); if (s && len) { s += --len; - if (rspara) { + if (RsPARA(rs)) { if (*s != '\n') goto nope; ++count; @@ -482,21 +485,24 @@ register SV *sv; ++count; } } - else if (rslen == 1) { - if (*s != rschar) - goto nope; - ++count; - } else { - if (len < rslen - 1) - goto nope; - len -= rslen - 1; - s -= rslen - 1; - if (bcmp(s, rs, rslen)) - goto nope; - count += rslen; + STRLEN rslen; + char *rsptr = SvPV(rs, rslen); + if (rslen == 1) { + if (*s != *rsptr) + goto nope; + ++count; + } + else { + if (len < rslen) + goto nope; + len -= rslen - 1; + s -= rslen - 1; + if (bcmp(s, rsptr, rslen)) + goto nope; + count += rslen; + } } - *s = '\0'; SvCUR_set(sv, len); SvNIOK_off(sv); @@ -1,5 +1,8 @@ #define ABORT() abort(); +#define BIT_BUCKET "/dev/null" /* Will this work? */ +#define PERL_SYS_INIT(c,v) + /* * fwrite1() should be a routine with the same calling sequence as fwrite(), * but which outputs all of the bytes requested as a single stream (unlike @@ -185,7 +185,9 @@ register OP *op; op->op_type == OP_AELEM || op->op_type == OP_HELEM ) { - if (op->op_private & OPpDEREF_DB) + if (op->op_private & OPpENTERSUB_AMPER) + (void)strcat(buf,"AMPER,"); + if (op->op_private & OPpENTERSUB_DB) (void)strcat(buf,"DB,"); if (op->op_private & OPpDEREF_AV) (void)strcat(buf,"AV,"); diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el index 5a400ef2b7..0505ea71f3 100644 --- a/emacs/cperl-mode.el +++ b/emacs/cperl-mode.el @@ -27,7 +27,7 @@ ;;; 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.15 1995/10/07 22:23:37 ilya Exp ilya $ +;; $Id: cperl-mode.el,v 1.19 1996/01/31 01:14:31 ilya Exp ilya $ ;;; To use this mode put the following into your .emacs file: @@ -80,56 +80,6 @@ ;;; lot of faces can be set up, but are not visible on your screen ;;; since the coloring rules for this faces are not defined. -;;; Tips: ======================================== - -;;; get newest version of this package from -;;; ftp://ftp.math.ohio-state.edu/pub/users/ilya/lisp -;;; and/or -;;; ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl - -;;; Get support packages font-lock-extra.el, imenu-go.el from the same place. -;;; (Look for other files there too... ;-) Get a patch for imenu.el. - -;;; Get perl5-info from -;; http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz -;;; (may be quite obsolete, but still useful). - -;;; If you use imenu-go, run imenu on perl5-info buffer (can do it from -;;; CPerl menu). - -;;;; Known problems: ======================================== - -;;; The very new pod -;;; features. The rules are: - -;;; /\n=/ should start comment mode, and -;;; /\n=cut\s/ should stop comment mode - -;;; Expansion of keywords tries to detect this kind of commenting, but -;;; a "=" that starts a perl row (as in multiline comment and here -;;; document) can confuse it. - -;;; The main trick (to -;;; make $ a "backslash") makes constructions like ${aaa} look like -;;; unbalanced braces. The only trick I can think out is to insert it as -;;; $ {aaa} (legal in perl5, not in perl4). - -;;;; Known non-problems: ======================================== - -;;; Perl quoting rules are too hard for CPerl. Try to help it: add -;;; comments with embedded quotes to fix CPerl misunderstandings: - -;;; $a='500$'; # '; - -;;; You won't need it too often. - -;;; Now the indentation code is pretty wise. If you still get wrong -;;; indentation in situation that you think the code should be able to -;;; parse, try: - -;;; a) Check what Emacs thinks about balance of your parentheses. -;;; b) Supply the code to me (IZ). - ;;; Updates: ======================================== ;;; Made less hairy by default: parentheses not electric, @@ -233,6 +183,58 @@ ;;;; After 1.14: ;;; Recognizes (tries to ;-) {...} which are not blocks during indentation. ;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block) +;;; Bug with auto-filling comments started with "##" corrected. + +;;;; Very slow now: on DB::DB 0.91, 486/66: + +;;;Function Name Call Count Elapsed Time Average Time +;;;======================================== ========== ============ ============ +;;;cperl-block-p 469 3.7799999999 0.0080597014 +;;;cperl-get-state 505 163.39000000 0.3235445544 +;;;cperl-comment-indent 12 0.0299999999 0.0024999999 +;;;cperl-backward-to-noncomment 939 4.4599999999 0.0047497337 +;;;cperl-calculate-indent 505 172.22000000 0.3410297029 +;;;cperl-indent-line 505 172.88000000 0.3423366336 +;;;cperl-use-region-p 40 0.0299999999 0.0007499999 +;;;cperl-indent-exp 1 177.97000000 177.97000000 +;;;cperl-to-comment-or-eol 1453 3.9800000000 0.0027391603 +;;;cperl-backward-to-start-of-continued-exp 9 0.0300000000 0.0033333333 +;;;cperl-indent-region 1 177.94000000 177.94000000 + +;;;; After 1.15: +;;; Takes into account white space after opening parentheses during indent. +;;; May highlight pods and here-documents: see `cperl-pod-here-scan', +;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info +;;; for indentation so far. +;;; Fontification updated to 19.30 style. +;;; The change 19.29->30 did not add all the required functionality, +;;; but broke "font-lock-extra.el". Get "choose-color.el" from +;;; ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs + +;;;; After 1.16: +;;; else # comment +;;; recognized as a start of a block. +;;; Two different font-lock-levels provided. +;;; `cperl-pod-head-face' introduced. Used for highlighting. +;;; `imenu' marks pods, +Packages moved to the head. + +;;;; After 1.17: +;;; Scan for pods highlights here-docs too. +;;; Note that the tag of here-doc may be rehighlighted later by lazy-lock. +;;; Only one here-doc-tag per line is supported, and one in comment +;;; or a string may break fontification. +;;; POD headers were supposed to fill one line only. + +;;;; After 1.18: +;;; `font-lock-keywords' were set in 19.30 style _always_. Current scheme +;;; may break under XEmacs. +;;; `cperl-calculate-indent' dis suppose that `parse-start' was defined. +;;; `fontified' tag is added to fontified text as well as `lazy-lock' (for +;;; compatibility with older lazy-lock.el) (older one overfontifies +;;; something nevertheless :-(). +;;; Will not indent something inside pod and here-documents. +;;; Fontifies the package name after import/no/bootstrap. +;;; Added new entry to menu with meta-info about the mode. (defvar cperl-extra-newline-before-brace nil "*Non-nil means that if, elsif, while, until, else, for, foreach @@ -247,6 +249,7 @@ instead of: if () { } ") + (defvar cperl-indent-level 2 "*Indentation of CPerl statements with respect to containing block.") (defvar cperl-lineup-step nil @@ -313,6 +316,118 @@ Can be overwritten by `cperl-hairy' if nil.") "*Not-nil (and non-null) means not to prompt on C-h f. The opposite behaviour is always available if prefixed with C-c. Can be overwritten by `cperl-hairy' if nil.") + +(defvar cperl-pod-face 'font-lock-comment-face + "*The result of evaluation of this expression is used for pod highlighting.") + +(defvar cperl-pod-head-face 'font-lock-variable-name-face + "*The result of evaluation of this expression is used for pod highlighting. +Font for POD headers.") + +(defvar cperl-here-face 'font-lock-string-face + "*The result of evaluation of this expression is used for here-docs highlighting.") + +(defvar cperl-pod-here-fontify '(featurep 'font-lock) + "*Not-nil after evaluation means to highlight pod and here-docs sections.") + +(defvar cperl-pod-here-scan t + "*Not-nil means look for pod and here-docs sections during startup. +You can always make lookup from menu or using \\[cperl-find-pods-heres].") + + + +;;; Short extra-docs. + +(defvar cperl-tips 'please-ignore-this-line + "Get newest version of this package from + ftp://ftp.math.ohio-state.edu/pub/users/ilya/lisp +and/or + ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl + +Get support packages font-lock-extra.el, imenu-go.el from the same place. +\(Look for other files there too... ;-) Get a patch for imenu.el in 19.29. +Note that for 19.30 you should use choose-color.el *instead* of +font-lock-extra.el (and you will not get smart highlighting in C :-(). + +Note that to enable Compile choices in the menu you need to install +compile-mode.el. + +Get perl5-info from + http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz +\(may be quite obsolete, but still useful). + +If you use imenu-go, run imenu on perl5-info buffer (you can do it from +CPerl menu). + +Before reporting (non-)problems look in the problem section on what I +know about them.") + +(defvar cperl-problems 'please-ignore-this-line +"Emacs has a _very_ restricted syntax parsing engine. + +It may be corrected on the level of C ocde, please look in the +`non-problems' section if you want to volonteer. + +CPerl mode tries to corrects some Emacs misunderstandings, however, +for effeciency 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 +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 +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 +:-(. " ) + +(defvar cperl-non-problems 'please-ignore-this-line +"As you know from `problems' section, Perl syntax too hard for CPerl. + +Most the time, if you write your own code, you may find an equivalent +\(and almost as readable) expression. + +Try to help it: add comments with embedded quotes to fix CPerl +misunderstandings about the end of quotation: + +$a='500$'; # '; + +You won't need it too often. The reason: $ \"quotes\" the following +character (this saves a life a lot of times in CPerl), thus due to +Emacs parsing rules it does not consider tick after the dollar as a +closing one, but as a usual character. + +Now the indentation code is pretty wise. The only drawback is that it +relies on Emacs parsing to find matching parentheses. And Emacs +*cannot* match parentheses in Perl 100% correctly. So + 1 if s#//#/#; +will not break indentation, but + 1 if ( s#//#/# ); +will. + +If you still get wrong indentation in situation that you think the +code should be able to parse, try: + +a) Check what Emacs thinks about balance of your parentheses. +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.) + +To speed up coloring the following compromises exist: + a) sub in $mypackage::sub may be highlighted. + b) -z in [a-z] may be highlighted. + c) if your regexp contains a keyword (like \"s\"), it may be highlighted. +") + ;;; Portability stuff: @@ -464,6 +579,7 @@ Can be overwritten by `cperl-hairy' if nil.") (cperl-etags nil 'recursive) t] ["Add tags for Perl files in (sub)directories" (cperl-etags t 'recursive) t]) + ["Recalculate PODs" cperl-find-pods-heres t] ["Define word at point" imenu-go-find-at-position (fboundp 'imenu-go-find-at-position)] ["Help on function" cperl-info-on-command t] @@ -473,7 +589,11 @@ Can be overwritten by `cperl-hairy' if nil.") ["C++" (cperl-set-style "C++") t] ["FSF" (cperl-set-style "FSF") t] ["BSD" (cperl-set-style "BSD") t] - ["Whitesmith" (cperl-set-style "Whitesmith") t])))) + ["Whitesmith" (cperl-set-style "Whitesmith") t]) + ("Micro-docs" + ["Tips" (describe-variable 'cperl-tips) t] + ["Problems" (describe-variable 'cperl-problems) t] + ["Non-problems" (describe-variable 'cperl-non-problems) t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" @@ -585,6 +705,11 @@ 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'). +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 +for indentation too, currently they are used for highlighting only. + Variables controlling indentation style: `cperl-tab-always-indent' Non-nil means TAB in CPerl mode should always reindent the current line, @@ -695,8 +820,17 @@ with no args." (make-local-variable 'imenu-create-index-function) (setq imenu-create-index-function (function imenu-example--create-perl-index)) + (make-local-variable 'imenu-sort-function) + (setq imenu-sort-function nil) (make-local-variable 'vc-header-alist) (setq vc-header-alist cperl-vc-header-alist) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + (if (string< emacs-version "19.30") + '(perl-font-lock-keywords-2) + '((perl-font-lock-keywords + perl-font-lock-keywords-1 + perl-font-lock-keywords-2)))) (or (fboundp 'cperl-old-auto-fill-mode) (progn (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) @@ -706,11 +840,15 @@ with no args." (and auto-fill-function (eq major-mode 'perl-mode) (setq auto-fill-function 'cperl-do-auto-fill))))) (if (cperl-enable-font-lock) - (if (cperl-val 'cperl-font-lock) (font-lock-mode 1))) + (if (cperl-val 'cperl-font-lock) + (progn (or cperl-faces-init (cperl-init-faces)) + (font-lock-mode 1)))) (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) - (run-hooks 'cperl-mode-hook)) + (run-hooks 'cperl-mode-hook) + ;; After hooks since fontification will break this + (if cperl-pod-here-scan (cperl-find-pods-heres))) ;; Fix for msb.el (defvar cperl-msb-fixed nil) @@ -826,7 +964,7 @@ place (even in empty line), but not after." (skip-chars-backward "$") (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)")) (insert ? )) - (if (cperl-after-expr) nil (setq cperl-auto-newline nil)) + (if (cperl-after-expr-p) nil (setq cperl-auto-newline nil)) (cperl-electric-brace arg) (and (eq last-command-char ?{) (memq last-command-char @@ -844,7 +982,7 @@ place (even in empty line), but not after." (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) ;;(not (save-excursion (search-backward "#" beg t))) (if (eq last-command-char ?<) - (cperl-after-expr nil "{};(,:=") + (cperl-after-expr-p nil "{};(,:=") 1)) (progn (insert last-command-char) @@ -861,7 +999,7 @@ place (even in empty line), but not after." (let ((beg (save-excursion (beginning-of-line) (point)))) (and (save-excursion (backward-sexp 1) - (cperl-after-expr nil "{};:")) + (cperl-after-expr-p nil "{};:")) (save-excursion (not (re-search-backward @@ -893,7 +1031,7 @@ place (even in empty line), but not after." (let ((beg (save-excursion (beginning-of-line) (point)))) (and (save-excursion (backward-sexp 1) - (cperl-after-expr nil "{};:")) + (cperl-after-expr-p nil "{};:")) (save-excursion (not (re-search-backward @@ -1008,22 +1146,23 @@ place (even in empty line), but not after." (not (save-excursion (beginning-of-line) (skip-chars-forward " \t") - (or (= (following-char) ?#) - ;; Colon is special only after a label, or case .... - ;; So quickly rule out most other uses of colon - ;; and do no indentation for them. - (and (eq last-command-char ?:) - (not (looking-at "case[ \t]")) - (save-excursion - (forward-word 1) - (skip-chars-forward " \t") - (and (< (point) end) - (progn (goto-char (- end 1)) - (not (looking-at ":")))))) - (progn - (beginning-of-defun) - (let ((pps (parse-partial-sexp (point) end))) - (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) + (or + ;; Ignore in comment lines + (= (following-char) ?#) + ;; Colon is special only after a label + ;; So quickly rule out most other uses of colon + ;; and do no indentation for them. + (and (eq last-command-char ?:) + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (and (< (point) end) + (progn (goto-char (- end 1)) + (not (looking-at ":")))))) + (progn + (beginning-of-defun) + (let ((pps (parse-partial-sexp (point) end))) + (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn (if cperl-auto-newline (setq insertpos (point))) @@ -1112,11 +1251,6 @@ Return the amount the indentation changed by." (and (> indent 0) (setq indent (max cperl-min-label-indent (+ indent cperl-label-offset))))) - ;;((and (looking-at "els\\(e\\|if\\)\\b") - ;; (not (looking-at "else\\s_"))) - ;; (setq indent (save-excursion - ;; (cperl-backward-to-start-of-if) - ;; (current-indentation)))) ((= (following-char) ?}) (setq indent (- indent cperl-indent-level))) ((memq (following-char) '(?\) ?\])) ; To line up with opening paren. @@ -1136,7 +1270,7 @@ Return the amount the indentation changed by." (goto-char (- (point-max) pos)))) shift-amt)) -(defsubst cperl-after-label () +(defun cperl-after-label () ;; Returns true if the point is after label. Does not do save-excursion. (and (eq (preceding-char) ?:) (memq (char-syntax (char-after (- (point) 2))) @@ -1145,210 +1279,257 @@ Return the amount the indentation changed by." (backward-sexp) (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:")))) -(defun cperl-calculate-indent (&optional parse-start symbol) - "Return appropriate indentation for current line as Perl code. -In usual case returns an integer: the column to indent to. -Returns nil if line starts inside a string, t if in a comment." +(defun cperl-get-state (&optional parse-start start-state) + ;; returns list (START STATE DEPTH PRESTART), START is a good place + ;; to start parsing, STATE is what is returned by + ;; `parse-partial-sexp'. DEPTH is true is we are immediately after + ;; end of block which contains START. PRESTART is the position + ;; basing on which START was found. (save-excursion - (beginning-of-line) - (let ((indent-point (point)) - (case-fold-search nil) - (char-after (save-excursion - (skip-chars-forward " \t") - (following-char))) - state start-indent start start-state moved - containing-sexp old-containing-sexp old-indent) - (or parse-start (null symbol) - (setq parse-start (symbol-value symbol) - start-state (cadr parse-start) - start-indent (nth 2 parse-start) - parse-start (car parse-start) - old-containing-sexp (nth 1 start-state))) + (let ((start-point (point)) depth state start prestart) (if parse-start (goto-char parse-start) (beginning-of-defun)) + (setq prestart (point)) (if start-state nil - ;; Try to go out - (while (< (point) indent-point) - (setq start (point) parse-start start moved nil - state (parse-partial-sexp start indent-point -1)) + ;; Try to go out, if sub is not on the outermost level + (while (< (point) start-point) + (setq start (point) parse-start start depth nil + state (parse-partial-sexp start start-point -1)) (if (> (car state) -1) nil ;; The current line could start like }}}, so the indentation ;; corresponds to a different level than what we reached - (setq moved t) + (setq depth t) (beginning-of-line 2))) ; Go to the next line. - (if start ; Not at the start of file - (progn - (goto-char start) - (setq start-indent (current-indentation)) - (if moved ; Should correct... - (setq start-indent (- start-indent cperl-indent-level)))) - (setq start-indent 0))) - (if (< (point) indent-point) (setq parse-start (point))) - (or state (setq state (parse-partial-sexp - (point) indent-point -1 nil start-state))) - (setq containing-sexp - (or (car (cdr state)) - (and (>= (nth 6 state) 0) old-containing-sexp)) - old-containing-sexp nil start-state nil) -;; (while (< (point) indent-point) -;; (setq parse-start (point)) -;; (setq state (parse-partial-sexp (point) indent-point -1 nil start-state)) -;; (setq containing-sexp -;; (or (car (cdr state)) -;; (and (>= (nth 6 state) 0) old-containing-sexp)) -;; old-containing-sexp nil start-state nil)) - (if symbol (set symbol (list indent-point state start-indent))) - (goto-char indent-point) - (cond ((or (nth 3 state) (nth 4 state)) - ;; return nil or t if should not change this line - (nth 4 state)) - ((null containing-sexp) - ;; Line is at top level. May be data or function definition, - ;; or may be function argument declaration. - ;; Indent like the previous top level line - ;; unless that ends in a closeparen without semicolon, - ;; in which case this line is the first argument decl. - (skip-chars-forward " \t") - (+ start-indent - (if (= (following-char) ?{) cperl-continued-brace-offset 0) - (progn - (cperl-backward-to-noncomment (or parse-start (point-min))) - (skip-chars-backward " \t\f\n") - ;; Look at previous line that's at column 0 - ;; to determine whether we are in top-level decls - ;; or function's arg decls. Set basic-indent accordingly. - ;; Now add a little if this is a continuation line. - (if (or (bobp) - (memq (preceding-char) (append ");}" nil)) - (memq char-after (append ")]}" nil))) - 0 - cperl-continued-statement-offset)))) - ((/= (char-after containing-sexp) ?{) - ;; line is expression, not statement: - ;; indent to just after the surrounding open. - (goto-char (1+ containing-sexp)) - (current-column)) - ((progn - ;; Containing-expr starts with \{. Check whether it is a hash. - (goto-char containing-sexp) - (cperl-backward-to-noncomment (or parse-start (point-min))) - (skip-chars-backward " \t\n\f") - (not - (or (memq (preceding-char) (append ";)}$@&%" nil)) ; Or label! + (if start (goto-char start))) ; Not at the start of file + (setq start (point)) + (if (< start start-point) (setq parse-start start)) + (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) + (list start state depth prestart)))) + +(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! + ;; Positions is before ?\{. Checks whether it starts a block. + ;; No save-excursion! + (cperl-backward-to-noncomment (point-min)) + ;;(skip-chars-backward " \t\n\f") + (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp ; Label may be mixed up with `$blah :' - (save-excursion (cperl-after-label)) - (and (eq (char-syntax (preceding-char)) ?w) - (progn - (backward-sexp) - (or (looking-at "\\sw+[ \t\n\f]*{") ; Method call syntax - (progn - (skip-chars-backward " \t\n\f") - (and (eq (char-syntax (preceding-char)) ?w) - (progn - (backward-sexp) - (looking-at - "sub[ \t]+\\sw+[ \t\n\f]*{")))))))))) - (goto-char containing-sexp) - (+ (current-column) 1 ; Correct indentation of trailing ?\} - (if (eq char-after ?\}) (+ cperl-indent-level - cperl-close-paren-offset) - 0))) - (t - ;; Statement level. Is it a continuation or a new statement? - ;; Find previous non-comment character. - (goto-char indent-point) - (cperl-backward-to-noncomment containing-sexp) - ;; Back up over label lines, since they don't - ;; affect whether our line is a continuation. - (while (or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (or ;;(eq (char-after (- (point) 2)) ?\') ; ???? - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_))))) - (if (eq (preceding-char) ?\,) - (cperl-backward-to-start-of-continued-exp containing-sexp)) - (beginning-of-line) - (cperl-backward-to-noncomment containing-sexp)) - ;; Now we get the answer. - (if (not (memq (preceding-char) (append ",;}{" '(nil)))) ; Was ?\, - ;; This line is continuation of preceding line's statement; - ;; indent `cperl-continued-statement-offset' more than the - ;; previous line of the statement. + (save-excursion (cperl-after-label)) + (and (eq (char-syntax (preceding-char)) ?w) + (progn + (backward-sexp) + (or (looking-at "\\sw+[ \t\n\f]*[{#]") ; Method call syntax (progn - (cperl-backward-to-start-of-continued-exp containing-sexp) - (+ (if (memq char-after (append "}])" nil)) - 0 ; Closing parenth - cperl-continued-statement-offset) - (current-column) - (if (eq char-after ?\{) - cperl-continued-brace-offset 0))) - ;; This line starts a new statement. - ;; Position following last unclosed open. - (goto-char containing-sexp) - ;; Is line first statement after an open-brace? - (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 - ;; small. - (save-excursion - (forward-char 1) - (setq old-indent (current-indentation)) - (let ((colon-line-end 0)) - (while (progn (skip-chars-forward " \t\n") - (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) - ;; Skip over comments and labels following openbrace. - (cond ((= (following-char) ?\#) - (forward-line 1)) - ;; label: - (t - (save-excursion (end-of-line) - (setq colon-line-end (point))) - (search-forward ":")))) - ;; The first following code counts - ;; if it is before the line we want to indent. - (and (< (point) indent-point) - (if (> colon-line-end (point)) ; After label - (if (> (current-indentation) - cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not belive: `max' is involved - (+ old-indent cperl-indent-level)) - (current-column))))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open brace in column zero, don't let statement - ;; start there too. If cperl-indent-level is zero, - ;; use cperl-brace-offset + cperl-continued-statement-offset instead. - ;; For open-braces not the first thing in a line, - ;; add in cperl-brace-imaginary-offset. + (skip-chars-backward " \t\n\f") + (and (eq (char-syntax (preceding-char)) ?w) + (progn + (backward-sexp) + (looking-at + "sub[ \t]+\\sw+[ \t\n\f]*[#{]"))))))))) - ;; If first thing on a line: ????? - (+ (if (and (bolp) (zerop cperl-indent-level)) - (+ cperl-brace-offset cperl-continued-statement-offset) - cperl-indent-level) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the cperl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 cperl-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; - ;; possibly a different line +(defun cperl-calculate-indent (&optional parse-start symbol) + "Return appropriate indentation for current line as Perl code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment." + (save-excursion + (if (memq (get-text-property (point) 'syntax-type) '(pod here-doc)) nil + (beginning-of-line) + (let* ((indent-point (point)) + (case-fold-search nil) + (s-s (cperl-get-state)) + (start (nth 0 s-s)) + (state (nth 1 s-s)) + (containing-sexp (car (cdr state))) + (char-after (save-excursion + (skip-chars-forward " \t") + (following-char))) + (start-indent (save-excursion + (goto-char start) + (- (current-indentation) + (if (nth 2 s-s) cperl-indent-level 0)))) + old-indent) + ;; (or parse-start (null symbol) + ;; (setq parse-start (symbol-value symbol) + ;; start-indent (nth 2 parse-start) + ;; parse-start (car parse-start))) + ;; (if parse-start + ;; (goto-char parse-start) + ;; (beginning-of-defun)) + ;; ;; Try to go out + ;; (while (< (point) indent-point) + ;; (setq start (point) parse-start start moved nil + ;; state (parse-partial-sexp start indent-point -1)) + ;; (if (> (car state) -1) nil + ;; ;; The current line could start like }}}, so the indentation + ;; ;; corresponds to a different level than what we reached + ;; (setq moved t) + ;; (beginning-of-line 2))) ; Go to the next line. + ;; (if start ; Not at the start of file + ;; (progn + ;; (goto-char start) + ;; (setq start-indent (current-indentation)) + ;; (if moved ; Should correct... + ;; (setq start-indent (- start-indent cperl-indent-level)))) + ;; (setq start-indent 0)) + ;; (if (< (point) indent-point) (setq parse-start (point))) + ;; (or state (setq state (parse-partial-sexp + ;; (point) indent-point -1 nil start-state))) + ;; (setq containing-sexp + ;; (or (car (cdr state)) + ;; (and (>= (nth 6 state) 0) old-containing-sexp)) + ;; old-containing-sexp nil start-state nil) +;;;; (while (< (point) indent-point) +;;;; (setq parse-start (point)) +;;;; (setq state (parse-partial-sexp (point) indent-point -1 nil start-state)) +;;;; (setq containing-sexp +;;;; (or (car (cdr state)) +;;;; (and (>= (nth 6 state) 0) old-containing-sexp)) +;;;; old-containing-sexp nil start-state nil)) + ;; (if symbol (set symbol (list indent-point state start-indent))) + ;; (goto-char indent-point) + (cond ((or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state)) + ((null containing-sexp) + ;; Line is at top level. May be data or function definition, + ;; or may be function argument declaration. + ;; Indent like the previous top level line + ;; unless that ends in a closeparen without semicolon, + ;; in which case this line is the first argument decl. + (skip-chars-forward " \t") + (+ start-indent + (if (= (following-char) ?{) cperl-continued-brace-offset 0) + (progn + (cperl-backward-to-noncomment (or parse-start (point-min))) + ;;(skip-chars-backward " \t\f\n") + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordingly. + ;; Now add a little if this is a continuation line. + (if (or (bobp) + (memq (preceding-char) (append " ;}" nil)) ; Was ?\) + (memq char-after (append ")]}" nil))) + 0 + cperl-continued-statement-offset)))) + ((/= (char-after containing-sexp) ?{) + ;; line is expression, not statement: + ;; indent to just after the surrounding open, + ;; skip blanks if we do not close the expression. + (goto-char (1+ containing-sexp)) + (or (memq char-after (append ")]}" nil)) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (current-column)) + ((progn + ;; Containing-expr starts with \{. Check whether it is a hash. + (goto-char containing-sexp) + (not (cperl-block-p))) + (goto-char (1+ containing-sexp)) + (or (eq char-after ?\}) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (+ (current-column) ; Correct indentation of trailing ?\} + (if (eq char-after ?\}) (+ cperl-indent-level + cperl-close-paren-offset) + 0))) + (t + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (goto-char indent-point) + (cperl-backward-to-noncomment containing-sexp) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + (while (or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (or;;(eq (char-after (- (point) 2)) ?\') ; ???? + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_))))) + (if (eq (preceding-char) ?\,) + ;; Will go to beginning of line, essentially. + ;; Will ignore embedded sexpr XXXX. + (cperl-backward-to-start-of-continued-exp containing-sexp)) + (beginning-of-line) + (cperl-backward-to-noncomment containing-sexp)) + ;; Now we get the answer. + (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\, + ;; This line is continuation of preceding line's statement; + ;; indent `cperl-continued-statement-offset' more than the + ;; previous line of the statement. (progn - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; Get initial indentation of the line we are on. - ;; If line starts with label, calculate label indentation - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]")) - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - (cperl-calculate-indent - (if (<= parse-start (point)) parse-start))) - (current-indentation))))))))))) + (cperl-backward-to-start-of-continued-exp containing-sexp) + (+ (if (memq char-after (append "}])" nil)) + 0 ; Closing parenth + cperl-continued-statement-offset) + (current-column) + (if (eq char-after ?\{) + cperl-continued-brace-offset 0))) + ;; This line starts a new statement. + ;; Position following last unclosed open. + (goto-char containing-sexp) + ;; Is line first statement after an open-brace? + (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 + ;; small. + (save-excursion + (forward-char 1) + (setq old-indent (current-indentation)) + (let ((colon-line-end 0)) + (while (progn (skip-chars-forward " \t\n") + (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) + ;; Skip over comments and labels following openbrace. + (cond ((= (following-char) ?\#) + (forward-line 1)) + ;; label: + (t + (save-excursion (end-of-line) + (setq colon-line-end (point))) + (search-forward ":")))) + ;; The first following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (if (> colon-line-end (point)) ; After label + (if (> (current-indentation) + cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not belive: `max' is involved + (+ old-indent cperl-indent-level)) + (current-column))))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open brace in column zero, don't let statement + ;; start there too. If cperl-indent-level is zero, + ;; use cperl-brace-offset + cperl-continued-statement-offset instead. + ;; For open-braces not the first thing in a line, + ;; add in cperl-brace-imaginary-offset. + + ;; If first thing on a line: ????? + (+ (if (and (bolp) (zerop cperl-indent-level)) + (+ cperl-brace-offset cperl-continued-statement-offset) + cperl-indent-level) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the cperl-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 cperl-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + ;; possibly a different line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; Get initial indentation of the line we are on. + ;; If line starts with label, calculate label indentation + (if (save-excursion + (beginning-of-line) + (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]")) + (if (> (current-indentation) cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + (cperl-calculate-indent + (if (and parse-start (<= parse-start (point))) + parse-start))) + (current-indentation)))))))))))) (defvar cperl-indent-alist '((string nil) @@ -1364,96 +1545,79 @@ The values mean: (defun cperl-where-am-i (&optional parse-start start-state) ;; Unfinished - "Return a list (TYPE POS) of the start of enclosing construction. + "Return a list of lists ((TYPE POS)...) of good points before the point. POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'." (save-excursion - (let ((start-point (point)) - (case-fold-search nil) - state start-indent start moved - containing-sexp old-containing-sexp old-indent) - (if parse-start - (goto-char parse-start) - (beginning-of-defun)) - (if start-state nil - ;; Try to go out, if sub is not on the outermost level - (while (< (point) start-point) - (setq start (point) parse-start start moved nil - state (parse-partial-sexp start start-point -1)) - (if (> (car state) -1) nil - ;; The current line could start like }}}, so the indentation - ;; corresponds to a different level than what we reached - (setq moved t) - (beginning-of-line 2))) ; Go to the next line. - (if start (goto-char start))) ; Not at the start of file - (skip-chars-forward " \t") - (setq start (point)) - (if (< (point) start-point) (setq parse-start (point))) - (or state (setq state (parse-partial-sexp - (point) start-point -1 nil start-state))) - (setq containing-sexp - (or (car (cdr state)) - (and (>= (nth 6 state) 0) old-containing-sexp)) - old-containing-sexp nil start-state nil) -;; (while (< (point) start-point) -;; (setq parse-start (point)) -;; (setq state (parse-partial-sexp (point) start-point -1 nil start-state)) -;; (setq containing-sexp -;; (or (car (cdr state)) -;; (and (>= (nth 6 state) 0) old-containing-sexp)) -;; old-containing-sexp nil start-state nil)) - (goto-char start-point) + (let* ((start-point (point)) + (s-s (cperl-get-state)) + (start (nth 0 s-s)) + (state (nth 1 s-s)) + (prestart (nth 3 s-s)) + (containing-sexp (car (cdr state))) + (case-fold-search nil) + (res (list (list 'parse-start start) (list 'parse-prestart prestart)))) (cond ((nth 3 state) ; In string - (list 'string nil (nth 3 state))) ; What started string + (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string ((nth 4 state) ; In comment - '(comment)) + (setq res (cons '(comment) res))) ((null containing-sexp) ;; Line is at top level. ;; Indent like the previous top level line ;; unless that ends in a closeparen without semicolon, ;; in which case this line is the first argument decl. (cperl-backward-to-noncomment (or parse-start (point-min))) - (skip-chars-backward " \t\f\n") ; Why??? + ;;(skip-chars-backward " \t\f\n") (cond ((or (bobp) (memq (preceding-char) (append ";}" nil))) - (list 'toplevel start)) + (setq res (cons (list 'toplevel start) res))) ((eq (preceding-char) ?\) ) - (list 'toplevel-after-parenth start)) - (t (list 'toplevel-continued start)))) + (setq res (cons (list 'toplevel-after-parenth start) res))) + (t + (setq res (cons (list 'toplevel-continued start) res))))) ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement: ;; indent to just after the surrounding open. - (list 'expression containing-sexp)) + ;; skip blanks if we do not close the expression. + (setq res (cons (list 'expression-blanks + (progn + (goto-char (1+ containing-sexp)) + (or (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (point))) + (cons (list 'expression containing-sexp) res)))) ((progn ;; Containing-expr starts with \{. Check whether it is a hash. (goto-char containing-sexp) - (cperl-backward-to-noncomment (or parse-start (point-min))) - (skip-chars-backward " \t\n\f") - (not - (or (memq (preceding-char) (append ";)}$@&%" nil)) ; Or label! - ; Label may be mixed up with `$blah :' - (save-excursion (cperl-after-label)) - (and (eq (char-syntax (preceding-char)) ?w) - (progn - (backward-sexp) - (looking-at "\\sw+[ \t\n\f]*{")))))) ; Method call syntax - (list 'expression containing-sexp)) + (not (cperl-block-p))) + (setq res (cons (list 'expression-blanks + (progn + (goto-char (1+ containing-sexp)) + (or (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (point))) + (cons (list 'expression containing-sexp) res)))) (t - ;; Statement level. Is it a continuation or a new statement? + ;; Statement level. + (setq res (cons (list 'in-block containing-sexp) res)) + ;; Is it a continuation or a new statement? ;; Find previous non-comment character. (cperl-backward-to-noncomment containing-sexp) ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. + ;; Back up comma-delimited lines too ????? (while (or (eq (preceding-char) ?\,) - (cperl-after-label)) + (save-excursion (cperl-after-label))) (if (eq (preceding-char) ?\,) + ;; Will go to beginning of line, essentially + ;; Will ignore embedded sexpr XXXX. (cperl-backward-to-start-of-continued-exp containing-sexp)) (beginning-of-line) (cperl-backward-to-noncomment containing-sexp)) ;; Now we get the answer. (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\, ;; This line is continuation of preceding line's statement. - '(statement-continued containing-sexp) + (list (list 'statement-continued containing-sexp)) ;; This line starts a new statement. ;; Position following last unclosed open. (goto-char containing-sexp) @@ -1465,28 +1629,33 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'." ;; small. (save-excursion (forward-char 1) - (setq old-indent (current-indentation)) (let ((colon-line-end 0)) - (while (progn (skip-chars-forward " \t\n") - (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) + (while (progn (skip-chars-forward " \t\n" start-point) + (and (< (point) start-point) + (looking-at + "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) - (forward-line 1)) + ;;(forward-line 1) + (end-of-line)) ;; label: (t (save-excursion (end-of-line) (setq colon-line-end (point))) (search-forward ":")))) - ;; The first following code counts - ;; if it is before the line we want to indent. + ;; Now at the point, after label, or at start + ;; of first statement in the block. (and (< (point) start-point) - (if (> colon-line-end (point)) ; After label + (if (> colon-line-end (point)) + ;; Before statement after label (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) + (list (list 'label-in-block (point))) ;; Do not belive: `max' is involved - (+ old-indent cperl-indent-level)) - (current-column))))) + (list + (list 'label-in-block-min-indent (point)))) + ;; Before statement + (list 'statement-in-block (point)))))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open brace in column zero, don't let statement @@ -1518,8 +1687,10 @@ POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'." (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) (cperl-calculate-indent - (if (<= parse-start (point)) parse-start))) - (current-indentation))))))))))) + (if (and parse-start (<= parse-start (point))) + parse-start))) + (current-indentation)))))))) + res))) (defun cperl-calculate-indent-within-comment () "Return the indentation amount for line, assuming that @@ -1584,7 +1755,101 @@ Returns true if comment is found." ) (nth 4 state)))) -(defun cperl-backward-to-noncomment (lim) +(defun cperl-find-pods-heres (&optional min max) + "Scans the buffer for POD sections and here-documents. +If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify +the sections using `cperl-pod-head-face', `cperl-pod-face', +`cperl-here-face'." + (interactive) + (or min (setq min (point-min))) + (or max (setq max (point-max))) + (let (face head-face here-face b e bb tag err + (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) + (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) + (modified (buffer-modified-p))) + (unwind-protect + (progn + (save-excursion + (message "Scanning for pods and here-docs...") + (if cperl-pod-here-fontify + (setq face (eval cperl-pod-face) + head-face (eval cperl-pod-head-face) + here-face (eval cperl-here-face))) + (remove-text-properties min max '(syntax-type t)) + ;; Need to remove face as well... + (goto-char min) + (while (re-search-forward "^=" max t) + (if (looking-at "cut\\>") + (progn + (message "=cut is not preceeded by a pod section") + (setq err (point))) + (beginning-of-line) + (setq b (point) bb b) + (re-search-forward "^=cut\\>" max 'toend) + (beginning-of-line 2) + (setq e (point)) + (put-text-property b e 'in-pod t) + (goto-char b) + (while (re-search-forward "\n\n[ \t]" e t) + (beginning-of-line) + (put-text-property b (point) 'syntax-type 'pod) + (put-text-property b (point) 'fontified t) ; Old lazy-lock + (put-text-property b (point) 'lazy-lock t) ; New lazy-lock + (if cperl-pod-here-fontify (put-text-property b (point) 'face face)) + (re-search-forward "\n\n[^ \t\f]" e 'toend) + (beginning-of-line) + (setq b (point))) + (put-text-property (point) e 'syntax-type 'pod) + (put-text-property (point) e 'fontified t) + (put-text-property (point) e 'lazy-lock t) + (if cperl-pod-here-fontify + (progn (put-text-property (point) e 'face face) + (goto-char bb) + (while (re-search-forward + ;; One paragraph + "^=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$" + e 'toend) + (put-text-property + (match-beginning 1) (match-end 1) + 'face head-face)))) + (goto-char e))) + (goto-char min) + (while (re-search-forward + "<<\\(\\([\"'`]\\)?\\)\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\1" + max t) + (setq tag (buffer-substring (match-beginning 3) + (match-end 3))) + (if cperl-pod-here-fontify + (put-text-property (match-beginning 3) (match-end 3) + 'face font-lock-reference-face)) + (forward-line) + (setq b (point)) + (and (re-search-forward (concat "^" tag "$") max 'toend) + (progn + (if cperl-pod-here-fontify + (progn + (put-text-property (match-beginning 0) (match-end 0) + 'face font-lock-reference-face) + (put-text-property (match-beginning 0) + (1+ (match-end 0)) + 'lazy-lock t) + (put-text-property (match-beginning 0) + (1+ (match-end 0)) + 'fontified t) + (put-text-property b (match-beginning 0) + 'face here-face) + (put-text-property b (match-beginning 0) + 'lazy-lock t))) + (put-text-property b (match-beginning 0) + 'syntax-type 'here-doc))))) + (if err (goto-char err) + (message "Scan for pods and here-docs completed."))) + (and (buffer-modified-p) + (not modified) + (set-buffer-modified-p nil))))) + +(defun cperl-backward-to-noncomment (lim) + ;; Stops at lim or after non-whitespace that is not in comment (let (stop p) (while (and (not stop) (> (point) (or lim 1))) (skip-chars-backward " \t\n\f" lim) @@ -1597,7 +1862,7 @@ Returns true if comment is found." (if (< p (point)) (goto-char p)) (setq stop t))))) -(defun cperl-after-expr (&optional lim chars test) +(defun cperl-after-expr-p (&optional lim chars test) "Returns true if the position is good for start of expression. TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us." @@ -1620,29 +1885,13 @@ CHARS is a string that contains good characters to have before us." (memq (following-char) (append (or chars "{};") nil)))))))) (defun cperl-backward-to-start-of-continued-exp (lim) - (if (memq (preceding-char) (append ")]}" nil)) + (if (memq (preceding-char) (append ")]}\"'`" nil)) (forward-sexp -1)) (beginning-of-line) (if (<= (point) lim) (goto-char (1+ lim))) (skip-chars-forward " \t")) -(defun cperl-backward-to-start-of-if (&optional limit) - "Move to the start of the last ``unbalanced'' if." - (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) - (let ((if-level 1) - (case-fold-search nil)) - (while (not (zerop if-level)) - (backward-sexp 1) - (cond ((looking-at "else\\b") - (setq if-level (1+ if-level))) - ((looking-at "if\\b") - (setq if-level (1- if-level))) - ((<= (point) limit) - (setq if-level 0) - (goto-char limit)))))) - - (defvar innerloop-done nil) (defvar last-depth nil) @@ -1725,7 +1974,7 @@ inclusive." (and (not (memq (get-text-property (point) 'face) '(font-lock-string-face font-lock-comment-face))) - (cperl-after-expr nil nil ' + (cperl-after-expr-p nil nil ' (or (looking-at "[^]a-zA-Z0-9_)}]") (eq (get-text-property (point) 'face) 'font-lock-keyword-face)))))) @@ -1783,15 +2032,15 @@ indentation and initial hashes. Behaves usually outside of comment." (if start (progn (beginning-of-line) (point)) (save-excursion (while (and (zerop (forward-line -1)) - (looking-at "^[ \t]*#+[ \t]*[^ \t\n]"))) + (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]"))) ;; We may have gone to far. Go forward again. - (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n]") + (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]") (forward-line 1)) (point))) ;; Find the beginning of the first line past the region to fill. (save-excursion (while (progn (forward-line 1) - (looking-at "^[ \t]*#+[ \t]*[^ \t\n]"))) + (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]"))) (point))) ;; Remove existing hashes (goto-char (point-min)) @@ -1840,12 +2089,14 @@ indentation and initial hashes. Behaves usually outside of comment." (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) (defvar imenu-example--function-name-regexp-perl - "^[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*") + "^\\([ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\|=head\\([12]\\)[ \t]+\\([^\n]+\\)$\\)") (defun imenu-example--create-perl-index (&optional regexp) (require 'cl) - (let ((index-alist '()) (index-pack-alist '()) packages ends-ranges p - (prev-pos 0) char fchar index name (end-range 0) package) + (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) + (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) + packages ends-ranges p + (prev-pos 0) char fchar index index1 name (end-range 0) package) (goto-char (point-min)) (imenu-progress-message prev-pos 0) ;; Search for the function @@ -1855,44 +2106,72 @@ indentation and initial hashes. Behaves usually outside of comment." nil t) (imenu-progress-message prev-pos) ;;(backward-up-list 1) - (save-excursion - (goto-char (match-beginning 1)) - (setq fchar (following-char)) - ) - (setq char (following-char)) - (setq p (point)) - (while (and ends-ranges (>= p (car ends-ranges))) - ;; delete obsolete entries - (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) - (setq package (or (car packages) "") - end-range (or (car ends-ranges) 0)) - (if (eq fchar ?p) - (progn - (setq name (buffer-substring (match-beginning 2) (match-end 2)) - package (concat name "::") - name (concat "package " name) - end-range - (save-excursion - (parse-partial-sexp (point) (point-max) -1) (point)) - ends-ranges (cons end-range ends-ranges) - packages (cons package packages)))) - ;; ) - ;; Skip this function name if it is a prototype declaration. - (if (and (eq fchar ?s) (eq char ?\;)) nil - (if (eq fchar ?p) nil - (setq name (buffer-substring (match-beginning 2) (match-end 2))) - (if (or (> p end-range) (string-match "[:']" name)) nil - (setq name (concat package name)))) - (setq index (imenu-example--name-and-position)) + (cond + ((match-beginning 2) ; package or sub + (save-excursion + (goto-char (match-beginning 2)) + (setq fchar (following-char)) + ) + (setq char (following-char)) + (setq p (point)) + (while (and ends-ranges (>= p (car ends-ranges))) + ;; delete obsolete entries + (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) + (setq package (or (car packages) "") + end-range (or (car ends-ranges) 0)) + (if (eq fchar ?p) + (progn + (setq name (buffer-substring (match-beginning 3) (match-end 3)) + package (concat name "::") + name (concat "package " name) + end-range + (save-excursion + (parse-partial-sexp (point) (point-max) -1) (point)) + ends-ranges (cons end-range ends-ranges) + packages (cons package packages)))) + ;; ) + ;; Skip this function name if it is a prototype declaration. + (if (and (eq fchar ?s) (eq char ?\;)) nil + (if (eq fchar ?p) nil + (setq name (buffer-substring (match-beginning 3) (match-end 3))) + (if (or (> p end-range) (string-match "[:']" name)) nil + (setq name (concat package name)))) + (setq index (imenu-example--name-and-position)) + (setcar index name) + (if (eq fchar ?p) + (push index index-pack-alist) + (push index index-alist)) + (push index index-unsorted-alist))) + (t ; Pod section + ;; (beginning-of-line) + (setq index (imenu-example--name-and-position) + name (buffer-substring (match-beginning 5) (match-end 5))) + (if (eq (char-after (match-beginning 4)) ?2) + (setq name (concat " " name))) (setcar index name) - (if (eq fchar ?p) - (push index index-pack-alist) - (push index index-alist))))) + (setq index1 (cons (concat "=" name) (cdr index))) + (push index index-pod-alist) + (push index1 index-unsorted-alist))))) (imenu-progress-message prev-pos 100) + (setq index-alist + (if (default-value 'imenu-sort-function) + (sort index-alist (default-value 'imenu-sort-function)) + (nreverse index-alist))) + (and index-pod-alist + (push (cons (imenu-create-submenu-name "+POD headers+") + (nreverse index-pod-alist)) + index-alist)) (and index-pack-alist - (push (cons (imenu-create-submenu-name "Packages") index-pack-alist) + (push (cons (imenu-create-submenu-name "+Packages+") + (nreverse index-pack-alist)) + index-alist)) + (and (or index-pack-alist index-pod-alist + (default-value 'imenu-sort-function)) + index-unsorted-alist + (push (cons (imenu-create-submenu-name "+Unsorted List+") + (nreverse index-unsorted-alist)) index-alist)) - (nreverse index-alist))) + index-alist)) (defvar cperl-compilation-error-regexp-alist ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). @@ -1918,17 +2197,27 @@ indentation and initial hashes. Behaves usually outside of comment." (eq major-mode 'perl-mode) (eq major-mode 'cperl-mode)) (progn - (or cperl-faces-init (cperl-init-faces)) - (setq font-lock-keywords perl-font-lock-keywords - cperl-faces-init t))))))) + (or cperl-faces-init (cperl-init-faces)))))))) + +(defvar perl-font-lock-keywords-1 nil + "Additional expressions to highlight in Perl mode. Minimal set.") +(defvar perl-font-lock-keywords nil + "Additional expressions to highlight in Perl mode. Default set.") +(defvar perl-font-lock-keywords-2 nil + "Additional expressions to highlight in Perl mode. Maximal set") (defun cperl-init-faces () (condition-case nil (progn (require 'font-lock) - (let (t-font-lock-keywords) + (and (fboundp 'font-lock-fontify-anchored-keywords) + (featurep 'font-lock-extra) + (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) + (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) ;;(defvar cperl-font-lock-enhanced nil ;; "Set to be non-nil if font-lock allows active highlights.") + (if (fboundp 'font-lock-fontify-anchored-keywords) + (setq font-lock-anchored t)) (setq t-font-lock-keywords (list @@ -2036,64 +2325,78 @@ indentation and initial hashes. Behaves usually outside of comment." ;; "\\|") '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0 font-lock-function-name-face) ; Not very good, triggers at "[a-z]" - '("\\<sub[ \t]+\\([^ \t{]+\\)[ \t]*[{\n]" 1 + '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1 font-lock-function-name-face) - '("\\<\\(package\\|require\\|use\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B; + '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B; 2 font-lock-function-name-face) - (if (featurep 'font-lock-extra) - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" - (2 font-lock-string-face t) - (0 '(restart 2 t))) ; To highlight $a{bc}{ef} - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" - 2 font-lock-string-face t)) + (cond ((featurep 'font-lock-extra) + '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" + (2 font-lock-string-face t) + (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} + (font-lock-anchored + '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" + (2 font-lock-string-face t) + ("\\=[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" + nil nil + (1 font-lock-string-face t)))) + (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\([a-zA-Z0-9_:]+\\)[ \t]*}" + 2 font-lock-string-face t))) '("[ \t{,(]\\([a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 font-lock-reference-face) ; labels '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets 2 font-lock-reference-face) - (if (featurep 'font-lock-extra) - '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%][a-zA-Z0-9_]+\\)\\([ \t]*,\\)?" - (3 font-lock-variable-name-face) - (4 '(another 4 nil - ("[ \t]*,[ \t]*\\([$@%][a-zA-Z0-9_]+\\)\\([ \t]*,\\)?" - (1 font-lock-variable-name-face) - (2 '(restart 2 nil) nil t))) - nil t)) ; local variables, multiple - '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%][a-zA-Z0-9_]+\\)" - 3 font-lock-variable-name-face)) + (cond ((featurep 'font-lock-extra) + '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" + (3 font-lock-variable-name-face) + (4 '(another 4 nil + ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" + (1 font-lock-variable-name-face) + (2 '(restart 2 nil) nil t))) + nil t))) ; local variables, multiple + (font-lock-anchored + '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" + (3 font-lock-variable-name-face) + ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)" + nil nil + (1 font-lock-variable-name-face)))) + (t '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" + 3 font-lock-variable-name-face))) '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" 2 font-lock-variable-name-face))) - (if (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock - (not (cperl-xemacs-p))) ; not yet as of XEmacs 19.12 - (setq t-font-lock-keywords - (append - t-font-lock-keywords - '(("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - font-lock-other-emphasized-face - 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") + (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]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + font-lock-other-emphasized-face + 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_]\\)\\|\\(/\\)\\)" - ;;(3 font-lock-function-name-face t t) - ;;(4 - ;; (if (cperl-slash-is-regexp) - ;; font-lock-function-name-face 'default) nil t)) - )))) - (defconst perl-font-lock-keywords t-font-lock-keywords - "Additional expressions to highlight in Perl mode.")) + ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" + ;;(3 font-lock-function-name-face t t) + ;;(4 + ;; (if (cperl-slash-is-regexp) + ;; font-lock-function-name-face 'default) nil t)) + ))) + (setq perl-font-lock-keywords-1 t-font-lock-keywords + perl-font-lock-keywords perl-font-lock-keywords-1 + perl-font-lock-keywords-2 (append + t-font-lock-keywords + t-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) - (if (featurep 'font-lock-extra) + (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) (font-lock-require-faces (list ;; Color-light Color-dark Gray-light Gray-dark Mono @@ -2319,7 +2622,8 @@ indentation and initial hashes. Behaves usually outside of comment." (if (is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) (if (is-face 'font-lock-reference-face) nil - (copy-face 'italic 'font-lock-reference-face))))) + (copy-face 'italic 'font-lock-reference-face)))) + (setq cperl-faces-init t)) (error nil))) @@ -2413,7 +2717,7 @@ Available styles are GNU, K&R, BSD and Whitesmith." read)))) (let ((buffer (current-buffer)) - (cmd-desc (concat "^" (regexp-quote command) "[ \t\n]")) + (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" pos) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) @@ -2428,7 +2732,7 @@ Available styles are GNU, K&R, BSD and Whitesmith." (pop-to-buffer (cperl-info-buffer)) (set-window-start (selected-window) pos)) (message "No entry for %s found." command)) - (pop-to-buffer buffer))) + (pop-to-buffer buffer))) (defun cperl-info-on-current-command () "Shows documentation for Perl command at point in other window." @@ -136,6 +136,7 @@ #define oldbufptr Perl_oldbufptr #define oldoldbufptr Perl_oldoldbufptr #define op Perl_op +#define op_desc Perl_op_desc #define op_name Perl_op_name #define op_seqmax Perl_op_seqmax #define opargs Perl_opargs @@ -268,10 +269,14 @@ #define yysindex Perl_yysindex #define yytable Perl_yytable #define yyval Perl_yyval +#define Gv_AMupdate Perl_Gv_AMupdate +#define amagic_call Perl_amagic_call #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply +#define assertref Perl_assertref #define av_clear Perl_av_clear +#define av_extend Perl_av_extend #define av_fake Perl_av_fake #define av_fetch Perl_av_fetch #define av_fill Perl_av_fill @@ -288,8 +293,10 @@ #define block_start Perl_block_start #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 chsize Perl_chsize #define ck_aelem Perl_ck_aelem #define ck_concat Perl_ck_concat #define ck_eof Perl_ck_eof @@ -320,17 +327,21 @@ #define convert Perl_convert #define cpytill Perl_cpytill #define croak Perl_croak +#define cv_clone Perl_cv_clone #define cv_undef Perl_cv_undef +#define cx_dump Perl_cx_dump #define cxinc Perl_cxinc #define deb Perl_deb #define deb_growlevel Perl_deb_growlevel #define debop Perl_debop +#define debprofdump Perl_debprofdump #define debstack Perl_debstack #define debstackptrs Perl_debstackptrs #define deprecate Perl_deprecate #define die Perl_die #define die_where Perl_die_where #define do_aexec Perl_do_aexec +#define do_chomp Perl_do_chomp #define do_chop Perl_do_chop #define do_close Perl_do_close #define do_eof Perl_do_eof @@ -346,7 +357,6 @@ #define do_pipe Perl_do_pipe #define do_print Perl_do_print #define do_readline Perl_do_readline -#define do_chomp Perl_do_chomp #define do_seek Perl_do_seek #define do_semop Perl_do_semop #define do_shmio Perl_do_shmio @@ -358,10 +368,14 @@ #define doeval Perl_doeval #define dofindlabel Perl_dofindlabel #define dopoptoeval Perl_dopoptoeval +#define dounwind Perl_dounwind #define dowantarray Perl_dowantarray #define dump_all Perl_dump_all #define dump_eval Perl_dump_eval +#define dump_fds Perl_dump_fds +#define dump_form Perl_dump_form #define dump_gv Perl_dump_gv +#define dump_mstats Perl_dump_mstats #define dump_op Perl_dump_op #define dump_packsubs Perl_dump_packsubs #define dump_pm Perl_dump_pm @@ -370,8 +384,12 @@ #define fbm_instr Perl_fbm_instr #define fetch_gv Perl_fetch_gv #define fetch_io Perl_fetch_io +#define filter_add Perl_filter_add +#define filter_del Perl_filter_del +#define filter_read Perl_filter_read #define fold_constants Perl_fold_constants #define force_ident Perl_force_ident +#define force_list Perl_force_list #define force_next Perl_force_next #define force_word Perl_force_word #define free_tmps Perl_free_tmps @@ -380,6 +398,7 @@ #define gp_ref Perl_gp_ref #define gv_AVadd Perl_gv_AVadd #define gv_HVadd Perl_gv_HVadd +#define gv_IOadd Perl_gv_IOadd #define gv_check Perl_gv_check #define gv_efullname Perl_gv_efullname #define gv_fetchfile Perl_gv_fetchfile @@ -398,13 +417,13 @@ #define hv_delete Perl_hv_delete #define hv_exists Perl_hv_exists #define hv_fetch Perl_hv_fetch -#define hv_stashpv Perl_hv_stashpv #define hv_iterinit Perl_hv_iterinit #define hv_iterkey Perl_hv_iterkey #define hv_iternext Perl_hv_iternext #define hv_iternextsv Perl_hv_iternextsv #define hv_iterval Perl_hv_iterval #define hv_magic Perl_hv_magic +#define hv_stashpv Perl_hv_stashpv #define hv_store Perl_hv_store #define hv_undef Perl_hv_undef #define ibcmp Perl_ibcmp @@ -422,7 +441,9 @@ #define listkids Perl_listkids #define localize Perl_localize #define looks_like_number Perl_looks_like_number +#define magic_clearenv Perl_magic_clearenv #define magic_clearpack Perl_magic_clearpack +#define magic_existspack Perl_magic_existspack #define magic_get Perl_magic_get #define magic_getarylen Perl_magic_getarylen #define magic_getglob Perl_magic_getglob @@ -463,22 +484,29 @@ #define mod Perl_mod #define modkids Perl_modkids #define moreswitches Perl_moreswitches +#define mstats Perl_mstats #define my Perl_my +#define my_bcopy Perl_my_bcopy +#define my_bzero Perl_my_bzero #define my_exit Perl_my_exit +#define my_htonl Perl_my_htonl #define my_lstat Perl_my_lstat +#define my_memcmp Perl_my_memcmp +#define my_ntohl Perl_my_ntohl #define my_pclose Perl_my_pclose #define my_popen Perl_my_popen #define my_setenv Perl_my_setenv #define my_stat Perl_my_stat +#define my_swap Perl_my_swap #define my_unexec Perl_my_unexec #define newANONHASH Perl_newANONHASH #define newANONLIST Perl_newANONLIST +#define newANONSUB Perl_newANONSUB #define newASSIGNOP Perl_newASSIGNOP #define newAV Perl_newAV #define newAVREF Perl_newAVREF #define newBINOP Perl_newBINOP #define newCONDOP Perl_newCONDOP -#define newCVOP Perl_newCVOP #define newCVREF Perl_newCVREF #define newFORM Perl_newFORM #define newFOROP Perl_newFOROP @@ -492,11 +520,10 @@ #define newLOGOP Perl_newLOGOP #define newLOOPEX Perl_newLOOPEX #define newLOOPOP Perl_newLOOPOP -#define newMETHOD Perl_newMETHOD #define newNULLLIST Perl_newNULLLIST #define newOP Perl_newOP -#define newPROG Perl_newPROG #define newPMOP Perl_newPMOP +#define newPROG Perl_newPROG #define newPVOP Perl_newPVOP #define newRANGE Perl_newRANGE #define newRV Perl_newRV @@ -509,11 +536,12 @@ #define newSViv Perl_newSViv #define newSVnv Perl_newSVnv #define newSVpv Perl_newSVpv +#define newSVrv Perl_newSVrv #define newSVsv Perl_newSVsv #define newUNOP Perl_newUNOP #define newWHILEOP Perl_newWHILEOP -#define newXSUB Perl_newXSUB #define newXS Perl_newXS +#define newXSUB Perl_newXSUB #define nextargv Perl_nextargv #define ninstr Perl_ninstr #define no_fh_allowed Perl_no_fh_allowed @@ -533,6 +561,7 @@ #define pad_swipe Perl_pad_swipe #define peep Perl_peep #define pidgone Perl_pidgone +#define pmflag Perl_pmflag #define pmruntime Perl_pmruntime #define pmtrans Perl_pmtrans #define pop_return Perl_pop_return @@ -559,6 +588,7 @@ #define pp_caller Perl_pp_caller #define pp_chdir Perl_pp_chdir #define pp_chmod Perl_pp_chmod +#define pp_chomp Perl_pp_chomp #define pp_chop Perl_pp_chop #define pp_chown Perl_pp_chown #define pp_chroot Perl_pp_chroot @@ -742,6 +772,7 @@ #define pp_predec Perl_pp_predec #define pp_preinc Perl_pp_preinc #define pp_print Perl_pp_print +#define pp_prototype Perl_pp_prototype #define pp_prtf Perl_pp_prtf #define pp_push Perl_pp_push #define pp_pushmark Perl_pp_pushmark @@ -774,9 +805,9 @@ #define pp_rv2gv Perl_pp_rv2gv #define pp_rv2hv Perl_pp_rv2hv #define pp_rv2sv Perl_pp_rv2sv -#define pp_chomp Perl_pp_chomp #define pp_sassign Perl_pp_sassign #define pp_scalar Perl_pp_scalar +#define pp_schomp Perl_pp_schomp #define pp_schop Perl_pp_schop #define pp_scmp Perl_pp_scmp #define pp_scope Perl_pp_scope @@ -817,7 +848,6 @@ #define pp_sqrt Perl_pp_sqrt #define pp_srand Perl_pp_srand #define pp_srefgen Perl_pp_srefgen -#define pp_schomp Perl_pp_schomp #define pp_sselect Perl_pp_sselect #define pp_sservent Perl_pp_sservent #define pp_ssockopt Perl_pp_ssockopt @@ -828,7 +858,6 @@ #define pp_substcont Perl_pp_substcont #define pp_substr Perl_pp_substr #define pp_subtract Perl_pp_subtract -#define pp_sv2len Perl_pp_sv2len #define pp_symlink Perl_pp_symlink #define pp_syscall Perl_pp_syscall #define pp_sysread Perl_pp_sysread @@ -837,6 +866,7 @@ #define pp_tell Perl_pp_tell #define pp_telldir Perl_pp_telldir #define pp_tie Perl_pp_tie +#define pp_tied Perl_pp_tied #define pp_time Perl_pp_time #define pp_tms Perl_pp_tms #define pp_trans Perl_pp_trans @@ -858,28 +888,28 @@ #define pp_wantarray Perl_pp_wantarray #define pp_warn Perl_pp_warn #define pp_xor Perl_pp_xor +#define pregcomp Perl_pregcomp +#define pregexec Perl_pregexec +#define pregfree Perl_pregfree #define prepend_elem Perl_prepend_elem #define push_return Perl_push_return #define push_scope Perl_push_scope #define q Perl_q #define ref Perl_ref #define refkids Perl_refkids -#define pregcomp Perl_pregcomp #define regdump Perl_regdump -#define pregexec Perl_pregexec -#define pregfree Perl_pregfree #define regnext Perl_regnext #define regprop Perl_regprop #define repeatcpy Perl_repeatcpy #define rninstr Perl_rninstr #define run Perl_run -#define savepv Perl_savepv -#define savepvn Perl_savepvn +#define same_dirent Perl_same_dirent #define save_I32 Perl_save_I32 #define save_aptr Perl_save_aptr #define save_ary Perl_save_ary #define save_clearsv Perl_save_clearsv #define save_delete Perl_save_delete +#define save_destructor Perl_save_destructor #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv #define save_freesv Perl_save_freesv @@ -888,10 +918,14 @@ #define save_int Perl_save_int #define save_item Perl_save_item #define save_list Perl_save_list +#define save_long Perl_save_long #define save_nogv Perl_save_nogv +#define save_pptr Perl_save_pptr #define save_scalar Perl_save_scalar #define save_sptr Perl_save_sptr #define save_svref Perl_save_svref +#define savepv Perl_savepv +#define savepvn Perl_savepvn #define savestack_grow Perl_savestack_grow #define sawparens Perl_sawparens #define scalar Perl_scalar @@ -916,6 +950,7 @@ #define screaminstr Perl_screaminstr #define setdefout Perl_setdefout #define setenv_getix Perl_setenv_getix +#define sighandler Perl_sighandler #define skipspace Perl_skipspace #define stack_grow Perl_stack_grow #define start_subparse Perl_start_subparse @@ -943,6 +978,7 @@ #define sv_dump Perl_sv_dump #define sv_eq Perl_sv_eq #define sv_free Perl_sv_free +#define sv_free_arenas Perl_sv_free_arenas #define sv_gets Perl_sv_gets #define sv_grow Perl_sv_grow #define sv_inc Perl_sv_inc @@ -953,8 +989,11 @@ #define sv_magic Perl_sv_magic #define sv_mortalcopy Perl_sv_mortalcopy #define sv_newmortal Perl_sv_newmortal +#define sv_newref Perl_sv_newref #define sv_peek Perl_sv_peek +#define sv_pvn_force Perl_sv_pvn_force #define sv_ref Perl_sv_ref +#define sv_reftype Perl_sv_reftype #define sv_replace Perl_sv_replace #define sv_report_used Perl_sv_report_used #define sv_reset Perl_sv_reset @@ -964,9 +1003,12 @@ #define sv_setpv Perl_sv_setpv #define sv_setpvn Perl_sv_setpvn #define sv_setref_iv Perl_sv_setref_iv +#define sv_setref_nv Perl_sv_setref_nv #define sv_setref_pv Perl_sv_setref_pv +#define sv_setref_pvn Perl_sv_setref_pvn #define sv_setsv Perl_sv_setsv #define sv_unmagic Perl_sv_unmagic +#define sv_unref Perl_sv_unref #define sv_upgrade Perl_sv_upgrade #define sv_usepvn Perl_sv_usepvn #define taint_env Perl_taint_env @@ -974,6 +1016,8 @@ #define taint_proper Perl_taint_proper #define too_few_arguments Perl_too_few_arguments #define too_many_arguments Perl_too_many_arguments +#define unlnk Perl_unlnk +#define utilize Perl_utilize #define wait4pid Perl_wait4pid #define warn Perl_warn #define watch Perl_watch @@ -984,7 +1028,6 @@ #define xpv_root Perl_xpv_root #define xrv_root Perl_xrv_root #define yyerror Perl_yyerror -#define yyerror Perl_yyerror #define yylex Perl_yylex #define yyparse Perl_yyparse #define yywarn Perl_yywarn @@ -1087,8 +1130,6 @@ #define mystack_sp (curinterp->Imystack_sp) #define mystrk (curinterp->Imystrk) #define nrs (curinterp->Inrs) -#define nrschar (curinterp->Inrschar) -#define nrslen (curinterp->Inrslen) #define ofmt (curinterp->Iofmt) #define ofs (curinterp->Iofs) #define ofslen (curinterp->Iofslen) @@ -1113,9 +1154,6 @@ #define restartop (curinterp->Irestartop) #define rightgv (curinterp->Irightgv) #define rs (curinterp->Irs) -#define rschar (curinterp->Irschar) -#define rslen (curinterp->Irslen) -#define rspara (curinterp->Irspara) #define runlevel (curinterp->Irunlevel) #define sawampersand (curinterp->Isawampersand) #define sawi (curinterp->Isawi) @@ -1246,8 +1284,6 @@ #define Imystack_sp mystack_sp #define Imystrk mystrk #define Inrs nrs -#define Inrschar nrschar -#define Inrslen nrslen #define Iofmt ofmt #define Iofs ofs #define Iofslen ofslen @@ -1272,9 +1308,6 @@ #define Irestartop restartop #define Irightgv rightgv #define Irs rs -#define Irschar rschar -#define Irslen rslen -#define Irspara rspara #define Irunlevel runlevel #define Isawampersand sawampersand #define Isawi sawi diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 08463dfabc..6ca011b5d0 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -170,12 +170,12 @@ sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } package DB_File ; use Carp; -$VERSION = 1.01 ; +$VERSION = $VERSION = 1.01 ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; -$DB_BTREE = TIEHASH DB_File::BTREEINFO ; -$DB_HASH = TIEHASH DB_File::HASHINFO ; -$DB_RECNO = TIEHASH DB_File::RECNOINFO ; +$DB_BTREE = $DB_BTREE = TIEHASH DB_File::BTREEINFO ; +$DB_HASH = $DB_HASH = TIEHASH DB_File::HASHINFO ; +$DB_RECNO = $DB_RECNO = TIEHASH DB_File::RECNOINFO ; require TieHash; require Exporter; @@ -233,11 +233,7 @@ sub AUTOLOAD { goto &$AUTOLOAD; } -@liblist = (); -@liblist = split ' ', $Config::Config{"DB_File_loadlibs"} - if defined $Config::Config{"DB_File_loadlibs"}; - -bootstrap DB_File @liblist; +bootstrap DB_File ; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index f67e6cd642..4cda63507d 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -5,7 +5,7 @@ WriteMakefile( LIBS => ["-L/usr/local/lib -ldb"], MAN3PODS => ' ', # Pods will be built by installman. #INC => '-I/usr/local/include', - VERSION => 1.01, + VERSION_FROM => 'DB_File.pm', XSPROTOARG => '-noprototypes', # XXX remove later? ); diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index 8de1808151..d809b82eaf 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -18,6 +18,7 @@ require AutoLoader; @ISA=qw(AutoLoader); +$VERSION = $VERSION = "1.00" ; sub import { } # override import inherited from AutoLoader diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index 1b1bf7ee24..3dd655da5b 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -6,6 +6,7 @@ WriteMakefile( MAN3PODS => ' ', # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'DynaLoader.pm', clean => {FILES => 'DynaLoader.c'}, ); diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index b9251509db..aef7ad3d00 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -27,6 +27,7 @@ require Exporter; use AutoLoader; require DynaLoader; @ISA = qw(Exporter DynaLoader); +$VERSION = $VERSION = "1.00"; # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @EXPORT = diff --git a/ext/Fcntl/Makefile.PL b/ext/Fcntl/Makefile.PL index c432e1aa63..9dc0474e7e 100644 --- a/ext/Fcntl/Makefile.PL +++ b/ext/Fcntl/Makefile.PL @@ -2,5 +2,6 @@ use ExtUtils::MakeMaker; WriteMakefile( MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'Fcntl.pm', ); diff --git a/ext/FileHandle/FileHandle.pm b/ext/FileHandle/FileHandle.pm new file mode 100644 index 0000000000..93a3088886 --- /dev/null +++ b/ext/FileHandle/FileHandle.pm @@ -0,0 +1,426 @@ +package FileHandle; + +=head1 NAME + +FileHandle - supply object methods for filehandles + +=head1 SYNOPSIS + + use FileHandle; + + $fh = new FileHandle; + if ($fh->open "< file") { + print <$fh>; + $fh->close; + } + + $fh = new FileHandle "> FOO"; + if (defined $fh) { + print $fh "bar\n"; + $fh->close; + } + + $fh = new FileHandle "file", "r"; + if (defined $fh) { + print <$fh>; + undef $fh; # automatically closes the file + } + + $fh = new FileHandle "file", O_WRONLY|O_APPEND; + if (defined $fh) { + print $fh "corge\n"; + undef $fh; # automatically closes the file + } + + ($readfh, $writefh) = FileHandle::pipe; + + autoflush STDOUT 1; + +=head1 DESCRIPTION + +C<FileHandle::new> creates a C<FileHandle>, which is a reference to a +newly created symbol (see the C<Symbol> package). If it receives any +parameters, they are passed to C<FileHandle::open>; if the open fails, +the C<FileHandle> object is destroyed. Otherwise, it is returned to +the caller. + +C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does. +It requires two parameters, which are passed to C<FileHandle::fdopen>; +if the fdopen fails, the C<FileHandle> object is destroyed. +Otherwise, it is returned to the caller. + +C<FileHandle::open> accepts one parameter or two. With one parameter, +it is just a front end for the built-in C<open> function. With two +parameters, the first parameter is a filename that may include +whitespace or other special characters, and the second parameter is +the open mode in either Perl form (">", "+<", etc.) or POSIX form +("w", "r+", etc.). + +C<FileHandle::fdopen> is like C<open> except that its first parameter +is not a filename but rather a file handle name, a FileHandle object, +or a file descriptor number. + +See L<perlfunc> for complete descriptions of each of the following +supported C<FileHandle> methods, which are just front ends for the +corresponding built-in functions: + + close + fileno + getc + gets + eof + clearerr + seek + tell + +See L<perlvar> for complete descriptions of each of the following +supported C<FileHandle> methods: + + autoflush + output_field_separator + output_record_separator + input_record_separator + input_line_number + format_page_number + format_lines_per_page + format_lines_left + format_name + format_top_name + format_line_break_characters + format_formfeed + +Furthermore, for doing normal I/O you might need these: + +=over + +=item $fh->print + +See L<perlfunc/print>. + +=item $fh->printf + +See L<perlfunc/printf>. + +=item $fh->getline + +This works like <$fh> described in L<perlop/"I/O Operators"> +except that it's more readable and can be safely called in an +array context but still returns just one line. + +=item $fh->getlines + +This works like <$fh> when called in an array context to +read all the remaining lines in a file, except that it's more readable. +It will also croak() if accidentally called in a scalar context. + +=back + +=head1 SEE ALSO + +L<perlfunc>, +L<perlop/"I/O Operators">, +L<POSIX/"FileHandle"> + +=head1 BUGS + +Due to backwards compatibility, all filehandles resemble objects +of class C<FileHandle>, or actually classes derived from that class. +They actually aren't. Which means you can't derive your own +class from C<FileHandle> and inherit those methods. + +=cut + +require 5.000; +use Carp; +use Fcntl; +use Symbol; +use English; +use SelectSaver; + +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); + +@EXPORT = (@Fcntl::EXPORT, + qw(_IOFBF _IOLBF _IONBF)); + +@EXPORT_OK = qw( + autoflush + output_field_separator + output_record_separator + input_record_separator + input_line_number + format_page_number + format_lines_per_page + format_lines_left + format_name + format_top_name + format_line_break_characters + format_formfeed + + print + printf + getline + getlines +); + + +################################################ +## Interaction with the XS. +## + +bootstrap FileHandle; + +sub AUTOLOAD { + if ($AUTOLOAD =~ /::(_?[a-z])/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD + } + my $constname = $AUTOLOAD; + $constname =~ s/.*:://; + my $val = constant($constname); + defined $val or croak "$constname is not a valid FileHandle macro"; + *$AUTOLOAD = sub { $val }; + goto &$AUTOLOAD; +} + + +################################################ +## Constructors, destructors. +## + +sub new { + @_ >= 1 && @_ <= 3 or croak 'usage: new FileHandle [FILENAME [,MODE]]'; + my $class = shift; + my $fh = gensym; + if (@_) { + FileHandle::open($fh, @_) + or return undef; + } + bless $fh, $class; +} + +sub new_from_fd { + @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE'; + my $class = shift; + my $fh = gensym; + FileHandle::fdopen($fh, @_) + or return undef; + bless $fh, $class; +} + +sub DESTROY { + my ($fh) = @_; + close($fh); +} + +################################################ +## Open and close. +## + +sub pipe { + @_ and croak 'usage: FileHandle::pipe()'; + my $readfh = new FileHandle; + my $writefh = new FileHandle; + pipe($readfh, $writefh) + or return undef; + ($readfh, $writefh); +} + +sub _open_mode_string { + my ($mode) = @_; + $mode =~ /^\+?(<|>>?)$/ + or $mode =~ s/^r(\+?)$/$1</ + or $mode =~ s/^w(\+?)$/$1>/ + or $mode =~ s/^a(\+?)$/$1>>/ + or croak "FileHandle: bad open mode: $mode"; + $mode; +} + +sub open { + @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; + my ($fh, $file) = @_; + if (@_ > 2) { + my ($mode, $perms) = @_[2, 3]; + if ($mode =~ /^\d+$/) { + defined $perms or $perms = 0666; + return sysopen($fh, $file, $mode, $perms); + } + $file = "./" . $file unless $file =~ m#^/#; + $file = _open_mode_string($mode) . " $file\0"; + } + open($fh, $file); +} + +sub fdopen { + @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)'; + my ($fh, $fd, $mode) = @_; + if (ref($fd) =~ /GLOB\(/) { + # It's a glob reference; remove the star from its name. + ($fd = "".$$fd) =~ s/^\*//; + } elsif ($fd =~ m#^\d+$#) { + # It's an FD number; prefix with "=". + $fd = "=$fd"; + } + open($fh, _open_mode_string($mode) . '&' . $fd); +} + +sub close { + @_ == 1 or croak 'usage: $fh->close()'; + close($_[0]); +} + +################################################ +## Normal I/O functions. +## + +sub fileno { + @_ == 1 or croak 'usage: $fh->fileno()'; + fileno($_[0]); +} + +sub getc { + @_ == 1 or croak 'usage: $fh->getc()'; + getc($_[0]); +} + +sub gets { + @_ == 1 or croak 'usage: $fh->gets()'; + my ($handle) = @_; + scalar <$handle>; +} + +sub eof { + @_ == 1 or croak 'usage: $fh->eof()'; + eof($_[0]); +} + +sub clearerr { + @_ == 1 or croak 'usage: $fh->clearerr()'; + seek($_[0], 0, 1); +} + +sub seek { + @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)'; + seek($_[0], $_[1], $_[2]); +} + +sub tell { + @_ == 1 or croak 'usage: $fh->tell()'; + tell($_[0]); +} + +sub print { + @_ or croak 'usage: $fh->print([ARGS])'; + my $this = shift; + print $this @_; +} + +sub printf { + @_ or croak 'usage: $fh->printf([ARGS])'; + my $this = shift; + printf $this @_; +} + +sub getline { + @_ == 1 or croak 'usage: $fh->getline'; + my $this = shift; + return scalar <$this>; +} + +sub getlines { + @_ == 1 or croak 'usage: $fh->getline()'; + my $this = shift; + wantarray or croak "Can't call FileHandle::getlines in a scalar context"; + return <$this>; +} + +################################################ +## State modification functions. +## + +sub autoflush { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_AUTOFLUSH; + $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; + $prev; +} + +sub output_field_separator { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_FIELD_SEPARATOR; + $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; + $prev; +} + +sub output_record_separator { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_RECORD_SEPARATOR; + $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; + $prev; +} + +sub input_record_separator { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $INPUT_RECORD_SEPARATOR; + $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; + $prev; +} + +sub input_line_number { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $INPUT_LINE_NUMBER; + $INPUT_LINE_NUMBER = $_[1] if @_ > 1; + $prev; +} + +sub format_page_number { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_PAGE_NUMBER; + $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; + $prev; +} + +sub format_lines_per_page { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINES_PER_PAGE; + $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1; + $prev; +} + +sub format_lines_left { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINES_LEFT; + $FORMAT_LINES_LEFT = $_[1] if @_ > 1; + $prev; +} + +sub format_name { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_NAME; + $FORMAT_NAME = qualify($_[1], caller) if @_ > 1; + $prev; +} + +sub format_top_name { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_TOP_NAME; + $FORMAT_TOP_NAME = qualify($_[1], caller) if @_ > 1; + $prev; +} + +sub format_line_break_characters { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINE_BREAK_CHARACTERS; + $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1; + $prev; +} + +sub format_formfeed { + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_FORMFEED; + $FORMAT_FORMFEED = $_[1] if @_ > 1; + $prev; +} + +1; diff --git a/ext/FileHandle/FileHandle.xs b/ext/FileHandle/FileHandle.xs new file mode 100644 index 0000000000..d9c8b68dc1 --- /dev/null +++ b/ext/FileHandle/FileHandle.xs @@ -0,0 +1,159 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <stdio.h> + +typedef int SysRet; +typedef FILE * InputStream; +typedef FILE * OutputStream; + +static bool +constant(name, pval) +char *name; +IV *pval; +{ + switch (*name) { + case '_': + if (strEQ(name, "_IOFBF")) +#ifdef _IOFBF + { *pval = _IOFBF; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "_IOLBF")) +#ifdef _IOLBF + { *pval = _IOLBF; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "_IONBF")) +#ifdef _IONBF + { *pval = _IONBF; return TRUE; } +#else + return FALSE; +#endif + break; + } + + return FALSE; +} + + +MODULE = FileHandle PACKAGE = FileHandle PREFIX = f + +SV * +constant(name) + char * name + CODE: + IV i; + if (constant(name, &i)) + RETVAL = newSViv(i); + else + RETVAL = &sv_undef; + OUTPUT: + RETVAL + +SV * +fgetpos(handle) + InputStream handle + CODE: + if (handle) { + Fpos_t pos; + fgetpos(handle, &pos); + ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); + } + else { + ST(0) = &sv_undef; + errno = EINVAL; + } + +SysRet +fsetpos(handle, pos) + InputStream handle + SV * pos + CODE: + if (handle) + RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos)); + else { + RETVAL = -1; + errno = EINVAL; + } + OUTPUT: + RETVAL + +int +ungetc(handle, c) + InputStream handle + int c + CODE: + if (handle) + RETVAL = ungetc(c, handle); + else { + RETVAL = -1; + errno = EINVAL; + } + OUTPUT: + RETVAL + +OutputStream +new_tmpfile(packname = "FileHandle") + char * packname + CODE: + RETVAL = tmpfile(); + OUTPUT: + RETVAL + +int +ferror(handle) + InputStream handle + CODE: + if (handle) + RETVAL = ferror(handle); + else { + RETVAL = -1; + errno = EINVAL; + } + OUTPUT: + RETVAL + +SysRet +fflush(handle) + OutputStream handle + CODE: + if (handle) + RETVAL = fflush(handle); + else { + RETVAL = -1; + errno = EINVAL; + } + OUTPUT: + RETVAL + +void +setbuf(handle, buf) + OutputStream handle + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; + CODE: + if (handle) + setbuf(handle, buf); + + +#ifdef _IOFBF + +SysRet +setvbuf(handle, buf, type, size) + OutputStream handle + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + int type + int size + CODE: + if (handle) + RETVAL = setvbuf(handle, buf, type, size); + else { + RETVAL = -1; + errno = EINVAL; + } + OUTPUT: + RETVAL + +#endif /* _IOFBF */ diff --git a/ext/FileHandle/Makefile.PL b/ext/FileHandle/Makefile.PL new file mode 100644 index 0000000000..8424f4d985 --- /dev/null +++ b/ext/FileHandle/Makefile.PL @@ -0,0 +1,5 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? +); diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 179f9a96e8..ed80aa9c6b 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -56,6 +56,8 @@ require DynaLoader; GDBM_WRITER ); +$VERSION = $VERSION = "1.00"; + sub AUTOLOAD { local($constname); ($constname = $AUTOLOAD) =~ s/.*:://; diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index 5567020391..a423c88c70 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -233,7 +233,7 @@ gdbm_sync(db) GDBM_File db int -gdbm_exists(db, key) +gdbm_EXISTS(db, key) GDBM_File db datum key diff --git a/ext/GDBM_File/Makefile.PL b/ext/GDBM_File/Makefile.PL index 627800899b..1925623031 100644 --- a/ext/GDBM_File/Makefile.PL +++ b/ext/GDBM_File/Makefile.PL @@ -3,4 +3,5 @@ WriteMakefile( LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"], MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'GDBM_File.pm', ); diff --git a/ext/NDBM_File/Makefile.PL b/ext/NDBM_File/Makefile.PL index c765dd5cd9..9fd37eb85e 100644 --- a/ext/NDBM_File/Makefile.PL +++ b/ext/NDBM_File/Makefile.PL @@ -3,4 +3,5 @@ WriteMakefile( LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'NDBM_File.pm', ); diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm index e40fe854fe..53a136ebf0 100644 --- a/ext/NDBM_File/NDBM_File.pm +++ b/ext/NDBM_File/NDBM_File.pm @@ -4,6 +4,8 @@ require TieHash; require DynaLoader; @ISA = qw(TieHash DynaLoader); +$VERSION = $VERSION = "1.00"; + bootstrap NDBM_File; 1; diff --git a/ext/ODBM_File/Makefile.PL b/ext/ODBM_File/Makefile.PL index 495df3ad1f..9662f6e63a 100644 --- a/ext/ODBM_File/Makefile.PL +++ b/ext/ODBM_File/Makefile.PL @@ -3,4 +3,5 @@ WriteMakefile( LIBS => ["-ldbm -lucb"], MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'ODBM_File.pm', ); diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm index d844c673c3..336af3dba1 100644 --- a/ext/ODBM_File/ODBM_File.pm +++ b/ext/ODBM_File/ODBM_File.pm @@ -4,6 +4,8 @@ require TieHash; require DynaLoader; @ISA = qw(TieHash DynaLoader); +$VERSION = $VERSION = "1.00"; + bootstrap ODBM_File; 1; diff --git a/ext/ODBM_File/hints/dec_osf.pl b/ext/ODBM_File/hints/dec_osf.pl new file mode 100644 index 0000000000..f041bf96c0 --- /dev/null +++ b/ext/ODBM_File/hints/dec_osf.pl @@ -0,0 +1,5 @@ +# The -hidden option causes compilation to fail on Digital Unix. +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# Sat Jan 13 16:29:52 EST 1996 +$self->{LDDLFLAGS} = $Config{lddlflags}; +$self->{LDDLFLAGS} =~ s/-hidden//; diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index 4a7eb9af73..68bce135f8 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -3,4 +3,5 @@ WriteMakefile( LIBS => ["-lm -lposix -lcposix"], MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'POSIX.pm', ); diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index ee35ea20fb..ab309cc609 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -1,12 +1,16 @@ package POSIX; use Carp; -require Exporter; use AutoLoader; -require DynaLoader; require Config; +use Symbol; + +require Exporter; +require DynaLoader; @ISA = qw(Exporter DynaLoader); +$VERSION = $VERSION = "1.00" ; + %EXPORT_TAGS = ( assert_h => [qw(assert NDEBUG)], @@ -78,8 +82,8 @@ require Config; stddef_h => [qw(NULL offsetof)], stdio_h => [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid - L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET STREAM_MAX - TMP_MAX stderr stdin stdout _IOFBF _IOLBF _IONBF + L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET + STREAM_MAX TMP_MAX stderr stdin stdout clearerr fclose fdopen feof ferror fflush fgetc fgetpos fgets fopen fprintf fputc fputs fread freopen fscanf fseek fsetpos ftell fwrite getchar gets @@ -206,30 +210,21 @@ sub AUTOLOAD { } sub usage { - local ($mess) = @_; + my ($mess) = @_; croak "Usage: POSIX::$mess"; } sub redef { - local ($mess) = @_; + my ($mess) = @_; croak "Use method $mess instead"; } sub unimpl { - local ($mess) = @_; + my ($mess) = @_; $mess =~ s/xxx//; croak "Unimplemented: POSIX::$mess"; } -sub gensym { - my $pkg = @_ ? ref($_[0]) || $_[0] : ""; - local *{$pkg . "::GLOB" . ++$seq}; - \delete ${$pkg . "::"}{'GLOB' . $seq}; -} - -sub ungensym { -} - ############################ package POSIX::SigAction; @@ -238,75 +233,6 @@ sub new { } ############################ -package FileHandle; - -sub new { - POSIX::usage "FileHandle->new(filename, posixmode)" if @_ != 3; - local($class,$filename,$mode) = @_; - local($sym) = $class->POSIX::gensym; - $mode =~ s/a.*/>>/ || - $mode =~ s/w.*/>/ || - ($mode = '<'); - open($sym, "$mode $filename") and - bless $sym => $class; -} - -sub new_from_fd { - POSIX::usage "FileHandle->new_from_fd(fd,mode)" if @_ != 3; - local($class,$fd,$mode) = @_; - local($sym) = $class->POSIX::gensym; - $mode =~ s/a.*/>>/ || - $mode =~ s/w.*/>/ || - ($mode = '<'); - open($sym, "$mode&=$fd") and - bless $sym => $class; -} - -sub clearerr { - POSIX::usage "clearerr(filehandle)" if @_ != 1; - seek($_[0], 0, 1); -} - -sub close { - POSIX::usage "close(filehandle)" if @_ != 1; - close($_[0]); -} - -sub DESTROY { - close($_[0]); -} - -sub eof { - POSIX::usage "eof(filehandle)" if @_ != 1; - eof($_[0]); -} - -sub getc { - POSIX::usage "getc(filehandle)" if @_ != 1; - getc($_[0]); -} - -sub gets { - POSIX::usage "gets(filehandle)" if @_ != 1; - local($handle) = @_; - scalar <$handle>; -} - -sub fileno { - POSIX::usage "fileno(filehandle)" if @_ != 1; - fileno($_[0]); -} - -sub seek { - POSIX::usage "seek(filehandle,pos,whence)" if @_ != 3; - seek($_[0], $_[1], $_[2]); -} - -sub tell { - POSIX::usage "tell(filehandle)" if @_ != 1; - tell($_[0]); -} -############################ package POSIX; # return to package POSIX so AutoSplit is happy 1; __END__ @@ -335,7 +261,7 @@ sub closedir { sub opendir { usage "opendir(directory)" if @_ != 1; - local($dirhandle) = POSIX->gensym; + my $dirhandle = gensym; opendir($dirhandle, $_[0]) ? $dirhandle : undef; @@ -807,9 +733,9 @@ sub chmod { sub fstat { usage "fstat(fd)" if @_ != 1; - local(*TMP); + local *TMP; open(TMP, "<&$_[0]"); # Gross. - local(@l) = stat(TMP); + my @l = stat(TMP); close(TMP); @l; } @@ -922,7 +848,7 @@ sub getgid { sub getgroups { usage "getgroups()" if @_ != 0; - local(%seen) = (); + my %seen; grep(!$seen{$_}++, split(' ', $) )); } diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod index 2549a613ac..4b7585117c 100644 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -1230,144 +1230,6 @@ Returns C<undef> on failure. =head1 CLASSES -=head2 FileHandle - -=over 8 - -=item new - -Open a file and return a Perl filehandle. The first parameter is the -filename and the second parameter is the mode. The mode should be specified -as C<a> for append, C<w> for write, and E<lt> or C<""> for read. - -Open a file for reading. - - $fh = FileHandle->new( "foo", "" ); - die "Unable to open foo for reading" unless $fh; - -Open a file for writing. - - $fh = FileHandle->new( "foo", "w" ); - die "Unable to open foo for writing" unless $fh; - -Use C<FileHandle::close()> to close the file or let the FileHandle object's -destructor perform the close. - -=item clearerr - -Resets the error indicator and EOF indicator to zero. - - $fh->clearerr; - -=item close - -Close the file. - - $fh->close; - -=item eof - -Tests for end of file. - - if( $fh->eof ){ - print "end of file\n"; - } - -=item error - -Returns non-zero if there has been an error while reading or writing a file. - - if( $fh->error ){ - print "error\n"; - } - -=item fileno - -Returns the integer file descriptor associated with the file. - - $fileno = $fh->fileno; - -=item flush - -Flush the stream. - - $fh->flush; - -Returns C<undef> on failure. - -=item getc - -Get a character from the stream. - - $ch = $fh->getc; - -=item getpos - -Retrieve the file pointer position. The returned value can be used as an -argument to C<setpos()>. - - $pos = $fh->getpos; - -=item gets - -Retrieve a line from the open file. - - $line = $fh->gets; - -=item new_from_fd - -Open a file using a file descriptor. Return a Perl filehandle. The first -parameter should be a file descriptor, which can come from C<POSIX::open()>. -The second parameter, the mode, should be C<a> for append, C<w> for write, -and E<lt> or C<""> for read. The mode should match the mode which was used -when the file descriptor was created. - - $fd = POSIX::open( "typemap" ); - $fh = FileHandle->new_from_fd( $fd, "<" ); - die "FileHandle failed" unless $fh; - -=item new_tmpfile - -Creates a temporary file, opens it for writing, and returns a Perl -filehandle. Consult your system's C<tmpfile()> manpage for details. - - $fh = FileHandle->new_tmpfile; - die "FileHandle failed" unless $fh; - -=item seek - -Reposition file pointer. - - $fh->seek( 2, &POSIX::SEEK_SET ); - -=item setbuf - - -=item setpos - -Set the file pointer position. - - $pos = $fh->getpos; - $fh->setpos( $pos ); - -Returns C<undef> on failure. - -=item setvbuf - - -Returns C<undef> on failure. - -=item tell - -Returns the current file position, in bytes. - - $pos = $fh->tell; - -=item ungetc - - -=back - =head2 POSIX::SigAction =over 8 @@ -1733,7 +1595,7 @@ EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX RAND_MAX =item Constants -BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX _IOFBF _IOLBF _IONBF +BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX =back @@ -1773,5 +1635,5 @@ WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG =head1 CREATION -This document generated by ./mkposixman.PL version 19951212. +This document generated by ./mkposixman.PL version 19960129. diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 2a6244a752..69db228b33 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -52,8 +52,6 @@ #include <utime.h> #endif -typedef FILE * InputStream; -typedef FILE * OutputStream; typedef int SysRet; typedef long SysRetLong; typedef sigset_t* POSIX__SigSet; @@ -2123,25 +2121,6 @@ int arg; #endif break; } - if (strEQ(name, "_IOFBF")) -#ifdef _IOFBF - return _IOFBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IOLBF")) -#ifdef _IOLBF - return _IOLBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IONBF")) -#ifdef _IONBF - return _IONBF; -#else - goto not_there; -#endif - break; } errno = EINVAL; return 0; @@ -2382,65 +2361,6 @@ setcc(termios_ref, ccix, cc) #endif - -MODULE = FileHandle PACKAGE = FileHandle PREFIX = f - -SV * -fgetpos(handle) - InputStream handle - CODE: - { - Fpos_t pos; - fgetpos(handle, &pos); - ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); - } - -SysRet -fsetpos(handle, pos) - InputStream handle - SV * pos - CODE: - RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos)); - OUTPUT: - RETVAL - -int -ungetc(handle, c) - InputStream handle - int c - CODE: - RETVAL = ungetc(c, handle); - OUTPUT: - RETVAL - -OutputStream -new_tmpfile(packname = "FileHandle") - char * packname - CODE: - RETVAL = tmpfile(); - OUTPUT: - RETVAL - -int -ferror(handle) - InputStream handle - -SysRet -fflush(handle) - OutputStream handle - -void -setbuf(handle, buf) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; - -SysRet -setvbuf(handle, buf, type, size) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; - int type - int size - MODULE = POSIX PACKAGE = POSIX double diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL index 634df7ce0d..2ad5745858 100644 --- a/ext/SDBM_File/Makefile.PL +++ b/ext/SDBM_File/Makefile.PL @@ -9,6 +9,7 @@ WriteMakefile( MYEXTLIB => 'sdbm/libsdbm$(LIB_EXT)', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'SDBM_File.pm', ); diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm index 1f93e52893..d8b80c7a63 100644 --- a/ext/SDBM_File/SDBM_File.pm +++ b/ext/SDBM_File/SDBM_File.pm @@ -4,6 +4,8 @@ require TieHash; require DynaLoader; @ISA = qw(TieHash DynaLoader); +$VERSION = $VERSION = "1.00" ; + bootstrap SDBM_File; 1; diff --git a/ext/Safe/Makefile.PL b/ext/Safe/Makefile.PL index 2024998728..77d3b7372e 100644 --- a/ext/Safe/Makefile.PL +++ b/ext/Safe/Makefile.PL @@ -2,4 +2,5 @@ use ExtUtils::MakeMaker; WriteMakefile( MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'Safe.pm', ); diff --git a/ext/Safe/Safe.pm b/ext/Safe/Safe.pm index 5014b384fc..5f24d1928a 100644 --- a/ext/Safe/Safe.pm +++ b/ext/Safe/Safe.pm @@ -2,8 +2,9 @@ package Safe; require Exporter; require DynaLoader; use Carp; +$VERSION = $VERSION = "1.00"; @ISA = qw(Exporter DynaLoader); -@EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname +@EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname opdesc MAXO emptymask fullmask); =head1 NAME @@ -250,13 +251,6 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk. =cut -my $safes = "1111111111111111111111101111111111111111111111111111111111111111" - . "1111111111111111111111111111111111111111111111111111111111111111" - . "1111110011111111111011111111111111111111111111111111111101001010" - . "0110111111111111111111110011111111100001000000000000000000000100" - . "0000000000000111110000001111111110100000000000001111111111111111" - . "11111111111111111110"; - my $default_root = 'Root000000000'; my $default_mask; @@ -392,7 +386,282 @@ EOT bootstrap Safe; -$safes .= "0" x (MAXO() - length($safes)); -($default_mask = $safes) =~ tr/01/\1\0/; # invert for mask +$default_mask = fullmask; +my $name; +while (defined ($name = <DATA>)) { + chomp $name; + next if $name =~ /^#/; + my $code = opcode($name); + substr($default_mask, $code, 1) = "\0"; +} 1; + +__DATA__ +null +stub +scalar +pushmark +wantarray +const +gvsv +gv +gelem +padsv +padav +padhv +padany +pushre +rv2gv +rv2sv +av2arylen +rv2cv +anoncode +prototype +refgen +srefgen +ref +bless +glob +readline +rcatline +regcmaybe +regcomp +match +subst +substcont +trans +sassign +aassign +chop +schop +chomp +schomp +defined +undef +study +pos +preinc +i_preinc +predec +i_predec +postinc +i_postinc +postdec +i_postdec +pow +multiply +i_multiply +divide +i_divide +modulo +i_modulo +repeat +add +i_add +subtract +i_subtract +concat +stringify +left_shift +right_shift +lt +i_lt +gt +i_gt +le +i_le +ge +i_ge +eq +i_eq +ne +i_ne +ncmp +i_ncmp +slt +sgt +sle +sge +seq +sne +scmp +bit_and +bit_xor +bit_or +negate +i_negate +not +complement +atan2 +sin +cos +rand +srand +exp +log +sqrt +int +hex +oct +abs +length +substr +vec +index +rindex +sprintf +formline +ord +chr +crypt +ucfirst +lcfirst +uc +lc +quotemeta +rv2av +aelemfast +aelem +aslice +each +values +keys +delete +exists +rv2hv +helem +hslice +split +join +list +lslice +anonlist +anonhash +splice +push +pop +shift +unshift +reverse +grepstart +grepwhile +mapstart +mapwhile +range +flip +flop +and +or +xor +cond_expr +andassign +orassign +method +entersub +leavesub +caller +warn +die +reset +lineseq +nextstate +dbstate +unstack +enter +leave +scope +enteriter +iter +enterloop +leaveloop +return +last +next +redo +goto +close +fileno +tie +untie +dbmopen +dbmclose +sselect +select +getc +read +enterwrite +leavewrite +prtf +print +sysread +syswrite +send +recv +eof +tell +seek +truncate +fcntl +ioctl +sockpair +bind +connect +listen +accept +shutdown +gsockopt +ssockopt +getsockname +ftrwrite +ftsvtx +open_dir +readdir +telldir +seekdir +rewinddir +kill +getppid +getpgrp +setpgrp +getpriority +setpriority +time +tms +localtime +alarm +dofile +entereval +leaveeval +entertry +leavetry +ghbyname +ghbyaddr +ghostent +gnbyname +gnbyaddr +gnetent +gpbyname +gpbynumber +gprotoent +gsbyname +gsbyport +gservent +shostent +snetent +sprotoent +sservent +ehostent +enetent +eprotoent +eservent +gpwnam +gpwuid +gpwent +spwent +epwent +ggrnam +ggrgid +ggrent +sgrent +egrent diff --git a/ext/Safe/Safe.xs b/ext/Safe/Safe.xs index ec7abce67a..8296262dd7 100644 --- a/ext/Safe/Safe.xs +++ b/ext/Safe/Safe.xs @@ -92,6 +92,18 @@ opname(...) } void +opdesc(...) + PPCODE: + int i, myopcode; + for (i = 0; i < items; i++) + { + myopcode = SvIV(ST(i)); + if (myopcode < 0 || myopcode >= maxo) + croak("opcode out of range"); + XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); + } + +void opcode(...) PPCODE: int i, j; @@ -99,7 +111,10 @@ opcode(...) for (i = 0; i < items; i++) { op = SvPV(ST(i), na); - for (j = 0; j < maxo && strNE(op, op_name[j]); j++) /* nothing */ ; + for (j = 0; j < maxo; j++) { + if (strEQ(op, op_name[j]) || strEQ(op, op_desc[j])) + break; + } if (j == maxo) croak("bad op name \"%s\"", op); XPUSHs(sv_2mortal(newSViv(j))); diff --git a/ext/Socket/Makefile.PL b/ext/Socket/Makefile.PL index f4850a0175..acf167e057 100644 --- a/ext/Socket/Makefile.PL +++ b/ext/Socket/Makefile.PL @@ -1,6 +1,6 @@ use ExtUtils::MakeMaker; WriteMakefile( - VERSION => 1.5, + VERSION_FROM => 'Socket.pm', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? ); diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index 6462713c43..9cc7585cb3 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -1,5 +1,5 @@ package Socket; -$VERSION = 1.5; +$VERSION = $VERSION = "1.5"; =head1 NAME diff --git a/global.sym b/global.sym index 5f398496f5..463c387d6d 100644 --- a/global.sym +++ b/global.sym @@ -133,6 +133,7 @@ numer_amg oldbufptr oldoldbufptr op +op_desc op_name op_seqmax opargs @@ -268,10 +269,14 @@ yyval # Functions +Gv_AMupdate +amagic_call append_elem append_list apply +assertref av_clear +av_extend av_fake av_fetch av_fill @@ -288,8 +293,10 @@ block_end block_start calllist cando +cast_ulong check_uni checkcomma +chsize ck_aelem ck_concat ck_eof @@ -320,17 +327,21 @@ 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 @@ -346,7 +357,6 @@ do_open do_pipe do_print do_readline -do_chomp do_seek do_semop do_shmio @@ -358,10 +368,14 @@ 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 @@ -370,8 +384,12 @@ 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 @@ -380,6 +398,7 @@ gp_free gp_ref gv_AVadd gv_HVadd +gv_IOadd gv_check gv_efullname gv_fetchfile @@ -398,13 +417,13 @@ hv_clear hv_delete hv_exists hv_fetch -hv_stashpv hv_iterinit hv_iterkey hv_iternext hv_iternextsv hv_iterval hv_magic +hv_stashpv hv_store hv_undef ibcmp @@ -422,7 +441,9 @@ list listkids localize looks_like_number +magic_clearenv magic_clearpack +magic_existspack magic_get magic_getarylen magic_getglob @@ -463,22 +484,29 @@ mg_set mod modkids moreswitches +mstats my +my_bcopy +my_bzero 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 -newCVOP newCVREF newFORM newFOROP @@ -492,11 +520,10 @@ newLISTOP newLOGOP newLOOPEX newLOOPOP -newMETHOD newNULLLIST newOP -newPROG newPMOP +newPROG newPVOP newRANGE newRV @@ -509,11 +536,12 @@ newSVREF newSViv newSVnv newSVpv +newSVrv newSVsv newUNOP newWHILEOP -newXSUB newXS +newXSUB nextargv ninstr no_fh_allowed @@ -533,6 +561,7 @@ pad_sv pad_swipe peep pidgone +pmflag pmruntime pmtrans pop_return @@ -559,6 +588,7 @@ pp_bless pp_caller pp_chdir pp_chmod +pp_chomp pp_chop pp_chown pp_chroot @@ -742,6 +772,7 @@ pp_pow pp_predec pp_preinc pp_print +pp_prototype pp_prtf pp_push pp_pushmark @@ -774,9 +805,9 @@ pp_rv2cv pp_rv2gv pp_rv2hv pp_rv2sv -pp_chomp pp_sassign pp_scalar +pp_schomp pp_schop pp_scmp pp_scope @@ -817,7 +848,6 @@ pp_spwent pp_sqrt pp_srand pp_srefgen -pp_schomp pp_sselect pp_sservent pp_ssockopt @@ -828,7 +858,6 @@ pp_subst pp_substcont pp_substr pp_subtract -pp_sv2len pp_symlink pp_syscall pp_sysread @@ -837,6 +866,7 @@ pp_syswrite pp_tell pp_telldir pp_tie +pp_tied pp_time pp_tms pp_trans @@ -858,28 +888,28 @@ pp_waitpid pp_wantarray pp_warn pp_xor +pregcomp +pregexec +pregfree prepend_elem push_return push_scope q ref refkids -pregcomp regdump -pregexec -pregfree regnext regprop repeatcpy rninstr run -savepv -savepvn +same_dirent save_I32 save_aptr save_ary save_clearsv save_delete +save_destructor save_freeop save_freepv save_freesv @@ -888,10 +918,14 @@ 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 @@ -916,6 +950,7 @@ scope screaminstr setdefout setenv_getix +sighandler skipspace stack_grow start_subparse @@ -943,6 +978,7 @@ sv_dec sv_dump sv_eq sv_free +sv_free_arenas sv_gets sv_grow sv_inc @@ -953,8 +989,11 @@ 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 @@ -964,9 +1003,12 @@ 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 @@ -974,6 +1016,8 @@ taint_not taint_proper too_few_arguments too_many_arguments +unlnk +utilize wait4pid warn watch @@ -984,7 +1028,6 @@ xnv_root xpv_root xrv_root yyerror -yyerror yylex yyparse yywarn @@ -284,6 +284,8 @@ char* name; sv_catpvn(tmpstr,"::", 2); sv_catpvn(tmpstr, name, nend - name); sv_setsv(GvSV(CvGV(cv)), tmpstr); + if (tainting) + sv_unmagic(GvSV(CvGV(cv)), 't'); } } } @@ -338,6 +340,9 @@ I32 sv_type; bool global = FALSE; char *tmpbuf; + if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ + name++; + for (namend = name; *namend; namend++) { if ((*namend == '\'' && namend[1]) || (*namend == ':' && namend[1] == ':')) @@ -422,7 +427,8 @@ I32 sv_type; sv_type != SVt_PVCV && sv_type != SVt_PVGV && sv_type != SVt_PVFM && - sv_type != SVt_PVIO) + sv_type != SVt_PVIO && + !(len == 1 && sv_type == SVt_PV && index("ab",*name)) ) { gvp = (GV**)hv_fetch(stash,name,len,0); if (!gvp || @@ -432,10 +438,7 @@ I32 sv_type; stash = 0; else if (sv_type == SVt_PVAV && !GvAV(*gvp) || sv_type == SVt_PVHV && !GvHV(*gvp) || - sv_type == SVt_PV && - (!GvSV(*gvp) || - (!SvTYPE(GvSV(*gvp)) && - SvREFCNT(GvSV(*gvp)) == 1) )) + sv_type == SVt_PV && !GvSV(*gvp) ) { warn("Variable \"%c%s\" is not exported", sv_type == SVt_PVAV ? '@' : @@ -1074,7 +1077,7 @@ int flags; } else { if (off==-1) off=method; sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s", - ((char**)AMG_names)[method], + ((char**)AMG_names)[method + assignshift], SvAMAGIC(left)? "in overloaded package ": "has no overloaded magic", @@ -1113,7 +1116,7 @@ int flags; * to dublicate the contents, probably calling user-supplied * version of copy operator */ - if ((method+assignshift==off + if ((method + assignshift==off && (assign || method==inc_amg || method==dec_amg)) || inc_dec_ass) RvDEEPCP(left); } @@ -1138,7 +1141,7 @@ int flags; PUSHs(lr>0? left: right); PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no)); if (notfound) { - PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[off],0)) ); + PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[method + assignshift],0)) ); } PUSHs((SV*)cv); PUTBACK; diff --git a/hints/aix.sh b/hints/aix.sh index 35fbb5ec39..6a4c585eb6 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -30,7 +30,7 @@ case "$osvers" in *) # These hints at least work for 4.x, possibly other systems too. d_setregid='undef' d_setreuid='undef' - ccflags='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE' + ccflags='-qmaxmem=8192 -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE' nm_opt='-B' ;; esac @@ -38,7 +38,8 @@ esac # The optimizer in 4.1.1 apparently generates bad code for scope.c. # Configure doesn't offer an easy way to propagate extra variables # only for certain cases, so the following contortion is required: -scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac' +# This is probably not needed in 5.002 and later. +# scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac' # Changes for dynamic linking by Wayne Scott <wscott@ichips.intel.com> # @@ -53,7 +54,12 @@ esac # -bI:$(PERL_INC)/perl.exp Read the exported symbols from the perl binary # -bE:$(BASEEXT).exp Export these symbols. This file contains only one # symbol: boot_$(EXP) can it be auto-generated? +case "$osvers" in +3*) lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' + ;; +*) +lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' -# The '-e _nostart' might not be needed on AIX 4.1, but appears to be -# harmless. +;; +esac diff --git a/hints/dgux.sh b/hints/dgux.sh index 733570b02b..bc54c945bd 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -1,26 +1,123 @@ +# $Id: dgux.sh,v 1.4 1996/01/18 03:40:38 roderick Exp $ + +# This is a hints file for DGUX, which is Data General's Unix. It was +# developed using version 5.4.3.10 of the OS. I think the gross +# features should work with versions 5.4.2 through 5.4.4.11 with perhaps +# minor tweaking, but I don't have any older or newer versions installed +# at the moment with which to test it. # -# hints file for Data General DG/UX -# these hints tweaked for perl5 on an AViiON mc88100, running DG/UX 5.4R2.01 +# DGUX is a SVR4 derivative. It ships with gcc as the standard +# compiler. Since version 5.4.3.0 it has shipped with Perl 4.036 +# installed in /usr/bin, which is kind of neat. Be careful when you +# install that you don't overwrite the system version, though (by +# answering yes to the question about installing perl as /usr/bin/perl), +# as it would suck to try to get support if the vendor learned that you +# were physically replacing the system binaries. # +# Be aware that if you opt to use dynamic loading you'll need to set +# your $LD_LIBRARY_PATH to include the source directory when you build, +# test and install the software. +# +# -Roderick Schertler <roderick@gate.net> -gidtype='gid_t' -groupstype='gid_t' -libswanted="dgc $libswanted" -uidtype='uid_t' -d_index='define' -ccflags='-D_POSIX_SOURCE -D_DGUX_SOURCE' - -# this hasn't been tried with dynamic loading at all -usedl='false' +# Here are the things from some old DGUX hints files which are different +# from what's in here now. I don't know the exact reasons that most of +# these settings were in the hints files, presumably they can be chalked +# up to old Configure inadequacies and changes in the OS headers and the +# like. These settings might make a good place to start looking if you +# have problems. # -# an ugly hack, since the Configure test for "gcc -P -" hangs. -# can't just use 'cppstdin', since our DG has a broken cppstdin :-( +# This was specified the the 4.036 hints file. That hints file didn't +# say what version of the OS it was developed using. # -cppstdin=`cd ..; pwd`/cppstdin -cpprun=`cd ..; pwd`/cppstdin - +# cppstdin='/lib/cpp' +# +# The 4.036 and 5.001 hints files both contained these. The 5.001 hints +# file said it was developed with version 5.4.2.01 of DGUX. +# +# gidtype='gid_t' +# groupstype='gid_t' +# uidtype='uid_t' +# d_index='define' +# cc='gcc' +# +# These were peculiar to the 5.001 hints file. +# +# ccflags='-D_POSIX_SOURCE -D_DGUX_SOURCE' # -# you don't want to use /usr/ucb/cc +# # an ugly hack, since the Configure test for "gcc -P -" hangs. +# # can't just use 'cppstdin', since our DG has a broken cppstdin :-( +# cppstdin=`cd ..; pwd`/cppstdin +# cpprun=`cd ..; pwd`/cppstdin # -cc='gcc' +# One last note: The 5.001 hints file said "you don't want to use +# /usr/ucb/cc" in the place at which it set cc to gcc. That in +# particular baffles me, as I used to have 5.4.2.01 loaded and my memory +# is telling me that even then /usr/ucb was a symlink to /usr/bin. + + +# The standard system compiler is gcc, but invoking it as cc changes its +# behavior. I have to pick one name or the other so I can get the +# dynamic loading switches right (they vary depending on this). I'm +# picking gcc because there's no way to get at the optimization options +# and so on when you call it cc. +case $cc in + '') + cc=gcc + case $optimize in + '') optimize=-O2;; + esac + ;; +esac + +usevfork=true + +# DG has this thing set up with symlinks which point to different places +# depending on environment variables (see elink(5)) and the compiler and +# related tools use them to access different development environments +# (COFF, ELF, m88k BCS and so on), see sde(5). The upshot, however, is +# that when a normal program tries to access one of these elinks it sees +# no such file (like stat()ting a mis-directed symlink). Setting +# $plibpth to explicitly include the place to which the elinks point +# allows Configure to find libraries which vary based on the development +# environment. +plibpth="$plibpth \ + ${SDE_PATH:-/usr}/sde/${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib" + +# Many functions (eg, gethostent(), killpg(), getpriority(), setruid() +# dbm_*(), and plenty more) are defined in -ldgc. Usually you don't +# need to know this (it seems that libdgc.so is searched automatically +# by ld), but Configure needs to check it otherwise it will report all +# those functions as missing. +libswanted="dgc $libswanted" + +# Dynamic loading works using the dlopen() functions. Note that dlfcn.h +# is broken, it declares _dl*() rather than dl*(). (This is in my +# I'd-open-a-ticket-about-this-if-it-weren't-going-to-be-such-a-hassle +# file.) You can ignore the warnings caused by the missing +# declarations, they're harmless. +usedl=true +# For cc rather than gcc the flags would be `-K PIC' for compiling and +# -G for loading. I haven't tested this. +cccdlflags=-fpic +lddlflags=-shared +# The Perl library has to be built as a shared library so that dynamic +# loading will work (otherwise code loaded with dlopen() won't be able +# to reference symbols in the main part of perl). Note that since +# Configure doesn't normally prompt about $d_shrplib this will cause a +# `Whoa there!'. This is normal, just keep the recommended value. A +# consequence of all this is that you've got to include the source +# directory in your LD_LIBRARY_PATH when you're building and testing +# perl. +d_shrplib=define + +# The system has a function called dg_flock() which is an flock() +# emulation built using fcntl() locking. Perl currently comes with an +# flock() emulation which uses lockf(), it should eventually also +# include an fcntl() emulation of its own. Until that happens I +# recommend using DG's emulation (and ignoring the `WHOA THERE!' this +# causes), it provides semantics closer to the original than the lockf() +# emulation. +ccflags="$ccflags -Dflock=dg_flock" +d_flock=define diff --git a/hints/dynix.sh b/hints/dynix.sh index 3b759cba25..4bdb804f53 100644 --- a/hints/dynix.sh +++ b/hints/dynix.sh @@ -1,3 +1,7 @@ # If this doesn't work, try specifying 'none' for hints. d_castneg=undef libswanted=`echo $libswanted | sed -e 's/socket /socket seq /'` + +# Reported by Craig Milo Rogers <Rogers@ISI.EDU> +# Date: Tue, 30 Jan 96 15:29:26 PST +d_casti32=undef diff --git a/hints/irix_5.sh b/hints/irix_5.sh index 5b92cacd84..5027b1574f 100644 --- a/hints/irix_5.sh +++ b/hints/irix_5.sh @@ -1,5 +1,8 @@ # irix_5.sh -# Last modified Tue Jan 2 14:52:36 EST 1996 +# Tue Jan 9 16:04:38 EST 1996 +# Add note about socket patch. +# +# Tue Jan 2 14:52:36 EST 1996 # Apparently, there's a stdio bug that can lead to memory # corruption using perl's malloc, but not SGI's malloc. usemymalloc='n' @@ -18,3 +21,14 @@ lddlflags="-shared" set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` shift libswanted="$*" + +# Date: Fri, 22 Dec 1995 11:49:17 -0800 +# From: Matthew Black <black@csulb.edu> +# Subject: sockets broken under IRIX 5.3? YES...how to fix +# Anyone attempting to use perl4 or perl5 with SGI IRIX 5.3 may discover +# that sockets are essentially broken. The syslog interface for perl also +# fails because it uses the broken socket interface. This problem was +# reported to SGI as bug #255347 and it can be fixed by installing +# patchSG0000596. The patch can be downloaded from Advantage OnLine (SGI's +# WWW server) or from the Support Advantage 9/95 Patch CDROM. Thanks to Tom +# Christiansen and others who provided assistance. diff --git a/hints/linux.sh b/hints/linux.sh index b8dbc25698..abe8bbcad1 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -8,12 +8,8 @@ # # Consolidated by Andy Dougherty <doughera@lafcol.lafayette.edu> # -# Last updated Tue May 30 14:25:02 EDT 1995 -# -# If you wish to use something other than 'gcc' for your compiler, -# you should specify it on the Configure command line. To use -# gcc-elf, for exmample, type -# ./Configure -Dcc=gcc-elf +# Updated Tue May 30 14:25:02 EDT 1995 +# Add ability to use command-line overrides for optinal settings. # perl goes into the /usr tree. See the Filesystem Standard # available via anonymous FTP at tsx-11.mit.edu in @@ -23,28 +19,27 @@ case "$prefix" in '') prefix='/usr' ;; esac -# Perl expects BSD style signal handling. +# Perl users typically expect BSD style signal handling. +# This may not be needed in 5.002 since sigaction is used. # gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool. ccflags="-D__USE_BSD_SIGNAL -Dbool=char -DHAS_BOOL $ccflags" -# The following functions are gcc built-ins, but the Configure tests -# may fail because they don't supply proper prototypes. -# This should be fixed as of 5.001f. I'd appreciate reports. -d_memcmp=define -d_memcpy=define - # Configure may fail to find lstat() since it's a static/inline # function in <sys/stat.h>. d_lstat=define # Explanation? -d_dosuid='define' +case "$d_dosuid" in +'') d_dosuid='define' ;; +esac # I think Configure gets this right now, but I'd appreciate reports. malloctype='void *' # Explanation? -usemymalloc='n' +case "$usemymalloc" in +'') usemymalloc='n' ;; +esac case "$optimize" in '') optimize='-O2' ;; @@ -89,6 +84,7 @@ EOM # Linux ELF values. ccdlflags=' ' cccdlflags=' ' + ccflags="-DOVR_DBL_DIG=14 $ccflags" so='sa' dlext='o' ## If you are using DLD 3.2.4 which does not support shared libs, @@ -119,5 +115,7 @@ fi # This will generate a harmless message: # Hmm...You had some extra variables I don't know about...I'll try to keep 'em. # Propagating recommended variable d_dbm_open -d_dbm_open=undef +case "$d_dbm_open" in +'') d_dbm_open=undef ;; +esac diff --git a/hints/machten.sh b/hints/machten.sh index cbf634ab67..d937128b0f 100644 --- a/hints/machten.sh +++ b/hints/machten.sh @@ -25,3 +25,26 @@ useposix=false #MachTen might have an incomplete Berkeley DB implementation. i_db=$undef + +#MachTen versions 2.X have no hard links. This variable is used +# by File::Find. +# This will generate a harmless message: +# Hmm...You had some extra variables I don't know about...I'll try to keep 'em. +# Propagating recommended variable dont_use_nlink +case "$osver" in +2*) dont_use_nlink=define ;; +*) ;; +esac + +case "$osvers" in +2*) + cat <<'EOM' >&4 + +Tests + io/fs test 4 and + op/stat test 3 +may fail since MachTen versions 2.X have no hard links. + +EOM + ;; +esac diff --git a/hints/powerunix.sh b/hints/powerux.sh index 0878e748b7..b1c082651f 100644 --- a/hints/powerunix.sh +++ b/hints/powerux.sh @@ -1,9 +1,8 @@ -# Hints for the Power UNIX operating system running on Harris NightHawk +# Hints for the PowerUX operating system running on Harris NightHawk # machines. Written by Tom.Horsley@mail.hcsc.com # # This config uses dynamic linking and the Harris C compiler. It has been -# tested on a Harris 5800 running Power UNIX as well as a (prototype) Harris -# 6800 running Power UNIX. +# tested on a Harris 6800 running PowerUX. # Internally at Harris, we use a source management tool which winds up # giving us read-only copies of source trees that are mostly symbolic links. @@ -320,7 +320,9 @@ HV *hv; register HE **b; register HE *entry; register HE **oentry; +#ifndef STRANGE_MALLOC I32 tmp; +#endif a = (HE**)xhv->xhv_array; nomemok = TRUE; @@ -337,11 +339,9 @@ HV *hv; assert(tmp >= newsize); New(2,a, tmp, HE*); Copy(xhv->xhv_array, a, oldsize, HE*); - if (oldsize >= 64 && *(char*)&xhv->xnv_nv == 0) { - sv_add_arena((char*)xhv->xhv_array, oldsize * sizeof(HE*), 0); - sv_add_arena(((char*)a) + newsize * sizeof(HE*), - newsize * sizeof(HE*) - MALLOC_OVERHEAD, - SVf_FAKE); + if (oldsize >= 64 && !nice_chunk) { + nice_chunk = (char*)xhv->xhv_array; + nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; } else Safefree(xhv->xhv_array); @@ -387,7 +387,6 @@ newHV() xhv->xhv_max = 7; /* start with 8 buckets */ xhv->xhv_fill = 0; xhv->xhv_pmroot = 0; - *(char*)&xhv->xnv_nv = 0; (void)hv_iterinit(hv); /* so each() will start off right */ return hv; } @@ -475,14 +474,7 @@ HV *hv; return; xhv = (XPVHV*)SvANY(hv); hfreeentries(hv); -#ifdef STRANGE_MALLOC Safefree(xhv->xhv_array); -#else - if (xhv->xhv_max < 127 || *(char*)&xhv->xnv_nv) - Safefree(xhv->xhv_array); - else /* We used last half, so use first half for SV arena too. */ - sv_add_arena((char*)xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*),0); -#endif if (HvNAME(hv)) { Safefree(HvNAME(hv)); HvNAME(hv) = 0; @@ -491,7 +483,6 @@ HV *hv; xhv->xhv_max = 7; /* it's a normal associative array */ xhv->xhv_fill = 0; xhv->xhv_keys = 0; - *(char*)&xhv->xnv_nv = 1; if (SvRMAGICAL(hv)) mg_clear((SV*)hv); diff --git a/installman b/installman index 7d4611c84f..13cb75f649 100755 --- a/installman +++ b/installman @@ -26,7 +26,7 @@ $usage = man3ext = $Config{'man3ext'}; --notify (or -n) just lists commands that would be executed.\n"; -GetOptions( qw( man1dir=s man1ext=s man3dir=s man3ext=s notify help)) +GetOptions( qw( man1dir=s man1ext=s man3dir=s man3ext=s notify n help)) || die $usage; die $usage if $opt_help; @@ -36,7 +36,7 @@ $man1ext = defined($opt_man1ext) ? $opt_man1ext : $Config{'man1ext'}; $man3dir = defined($opt_man3dir) ? $opt_man3dir : $Config{'installman3dir'}; $man3ext = defined($opt_man3ext) ? $opt_man3ext : $Config{'man3ext'}; -$notify = defined($opt_notify) ? $opt_notify : 0; +$notify = $opt_notify || $opt_n; #Sanity checks diff --git a/installperl b/installperl index d60a4ddaec..da714586fa 100755 --- a/installperl +++ b/installperl @@ -75,7 +75,7 @@ if ($d_shrplib) { " (Installing other things anyway.)\n"; } else { mkpath($shrpdir, 1, 0777); - -w $shrpdir || die "$shrpdir is not writable by you\n"; + -w $shrpdir || $nonono || die "$shrpdir is not writable by you\n"; &cmd("cp libperl*.$so* $shrpdir"); } } diff --git a/interp.sym b/interp.sym index 8cad64be40..801eb41fd9 100644 --- a/interp.sym +++ b/interp.sym @@ -90,8 +90,6 @@ mystack_max mystack_sp mystrk nrs -nrschar -nrslen ofmt ofs ofslen @@ -116,9 +114,6 @@ preprocess restartop rightgv rs -rschar -rslen -rspara runlevel sawampersand sawi diff --git a/keywords.h b/keywords.h index a764b10ba0..8cb2748d75 100644 --- a/keywords.h +++ b/keywords.h @@ -144,99 +144,102 @@ #define KEY_pos 143 #define KEY_print 144 #define KEY_printf 145 -#define KEY_push 146 -#define KEY_q 147 -#define KEY_qq 148 -#define KEY_quotemeta 149 -#define KEY_qw 150 -#define KEY_qx 151 -#define KEY_rand 152 -#define KEY_read 153 -#define KEY_readdir 154 -#define KEY_readline 155 -#define KEY_readlink 156 -#define KEY_readpipe 157 -#define KEY_recv 158 -#define KEY_redo 159 -#define KEY_ref 160 -#define KEY_rename 161 -#define KEY_require 162 -#define KEY_reset 163 -#define KEY_return 164 -#define KEY_reverse 165 -#define KEY_rewinddir 166 -#define KEY_rindex 167 -#define KEY_rmdir 168 -#define KEY_s 169 -#define KEY_scalar 170 -#define KEY_seek 171 -#define KEY_seekdir 172 -#define KEY_select 173 -#define KEY_semctl 174 -#define KEY_semget 175 -#define KEY_semop 176 -#define KEY_send 177 -#define KEY_setgrent 178 -#define KEY_sethostent 179 -#define KEY_setnetent 180 -#define KEY_setpgrp 181 -#define KEY_setpriority 182 -#define KEY_setprotoent 183 -#define KEY_setpwent 184 -#define KEY_setservent 185 -#define KEY_setsockopt 186 -#define KEY_shift 187 -#define KEY_shmctl 188 -#define KEY_shmget 189 -#define KEY_shmread 190 -#define KEY_shmwrite 191 -#define KEY_shutdown 192 -#define KEY_sin 193 -#define KEY_sleep 194 -#define KEY_socket 195 -#define KEY_socketpair 196 -#define KEY_sort 197 -#define KEY_splice 198 -#define KEY_split 199 -#define KEY_sprintf 200 -#define KEY_sqrt 201 -#define KEY_srand 202 -#define KEY_stat 203 -#define KEY_study 204 -#define KEY_sub 205 -#define KEY_substr 206 -#define KEY_symlink 207 -#define KEY_syscall 208 -#define KEY_sysread 209 -#define KEY_system 210 -#define KEY_syswrite 211 -#define KEY_tell 212 -#define KEY_telldir 213 -#define KEY_tie 214 -#define KEY_time 215 -#define KEY_times 216 -#define KEY_tr 217 -#define KEY_truncate 218 -#define KEY_uc 219 -#define KEY_ucfirst 220 -#define KEY_umask 221 -#define KEY_undef 222 -#define KEY_unless 223 -#define KEY_unlink 224 -#define KEY_unpack 225 -#define KEY_unshift 226 -#define KEY_untie 227 -#define KEY_until 228 -#define KEY_use 229 -#define KEY_utime 230 -#define KEY_values 231 -#define KEY_vec 232 -#define KEY_wait 233 -#define KEY_waitpid 234 -#define KEY_wantarray 235 -#define KEY_warn 236 -#define KEY_while 237 -#define KEY_write 238 -#define KEY_x 239 -#define KEY_xor 240 -#define KEY_y 241 +#define KEY_prototype 146 +#define KEY_push 147 +#define KEY_q 148 +#define KEY_qq 149 +#define KEY_quotemeta 150 +#define KEY_qw 151 +#define KEY_qx 152 +#define KEY_rand 153 +#define KEY_read 154 +#define KEY_readdir 155 +#define KEY_readline 156 +#define KEY_readlink 157 +#define KEY_readpipe 158 +#define KEY_recv 159 +#define KEY_redo 160 +#define KEY_ref 161 +#define KEY_rename 162 +#define KEY_require 163 +#define KEY_reset 164 +#define KEY_return 165 +#define KEY_reverse 166 +#define KEY_rewinddir 167 +#define KEY_rindex 168 +#define KEY_rmdir 169 +#define KEY_s 170 +#define KEY_scalar 171 +#define KEY_seek 172 +#define KEY_seekdir 173 +#define KEY_select 174 +#define KEY_semctl 175 +#define KEY_semget 176 +#define KEY_semop 177 +#define KEY_send 178 +#define KEY_setgrent 179 +#define KEY_sethostent 180 +#define KEY_setnetent 181 +#define KEY_setpgrp 182 +#define KEY_setpriority 183 +#define KEY_setprotoent 184 +#define KEY_setpwent 185 +#define KEY_setservent 186 +#define KEY_setsockopt 187 +#define KEY_shift 188 +#define KEY_shmctl 189 +#define KEY_shmget 190 +#define KEY_shmread 191 +#define KEY_shmwrite 192 +#define KEY_shutdown 193 +#define KEY_sin 194 +#define KEY_sleep 195 +#define KEY_socket 196 +#define KEY_socketpair 197 +#define KEY_sort 198 +#define KEY_splice 199 +#define KEY_split 200 +#define KEY_sprintf 201 +#define KEY_sqrt 202 +#define KEY_srand 203 +#define KEY_stat 204 +#define KEY_study 205 +#define KEY_sub 206 +#define KEY_substr 207 +#define KEY_symlink 208 +#define KEY_syscall 209 +#define KEY_sysopen 210 +#define KEY_sysread 211 +#define KEY_system 212 +#define KEY_syswrite 213 +#define KEY_tell 214 +#define KEY_telldir 215 +#define KEY_tie 216 +#define KEY_tied 217 +#define KEY_time 218 +#define KEY_times 219 +#define KEY_tr 220 +#define KEY_truncate 221 +#define KEY_uc 222 +#define KEY_ucfirst 223 +#define KEY_umask 224 +#define KEY_undef 225 +#define KEY_unless 226 +#define KEY_unlink 227 +#define KEY_unpack 228 +#define KEY_unshift 229 +#define KEY_untie 230 +#define KEY_until 231 +#define KEY_use 232 +#define KEY_utime 233 +#define KEY_values 234 +#define KEY_vec 235 +#define KEY_wait 236 +#define KEY_waitpid 237 +#define KEY_wantarray 238 +#define KEY_warn 239 +#define KEY_while 240 +#define KEY_write 241 +#define KEY_x 242 +#define KEY_xor 243 +#define KEY_y 244 diff --git a/keywords.pl b/keywords.pl index 8cbaa83835..086a10956a 100755 --- a/keywords.pl +++ b/keywords.pl @@ -169,6 +169,7 @@ pop pos print printf +prototype push q qq @@ -232,12 +233,14 @@ sub substr symlink syscall +sysopen sysread system syswrite tell telldir tie +tied time times tr diff --git a/lib/Carp.pm b/lib/Carp.pm index 2d857ba4e7..f30bd24135 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -28,6 +28,7 @@ not where carp() was called. # exceptions outside of the current package. $CarpLevel = 0; # How many extra package levels to skip on carp. +$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. require Exporter; @ISA = Exporter; @@ -37,11 +38,24 @@ sub longmess { my $error = shift; my $mess = ""; my $i = 1 + $CarpLevel; - my ($pack,$file,$line,$sub); - while (($pack,$file,$line,$sub) = caller($i++)) { + my ($pack,$file,$line,$sub,$eval,$require); + while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { if ($error =~ m/\n$/) { $mess .= $error; } else { + if (defined $eval) { + if ($require) { + $sub = "require $eval"; + } else { + $eval =~ s/[\\\']/\\$&/g; + if ($MaxEvalLen && length($eval) > $MaxEvalLen) { + substr($eval,$MaxEvalLen) = '...'; + } + $sub = "eval '$eval'"; + } + } elsif ($sub eq '(eval)') { + $sub = 'eval {...}'; + } $mess .= "\t$sub " if $error eq "called"; $mess .= "$error at $file line $line\n"; } @@ -55,8 +69,8 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages my ($curpack) = caller(1); my $extra = $CarpLevel; my $i = 2; - my ($pack,$file,$line,$sub); - while (($pack,$file,$line,$sub) = caller($i++)) { + my ($pack,$file,$line); + while (($pack,$file,$line) = caller($i++)) { if ($pack ne $curpack) { if ($extra-- > 0) { $curpack = $pack; diff --git a/lib/DirHandle.pm b/lib/DirHandle.pm new file mode 100644 index 0000000000..047755dc17 --- /dev/null +++ b/lib/DirHandle.pm @@ -0,0 +1,72 @@ +package DirHandle; + +=head1 NAME + +DirHandle - supply object methods for directory handles + +=head1 SYNOPSIS + + use DirHandle; + $d = new DirHandle "."; + if (defined $d) { + while (defined($_ = $d->read)) { something($_); } + $d->rewind; + while (defined($_ = $d->read)) { something_else($_); } + undef $d; + } + +=head1 DESCRIPTION + +The C<DirHandle> method provide an alternative interface to the +opendir(), closedir(), readdir(), and rewinddir() functions. + +The only objective benefit to using C<DirHandle> is that it avoids +namespace pollution by creating globs to hold directory handles. + +=cut + +require 5.000; +use Carp; +use Symbol; + +sub new { + @_ >= 1 && @_ <= 2 or croak 'usage: new DirHandle [DIRNAME]'; + my $class = shift; + my $dh = gensym; + if (@_) { + DirHandle::open($dh, $_[0]) + or return undef; + } + bless $dh, $class; +} + +sub DESTROY { + my ($dh) = @_; + closedir($dh); +} + +sub open { + @_ == 2 or croak 'usage: $dh->open(DIRNAME)'; + my ($dh, $dirname) = @_; + opendir($dh, $dirname); +} + +sub close { + @_ == 1 or croak 'usage: $dh->close()'; + my ($dh) = @_; + closedir($dh); +} + +sub read { + @_ == 1 or croak 'usage: $dh->read()'; + my ($dh) = @_; + readdir($dh); +} + +sub rewind { + @_ == 1 or croak 'usage: $dh->rewind()'; + my ($dh) = @_; + rewinddir($dh); +} + +1; diff --git a/lib/Exporter.pm b/lib/Exporter.pm index de0155b548..90a41d644b 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -3,7 +3,7 @@ package Exporter; require 5.001; $ExportLevel = 0; -$Verbose = 0; +$Verbose = 0 unless $Verbose; require Carp; @@ -125,7 +125,7 @@ sub export { } } - warn "Importing from $pkg into $callpkg: ", + warn "Importing into $callpkg from $pkg: ", join(", ",sort @imports) if $Verbose; foreach $sym (@imports) { @@ -155,7 +155,7 @@ sub import { sub _push_tags { my($pkg, $var, $syms) = @_; my $nontag; - *export_tags = *{"${pkg}::EXPORT_TAGS"}; + *export_tags = \%{"${pkg}::EXPORT_TAGS"}; push(@{"${pkg}::$var"}, map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) } (@$syms) ? @$syms : keys %export_tags); diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index ebb2536382..94d343bbf4 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -104,6 +104,17 @@ sub ext { } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){ } elsif (-f ($fullname="$thispth/$thislib$Config_libext")){ } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){ + } elsif ($Config{'osname'} eq 'dgux' + && -l ($fullname="$thispth/lib$thislib$Config_libext") + && readlink($fullname) =~ /^elink:/) { + # Some of DG's libraries look like misconnected symbolic + # links, but development tools can follow them. (They + # look like this: + # + # libm.a -> elink:${SDE_PATH:-/usr}/sde/\ + # ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a + # + # , the compilation tools expand the environment variables.) } else { print STDOUT "$thislib not found in $thispth\n" if $Verbose; next; diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 158c55a508..fde022ca06 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -1,11 +1,11 @@ # MM_VMS.pm # MakeMaker default methods for VMS # This package is inserted into @ISA of MakeMaker's MM before the -# built-in MM_Unix methods if MakeMaker.pm is run under VMS. +# built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS. # -# Version: 5.16 +# Version: 5.17 # Author: Charles Bailey bailey@genetics.upenn.edu -# Revised: 03-Jan-1996 +# Revised: 14-Jan-1996 package ExtUtils::MM_VMS; @@ -88,14 +88,17 @@ sub catdir { $self = $ExtUtils::MakeMaker::Parent[-1]; } my($dir) = pop @dirs; - my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); - my($spath,$sdir) = ($path,$dir); - $spath =~ s/.dir$//; $sdir =~ s/.dir$//; - $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/; + @dirs = grep($_,@dirs); my($rslt); - - $rslt = vmspath($self->eliminate_macros($spath)."/$sdir"); - print "catdir($path,$dir) = |$rslt|\n" if $Verbose >= 3; + if (@dirs) { + my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); + my($spath,$sdir) = ($path,$dir); + $spath =~ s/.dir$//; $sdir =~ s/.dir$//; + $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/; + $rslt = vmspath($self->eliminate_macros($spath)."/$sdir"); + } + else { $rslt = vmspath($dir); } + print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; $rslt; } @@ -106,13 +109,20 @@ sub catfile { $self = $ExtUtils::MakeMaker::Parent[-1]; } my($file) = pop @files; - my($path) = (@files == 1 ? $files[0] : $self->catdir(@files)); - my($spath) = $path; - $spath =~ s/.dir$//; + @files = grep($_,@files); my($rslt); - if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; } - else { $rslt = vmsify($self->eliminate_macros($spath).'/'.unixify($file)); } - print "catfile($path,$file) = |$rslt|\n" if $Verbose >= 3; + if (@files) { + my($path) = (@files == 1 ? $files[0] : $self->catdir(@files)); + my($spath) = $path; + $spath =~ s/.dir$//; + if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; } + else { + $rslt = $self->eliminate_macros($spath); + $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); + } + } + else { $rslt = vmsify($file); } + print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; $rslt; } @@ -263,15 +273,17 @@ sub init_others { $self->{NOOP} = "\t@ Continue"; $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS'; + $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS'; $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; + $self->{NOECHO} ||= '@ '; $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"'; - $self->{RM_RF} = '$(PERL) -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"'; + $self->{RM_RF} = '$(PERL) "-I$(INST_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"'; $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"'; $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"'; # expect Unix syntax from MakeMaker $self->{CP} = 'Copy/NoConfirm'; $self->{MV} = 'Rename/NoConfirm'; $self->{UMASK_NULL} = "\t!"; - &MM_Unix::init_others; + &ExtUtils::MM_Unix::init_others; } sub constants { @@ -343,7 +355,14 @@ FULLEXT = ",$self->fixpath($self->{FULLEXT},1)," BASEEXT = $self->{BASEEXT} ROOTEXT = ",($self->{ROOTEXT} eq '') ? '[]' : $self->fixpath($self->{ROOTEXT},1)," DLBASE = $self->{DLBASE} -INC = "; +"; + + push @m, " +VERSION_FROM = $self->{VERSION_FROM} +" if defined $self->{VERSION_FROM}; + + push @m,' +INC = '; if ($self->{'INC'}) { push @m,'/Include=('; @@ -404,7 +423,7 @@ MAN3EXT = $self->{MAN3EXT} MYEXTLIB = ",$self->fixpath($self->{MYEXTLIB})," # Here is the Config.pm that we are using/depend on -CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h +CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM) # Where to put things: INST_LIBDIR = ",($self->{'INST_LIBDIR'} = $self->catdir($self->{INST_LIB},$self->{ROOTEXT}))," @@ -425,6 +444,8 @@ INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs INST_STATIC = INST_DYNAMIC = INST_BOOT = +EXPORT_LIST = $(BASEEXT).opt +PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : 'Sys$Share:PerlShr.Exe'),' '; } @@ -537,7 +558,7 @@ sub const_cccmd { if ($Config{'vms_cc_type'} ne 'decc') { push @m,' .FIRST - @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS ', + ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS ', ($Config{'vms_cc_type'} eq 'gcc' ? 'GNU_CC_Include:[VMS]' : 'Sys$Library'),' @@ -677,7 +698,7 @@ sub tools_other { ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); $self = $ExtUtils::MakeMaker::Parent[-1]; } - " + qq! # Assumes \$(MMS) invokes MMS or MMK # (It is assumed in some cases later that the default makefile name # (Descrip.MMS for MM[SK]) is used.) @@ -694,7 +715,8 @@ RM_F = $self->{RM_F} RM_RF = $self->{RM_RF} UMASK_NULL = $self->{UMASK_NULL} MKPATH = Create/Directory -"; +EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,"">\$ARGV[1]"";close F;utime((stat(""\$ARGV[0]""))[8,9],\$ARGV[1])" +!; } @@ -789,7 +811,7 @@ sub top_targets { } my(@m); push @m, ' -all :: config $(INST_PM) subdirs linkext manifypods +all :: config $(INST_PM) subdirs linkext manifypods reorg_packlist $(NOOP) subdirs :: $(MYEXTLIB) @@ -809,7 +831,7 @@ config :: $(INST_AUTODIR).exists push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); if (%{$self->{MAN1PODS}}) { push @m, q[ -config :: $(INST_MAN1DIR)/.exists +config :: $(INST_MAN1DIR).exists $(NOOP) ]; push @m, $self->dir_target(qw[$(INST_MAN1DIR)]); @@ -833,9 +855,9 @@ help : push @m, q{ Version_check : - @ $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - - -e "use ExtUtils::MakeMaker qw($Version &Version_check);" - - -e "&Version_check('$(MM_VERSION)')" + },$self->{NOECHO},q{$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - + -e "use ExtUtils::MakeMaker qw($Version &Version_check);" - + -e "&Version_check('$(MM_VERSION)')" }; join('',@m); @@ -852,17 +874,30 @@ sub dlsyms { return '' unless $self->needs_linking(); my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || ''; my(@m); - push(@m,' + unless ($self->{SKIPHASH}{'dynamic'}) { + push(@m,' dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt $(NOOP) - +'); + if ($srcdir) { + my($opt) = $self->catfile($srcdir,'perlshr.opt'); + push(@m,"# Depend on $(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists +rtls.opt : $opt \$(BASEEXT).opt + Copy/Log $opt Sys\$Disk:[]rtls.opt +"); + } + else { + push(@m,' # rtls.opt is built in the same step as $(BASEEXT).opt rtls.opt : $(BASEEXT).opt $(TOUCH) $(MMS$TARGET) -') unless $self->{SKIPHASH}{'dynamic'}; +'); + } + } push(@m,' static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt @@ -872,12 +907,13 @@ static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt push(@m,' $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt $(CP) $(MMS$SOURCE) $(MMS$TARGET) - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" -$(BASEEXT).opt : makefile.PL - $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::MakeMaker qw(&mksymlists);" - - -e "MM->new({NAME => \'',$self->{NAME},'\'})->mksymlists({DL_FUNCS => ',neatvalue($self->{DL_FUNCS}),', DL_VARS => ',neatvalue($self->{DL_VARS}),'})" - $(PERL) -e "open OPT,\'>>$(MMS$TARGET)\'; print OPT ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";close OPT" +$(BASEEXT).opt : Makefile.PL + $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" - + ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], + neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')" + $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET) '); join('',@m); @@ -896,18 +932,20 @@ sub dynamic_lib { return '' unless $self->has_link_code(); - ($otherldflags) = $attribs{OTHERLDFLAGS} || ""; + my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; + my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; my(@m); push @m," OTHERLDFLAGS = $otherldflags +INST_DYNAMIC_DEP = $inst_dynamic_dep "; push @m, ' -$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(BASEEXT).opt $(INST_ARCHAUTODIR).exists - @ $(MKPATH) $(INST_ARCHAUTODIR) +$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) + ',$self->{NOECHO},'$(MKPATH) $(INST_ARCHAUTODIR) Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" '; push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); @@ -930,16 +968,16 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".' # we use touch to prevent make continually trying to remake it. # The DynaLoader only reads a non-empty file. $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists - @ Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))" - @ $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - + '.$self->{NOECHO}.'Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))" + '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" - -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" - @ $(TOUCH) $(MMS$TARGET) - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + '.$self->{NOECHO}.' $(TOUCH) $(MMS$TARGET) + '.$self->{NOECHO}.'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists - @ $(RM_RF) $(INST_BOOT) + '.$self->{NOECHO}.'$(RM_RF) $(INST_BOOT) - $(CP) $(BOOTSTRAP) $(INST_BOOT) - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + '.$self->{NOECHO}.'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" '; } # --- Static Loading Sections --- @@ -971,8 +1009,8 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) push(@m,' If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST) - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;" - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;" + ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" '); push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); @@ -985,8 +1023,10 @@ sub installpm_x { # called by installpm perl file ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); $self = $ExtUtils::MakeMaker::Parent[-1]; } - warn "Warning: Most probably 'make' will have problems processing this file: $inst\n" - if $inst =~ m!#!; + if ($inst =~ m!#!) { + warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n"; + return ''; + } $inst = $self->fixpath($inst); $dist = $self->fixpath($dist); my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst); @@ -994,10 +1034,10 @@ sub installpm_x { # called by installpm perl file push(@m, " $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists -",' @ $(RM_F) $(MMS$TARGET) - @ $(CP) ',"$dist $inst",' +",' ',$self->{NOECHO},'$(RM_F) $(MMS$TARGET) + ',$self->{NOECHO},'$(CP) ',"$dist $inst",' $(CHMOD) 644 $(MMS$TARGET) - @ $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" + ',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR).packlist\';print F qq[$(MMS$TARGET)\n];close F;" '); push(@m, ' $(AUTOSPLITFILE) $(MMS$TARGET) ', $self->catdir($splitlib,'auto')."\n\n") @@ -1038,7 +1078,7 @@ END push @m, qq[POD2MAN_EXE = $pod2man_exe\n], q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" - --e "system(""$^X $(POD2MAN_EXE) $_ >$m{$_}"");}" +-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}" ]; push @m, "\nmanifypods : "; push @m, join " ", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}; @@ -1141,7 +1181,8 @@ sub pasthru { my(@pasthru); foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN - INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A LINKTYPE)){ + INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A + LINKTYPE PREFIX)){ push @pasthru, "$key=\"$self->{$key}\""; } @@ -1194,7 +1235,7 @@ clean :: my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; - push(@otherfiles, 'blib.dir', 'Makeaperl.MMS', 'extralibs.ld', 'perlmain.c'); + push(@otherfiles, 'blib.dir', '$(MAKE_APERL_FILE)', 'extralibs.ld', 'perlmain.c'); push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); my($file,$line); $line = ''; #avoid unitialized var warning @@ -1367,14 +1408,17 @@ sub install { $self = $ExtUtils::MakeMaker::Parent[-1]; } my(@m); - push @m, q{ + push @m, q[ doc_install :: - @ Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod" - @ $(PERL) "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\ - -e "use ExtUtils::MakeMaker; MY->new({})->writedoc('Module', '$(NAME)', \\ - 'LINKTYPE=$(LINKTYPE)', 'VERSION=$(VERSION)', 'XS_VERSION=$(XS_VERSION)', 'EXE_FILES=$(EXE_FILES)')" \\ - >>$(INSTALLARCHLIB)perllocal.pod -}; + ],$self->{NOECHO},q[Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod" + ],$self->{NOECHO},q[$(PERL) -e "print q{use ExtUtils::MakeMaker; }" >.MM_tmp + ],$self->{NOECHO},q[$(PERL) -e "print q{MY->new({})->writedoc(}" >>.MM_tmp + ],$self->{NOECHO},q[$(PERL) -e "print q{'Module','$(NAME)','LINKTYPE=$(LINKTYPE)',}" >>.MM_tmp + ],$self->{NOECHO},q[$(PERL) -e "print q{'VERSION=$(VERSION)','XS_VERSION=$(XS_VERSION)',}" >>.MM_tmp + ],$self->{NOECHO},q[$(PERL) -e "print q{'EXE_FILES=$(EXE_FILES)')}" >>.MM_tmp + ],$self->{NOECHO},q[$(PERL) "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" .MM_tmp >>$(INSTALLARCHLIB)perllocal.pod + ],$self->{NOECHO},q[If F$Search(".MM_tmp") .nes. "" then Delete/NoLog .MM_tmp; +]; push(@m, " install :: pure_install doc_install @@ -1392,12 +1436,12 @@ pure_install :: all # '; print `$(MMS) install`"'."\n"); # } # -# push(@m, ' @ $(PERL) "-I$(PERL_LIB)" -e "use File::Path; mkpath(\@ARGV)" $(INSTALLPRIVLIB) $(INSTALLARCHLIB) -# @ $(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLPRIVLIB) -# @ $(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLARCHLIB)'," +# push(@m, ' ',$self->{NOECHO},'$(PERL) "-I$(PERL_LIB)" -e "use File::Path; mkpath(\@ARGV)" $(INSTALLPRIVLIB) $(INSTALLARCHLIB) +# ',$self->{NOECHO},'$(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLPRIVLIB) +# ',$self->{NOECHO},'$(PERL) -e "die qq{You do not have permissions to install into $ARGV[0]\n} unless -w VMS::Filespec::fileify($ARGV[0])" $(INSTALLARCHLIB)'," # # Can't install manpages here -- INST_MAN%DIR macros make line >255 chars # \$(MMS) \$(USEMACROS)INST_LIB=$self->{INSTALLPRIVLIB},INST_ARCHLIB=$self->{INSTALLARCHLIB},INST_EXE=$self->{INSTALLBIN}\$(MACROEND)",' -# @ $(PERL) -i_bak -lne "print unless $seen{$_}++" $(INST_ARCHAUTODIR).packlist +# ',$self->{NOECHO},'$(PERL) -i_bak -lne "print unless $seen{$_}++" $(INST_ARCHAUTODIR).packlist #'); my($curtop,$insttop); @@ -1405,6 +1449,30 @@ pure_install :: all ($insttop = $self->fixpath($self->{INSTALLPRIVLIB},1)) =~ s/]$//; push(@m," Backup/Log ${curtop}...]*.*; ${insttop}...]/New_Version/By_Owner=Parent\n"); + my($oldpacklist) = $self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist'); + push @m,' +# This song and dance brought to you by DCL\'s 255 char limit +reorg_packlist : +'; + my($oldpacklist) = $self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist'); + if ("\L$oldpacklist" ne "\L$self->{INST_ARCHAUTODIR}.packlist") { + push(@m,' If F$Search("',$oldpacklist,'").nes."" Then Append/New ',$oldpacklist,' $(INST_ARCHAUTODIR).packlist'); + } + push @m,' + $(PERL) -ne "BEGIN{exit unless -e $ARGV[0];}print unless $s{$_}++;" $(INST_ARCHAUTODIR).packlist >.MM_tmp + If F$Search(".MM_tmp").nes."" Then Copy/NoConfirm .MM_tmp $(INST_ARCHAUTODIR).packlist + If F$Search(".MM_tmp").nes."" Then Delete/NoConfirm .MM_tmp; +'; + +# From MM 5.16: + + push @m, q[ +# Comment on .packlist rewrite above: +# Read both .packlist files: the old one in PERL_ARCHLIB/auto/FULLEXT, and the new one +# in INSTARCHAUTODIR. Don't croak if they are missing. Write to the one +# in INSTARCHAUTODIR. +]; + push @m, ' ##### UNINSTALL IS STILL EXPERIMENTAL #### uninstall :: @@ -1446,11 +1514,11 @@ $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h # An out of date config.h is not fatal but complains loudly! #$(PERL_INC)config.h : $(PERL_SRC)config.sh $(PERL_INC)config.h : $(PERL_VMS)config.vms - @ Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms" + ',$self->{NOECHO},'Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms" #$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl - @ Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl" + ',$self->{NOECHO},'Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl" olddef = F$Environment("Default") Set Default $(PERL_SRC) $(MMS) $(USEMAKEFILE)[.VMS]$(MAKEFILE) [.lib.',$Config{'arch'},']config.pm @@ -1481,13 +1549,13 @@ $(OBJECT) : $(FIRST_MAKEFILE) # We take a very conservative approach here, but it\'s worth it. # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping. $(MAKEFILE) : Makefile.PL $(CONFIGDEP) - @ Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)" - @ Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..." + ',$self->{NOECHO},'Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)" + ',$self->{NOECHO},'Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..." - $(MV) $(MAKEFILE) $(MAKEFILE)_old - $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ',join(' ',@ARGV),' - @ Write Sys$Output "$(MAKEFILE) has been rebuilt." - @ Write Sys$Output "Please run $(MMS) to build the extension." + ',$self->{NOECHO},'Write Sys$Output "$(MAKEFILE) has been rebuilt." + ',$self->{NOECHO},'Write Sys$Output "Please run $(MMS) to build the extension." '; join('',@m); @@ -1514,13 +1582,14 @@ test : \$(TEST_TYPE) push(@m, ' If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'", '; print `$(MMS) $(PASTHRU2) test`'."\n"); } - push(@m, "\t\@ Write Sys\$Output 'No tests defined for \$(NAME) extension.'\n") + push(@m, "\t$self->{NOECHO}Write Sys\$Output \"No tests defined for \$(NAME) extension.\"\n") unless $tests or -f "test.pl" or @{$self->{DIR}}; push(@m, "\n"); push(@m, "test_dynamic :: all\n"); push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests; push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl"; + push(@m, " \$(NOOP)\n") if (!$tests && ! -f "test.pl"); push(@m, "\n"); # Occasionally we may face this degenerate target: @@ -1530,10 +1599,11 @@ test : \$(TEST_TYPE) push(@m, "test_static :: all \$(MAP_TARGET)\n"); push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests; push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f "test.pl"; + push(@m, "\t$self->{NOECHO}\$(NOOP)\n") if (!$tests && ! -f "test.pl"); push(@m, "\n"); } else { - push @m, "test_static :: test_dynamic\n"; + push @m, "test_static :: test_dynamic\n\t$self->{NOECHO}\$(NOOP)\n"; } join('',@m); @@ -1582,8 +1652,8 @@ MAP_TARGET = $target unless ($self->{MAKEAPERL}) { push @m, q{ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) - @ Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" - @ $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + },$self->{NOECHO},q{Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" + },$self->{NOECHO},q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ Makefile.PL DIR=}, $dir, q{ \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 @@ -1699,19 +1769,19 @@ $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",' $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",' $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option - @ Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say" - @ Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" - @ Write Sys$Output "To remove the intermediate files, say - @ Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean" + ',$self->{NOECHO},'Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say" + ',$self->{NOECHO},'Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" + ',$self->{NOECHO},'Write Sys$Output "To remove the intermediate files, say + ',$self->{NOECHO},'Write Sys$Output " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean" '; push @m,' ',"${tmp}perlmain.c",' : $(MAKEFILE) - @ $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET) + ',$self->{NOECHO},'$(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET) '; push @m, q{ doc_inst_perl : - @ $(PERL) -e "use ExtUtils::MakeMaker; MY->new()->writedoc('Perl binary','$(MAP_TARGET)','MAP_STATIC=$(MAP_STATIC)','MAP_EXTRA=$(MAP_EXTRA)','MAP_LIBPERL=$(MAP_LIBPERL)')" + },$self->{NOECHO},q{$(PERL) -e "use ExtUtils::MakeMaker; MY->new()->writedoc('Perl binary','$(MAP_TARGET)','MAP_STATIC=$(MAP_STATIC)','MAP_EXTRA=$(MAP_EXTRA)','MAP_LIBPERL=$(MAP_LIBPERL)')" }; push @m, " @@ -1743,63 +1813,6 @@ sub extliblist { } -sub mksymlists { - my($self,%attribs) = @_; - unless (ref $self){ - ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); - $self = $ExtUtils::MakeMaker::Parent[-1]; - } - - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($procs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS}; - my($package,$packprefix,$sym,$optname); - local(*OPT); - - if (!$procs) { - $package = $self->{NAME}; - $package =~ s/\W/_/g; - $procs = { $package => ["boot_$package"] }; - } - my($isvax) = $Config{'arch'} =~ /VAX/i; - - # Options file declaring universal symbols - # Used when linking shareable image for dynamic extension, - # or when linking PerlShr into which we've added this package - # as a static extension - # We don't do anything to preserve order, so we won't relax - # the GSMATCH criteria for a dynamic extension - - # BASEEXT is not available when mksymlists is run, so we - # create the options file name directly from NAME - # May cause trouble if Makefile.PL author specifies NAME - # and BASEEXT directly as unrelated strings. - ($optname = $self->{NAME}) =~ s/.*:://; - open OPT, ">$optname.opt"; - foreach $package (keys %$procs) { - ($packprefix = $package) =~ s/\W/_/g; - foreach $sym (@{$$procs{$package}}) { - $sym = "XS_${packprefix}_$sym" unless $sym =~ /^boot_/; - if ($isvax) { print OPT "UNIVERSAL=$sym\n" } - else { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; } - } - } - foreach $sym (@$vars) { - print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; - if ($isvax) { print OPT "UNIVERSAL=$sym\n" } - else { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; } - } - close OPT; - - # Options file specifying RTLs to which this extension must be linked. - # Eventually, the list of libraries will be supplied by a working - # extliblist routine. - open OPT,'>rtls.opt'; - print OPT "PerlShr/Share\n"; - foreach $rtl (split(/\s+/,$Config{'libs'})) { print OPT "$rtl\n"; } - close OPT; -} - - # --- Make-Directories section (internal method) --- # dir_target(@array) returns a Makefile entry for the file .exists in each # named directory. Returns nothing, if the entry has already been processed. @@ -1820,8 +1833,8 @@ sub dir_target { my($vmsdir) = $self->fixpath($dir,1); push @m, " ${vmsdir}.exists :: \$(PERL_INC)perl.h - \@ \$(MKPATH) $vmsdir - \@ \$(TOUCH) ${vmsdir}.exists + $self->{NOECHO}\$(MKPATH) $vmsdir + $self->{NOECHO}\$(EQUALIZE_TIMESTAMP) \$(MMS\$SOURCE) \$(MMS\$TARGET) "; } join "", @m; diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index a8b0fa173d..b66a91ba42 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -56,12 +56,12 @@ sub warndirectuse { package ExtUtils::MakeMaker; -# Last edited $Date: 1996/01/05 20:40:47 $ by Andreas Koenig -# $Id: MakeMaker.pm,v 1.135 1996/01/05 20:40:47 k Exp $ +# Last edited $Date: 1996/01/28 11:33:38 $ by Andreas Koenig +# $Id: MakeMaker.pm,v 1.141 1996/01/28 11:33:38 k Exp $ -$Version = $VERSION = "5.16"; +$Version = $VERSION = "5.18"; -$ExtUtils::MakeMaker::Version_OK = 4.13; # Makefiles older than $Version_OK will die +$ExtUtils::MakeMaker::Version_OK = "5.05"; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) use Config; @@ -116,7 +116,7 @@ unshift(@MY::ISA, qw(MM)); # default routine without having to know under what OS # it's running. -@MM::ISA = qw[MM_Unix ExtUtils::MakeMaker]; +@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::MakeMaker]; unshift @MM::ISA, 'ExtUtils::MM_VMS' if $Is_VMS; unshift @MM::ISA, 'ExtUtils::MM_OS2' if $Is_OS2; @@ -132,6 +132,7 @@ unshift @MM::ISA, 'ExtUtils::MM_OS2' if $Is_OS2; tools_other => {}, dist => {}, macro => {}, + depend => {}, post_constants => {}, pasthru => {}, c_o => {}, @@ -633,21 +634,12 @@ sub Version_check { Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable changes in the meantime. Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n" - if $checkversion < $ExtUtils::MakeMaker::Version_OK; + if $checkversion lt $ExtUtils::MakeMaker::Version_OK; printf STDOUT "%s %s %s %s.\n", "Makefile built with ExtUtils::MakeMaker v", $checkversion, "Current Version is", $ExtUtils::MakeMaker::VERSION unless $checkversion == $ExtUtils::MakeMaker::VERSION; } -sub mksymlists { - my $class = shift; - my $self = shift; - bless $self, $class; - tie %att, ExtUtils::MakeMaker::TieAtt, $self; - $self->parse_args(@ARGV); - $self->mksymlists(@_); -} - # The following mkbootstrap() is only for installations that are calling # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker # writes Makefiles, that use ExtUtils::Mkbootstrap directly. @@ -659,6 +651,15 @@ sub mkbootstrap { END } +# Ditto for mksymlists() as of MakeMaker 5.17 +sub mksymlists { + die <<END; +!!! Your Makefile has been built such a long time ago, !!! +!!! that is unlikely to work with current MakeMaker. !!! +!!! Please rebuild your Makefile !!! +END +} + sub neatvalue { my($v) = @_; return "undef" unless defined $v; @@ -705,7 +706,7 @@ sub selfdocument { # # # # # # # ## # # # # # # # ####### ##### # # # # # -package MM_Unix; +package ExtUtils::MM_Unix; use Config; use Cwd; @@ -713,7 +714,7 @@ use File::Basename; require Exporter; Exporter::import('ExtUtils::MakeMaker', - qw( $Verbose)); + qw( $Verbose &neatvalue)); # These attributes cannot be overridden externally @Other_Att_Keys{qw(EXTRALIBS BSLOADLIBS LDLOADLIBS)} = (1) x 3; @@ -1026,8 +1027,6 @@ EOM close PM; } $self->{VERSION} = "0.10" unless $self->{VERSION}; - $self->{VERSION} = sprintf("%.10g",$self->{VERSION}) - if ($self->{VERSION} =~ /^[\d.]{9,}$/); ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; # Graham Barr and Paul Marquess had some ideas how to ensure @@ -1089,7 +1088,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) } elsif ($name =~ /\.h$/i){ $h{$name} = 1; } elsif ($name =~ /\.(p[ml]|pod)$/){ - $pm{$name} = $self->catfile('$(INST_LIBDIR)',"$name"); + $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); } elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") { ($pl_files{$name} = $name) =~ s/\.PL$// ; } elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' && @@ -1153,7 +1152,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) my($striplibpath,$striplibname); $prefix = '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:); ($striplibname,$striplibpath) = fileparse($striplibpath); - my($inst) = $self->catfile($self->catdir($prefix,$striplibpath),$striplibname); + my($inst) = $self->catfile($prefix,$striplibpath,$striplibname); local($_) = $inst; # for backwards compatibility $inst = $self->libscan($inst); print "libscan($path) => '$inst'\n" if ($ExtUtils::MakeMaker::Verbose >= 2); @@ -1901,6 +1900,13 @@ MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\ -e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\ -e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\ -e 'mkdir("@p",0777)||die $$! } } exit 0;' + +# This helps us to minimize the effect of the .exists files A yet +# better solution would be to have a stable file in the perl +# distribution with a timestamp of zero. But this solution doesn't +# need any changes to the core distribution and works with older perls +EQUALIZE_TIMESTAMP = $(PERL) -we 'open F, ">$$ARGV[1]"; close F;' \\ +-e 'utime ((stat("$$ARGV[0]"))[8,9], $$ARGV[1])' }; } @@ -1955,6 +1961,19 @@ sub macro { join "", @m; } +sub depend { + my($self,%attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$key,$val); + while (($key,$val) = each %attribs){ + push @m, "$key: $val\n"; + } + join "", @m; +} + sub post_constants{ my($self) = shift; unless (ref $self){ @@ -1976,7 +1995,7 @@ sub pasthru { foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A - LINKTYPE)){ + LINKTYPE PREFIX)){ push @pasthru, "$key=\"\$($key)\""; } @@ -2130,11 +2149,10 @@ static :: $self->{BASEEXT}.exp push(@m," $self->{BASEEXT}.exp: Makefile.PL -",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::MakeMaker qw(&mksymlists); \\ - MM->new({NAME => "'.$self->{NAME}.'"})->mksymlists({DL_FUNCS => ', - %$funcs ? neatvalue($funcs) : '""',', DL_VARS => ', - @$vars ? neatvalue($vars) : '""', ", NAME => \"$self->{NAME}\"})' -"); +",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ + Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', + neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\' +'); join('',@m); } @@ -3101,39 +3119,6 @@ sub extliblist { ExtUtils::Liblist::ext($libs, $ExtUtils::MakeMaker::Verbose); } -sub mksymlists { - my($self) = shift; - unless (ref $self){ - ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); - $self = $ExtUtils::MakeMaker::Parent[-1]; - } - my($pkg); - - # only AIX requires a symbol list at this point - # (so does VMS, but that's handled by the MM_VMS package) - return '' unless $Config::Config{osname} eq 'aix'; - - $self->init_main(@ARGV) unless defined $self->{BASEEXT}; - if (! $self->{DL_FUNCS}) { - my($bootfunc); - ($bootfunc = $self->{NAME}) =~ s/\W/_/g; - $self->{DL_FUNCS} = {$self->{BASEEXT} => ["boot_$bootfunc"]}; - } - rename "$self->{BASEEXT}.exp", "$self->{BASEEXT}.exp_old"; - - open(EXP,">$self->{BASEEXT}.exp") or die $!; - print EXP join("\n",@{$self->{DL_VARS}}, "\n") if $self->{DL_VARS}; - foreach $pkg (keys %{$self->{DL_FUNCS}}) { - (my($prefix) = $pkg) =~ s/\W/_/g; - my $func; - foreach $func (@{$self->{DL_FUNCS}->{$pkg}}) { - $func = "XS_${prefix}_$func" unless $func =~ /^boot_/; - print EXP "$func\n"; - } - } - close EXP; -} - # --- Make-Directories section (internal method) --- # dir_target(@array) returns a Makefile entry for the file .exists in each # named directory. Returns nothing, if the entry has already been processed. @@ -3154,7 +3139,7 @@ sub dir_target { push @m, " $dir/.exists :: \$(PERL) $self->{NOECHO}\$(MKPATH) $dir - $self->{NOECHO}\$(TOUCH) $dir/.exists + $self->{NOECHO}\$(EQUALIZE_TIMESTAMP) \$(PERL) $dir/.exists $self->{NOECHO}-\$(CHMOD) 755 $dir "; } @@ -3233,7 +3218,7 @@ package ExtUtils::MM_OS2; require Exporter; Exporter::import('ExtUtils::MakeMaker', - qw( $Verbose)); + qw( $Verbose &neatvalue)); sub dlsyms { my($self,%attribs) = @_; @@ -3245,20 +3230,12 @@ sub dlsyms { if (not $self->{SKIPHASH}{'dynamic'}) { push(@m," -$self->{BASEEXT}.def: Makefile.PL" - . ' - echo "LIBRARY ' . "'$self->{DLBASE}'" . ' INITINSTANCE TERMINSTANCE" > $@ ; \\ - echo "CODE LOADONCALL" >> $@ ; \\ - echo "DATA LOADONCALL NONSHARED MULTIPLE" >> $@ ; \\ - echo "EXPORTS" >> $@ ; \\ - echo " ' . "boot_$boot" . '" >> $@'); - foreach $sym (keys %$funcs, @$vars) { - push(@m, " ; \\ - echo \" $sym\" >> \$@"); - } - push(@m,"\n"); +$self->{BASEEXT}.def: Makefile.PL +",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ + Mksymlists("NAME" => "',$self->{NAME},'", "DLBASE" => "',$self->{DLBASE}, + '", "DL_FUNCS" => ',neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\' +'); } - join('',@m); } @@ -3979,7 +3956,7 @@ B<after> the eval() will be assigned to the VERSION attribute of the MakeMaker object. The following lines will be parsed o.k.: $VERSION = '1.00'; - ( $VERSION ) = '$Revision: 1.135 $ ' =~ /\$Revision:\s+([^\s]+)/; + ( $VERSION ) = '$Revision: 1.141 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; but these will fail: @@ -4031,6 +4008,10 @@ part of the Makefile. These are not normally required: {FILES => "*.xyz foo"} +=item depend + + {ANY_TARGET => ANY_DEPENDECY, ...} + =item dist {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz', diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm new file mode 100644 index 0000000000..cc4aca1c82 --- /dev/null +++ b/lib/ExtUtils/Mksymlists.pm @@ -0,0 +1,217 @@ +package ExtUtils::Mksymlists; +use strict qw[ subs refs ]; +# no strict 'vars'; # until filehandles are exempted + +use Carp; +use Config; +use Exporter; +# mention vars twice to prevent single-use warnings +@ExtUtils::Mksymlists::ISA = @ExtUtils::Mksymlists::ISA = 'Exporter'; +@ExtUtils::Mksymlists::EXPORT = @ExtUtils::Mksymlists::EXPORT = '&Mksymlists'; +$ExtUtils::Mksymlists::VERSION = $ExtUtils::Mksymlists::VERSION = '1.00'; + +sub Mksymlists { + my(%spec) = @_; + my($osname) = $Config{'osname'}; + + croak("Insufficient information specified to Mksymlists") + unless ( $spec{NAME} or + ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) ); + + $spec{DL_VARS} = [] unless $spec{DL_VARS}; + ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE}; + $spec{DL_FUNCS} = { $spec{NAME} => [] } + unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or + $spec{FUNCLIST}); + $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; + if (defined $spec{DL_FUNCS}) { + my($package); + foreach $package (keys %{$spec{DL_FUNCS}}) { + my($packprefix,$sym,$bootseen); + ($packprefix = $package) =~ s/\W/_/g; + foreach $sym (@{$spec{DL_FUNCS}->{$package}}) { + if ($sym =~ /^boot_/) { + push(@{$spec{FUNCLIST}},$sym); + $bootseen++; + } + else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); } + } + push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen; + } + } + +# We'll need this if we ever add any OS which uses mod2fname +# require DynaLoader; +# if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) { +# $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]); +# } + + if ($osname eq 'aix') { _write_aix(\%spec); } + elsif ($osname eq 'VMS') { _write_vms(\%spec) } + elsif ($osname eq 'OS2') { _write_os2(\%spec) } + else { croak("Don't know how to create linker option file for $osname\n"); } +} + + +sub _write_aix { + my($data) = @_; + + rename "$data->{FILE}.exp", "$data->{FILE}.exp_old"; + + open(EXP,">$data->{FILE}.exp") + or croak("Can't create $data->{FILE}.exp: $!\n"); + print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; + print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; + close EXP; +} + + +sub _write_os2 { + my($data) = @_; + + if (not $data->{DLBASE}) { + ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; + $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; + } + rename "$data->{FILE}.def", "$data->{FILE}_def.old"; + + open(DEF,">$data->{FILE}.def") + or croak("Can't create $data->{FILE}.def: $!\n"); + print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n"; + print DEF "CODE LOADONCALL\n"; + print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; + print DEF "EXPORTS\n"; + print DEF join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; + print DEF join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; + close DEF; +} + + +sub _write_vms { + my($data) = @_; + my($isvax) = $Config{'arch'} =~ /VAX/i; + my($sym); + + rename "$data->{FILE}.opt", "$data->{FILE}.opt_old"; + + open(OPT,">$data->{FILE}.opt") + or croak("Can't create $data->{FILE}.opt: $!\n"); + + # Options file declaring universal symbols + # Used when linking shareable image for dynamic extension, + # or when linking PerlShr into which we've added this package + # as a static extension + # We don't do anything to preserve order, so we won't relax + # the GSMATCH criteria for a dynamic extension + + foreach $sym (@{$data->{FUNCLIST}}) { + if ($isvax) { print OPT "UNIVERSAL=$sym\n" } + else { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; } + } + foreach $sym (@{$data->{DL_VARS}}) { + print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; + if ($isvax) { print OPT "UNIVERSAL=$sym\n" } + else { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; } + } + close OPT; + + # Options file specifying RTLs to which this extension must be linked. + # Eventually, the list of libraries will be supplied by a working + # extliblist routine. + open OPT,'>rtls.opt'; + print OPT "PerlShr/Share\n"; + foreach $rtl (split(/\s+/,$Config{'libs'})) { print OPT "$rtl\n"; } + close OPT; +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::Mksymlists - write linker options files for dynamic extension + +=head1 SYNOPSIS + + use ExtUtils::Mksymlists; + Mksymlists({ NAME => $name , + DL_VARS => [ $var1, $var2, $var3 ], + DL_FUNCS => { $pkg1 => [ $func1, $func2 ], + $pkg2 => [ $func3 ] }); + +=head1 DESCRIPTION + +C<ExtUtils::Mksymlists> produces files used by the linker under some OSs +during the creation of shared libraries for synamic extensions. It is +normally called from a MakeMaker-generated Makefile when the extension +is built. The linker option file is generated by calling the function +C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>. +It takes one argument, a list of key-value pairs, in which the following +keys are recognized: + +=item NAME + +This gives the name of the extension (I<e.g.> Tk::Canvas) for which +the linker option file will be produced. + +=item DL_FUNCS + +This is identical to the DL_FUNCS attribute available via MakeMaker, +from which it is usually taken. Its value is a reference to an +associative array, in which each key is the name of a package, and +each value is an a reference to an array of function names which +should be exported by the extension. For instance, one might say +C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ], +Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The +function names should be identical to those in the XSUB code; +C<Mksymlists> will alter the names written to the linker option +file to match the changes made by F<xsubpp>. In addition, if +none of the functions in a list begin with the string B<boot_>, +C<Mksymlists> will add a bootstrap function for that package, +just as xsubpp does. (If a B<boot_E<lt>pkgE<gt>> function is +present in the list, it is passed through unchanged.) If +DL_FUNCS is not specified, it defaults to the bootstrap +function for the extension specified in NAME. + +=item DL_VARS + +This is identical to the DL_VARS attribute available via MakeMaker, +and, like DL_FUNCS, it is usually specified via MakeMaker. Its +value is a reference to an array of variable names which should +be exported by the extension. + +=item FILE + +This key can be used to specify the name of the linker option file +(minus the OS-specific extension), if for some reason you do not +want to use the default value, which is the last word of the NAME +attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas'). + +=item FUNCLIST + +This provides an alternate means to specify function names to be +exported from the extension. Its value is a reference to an +array of function names to be exported by the extension. These +names are passed through unaltered to the linker options file. + +=item DLBASE + +This item specifies the name by which the linker knows the +extension, which may be different from the name of the +extension itself (for instance, some linkers add an '_' to the +name of the extension). If it is not specified, it is derived +from the NAME attribute. It is presently used only by OS2. + +When calling C<Mksymlists>, one should always specify the NAME +attribute. In most cases, this is all that's necessary. In +the case of unusual extensions, however, the other attributes +can be used to provide additional information to the linker. + +=head1 AUTHOR + +Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> + +=head1 REVISION + +Last revised 14-Jan-1996, for Perl 5.002. diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 98493e7c04..a9733d0f49 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -261,7 +261,7 @@ T_ARRAY T_IN { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "<&", 2, $var) ) + if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &sv_undef; @@ -269,7 +269,7 @@ T_IN T_INOUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+<&", 3, $var) ) + if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &sv_undef; @@ -277,7 +277,7 @@ T_INOUT T_OUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+>&", 3, $var) ) + if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &sv_undef; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 3113c62ed9..0d9c816abc 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -76,13 +76,12 @@ perl(1), perlxs(1), perlxstut(1), perlapi(1) =cut # Global Constants -$XSUBPP_version = "1.929"; +$XSUBPP_version = "1.932"; require 5.002; sub Q ; -$FH_string = 'File0000' ; -*FH = $FH_string ; +$FH = 'File0000' ; $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n"; @@ -405,6 +404,9 @@ sub VERSIONCHECK_handler () sub PROTOTYPE_handler () { + death("Error: Only 1 PROTOTYPE definition allowed per xsub") + if $proto_in_this_xsub ++ ; + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { next unless /\S/; TrimWhitespace($_) ; @@ -422,7 +424,9 @@ sub PROTOTYPE_handler () $ProtoThisXSUB = C_string($_) ; } } + $ProtoUsed = 1 ; + } sub PROTOTYPES_handler () @@ -448,9 +452,6 @@ sub INCLUDE_handler () TrimWhitespace($_) ; - # If the filename is enclosed in quotes, remove them. - s/^'([^']*)'$/$1/ or s/^"([^"]*)"$/$1/ ; - death("INCLUDE: filename missing") unless $_ ; @@ -470,13 +471,13 @@ sub INCLUDE_handler () Line => \@line, LineNo => \@line_no, Filename => $filename, - Handle => $FH_string, + Handle => $FH, }) ; - ++ $FH_string ; + ++ $FH ; # open the new file - open ($FH_string, "$_") or death("Cannot open '$_': $!") ; + open ($FH, "$_") or death("Cannot open '$_': $!") ; print Q<<"EOF" ; # @@ -484,11 +485,17 @@ sub INCLUDE_handler () # EOF - *FH = $FH_string ; $filename = $_ ; - # Prime the pump by reading the first line - $lastline = <FH> ; + # Prime the pump by reading the first + # non-blank line + + # skip leading blank lines + while (<$FH>) { + last unless /^\s*$/ ; + } + + $lastline = $_ ; $lastline_no = $. ; } @@ -504,9 +511,9 @@ sub PopFile() -- $IncludedFiles{$filename} unless $isPipe ; - close FH ; + close $FH ; - *FH = $data->{Handle} ; + $FH = $data->{Handle} ; $filename = $data->{Filename} ; $lastline = $data->{LastLine} ; $lastline_no = $data->{LastLineNo} ; @@ -581,7 +588,7 @@ sub Q { $text; } -open(FH, $filename) or die "cannot open $filename: $!\n"; +open($FH, $filename) or die "cannot open $filename: $!\n"; # Identify the version of xsubpp used print <<EOM ; @@ -596,7 +603,7 @@ print <<EOM ; EOM -while (<FH>) { +while (<$FH>) { last if ($Module, $Package, $Prefix) = /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; print $_; @@ -607,14 +614,14 @@ $lastline = $_; $lastline_no = $.; -# Read next xsub into @line from ($lastline, <FH>). +# Read next xsub into @line from ($lastline, <$FH>). sub fetch_para { # parse paragraph @line = (); @line_no = () ; if (! defined $lastline) { return 1 if PopFile() ; - return 0 ; + return 0 ; } if ($lastline =~ @@ -638,11 +645,11 @@ sub fetch_para { } # Read next line and continuation lines - last unless defined($lastline = <FH>); + last unless defined($lastline = <$FH>); $lastline_no = $.; my $tmp_line; $lastline .= $tmp_line - while ($lastline =~ /\\$/ && defined($tmp_line = <FH>)); + while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>)); chomp $lastline; $lastline =~ s/^\s+$//; @@ -673,6 +680,7 @@ while (fetch_para()) { undef($wantRETVAL) ; undef(%arg_list) ; undef(@proto_arg) ; + undef($proto_in_this_xsub) ; $ProtoThisXSUB = $WantPrototypes ; $_ = shift(@line); @@ -986,7 +994,7 @@ for (@Func_name) { # XSANY.any_i32 = $value ; EOF print Q<<"EOF" if $proto ; -# sv_setpv(cv, $ProtoXSUB{$pname}) ; +# sv_setpv((SV*)cv, $ProtoXSUB{$pname}) ; EOF } } diff --git a/lib/FileCache.pm b/lib/FileCache.pm new file mode 100644 index 0000000000..3d01371b3b --- /dev/null +++ b/lib/FileCache.pm @@ -0,0 +1,78 @@ +package FileCache; + +=head1 NAME + +FileCache - keep more files open than the system permits + +=head1 SYNOPSIS + + cacheout $path; + print $path @data; + +=head1 DESCRIPTION + +The C<cacheout> function will make sure that there's a filehandle open +for writing available as the pathname you give it. It automatically +closes and re-opens files if you exceed your system file descriptor +maximum. + +=head1 BUGS + +F<sys/param.h> lies with its C<NOFILE> define on some systems, +so you may have to set $cacheout::maxopen yourself. + +=cut + +require 5.000; +use Carp; +use Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw( + cacheout +); + +# Open in their package. + +sub cacheout_open { + my $pack = caller(1); + open(*{$pack . '::' . $_[0]}, $_[1]); +} + +sub cacheout_close { + my $pack = caller(1); + close(*{$pack . '::' . $_[0]}); +} + +# But only this sub name is visible to them. + +$cacheout_seq = 0; +$cacheout_numopen = 0; + +sub cacheout { + ($file) = @_; + unless (defined $cacheout_maxopen) { + if (open(PARAM,'/usr/include/sys/param.h')) { + local $.; + while (<PARAM>) { + $cacheout_maxopen = $1 - 4 + if /^\s*#\s*define\s+NOFILE\s+(\d+)/; + } + close PARAM; + } + $cacheout_maxopen = 16 unless $cacheout_maxopen; + } + if (!$isopen{$file}) { + if (++$cacheout_numopen > $cacheout_maxopen) { + my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); + splice(@lru, $cacheout_maxopen / 3); + $cacheout_numopen -= @lru; + for (@lru) { &cacheout_close($_); delete $isopen{$_}; } + } + cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file) + or croak("Can't create $file: $!"); + } + $isopen{$file} = ++$cacheout_seq; +} + +1; diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index cbc6efbc6c..93a3088886 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -1,25 +1,80 @@ package FileHandle; -# Note that some additional FileHandle methods are defined in POSIX.pm. - =head1 NAME FileHandle - supply object methods for filehandles -cacheout - keep more files open than the system permits - =head1 SYNOPSIS use FileHandle; - autoflush STDOUT 1; - cacheout($path); - print $path @data; + $fh = new FileHandle; + if ($fh->open "< file") { + print <$fh>; + $fh->close; + } + + $fh = new FileHandle "> FOO"; + if (defined $fh) { + print $fh "bar\n"; + $fh->close; + } + + $fh = new FileHandle "file", "r"; + if (defined $fh) { + print <$fh>; + undef $fh; # automatically closes the file + } + + $fh = new FileHandle "file", O_WRONLY|O_APPEND; + if (defined $fh) { + print $fh "corge\n"; + undef $fh; # automatically closes the file + } + + ($readfh, $writefh) = FileHandle::pipe; + autoflush STDOUT 1; + =head1 DESCRIPTION -See L<perlvar> for complete descriptions of each of the following supported C<FileHandle> -methods: +C<FileHandle::new> creates a C<FileHandle>, which is a reference to a +newly created symbol (see the C<Symbol> package). If it receives any +parameters, they are passed to C<FileHandle::open>; if the open fails, +the C<FileHandle> object is destroyed. Otherwise, it is returned to +the caller. + +C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does. +It requires two parameters, which are passed to C<FileHandle::fdopen>; +if the fdopen fails, the C<FileHandle> object is destroyed. +Otherwise, it is returned to the caller. + +C<FileHandle::open> accepts one parameter or two. With one parameter, +it is just a front end for the built-in C<open> function. With two +parameters, the first parameter is a filename that may include +whitespace or other special characters, and the second parameter is +the open mode in either Perl form (">", "+<", etc.) or POSIX form +("w", "r+", etc.). + +C<FileHandle::fdopen> is like C<open> except that its first parameter +is not a filename but rather a file handle name, a FileHandle object, +or a file descriptor number. + +See L<perlfunc> for complete descriptions of each of the following +supported C<FileHandle> methods, which are just front ends for the +corresponding built-in functions: + + close + fileno + getc + gets + eof + clearerr + seek + tell + +See L<perlvar> for complete descriptions of each of the following +supported C<FileHandle> methods: autoflush output_field_separator @@ -48,9 +103,9 @@ See L<perlfunc/printf>. =item $fh->getline -This works like <$fh> described in L<perlop/"I/O Operators"> except that it's more readable -and can be safely called in an array context but still -returns just one line. +This works like <$fh> described in L<perlop/"I/O Operators"> +except that it's more readable and can be safely called in an +array context but still returns just one line. =item $fh->getlines @@ -60,12 +115,6 @@ It will also croak() if accidentally called in a scalar context. =back -=head2 The cacheout() Library - -The cacheout() function will make sure that there's a filehandle -open for writing available as the pathname you give it. It automatically -closes and re-opens files if you exceed your system file descriptor maximum. - =head1 SEE ALSO L<perlfunc>, @@ -74,15 +123,6 @@ L<POSIX/"FileHandle"> =head1 BUGS -F<sys/param.h> lies with its C<NOFILE> define on some systems, -so you may have to set $cacheout::maxopen yourself. - -Some of the methods that set variables (like format_name()) don't -seem to work. - -The POSIX functions that create FileHandle methods should be -in this module instead. - Due to backwards compatibility, all filehandles resemble objects of class C<FileHandle>, or actually classes derived from that class. They actually aren't. Which means you can't derive your own @@ -91,12 +131,20 @@ class from C<FileHandle> and inherit those methods. =cut require 5.000; -use English; use Carp; -use Exporter; +use Fcntl; +use Symbol; +use English; +use SelectSaver; + +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); + +@EXPORT = (@Fcntl::EXPORT, + qw(_IOFBF _IOLBF _IONBF)); -@ISA = qw(Exporter); -@EXPORT = qw( +@EXPORT_OK = qw( autoflush output_field_separator output_record_separator @@ -114,173 +162,265 @@ use Exporter; printf getline getlines - - cacheout ); + +################################################ +## Interaction with the XS. +## + +bootstrap FileHandle; + +sub AUTOLOAD { + if ($AUTOLOAD =~ /::(_?[a-z])/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD + } + my $constname = $AUTOLOAD; + $constname =~ s/.*:://; + my $val = constant($constname); + defined $val or croak "$constname is not a valid FileHandle macro"; + *$AUTOLOAD = sub { $val }; + goto &$AUTOLOAD; +} + + +################################################ +## Constructors, destructors. +## + +sub new { + @_ >= 1 && @_ <= 3 or croak 'usage: new FileHandle [FILENAME [,MODE]]'; + my $class = shift; + my $fh = gensym; + if (@_) { + FileHandle::open($fh, @_) + or return undef; + } + bless $fh, $class; +} + +sub new_from_fd { + @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE'; + my $class = shift; + my $fh = gensym; + FileHandle::fdopen($fh, @_) + or return undef; + bless $fh, $class; +} + +sub DESTROY { + my ($fh) = @_; + close($fh); +} + +################################################ +## Open and close. +## + +sub pipe { + @_ and croak 'usage: FileHandle::pipe()'; + my $readfh = new FileHandle; + my $writefh = new FileHandle; + pipe($readfh, $writefh) + or return undef; + ($readfh, $writefh); +} + +sub _open_mode_string { + my ($mode) = @_; + $mode =~ /^\+?(<|>>?)$/ + or $mode =~ s/^r(\+?)$/$1</ + or $mode =~ s/^w(\+?)$/$1>/ + or $mode =~ s/^a(\+?)$/$1>>/ + or croak "FileHandle: bad open mode: $mode"; + $mode; +} + +sub open { + @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; + my ($fh, $file) = @_; + if (@_ > 2) { + my ($mode, $perms) = @_[2, 3]; + if ($mode =~ /^\d+$/) { + defined $perms or $perms = 0666; + return sysopen($fh, $file, $mode, $perms); + } + $file = "./" . $file unless $file =~ m#^/#; + $file = _open_mode_string($mode) . " $file\0"; + } + open($fh, $file); +} + +sub fdopen { + @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)'; + my ($fh, $fd, $mode) = @_; + if (ref($fd) =~ /GLOB\(/) { + # It's a glob reference; remove the star from its name. + ($fd = "".$$fd) =~ s/^\*//; + } elsif ($fd =~ m#^\d+$#) { + # It's an FD number; prefix with "=". + $fd = "=$fd"; + } + open($fh, _open_mode_string($mode) . '&' . $fd); +} + +sub close { + @_ == 1 or croak 'usage: $fh->close()'; + close($_[0]); +} + +################################################ +## Normal I/O functions. +## + +sub fileno { + @_ == 1 or croak 'usage: $fh->fileno()'; + fileno($_[0]); +} + +sub getc { + @_ == 1 or croak 'usage: $fh->getc()'; + getc($_[0]); +} + +sub gets { + @_ == 1 or croak 'usage: $fh->gets()'; + my ($handle) = @_; + scalar <$handle>; +} + +sub eof { + @_ == 1 or croak 'usage: $fh->eof()'; + eof($_[0]); +} + +sub clearerr { + @_ == 1 or croak 'usage: $fh->clearerr()'; + seek($_[0], 0, 1); +} + +sub seek { + @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)'; + seek($_[0], $_[1], $_[2]); +} + +sub tell { + @_ == 1 or croak 'usage: $fh->tell()'; + tell($_[0]); +} + sub print { - local($this) = shift; + @_ or croak 'usage: $fh->print([ARGS])'; + my $this = shift; print $this @_; } sub printf { - local($this) = shift; + @_ or croak 'usage: $fh->printf([ARGS])'; + my $this = shift; printf $this @_; } sub getline { - local($this) = shift; - croak "usage: FileHandle::getline()" if @_; + @_ == 1 or croak 'usage: $fh->getline'; + my $this = shift; return scalar <$this>; } sub getlines { - local($this) = shift; - croak "usage: FileHandle::getline()" if @_; - croak "can't call FileHandle::getlines in a scalar context" if wantarray; + @_ == 1 or croak 'usage: $fh->getline()'; + my $this = shift; + wantarray or croak "Can't call FileHandle::getlines in a scalar context"; return <$this>; -} +} + +################################################ +## State modification functions. +## sub autoflush { - local($old) = select($_[0]); - local($prev) = $OUTPUT_AUTOFLUSH; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_AUTOFLUSH; $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; - select($old); $prev; } sub output_field_separator { - local($old) = select($_[0]); - local($prev) = $OUTPUT_FIELD_SEPARATOR; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_FIELD_SEPARATOR; $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; - select($old); $prev; } sub output_record_separator { - local($old) = select($_[0]); - local($prev) = $OUTPUT_RECORD_SEPARATOR; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $OUTPUT_RECORD_SEPARATOR; $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - select($old); $prev; } sub input_record_separator { - local($old) = select($_[0]); - local($prev) = $INPUT_RECORD_SEPARATOR; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $INPUT_RECORD_SEPARATOR; $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - select($old); $prev; } sub input_line_number { - local($old) = select($_[0]); - local($prev) = $INPUT_LINE_NUMBER; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $INPUT_LINE_NUMBER; $INPUT_LINE_NUMBER = $_[1] if @_ > 1; - select($old); $prev; } sub format_page_number { - local($old) = select($_[0]); - local($prev) = $FORMAT_PAGE_NUMBER; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_PAGE_NUMBER; $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; - select($old); $prev; } sub format_lines_per_page { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINES_PER_PAGE; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINES_PER_PAGE; $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1; - select($old); $prev; } sub format_lines_left { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINES_LEFT; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINES_LEFT; $FORMAT_LINES_LEFT = $_[1] if @_ > 1; - select($old); $prev; } sub format_name { - local($old) = select($_[0]); - local($prev) = $FORMAT_NAME; - $FORMAT_NAME = $_[1] if @_ > 1; - select($old); + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_NAME; + $FORMAT_NAME = qualify($_[1], caller) if @_ > 1; $prev; } sub format_top_name { - local($old) = select($_[0]); - local($prev) = $FORMAT_TOP_NAME; - $FORMAT_TOP_NAME = $_[1] if @_ > 1; - select($old); + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_TOP_NAME; + $FORMAT_TOP_NAME = qualify($_[1], caller) if @_ > 1; $prev; } sub format_line_break_characters { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINE_BREAK_CHARACTERS; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_LINE_BREAK_CHARACTERS; $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1; - select($old); $prev; } sub format_formfeed { - local($old) = select($_[0]); - local($prev) = $FORMAT_FORMFEED; + my $old = new SelectSaver qualify($_[0], caller); + my $prev = $FORMAT_FORMFEED; $FORMAT_FORMFEED = $_[1] if @_ > 1; - select($old); $prev; } - -# --- cacheout functions --- - -# Open in their package. - -sub cacheout_open { - my $pack = caller(1); - open(*{$pack . '::' . $_[0]}, $_[1]); -} - -sub cacheout_close { - my $pack = caller(1); - close(*{$pack . '::' . $_[0]}); -} - -# But only this sub name is visible to them. - -sub cacheout { - ($file) = @_; - if (!$cacheout_maxopen){ - if (open(PARAM,'/usr/include/sys/param.h')) { - local($.); - while (<PARAM>) { - $cacheout_maxopen = $1 - 4 - if /^\s*#\s*define\s+NOFILE\s+(\d+)/; - } - close PARAM; - } - $cacheout_maxopen = 16 unless $cacheout_maxopen; - } - if (!$isopen{$file}) { - if (++$cacheout_numopen > $cacheout_maxopen) { - local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); - splice(@lru, $cacheout_maxopen / 3); - $cacheout_numopen -= @lru; - for (@lru) { &cacheout_close($_); delete $isopen{$_}; } - } - &cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file) - || croak("Can't create $file: $!"); - } - $isopen{$file} = ++$cacheout_seq; -} - -$cacheout_seq = 0; -$cacheout_numopen = 0; - 1; diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 43e1e58e59..a3bd4fb765 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -137,11 +137,6 @@ Enable debugging output. Default is 0. =back -=head1 NOTE - -Does not yet use the Exporter--or even packages!! -Thus, it's not a real module. - =cut # newgetopt.pl -- new options parsing diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm index 1ac963ab6b..243412ef09 100644 --- a/lib/IPC/Open2.pm +++ b/lib/IPC/Open2.pm @@ -96,8 +96,8 @@ sub open2 { open(STDIN, "<&$kid_rdr"); open(STDOUT, ">&$kid_wtr"); warn "execing @cmd\n" if $debug; - exec @cmd; - croak "open2: exec of @cmd failed"; + exec @cmd + or croak "open2: exec of @cmd failed"; } close $kid_rdr; close $kid_wtr; select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 5bc757c344..dbf5562028 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -102,7 +102,7 @@ sub open3 { } if (($kidpid = fork) < 0) { - croak "open2: fork failed: $!"; + croak "open3: fork failed: $!"; } elsif ($kidpid == 0) { if ($dup_wtr) { open(STDIN, "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr)); @@ -128,8 +128,8 @@ sub open3 { open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT)); } local($")=(" "); - exec @cmd; - croak "open2: exec of @cmd failed"; + exec @cmd + or croak "open3: exec of @cmd failed"; } close $kid_rdr; close $kid_wtr; close $kid_err; diff --git a/lib/SelectSaver.pm b/lib/SelectSaver.pm new file mode 100644 index 0000000000..4c764bedcf --- /dev/null +++ b/lib/SelectSaver.pm @@ -0,0 +1,50 @@ +package SelectSaver; + +=head1 NAME + +SelectSaver - save and restore selected file handle + +=head1 SYNOPSIS + + use SelectSaver; + + { + my $saver = new SelectSaver(FILEHANDLE); + # FILEHANDLE is selected + } + # previous handle is selected + + { + my $saver = new SelectSaver; + # new handle may be selected, or not + } + # previous handle is selected + +=head1 DESCRIPTION + +A C<SelectSaver> object contains a reference to the file handle that +was selected when it was created. If its C<new> method gets an extra +parameter, then that parameter is selected; otherwise, the selected +file handle remains unchanged. + +When a C<SelectSaver> is destroyed, it re-selects the file handle +that was selected when it was created. + +=cut + +require 5.000; +use Carp; +use Symbol; + +sub new { + @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]'; + my $fh = (@_ > 1) ? (select qualify($_[1], caller)) : select; + bless [$fh], $_[0]; +} + +sub DESTROY { + my $this = $_[0]; + select $$this[0]; +} + +1; diff --git a/lib/Symbol.pm b/lib/Symbol.pm new file mode 100644 index 0000000000..ccc12b67c7 --- /dev/null +++ b/lib/Symbol.pm @@ -0,0 +1,99 @@ +package Symbol; + +=head1 NAME + +Symbol - manipulate Perl symbols and their names + +=head1 SYNOPSIS + + use Symbol; + + $sym = gensym; + open($sym, "filename"); + $_ = <$sym>; + # etc. + + ungensym $sym; # no effect + + print qualify("x"), "\n"; # "Test::x" + print qualify("x", "FOO"), "\n" # "FOO::x" + print qualify("BAR::x"), "\n"; # "BAR::x" + print qualify("BAR::x", "FOO"), "\n"; # "BAR::x" + print qualify("STDOUT", "FOO"), "\n"; # "main::STDOUT" (global) + print qualify(\*x), "\n"; # returns \*x + print qualify(\*x, "FOO"), "\n"; # returns \*x + +=head1 DESCRIPTION + +C<Symbol::gensym> creates an anonymous glob and returns a reference +to it. Such a glob reference can be used as a file or directory +handle. + +For backward compatibility with older implementations that didn't +support anonymous globs, C<Symbol::ungensym> is also provided. +But it doesn't do anything. + +C<Symbol::qualify> turns unqualified symbol names into qualified +variable names (e.g. "myvar" -> "MyPackage::myvar"). If it is given a +second parameter, C<qualify> uses it as the default package; +otherwise, it uses the package of its caller. Regardless, global +variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with +"main::". + +Qualification applies only to symbol names (strings). References are +left unchanged under the assumption that they are glob references, +which are qualified by their nature. + +=cut + +require 5.002; + +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw(gensym ungensym qualify); + +my $genpkg = "Symbol::"; +my $genseq = 0; + +my %global; +while (<DATA>) { + chomp; + $global{$_} = 1; +} + +sub gensym () { + my $name = "GEN" . $genseq++; + local *{$genpkg . $name}; + \delete ${$genpkg}{$name}; +} + +sub ungensym ($) {} + +sub qualify ($;$) { + my ($name) = @_; + if (! ref($name) && $name !~ /::/) { + my $pkg; + # Global names: special character, "^x", or other. + if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) { + $pkg = "main"; + } + else { + $pkg = (@_ > 1) ? $_[1] : caller; + } + $name = $pkg . "::" . $name; + } + $name; +} + +1; + +__DATA__ +ARGV +ARGVOUT +ENV +INC +SIG +STDERR +STDIN +STDOUT diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm index 5e900c3f23..656889591a 100644 --- a/lib/Term/Cap.pm +++ b/lib/Term/Cap.pm @@ -104,8 +104,9 @@ as C<$self-E<gt>{TERMCAP}>. sub termcap_path { ## private my @termcap_path; # $TERMCAP, if it's a filespec - push(@termcap_path, $ENV{TERMCAP}) if $ENV{TERMCAP} =~ /^\//; - if ($ENV{TERMPATH}) { + push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) && + ($ENV{TERMCAP} =~ /^\//)); + if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) { # Add the users $TERMPATH push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH})) } @@ -150,7 +151,7 @@ sub Tgetent { ## public -- static method # protect any pattern metacharacters in $tmp_term $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g; - my $foo = $ENV{TERMCAP}; + my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : ''); # $entry is the extracted termcap entry if (($foo !~ m:^/:) && ($foo =~ m/(^|\|)${termpat}[:|]/)) { diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 51044262fd..2ce7423186 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -1,6 +1,6 @@ =head1 NAME -C<Term::ReadLine>: Perl interface to various C<readline> packages. If +Term::ReadLine - Perl interface to various C<readline> packages. If no real package is found, substitutes stubs instead of basic functions. =head1 SYNOPSIS @@ -16,6 +16,13 @@ no real package is found, substitutes stubs instead of basic functions. $term->addhistory($_) if /\S/; } +=head1 DESCRIPTION + +This package is just a front end to some other packages. At the moment +this description is written, the only such package is Term-ReadLine, +available on CPAN near you. The real target of this stub package is to +set up a common interface to whatever Readline emerges with time. + =head1 Minimal set of supported functions All the supported functions should be called as methods, i.e., either as diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 99e06f7381..7f6de4aac2 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -3,85 +3,127 @@ package Test::Harness; use Exporter; use Benchmark; use Config; +require 5.002; -$Is_OS2 = $Config{'osname'} =~ m|^os/?2$|i ; +$VERSION = $VERSION = "1.02"; -$ENV{EMXSHELL} = 'sh' if $Is_OS2; # to run commands -$path_s = $Is_OS2 ? ';' : ':' ; - -@ISA=(Exporter); +@ISA=('Exporter'); @EXPORT= qw(&runtests); @EXPORT_OK= qw($verbose $switches); -$verbose = 0; -$switches = "-w"; + +$Test::Harness::verbose = 0; +$Test::Harness::switches = "-w"; sub runtests { my(@tests) = @_; local($|) = 1; - my($test,$te,$ok,$next,$max,$totmax, $files,$pct); + my($test,$te,$ok,$next,$max,$totmax, $files,$pct,@failed); my $bad = 0; my $good = 0; my $total = @tests; - local($ENV{'PERL5LIB'}) = join($path_s, @INC); # pass -I flags to children + local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); # pass -I flags to children my $t_start = new Benchmark; while ($test = shift(@tests)) { - $te = $test; - chop($te); - print "$te" . '.' x (20 - length($te)); - my $fh = "RESULTS"; - open($fh,"$^X $switches $test|") || (print "can't run. $!\n"); - $ok = 0; - $next = 0; - while (<$fh>) { - if( $verbose ){ - print $_; - } - unless (/^#/) { - if (/^1\.\.([0-9]+)/) { - $max = $1; - $totmax += $max; - $files += 1; - $next = 1; - $ok = 1; - } else { - $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; - if (/^ok (.*)/ && $1 == $next) { - $next = $next + 1; - } - } - } - } - close($fh); # must close to reap child resource values - $next -= 1; - if ($ok && $next == $max) { - print "ok\n"; - $good += 1; - } else { - $next += 1; - print "FAILED on test $next\n"; - $bad += 1; - $_ = $test; - } + $te = $test; + chop($te); + print "$te" . '.' x (20 - length($te)); + my $fh = "RESULTS"; + open($fh,"$^X $Test::Harness::switches $test|") || (print "can't run. $!\n"); + $ok = $next = $max = 0; + @failed = (); + while (<$fh>) { + if( $Test::Harness::verbose ){ + print $_; + } + unless (/^\#/) { + if (/^1\.\.([0-9]+)/) { + $max = $1; + $totmax += $max; + $files++; + $next = 1; + } elsif ($max) { + if (/^not ok ([0-9]*)/){ + push @failed, $next; + } elsif (/^ok (.*)/ && $1 == $next) { + $ok++; + } + $next = $1 + 1; + } + } + } + close($fh); # must close to reap child resource values + my $wstatus = $?; + my $estatus = $wstatus >> 8; + $next-- if $next; + if ($ok == $max && $next == $max && ! $wstatus) { + print "ok\n"; + $good++; + } else { + if (@failed) { + print canonfailed($max,@failed); + } else { + if ($next == 0) { + print "FAILED before any test output arrived\n"; + } else { + print canonfailed($max,$next+1..$max); + } + } + if ($wstatus) { + print "\tTest returned status $estatus (wstat $wstatus)\n"; + } + $bad++; + $_ = $test; + } } my $t_total = timediff(new Benchmark, $t_start); - + if ($bad == 0) { - if ($ok) { - print "All tests successful.\n"; - } else { - die "FAILED--no tests were run for some reason.\n"; - } + if ($ok) { + print "All tests successful.\n"; + } else { + die "FAILED--no tests were run for some reason.\n"; + } + } else { + $pct = sprintf("%.2f", $good / $total * 100); + if ($bad == 1) { + die "Failed 1 test script, $pct% okay.\n"; + } else { + die "Failed $bad/$total test scripts, $pct% okay.\n"; + } + } + printf("Files=%d, Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop')); +} + +sub canonfailed ($@) { + my($max,@failed) = @_; + my $failed = @failed; + my @result = (); + my @canon = (); + my $min; + my $last = $min = shift @failed; + if (@failed) { + for (@failed, $failed[-1]) { # don't forget the last one + if ($_ > $last+1 || $_ == $last) { + if ($min == $last) { + push @canon, $last; + } else { + push @canon, "$min-$last"; + } + $min = $_; + } + $last = $_; + } + local $" = ", "; + push @result, "FAILED tests @canon\n"; } else { - $pct = sprintf("%.2f", $good / $total * 100); - if ($bad == 1) { - die "Failed 1 test, $pct% okay.\n"; - } else { - die "Failed $bad/$total tests, $pct% okay.\n"; - } + push @result, "FAILED test $last\n"; } - printf("Files=%d, Tests=%d, %s\n", $files,$totmax, timestr($t_total, 'nop')); + + push @result, "\tFailed $failed/$max tests, "; + push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n"; + join "", @result; } 1; @@ -134,7 +176,14 @@ above messages. =head1 SEE ALSO -See L<Benchmerk> for the underlying timing routines. +See L<Benchmark> for the underlying timing routines. + +=head1 AUTHORS + +Either Tim Bunce or Andreas Koenig, we don't know. What we know for +sure is, that it was inspired by Larry Wall's TEST script that came +with perl distributions for ages. Current maintainer is Andreas +Koenig. =head1 BUGS diff --git a/lib/complete.pl b/lib/complete.pl index dabf8f66ad..1e08f9145a 100644 --- a/lib/complete.pl +++ b/lib/complete.pl @@ -35,7 +35,7 @@ CONFIG: { sub Complete { package Complete; - local($[) = 0; + local($[,$return) = 0; if ($_[1] =~ /^StB\0/) { ($prompt, *_) = @_; } diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index f40c51e030..2c55430ff6 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -3,7 +3,11 @@ eval 'exec perl -S $0 ${1+"$@"}' if 0; use Config; -$diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod"; +if ($Config{'osname'} eq 'VMS') { + $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlib'} . + '/pod/perldiag.pod'; +} +else { $diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod"; } package diagnostics; require 5.001; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index f6e8ecae47..711003a511 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -1293,588 +1293,3 @@ BEGIN { # This does not compile, alas. #use Carp; # This did break, left for debuggin 1; -package DB; - -# modified Perl debugger, to be run from Emacs in perldb-mode -# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990 -# Johan Vromans -- upgrade to 4.0 pl 10 - -$header = '$RCSfile: perl5db.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:07 $'; -# -# This file is automatically included if you do perl -d. -# It's probably not useful to include this yourself. -# -# Perl supplies the values for @line and %sub. It effectively inserts -# a &DB'DB(<linenum>); in front of every place that can -# have a breakpoint. It also inserts a do 'perldb.pl' before the first line. -# -# $Log: perldb.pl,v $ - -# Is Perl being run from Emacs? -$emacs = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs')); -shift(@main::ARGV) if $emacs; - -#require Term::ReadLine; - -local($^W) = 0; - -if (-e "/dev/tty") { - $console = "/dev/tty"; - $rcfile=".perldb"; -} -elsif (-e "con") { - $console = "con"; - $rcfile="perldb.ini"; -} -else { - $console = "sys\$command"; - $rcfile="perldb.ini"; -} - -# Around a bug: -if (defined $ENV{'OS2_SHELL'}) { # In OS/2 - if ($DB::emacs) { - $console = undef; - } else { - $console = "/dev/con"; - } -} - -open(IN, "<$console") || open(IN, "<&STDIN"); # so we don't dingle stdin -open(OUT,">$console") || open(OUT, ">&STDERR") - || open(OUT, ">&STDOUT"); # so we don't dongle stdout -select(OUT); -$| = 1; # for DB::OUT -select(STDOUT); -$| = 1; # for real STDOUT -$sub = ''; - -$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; -print OUT "\nLoading DB routines from $header\n"; -print OUT ("Emacs support ", - $emacs ? "enabled" : "available", - ".\n"); -print OUT "\nEnter h for help.\n\n"; - -@ARGS; - -sub DB { - &save; - ($pkg, $filename, $line) = caller; - $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' . - "package $pkg;"; # this won't let them modify, alas - local(*dbline) = "::_<$filename"; - $max = $#dbline; - if (($stop,$action) = split(/\0/,$dbline{$line})) { - if ($stop eq '1') { - $signal |= 1; - } - else { - $evalarg = "\$DB::signal |= do {$stop;}"; &eval; - $dbline{$line} =~ s/;9($|\0)/$1/; - } - } - if ($single || $trace || $signal) { - if ($emacs) { - print OUT "\032\032$filename:$line:0\n"; - } else { - $prefix = $sub =~ /'|::/ ? "" : "${pkg}::"; - $prefix .= "$sub($filename:"; - if (length($prefix) > 30) { - print OUT "$prefix$line):\n$line:\t",$dbline[$line]; - $prefix = ""; - $infix = ":\t"; - } - else { - $infix = "):\t"; - print OUT "$prefix$line$infix",$dbline[$line]; - } - for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { - last if $dbline[$i] =~ /^\s*(}|#|\n)/; - print OUT "$prefix$i$infix",$dbline[$i]; - } - } - } - $evalarg = $action, &eval if $action; - if ($single || $signal) { - $evalarg = $pre, &eval if $pre; - print OUT $#stack . " levels deep in subroutine calls!\n" - if $single & 4; - $start = $line; - CMD: - while ((print OUT " DB<", $#hist+1, "> "), $cmd=&gets) { - { - $single = 0; - $signal = 0; - $cmd eq '' && exit 0; - chop($cmd); - $cmd =~ s/\\$// && do { - print OUT " cont: "; - $cmd .= &gets; - redo CMD; - }; - $cmd =~ /^q$/ && exit 0; - $cmd =~ /^$/ && ($cmd = $laststep); - push(@hist,$cmd) if length($cmd) > 1; - ($i) = split(/\s+/,$cmd); - eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i}; - $cmd =~ /^h$/ && do { - print OUT " -T Stack trace. -s Single step. -n Next, steps over subroutine calls. -r Return from current subroutine. -c [line] Continue; optionally inserts a one-time-only breakpoint - at the specified line. -<CR> Repeat last n or s. -l min+incr List incr+1 lines starting at min. -l min-max List lines. -l line List line; -l List next window. -- List previous window. -w line List window around line. -l subname List subroutine. -f filename Switch to filename. -/pattern/ Search forwards for pattern; final / is optional. -?pattern? Search backwards for pattern. -L List breakpoints and actions. -S List subroutine names. -t Toggle trace mode. -b [line] [condition] - Set breakpoint; line defaults to the current execution line; - condition breaks if it evaluates to true, defaults to \'1\'. -b subname [condition] - Set breakpoint at first line of subroutine. -d [line] Delete breakpoint. -D Delete all breakpoints. -a [line] command - Set an action to be done before the line is executed. - Sequence is: check for breakpoint, print line if necessary, - do action, prompt user if breakpoint or step, evaluate line. -A Delete all actions. -V [pkg [vars]] List some (default all) variables in package (default current). -X [vars] Same as \"V currentpackage [vars]\". -< command Define command before prompt. -> command Define command after prompt. -! number Redo command (default previous command). -! -number Redo number\'th to last command. -H -number Display last number commands (default all). -q or ^D Quit. -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. - -"; - next CMD; }; - $cmd =~ /^t$/ && do { - $trace = !$trace; - print OUT "Trace = ".($trace?"on":"off")."\n"; - next CMD; }; - $cmd =~ /^S$/ && do { - foreach $subname (sort(keys %sub)) { - print OUT $subname,"\n"; - } - next CMD; }; - $cmd =~ s/^X\b/V $pkg/; - $cmd =~ /^V$/ && do { - $cmd = "V $pkg"; }; - $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do { - local ($savout) = select(OUT); - $packname = $1; - @vars = split(' ',$2); - do 'dumpvar.pl' unless defined &main::dumpvar; - if (defined &main::dumpvar) { - &main::dumpvar($packname,@vars); - } - else { - print DB::OUT "dumpvar.pl not available.\n"; - } - select ($savout); - next CMD; }; - $cmd =~ /^f\b\s*(.*)/ && do { - $file = $1; - if (!$file) { - print OUT "The old f command is now the r command.\n"; - print OUT "The new f command switches filenames.\n"; - next CMD; - } - if (!defined $main::{'_<' . $file}) { - if (($try) = grep(m#^_<.*$file#, keys %main::)) { - $file = substr($try,2); - print "\n$file:\n"; - } - } - if (!defined $main::{'_<' . $file}) { - print OUT "There's no code here anything matching $file.\n"; - next CMD; - } - elsif ($file ne $filename) { - *dbline = "::_<$file"; - $max = $#dbline; - $filename = $file; - $start = 1; - $cmd = "l"; - } }; - $cmd =~ /^l\b\s*([':A-Za-z_][':\w]*)/ && do { - $subname = $1; - $subname = "main::" . $subname unless $subname =~ /'|::/; - $subname = "main" . $subname if substr($subname,0,1)eq "'"; - $subname = "main" . $subname if substr($subname,0,2)eq "::"; - # VMS filespecs may (usually do) contain ':', so don't use split - ($file,$subrange) = $sub{$subname} =~ /(.*):(.*)/; - if ($file ne $filename) { - *dbline = "::_<$file"; - $max = $#dbline; - $filename = $file; - } - if ($subrange) { - if (eval($subrange) < -$window) { - $subrange =~ s/-.*/+/; - } - $cmd = "l $subrange"; - } else { - print OUT "Subroutine $1 not found.\n"; - next CMD; - } }; - $cmd =~ /^w\b\s*(\d*)$/ && do { - $incr = $window - 1; - $start = $1 if $1; - $start -= $preview; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^-$/ && do { - $incr = $window - 1; - $cmd = 'l ' . ($start-$window*2) . '+'; }; - $cmd =~ /^l$/ && do { - $incr = $window - 1; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do { - $start = $1 if $1; - $incr = $2; - $incr = $window - 1 unless $incr; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^l\b\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do { - $end = (!$2) ? $max : ($4 ? $4 : $2); - $end = $max if $end > $max; - $i = $2; - $i = $line if $i eq '.'; - $i = 1 if $i < 1; - if ($emacs) { - print OUT "\032\032$filename:$i:0\n"; - $i = $end; - } else { - for (; $i <= $end; $i++) { - print OUT "$i:\t", $dbline[$i]; - last if $signal; - } - } - $start = $i; # remember in case they want more - $start = $max if $start > $max; - next CMD; }; - $cmd =~ /^D$/ && do { - print OUT "Deleting all breakpoints...\n"; - for ($i = 1; $i <= $max ; $i++) { - if (defined $dbline{$i}) { - $dbline{$i} =~ s/^[^\0]+//; - if ($dbline{$i} =~ s/^\0?$//) { - delete $dbline{$i}; - } - } - } - next CMD; }; - $cmd =~ /^L$/ && do { - for ($i = 1; $i <= $max; $i++) { - if (defined $dbline{$i}) { - print OUT "$i:\t", $dbline[$i]; - ($stop,$action) = split(/\0/, $dbline{$i}); - print OUT " break if (", $stop, ")\n" - if $stop; - print OUT " action: ", $action, "\n" - if $action; - last if $signal; - } - } - next CMD; }; - $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do { - $subname = $1; - $cond = $2 || '1'; - $subname = "${pkg}::" . $subname - unless $subname =~ /'|::/; - $subname = "main" . $subname if substr($subname,0,1) eq "'"; - $subname = "main" . $subname if substr($subname,0,2) eq "::"; - # VMS filespecs may (usually do) contain ':', so don't use split - ($filename,$i) = $sub{$subname} =~ /(.*):(.*)/; - $i += 0; - if ($i) { - *dbline = "::_<$filename"; - ++$i while $dbline[$i] == 0 && $i < $#dbline; - $dbline{$i} =~ s/^[^\0]*/$cond/; - } else { - print OUT "Subroutine $subname not found.\n"; - } - next CMD; }; - $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do { - $i = ($1?$1:$line); - $cond = $2 || '1'; - if ($dbline[$i] == 0) { - print OUT "Line $i not breakable.\n"; - } else { - $dbline{$i} =~ s/^[^\0]*/$cond/; - } - next CMD; }; - $cmd =~ /^d\b\s*(\d+)?/ && do { - $i = ($1?$1:$line); - $dbline{$i} =~ s/^[^\0]*//; - delete $dbline{$i} if $dbline{$i} eq ''; - next CMD; }; - $cmd =~ /^A$/ && do { - for ($i = 1; $i <= $max ; $i++) { - if (defined $dbline{$i}) { - $dbline{$i} =~ s/\0[^\0]*//; - delete $dbline{$i} if $dbline{$i} eq ''; - } - } - next CMD; }; - $cmd =~ /^<\s*(.*)/ && do { - $pre = action($1); - next CMD; }; - $cmd =~ /^>\s*(.*)/ && do { - $post = action($1); - next CMD; }; - $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do { - $i = $1; - if ($dbline[$i] == 0) { - print OUT "Line $i may not have an action.\n"; - } else { - $dbline{$i} =~ s/\0[^\0]*//; - $dbline{$i} .= "\0" . action($3); - } - next CMD; }; - $cmd =~ /^n$/ && do { - $single = 2; - $laststep = $cmd; - last CMD; }; - $cmd =~ /^s$/ && do { - $single = 1; - $laststep = $cmd; - last CMD; }; - $cmd =~ /^c\b\s*(\d*)\s*$/ && do { - $i = $1; - if ($i) { - if ($dbline[$i] == 0) { - print OUT "Line $i not breakable.\n"; - next CMD; - } - $dbline{$i} =~ s/(\0|$)/;9$1/; # add one-time-only b.p. - } - for ($i=0; $i <= $#stack; ) { - $stack[$i++] &= ~1; - } - last CMD; }; - $cmd =~ /^r$/ && do { - $stack[$#stack] |= 2; - last CMD; }; - $cmd =~ /^T$/ && do { - local($p,$f,$l,$s,$h,$a,@a,@sub); - for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { - @a = (); - for $arg (@args) { - $_ = "$arg"; - s/'/\\'/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) . ')' : ''; - push(@sub, "$w$s$a from file $f line $l\n"); - last if $signal; - } - for ($i=0; $i <= $#sub; $i++) { - last if $signal; - print OUT $sub[$i]; - } - next CMD; }; - $cmd =~ /^\/(.*)$/ && do { - $inpat = $1; - $inpat =~ s:([^\\])/$:$1:; - if ($inpat ne "") { - eval '$inpat =~ m'."\a$inpat\a"; - if ($@ ne "") { - print OUT "$@"; - next CMD; - } - $pat = $inpat; - } - $end = $start; - eval ' - for (;;) { - ++$start; - $start = 1 if ($start > $max); - last if ($start == $end); - if ($dbline[$start] =~ m'."\a$pat\a".'i) { - if ($emacs) { - print OUT "\032\032$filename:$start:0\n"; - } else { - print OUT "$start:\t", $dbline[$start], "\n"; - } - last; - } - } '; - print OUT "/$pat/: not found\n" if ($start == $end); - next CMD; }; - $cmd =~ /^\?(.*)$/ && do { - $inpat = $1; - $inpat =~ s:([^\\])\?$:$1:; - if ($inpat ne "") { - eval '$inpat =~ m'."\a$inpat\a"; - if ($@ ne "") { - print OUT "$@"; - next CMD; - } - $pat = $inpat; - } - $end = $start; - eval ' - for (;;) { - --$start; - $start = $max if ($start <= 0); - last if ($start == $end); - if ($dbline[$start] =~ m'."\a$pat\a".'i) { - if ($emacs) { - print OUT "\032\032$filename:$start:0\n"; - } else { - print OUT "$start:\t", $dbline[$start], "\n"; - } - last; - } - } '; - print OUT "?$pat?: not found\n" if ($start == $end); - next CMD; }; - $cmd =~ /^!+\s*(-)?(\d+)?$/ && do { - pop(@hist) if length($cmd) > 1; - $i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist)); - $cmd = $hist[$i] . "\n"; - print OUT $cmd; - redo CMD; }; - $cmd =~ /^!(.+)$/ && do { - $pat = "^$1"; - pop(@hist) if length($cmd) > 1; - for ($i = $#hist; $i; --$i) { - last if $hist[$i] =~ $pat; - } - if (!$i) { - print OUT "No such command!\n\n"; - next CMD; - } - $cmd = $hist[$i] . "\n"; - print OUT $cmd; - redo CMD; }; - $cmd =~ /^H\b\s*(-(\d+))?/ && do { - $end = $2?($#hist-$2):0; - $hist = 0 if $hist < 0; - for ($i=$#hist; $i>$end; $i--) { - print OUT "$i: ",$hist[$i],"\n" - unless $hist[$i] =~ /^.?$/; - }; - next CMD; }; - $cmd =~ s/^p( .*)?$/print DB::OUT$1/; - $cmd =~ /^=/ && do { - if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) { - $alias{$k}="s~$k~$v~"; - print OUT "$k = $v\n"; - } elsif ($cmd =~ /^=\s*$/) { - foreach $k (sort keys(%alias)) { - if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) { - print OUT "$k = $v\n"; - } else { - print OUT "$k\t$alias{$k}\n"; - }; - }; - }; - next CMD; }; - } - $evalarg = $cmd; &eval; - print OUT "\n"; - } - if ($post) { - $evalarg = $post; &eval; - } - } - ($@, $!, $,, $/, $\, $^W) = @saved; - (); -} - -sub save { - @saved = ($@, $!, $,, $/, $\, $^W); - $, = ""; $/ = "\n"; $\ = ""; $^W = 0; -} - -# The following takes its argument via $evalarg to preserve current @_ - -sub eval { - eval "$usercontext $evalarg; &DB::save"; - print OUT $@; -} - -sub action { - local($action) = @_; - while ($action =~ s/\\$//) { - print OUT "+ "; - $action .= &gets; - } - $action; -} - -sub gets { - local($.); - <IN>; -} - -sub catch { - $signal = 1; -} - -sub sub { - push(@stack, $single); - $single &= 1; - $single |= 4 if $#stack == $deep; - if (wantarray) { - @i = &$sub; - $single |= pop(@stack); - @i; - } - else { - $i = &$sub; - $single |= pop(@stack); - $i; - } -} - -$trace = $signal = $single = 0; # uninitialized warning suppression - -@hist = ('?'); -$SIG{'INT'} = "DB::catch"; -$deep = 100; # warning if stack gets this deep -$window = 10; -$preview = 3; - -@stack = (0); -@ARGS = @ARGV; -for (@args) { - s/'/\\'/g; - s/(.*)/'$1'/ unless /^-?[\d.]+$/; -} - -if (-f $rcfile) { - do "./$rcfile"; -} -elsif (-f "$ENV{'LOGDIR'}/$rcfile") { - do "$ENV{'LOGDIR'}/$rcfile"; -} -elsif (-f "$ENV{'HOME'}/$rcfile") { - do "$ENV{'HOME'}/$rcfile"; -} - -1; diff --git a/lib/subs.pm b/lib/subs.pm index 0dbbaddd11..84c913a346 100644 --- a/lib/subs.pm +++ b/lib/subs.pm @@ -20,8 +20,6 @@ See L<perlmod/Pragmatic Modules> and L<strict/subs>. =cut require 5.000; -$ExportLevel = 0; - sub import { my $callpack = caller; my $pack = shift; diff --git a/lib/vars.pm b/lib/vars.pm new file mode 100644 index 0000000000..b9519291c4 --- /dev/null +++ b/lib/vars.pm @@ -0,0 +1,39 @@ +package vars; + +=head1 NAME + +vars - Perl pragma to predeclare global variable names + +=head1 SYNOPSIS + + use vars qw($frob @mung %seen); + +=head1 DESCRIPTION + +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. + +See L<perlmod/Pragmatic Modules>. + +=cut +require 5.000; +use Carp; + +sub import { + my $callpack = caller; + my ($pack, @imports, $sym, $ch) = @_; + foreach $sym (@imports) { + croak "Can't declare another package's variables" if $sym =~ /::/; + ($ch, $sym) = unpack('a1a*', $sym); + *{"${callpack}::$sym"} = + ( $ch eq "\$" ? \$ {"${callpack}::$sym"} + : $ch eq "\@" ? \@ {"${callpack}::$sym"} + : $ch eq "\%" ? \% {"${callpack}::$sym"} + : $ch eq "\*" ? \* {"${callpack}::$sym"} + : $ch eq "\&" ? \& {"${callpack}::$sym"} + : croak "'$ch$sym' is not a valid variable name\n"); + } +}; + +1; @@ -78,7 +78,7 @@ static int findbucket _((union overhead *freep, int srchlen)); static union overhead *nextf[NBUCKETS]; extern char *sbrk(); -#ifdef MSTATS +#ifdef DEBUGGING_MSTATS /* * nmalloc[i] is the difference between the number of mallocs and frees * for a given block size. @@ -169,7 +169,7 @@ malloc(nbytes) nextf[bucket] = p->ov_next; p->ov_magic = MAGIC; p->ov_index= bucket; -#ifdef MSTATS +#ifdef DEBUGGING_MSTATS nmalloc[bucket]++; #endif #ifdef RCHECK @@ -291,7 +291,7 @@ free(mp) size = op->ov_index; op->ov_next = nextf[size]; nextf[size] = op; -#ifdef MSTATS +#ifdef DEBUGGING_MSTATS nmalloc[size]--; #endif } @@ -429,7 +429,7 @@ findbucket(freep, srchlen) return (-1); } -#ifdef MSTATS +#ifdef DEBUGGING_MSTATS /* * mstats - print out statistics about malloc * @@ -438,28 +438,41 @@ findbucket(freep, srchlen) * frees for each size category. */ void -mstats(s) +dump_mstats(s) char *s; { register int i, j; register union overhead *p; - int totfree = 0, - totused = 0; + int topbucket=0, totfree=0, totused=0; + u_int nfree[NBUCKETS]; - fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s); - for (i = 0; i < NBUCKETS; i++) { + for (i=0; i < NBUCKETS; i++) { for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) ; - fprintf(stderr, " %d", j); - totfree += j * (1 << (i + 3)); - } - fprintf(stderr, "\nused:\t"); - for (i = 0; i < NBUCKETS; i++) { - fprintf(stderr, " %d", nmalloc[i]); + nfree[i] = j; + totfree += nfree[i] * (1 << (i + 3)); totused += nmalloc[i] * (1 << (i + 3)); + if (nfree[i] || nmalloc[i]) + topbucket = i; + } + if (s) + fprintf(stderr, "Memory allocation statistics %s (buckets 8..%d)\n", + s, (1 << (topbucket + 3)) ); + fprintf(stderr, " %7d free: ", totfree); + for (i=0; i <= topbucket; i++) { + fprintf(stderr, (i<5)?" %5d":" %3d", nfree[i]); } - fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n", - totused, totfree); + fprintf(stderr, "\n %7d used: ", totused); + for (i=0; i <= topbucket; i++) { + fprintf(stderr, (i<5)?" %5d":" %3d", nmalloc[i]); + } + fprintf(stderr, "\n"); +} +#else +void +dump_mstats(s) + char *s; +{ } #endif #endif /* lint */ @@ -21,6 +21,58 @@ #endif */ +/* + * Use the "DESTRUCTOR" scope cleanup to reinstate magic. + */ + +struct magic_state { + SV* mgs_sv; + U32 mgs_flags; +}; +typedef struct magic_state MGS; + +static void restore_magic _((void *p)); + +static MGS * +save_magic(sv) +SV* sv; +{ + MGS* mgs; + + assert(SvMAGICAL(sv)); + + mgs = (MGS*)safemalloc(sizeof(MGS)); + mgs->mgs_sv = sv; + mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv); + SAVEDESTRUCTOR(restore_magic, mgs); + + SvMAGICAL_off(sv); + SvREADONLY_off(sv); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + + return mgs; +} + +static void +restore_magic(p) +void* p; +{ + MGS *mgs = (MGS*)p; + SV* sv = mgs->mgs_sv; + + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) + { + if (mgs->mgs_flags) + SvFLAGS(sv) |= mgs->mgs_flags; + else + mg_magical(sv); + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + } + + Safefree(mgs); +} + void mg_magical(sv) @@ -44,30 +96,22 @@ int mg_get(sv) SV* sv; { + MGS* mgs; MAGIC* mg; - U32 savemagic = SvMAGICAL(sv) | SvREADONLY(sv); - assert(SvGMAGICAL(sv)); - SvMAGICAL_off(sv); - SvREADONLY_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + mgs = save_magic(sv); for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { (*vtbl->svt_get)(sv, mg); if (mg->mg_flags & MGf_GSKIP) - savemagic = 0; + mgs->mgs_flags = 0; } } - if (savemagic) - SvFLAGS(sv) |= savemagic; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return 0; } @@ -75,33 +119,25 @@ int mg_set(sv) SV* sv; { + MGS* mgs; MAGIC* mg; MAGIC* nextmg; - U32 savemagic = SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + mgs = save_magic(sv); for (mg = SvMAGIC(sv); mg; mg = nextmg) { MGVTBL* vtbl = mg->mg_virtual; nextmg = mg->mg_moremagic; /* it may delete itself */ if (mg->mg_flags & MGf_GSKIP) { mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ - savemagic = 0; + mgs->mgs_flags = 0; } if (vtbl && vtbl->svt_set) (*vtbl->svt_set)(sv, mg); } - if (SvMAGIC(sv)) { - if (savemagic) - SvFLAGS(sv) |= savemagic; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - } - + LEAVE; return 0; } @@ -116,18 +152,11 @@ SV* sv; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_len) { - U32 savemagic = SvMAGICAL(sv); - - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv)&(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; - + ENTER; + save_magic(sv); /* omit MGf_GSKIP -- not changed here */ len = (*vtbl->svt_len)(sv, mg); - - SvFLAGS(sv) |= savemagic; - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return len; } } @@ -141,10 +170,9 @@ mg_clear(sv) SV* sv; { MAGIC* mg; - U32 savemagic = SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + save_magic(sv); for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; @@ -154,10 +182,7 @@ SV* sv; (*vtbl->svt_clear)(sv, mg); } - SvFLAGS(sv) |= savemagic; - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return 0; } @@ -1078,19 +1103,10 @@ MAGIC* mg; multiline = (i != 0); break; case '/': - if (SvOK(sv)) { - nrs = rs = SvPV_force(sv,rslen); - nrslen = rslen; - if (rspara = !rslen) { - nrs = rs = "\n\n"; - nrslen = rslen = 2; - } - nrschar = rschar = rs[rslen - 1]; - } - else { - nrschar = rschar = 0777; /* fake a non-existent char */ - nrslen = rslen = 1; - } + SvREFCNT_dec(nrs); + nrs = newSVsv(sv); + SvREFCNT_dec(rs); + rs = SvREFCNT_inc(nrs); break; case '\\': if (ors) diff --git a/miniperlmain.c b/miniperlmain.c index 9f3e1d6155..1179a5f668 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -19,38 +19,48 @@ extern "C" { static void xs_init _((void)); static PerlInterpreter *my_perl; -void -i18nl14n() +int +perl_init_i18nl14n(printwarn) /* XXX move to perl.c */ + int printwarn; { - char * lang = getenv("LANG"); + int ok = 1; + /* returns + * 1 = set ok or not applicable, + * 0 = fallback to C locale, + * -1 = fallback to C locale failed + */ #if defined(HAS_SETLOCALE) && defined(LC_CTYPE) - { + char * lang = getenv("LANG"); char * lc_all = getenv("LC_ALL"); char * lc_ctype = getenv("LC_CTYPE"); int i; if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) { - fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n"); - fprintf(stderr, + if (printwarn) { + fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n"); + fprintf(stderr, "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n", lc_all ? lc_all : "(null)", lc_ctype ? lc_ctype : "(null)", lang ? lang : "(null)" ); - fprintf(stderr, "warning: falling back to the \"C\" locale.\n"); - setlocale(LC_CTYPE, "C"); + fprintf(stderr, "warning: falling back to the \"C\" locale.\n"); + } + ok = 0; + if (setlocale(LC_CTYPE, "C") == NULL) + ok = -1; } for (i = 0; i < 256; i++) { - if (isUPPER(i)) fold[i] = toLOWER(i); - else if (isLOWER(i)) fold[i] = toUPPER(i); - else fold[i] = i; + if (isUPPER(i)) fold[i] = toLOWER(i); + else if (isLOWER(i)) fold[i] = toUPPER(i); + else fold[i] = i; } - - } #endif + return ok; } + int #ifndef CAN_PROTOTYPE main(argc, argv, env) @@ -63,19 +73,9 @@ main(int argc, char **argv, char **env) { int exitstatus; -#ifdef OS2 - _response(&argc, &argv); - _wildcard(&argc, &argv); -#endif + PERL_SYS_INIT(&argc,&argv); -#ifdef VMS - getredirection(&argc,&argv); -#endif - -/* here a union of the cpp #if:s inside i18nl14n() */ -#if (defined(HAS_SETLOCALE) && defined(LC_CTYPE)) - i18nl14n(); -#endif + perl_init_i18nl14n(1); if (!do_undump) { my_perl = perl_alloc(); @@ -18,14 +18,17 @@ #include "EXTERN.h" #include "perl.h" +#define USE_OP_MASK /* Turned on by default in 5.002beta1h */ + #ifdef USE_OP_MASK /* * In the following definition, the ", (OP *) op" is just to make the compiler * think the expression is of the right type: croak actually does a longjmp. */ -#define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \ - (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \ - : (*check[type])((OP *) op)) +#define CHECKOP(type,op) \ + ((op_mask && op_mask[type]) \ + ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \ + : (*check[type])((OP*)op)) #else #define CHECKOP(type,op) (*check[type])(op) #endif /* USE_OP_MASK */ @@ -55,7 +58,7 @@ no_fh_allowed(op) OP *op; { sprintf(tokenbuf,"Missing comma after first argument to %s function", - op_name[op->op_type]); + op_desc[op->op_type]); yyerror(tokenbuf); return op; } @@ -88,7 +91,7 @@ char *name; OP *kid; { sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", - (int) n, name, t, op_name[kid->op_type]); + (int) n, name, t, op_desc[kid->op_type]); yyerror(tokenbuf); return op; } @@ -99,8 +102,7 @@ OP *op; { int type = op->op_type; if (type != OP_AELEM && type != OP_HELEM) { - sprintf(tokenbuf, "Can't use subscript on %s", - op_name[type]); + sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]); yyerror(tokenbuf); if (type == OP_RV2HV || type == OP_ENTERSUB) warn("(Did you mean $ or @ instead of %c?)\n", @@ -210,7 +212,8 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) } break; case CXt_EVAL: - if (cx->blk_eval.old_op_type != OP_ENTEREVAL) + if (cx->blk_eval.old_op_type != OP_ENTEREVAL && + cx->blk_eval.old_op_type != OP_ENTERTRY) return 0; /* require must have its own scope */ saweval = i; break; @@ -603,7 +606,6 @@ OP *op; case OP_PADHV: case OP_PADANY: case OP_AV2ARYLEN: - case OP_SV2LEN: case OP_REF: case OP_REFGEN: case OP_SREFGEN: @@ -667,7 +669,7 @@ OP *op; case OP_GGRGID: case OP_GETLOGIN: if (!(op->op_private & OPpLVAL_INTRO)) - useless = op_name[op->op_type]; + useless = op_desc[op->op_type]; break; case OP_RV2GV: @@ -713,7 +715,7 @@ OP *op; case OP_REPEAT: scalarvoid(cBINOP->op_first); - useless = op_name[op->op_type]; + useless = op_desc[op->op_type]; break; case OP_OR: @@ -911,8 +913,8 @@ I32 type; if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) break; sprintf(tokenbuf, "Can't modify %s in %s", - op_name[op->op_type], - type ? op_name[type] : "local"); + op_desc[op->op_type], + type ? op_desc[type] : "local"); yyerror(tokenbuf); return op; @@ -1162,7 +1164,7 @@ OP *op; type != OP_PADHV && type != OP_PUSHMARK) { - sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]); + sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]); yyerror(tokenbuf); return op; } @@ -1403,17 +1405,28 @@ register OP *o; return o; if (!(hints & HINT_INTEGER)) { + int vars = 0; + if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) return o; for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { if (curop->op_type == OP_CONST) { - if (SvIOK(((SVOP*)curop)->op_sv)) + if (SvIOK(((SVOP*)curop)->op_sv)) { + if (SvIVX(((SVOP*)curop)->op_sv) < 0 && vars++) + return o; /* negatives truncate wrong way, alas */ continue; + } return o; } if (opargs[curop->op_type] & OA_RETINTEGER) continue; + if (curop->op_type == OP_PADSV || curop->op_type == OP_RV2SV) { + if (vars++) + return o; + if (o->op_type >= OP_LT && o->op_type <= OP_NCMP) + continue; /* allow $i < 10000 to integerize */ + } return o; } o->op_ppaddr = ppaddr[++(o->op_type)]; @@ -1642,7 +1655,7 @@ I32 flags; op->op_flags = flags; op->op_next = op; - /* op->op_private = 0; */ + op->op_private = 0 + (flags >> 8); if (opargs[type] & OA_RETSCALAR) scalar(op); if (opargs[type] & OA_TARGET) @@ -1668,7 +1681,7 @@ OP* first; unop->op_ppaddr = ppaddr[type]; unop->op_first = first; unop->op_flags = flags | OPf_KIDS; - unop->op_private = 1; + unop->op_private = 1 | (flags >> 8); unop = (UNOP*) CHECKOP(type, unop); if (unop->op_next) @@ -1696,10 +1709,10 @@ OP* last; binop->op_flags = flags | OPf_KIDS; if (!last) { last = first; - binop->op_private = 1; + binop->op_private = 1 | (flags >> 8); } else { - binop->op_private = 2; + binop->op_private = 2 | (flags >> 8); first->op_sibling = last; } @@ -1790,7 +1803,7 @@ I32 flags; pmop->op_type = type; pmop->op_ppaddr = ppaddr[type]; pmop->op_flags = flags; - pmop->op_private = 0; + pmop->op_private = 0 | (flags >> 8); /* link into pm list */ if (type != OP_TRANS && curstash) { @@ -1979,28 +1992,6 @@ char *pv; return CHECKOP(type, pvop); } -OP * -newCVOP(type, flags, cv, cont) -I32 type; -I32 flags; -CV *cv; -OP *cont; -{ - CVOP *cvop; - Newz(1101, cvop, 1, CVOP); - cvop->op_type = type; - cvop->op_ppaddr = ppaddr[type]; - cvop->op_cv = cv; - cvop->op_cont = cont; - cvop->op_next = (OP*)cvop; - cvop->op_flags = flags; - if (opargs[type] & OA_RETSCALAR) - scalar((OP*)cvop); - if (opargs[type] & OA_TARGET) - cvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, cvop); -} - void package(op) OP *op; @@ -2027,8 +2018,9 @@ OP *op; } void -utilize(aver, id, arg) +utilize(aver, floor, id, arg) int aver; +I32 floor; OP *id; OP *arg; { @@ -2062,7 +2054,7 @@ OP *arg; rqop = newUNOP(OP_REQUIRE, 0, id); /* Fake up the BEGIN {}, which does its thing immediately. */ - newSUB(start_subparse(), + newSUB(floor, newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), Nullop, append_elem(OP_LINESEQ, @@ -2151,33 +2143,10 @@ OP *right; op_free(right); return Nullop; } - if (right && right->op_type == OP_SPLIT) { - if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) { - PMOP *pm = (PMOP*)op; - if (left->op_type == OP_RV2AV && - !(left->op_private & OPpLVAL_INTRO) ) - { - op = ((UNOP*)left)->op_first; - if (op->op_type == OP_GV && !pm->op_pmreplroot) { - pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv; - pm->op_pmflags |= PMf_ONCE; - op_free(left); - return right; - } - } - else { - if (modcount < 10000) { - SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv; - if (SvIVX(sv) == 0) - sv_setiv(sv, modcount+1); - } - } - } - } op = newBINOP(OP_AASSIGN, flags, list(force_list(right)), list(force_list(left)) ); - op->op_private = 0; + op->op_private = 0 | (flags >> 8); if (!(left->op_private & OPpLVAL_INTRO)) { static int generation = 100; OP *curop; @@ -2218,6 +2187,39 @@ OP *right; if (curop != op) op->op_private = OPpASSIGN_COMMON; } + if (right && right->op_type == OP_SPLIT) { + OP* tmpop; + if ((tmpop = ((LISTOP*)right)->op_first) && + tmpop->op_type == OP_PUSHRE) + { + PMOP *pm = (PMOP*)tmpop; + if (left->op_type == OP_RV2AV && + !(left->op_private & OPpLVAL_INTRO) && + !(op->op_private & OPpASSIGN_COMMON) ) + { + tmpop = ((UNOP*)left)->op_first; + if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) { + pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv; + pm->op_pmflags |= PMf_ONCE; + tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */ + tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ + tmpop->op_sibling = Nullop; /* don't free split */ + right->op_next = tmpop->op_next; /* fix starting loc */ + op_free(op); /* blow off assign */ + return right; + } + } + else { + if (modcount < 10000 && + ((LISTOP*)right)->op_last->op_type == OP_CONST) + { + SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv; + if (SvIVX(sv) == 0) + sv_setiv(sv, modcount+1); + } + } + } + } return op; } if (!right) @@ -2273,7 +2275,7 @@ OP *op; cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ]; } cop->op_flags = flags; - cop->op_private = 0; + cop->op_private = 0 | (flags >> 8); cop->op_next = (OP*)cop; if (label) { @@ -2335,7 +2337,7 @@ OP* other; } if (first->op_type == OP_CONST) { if (dowarn && (first->op_private & OPpCONST_BARE)) - warn("Probable precedence problem on %s", op_name[type]); + warn("Probable precedence problem on %s", op_desc[type]); if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { op_free(first); return other; @@ -2365,7 +2367,7 @@ OP* other; logop->op_first = first; logop->op_flags = flags | OPf_KIDS; logop->op_other = LINKLIST(other); - logop->op_private = 1; + logop->op_private = 1 | (flags >> 8); /* establish postfix order */ logop->op_next = LINKLIST(first); @@ -2418,7 +2420,7 @@ OP* false; condop->op_flags = flags | OPf_KIDS; condop->op_true = LINKLIST(true); condop->op_false = LINKLIST(false); - condop->op_private = 1; + condop->op_private = 1 | (flags >> 8); /* establish postfix order */ condop->op_next = LINKLIST(first); @@ -2453,7 +2455,7 @@ OP *right; condop->op_flags = OPf_KIDS; condop->op_true = LINKLIST(left); condop->op_false = LINKLIST(right); - condop->op_private = 1; + condop->op_private = 1 | (flags >> 8); left->op_sibling = right; @@ -2582,6 +2584,7 @@ OP *cont; loop->op_nextop = op; op->op_flags |= flags; + op->op_private |= (flags >> 8); return op; } @@ -2615,7 +2618,7 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont sv = Nullop; } else - croak("Can't use %s for loop variable", op_name[sv->op_type]); + croak("Can't use %s for loop variable", op_desc[sv->op_type]); } else { sv = newGVOP(OP_GV, 0, defgv); @@ -2774,7 +2777,7 @@ OP *block; { register CV *cv; char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; - GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); + GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); AV* av; char *s; I32 ix; @@ -2820,8 +2823,13 @@ OP *block; if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p)) warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p); sv_setpv((SV*)cv, p); + op_free(proto); } + if (error_count) { + op_free(block); + block = Nullop; + } if (!block) { CvROOT(cv) = 0; op_free(op); @@ -2853,6 +2861,7 @@ OP *block; s = name; if (strEQ(s, "BEGIN") && !error_count) { line_t oldline = compiling.cop_line; + SV *oldrs = rs; ENTER; SAVESPTR(compiling.cop_filegv); @@ -2861,16 +2870,11 @@ OP *block; beginav = newAV(); av_push(beginav, (SV *)cv); DEBUG_x( dump_sub(gv) ); - rs = nrs; - rslen = nrslen; - rschar = nrschar; - rspara = (nrslen == 2); + rs = SvREFCNT_inc(nrs); GvCV(gv) = 0; calllist(beginav); - rs = "\n"; - rslen = 1; - rschar = '\n'; - rspara = 0; + SvREFCNT_dec(rs); + rs = oldrs; curcop = &compiling; curcop->cop_line = oldline; /* might have recursed to yylex */ LEAVE; @@ -3030,25 +3034,6 @@ OP *block; } OP * -newMETHOD(ref,name) -OP *ref; -OP *name; -{ - LOGOP* mop; - Newz(1101, mop, 1, LOGOP); - mop->op_type = OP_METHOD; - mop->op_ppaddr = ppaddr[OP_METHOD]; - mop->op_first = scalar(ref); - mop->op_flags |= OPf_KIDS; - mop->op_private = 1; - mop->op_other = LINKLIST(name); - mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP); - mop->op_next = LINKLIST(ref); - ref->op_next = (OP*)mop; - return scalar((OP*)mop); -} - -OP * newANONLIST(op) OP* op; { @@ -3166,10 +3151,11 @@ OP *o; } OP * -newCVREF(o) +newCVREF(flags, o) +I32 flags; OP *o; { - return newUNOP(OP_RV2CV, 0, scalar(o)); + return newUNOP(OP_RV2CV, flags, scalar(o)); } OP * @@ -3228,7 +3214,7 @@ OP *op; if (op->op_flags & OPf_KIDS) { OP *kid = cUNOP->op_first; if (kid->op_type != OP_HELEM) - croak("%s argument is not a HASH element", op_name[op->op_type]); + croak("%s argument is not a HASH element", op_desc[op->op_type]); null(kid); } return op; @@ -3325,7 +3311,7 @@ register OP *op; { SVOP *kid = (SVOP*)cUNOP->op_first; - op->op_private = (hints & HINT_STRICT_REFS); + op->op_private |= (hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { int iscv = (op->op_type==OP_RV2CV)*2; GV *gv = 0; @@ -3447,14 +3433,14 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVAV) )); if (dowarn) warn("Array @%s missing the @ in argument %d of %s()", - name, numargs, op_name[type]); + name, numargs, op_desc[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; *tokid = kid; } else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) - bad_type(numargs, "array", op_name[op->op_type], kid); + bad_type(numargs, "array", op_desc[op->op_type], kid); mod(kid, type); break; case OA_HVREF: @@ -3465,14 +3451,14 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVHV) )); if (dowarn) warn("Hash %%%s missing the %% in argument %d of %s()", - name, numargs, op_name[type]); + name, numargs, op_desc[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; *tokid = kid; } else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) - bad_type(numargs, "hash", op_name[op->op_type], kid); + bad_type(numargs, "hash", op_desc[op->op_type], kid); mod(kid, type); break; case OA_CVREF: @@ -3513,9 +3499,9 @@ OP *op; tokid = &kid->op_sibling; kid = kid->op_sibling; } - op->op_private = numargs; + op->op_private |= numargs; if (kid) - return too_many_arguments(op,op_name[op->op_type]); + return too_many_arguments(op,op_desc[op->op_type]); listkids(op); } else if (opargs[type] & OA_DEFGV) { @@ -3527,7 +3513,7 @@ OP *op; while (oa & OA_OPTIONAL) oa >>= 4; if (oa && oa != OA_LIST) - return too_few_arguments(op,op_name[op->op_type]); + return too_few_arguments(op,op_desc[op->op_type]); } return op; } @@ -3588,7 +3574,7 @@ OP *op; kid = cLISTOP->op_first->op_sibling; if (!kid || !kid->op_sibling) - return too_few_arguments(op,op_name[op->op_type]); + return too_few_arguments(op,op_desc[op->op_type]); for (kid = kid->op_sibling; kid; kid = kid->op_sibling) mod(kid, OP_GREPSTART); @@ -3681,7 +3667,7 @@ ck_repeat(op) OP *op; { if (cBINOP->op_first->op_flags & OPf_PARENS) { - op->op_private = OPpREPEAT_DOLIST; + op->op_private |= OPpREPEAT_DOLIST; cBINOP->op_first = force_list(cBINOP->op_first); } else @@ -3724,8 +3710,9 @@ OP * ck_select(op) OP *op; { + OP* kid; if (op->op_flags & OPf_KIDS) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_sibling) { op->op_type = OP_SSELECT; op->op_ppaddr = ppaddr[OP_SSELECT]; @@ -3733,7 +3720,11 @@ OP *op; return fold_constants(op); } } - return ck_fun(op); + op = ck_fun(op); + kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ + if (kid && kid->op_type == OP_RV2GV) + kid->op_private &= ~HINT_STRICT_REFS; + return op; } OP * @@ -3848,7 +3839,7 @@ OP *op; scalar(kid); if (kid->op_sibling) - return too_many_arguments(op,op_name[op->op_type]); + return too_many_arguments(op,op_desc[op->op_type]); return op; } @@ -3869,17 +3860,18 @@ OP *op; for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ; if (cvop->op_type == OP_RV2CV) { SVOP* tmpop; + op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER); null(cvop); /* disable rv2cv */ tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV) { cv = GvCV(tmpop->op_sv); - if (cv && SvPOK(cv) && (op->op_flags & OPf_STACKED)) + if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) proto = SvPV((SV*)cv,na); } } - op->op_private = (hints & HINT_STRICT_REFS); + op->op_private |= (hints & HINT_STRICT_REFS); if (perldb && curstash != debstash) - op->op_private |= OPpDEREF_DB; + op->op_private |= OPpENTERSUB_DB; while (o != cvop) { if (proto) { switch (*proto) { @@ -4009,12 +4001,14 @@ register OP* o; for (; o; o = o->op_next) { if (o->op_seq) break; + if (!op_seqmax) + op_seqmax++; op = o; switch (o->op_type) { case OP_NEXTSTATE: case OP_DBSTATE: curcop = ((COP*)o); /* for warnings */ - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; case OP_CONCAT: @@ -4027,11 +4021,11 @@ register OP* o; case OP_QUOTEMETA: if (o->op_next->op_type == OP_STRINGIFY) null(o->op_next); - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; case OP_STUB: if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; /* Scalar stub must produce undef. List stub is noop */ } goto nothin; @@ -4047,7 +4041,7 @@ register OP* o; oldop->op_next = o->op_next; continue; } - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; case OP_GV: @@ -4084,25 +4078,25 @@ register OP* o; GvAVn((GV*)(((SVOP*)o)->op_sv)); } } - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; case OP_MAPWHILE: case OP_GREPWHILE: case OP_AND: case OP_OR: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; peep(cLOGOP->op_other); break; case OP_COND_EXPR: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; peep(cCONDOP->op_true); peep(cCONDOP->op_false); break; case OP_ENTERLOOP: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; peep(cLOOP->op_redoop); peep(cLOOP->op_nextop); peep(cLOOP->op_lastop); @@ -4110,12 +4104,12 @@ register OP* o; case OP_MATCH: case OP_SUBST: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; peep(cPMOP->op_pmreplstart); break; case OP_EXEC: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { if (o->op_next->op_sibling && o->op_next->op_sibling->op_type != OP_DIE) { @@ -4129,7 +4123,7 @@ register OP* o; } break; default: - o->op_seq = ++op_seqmax; + o->op_seq = op_seqmax++; break; } oldop = o; diff --git a/op.c.orig b/op.c.orig deleted file mode 100644 index 9ae1bdcde1..0000000000 --- a/op.c.orig +++ /dev/null @@ -1,4138 +0,0 @@ -/* op.c - * - * Copyright (c) 1991-1994, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - */ - -/* - * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck. She was - * our Mr. Bilbo's first cousin on the mother's side (her mother being the - * youngest of the Old Took's daughters); and Mr. Drogo was his second - * cousin. So Mr. Frodo is his first *and* second cousin, once removed - * either way, as the saying is, if you follow me." --the Gaffer - */ - -#include "EXTERN.h" -#include "perl.h" - -#ifdef USE_OP_MASK -/* - * In the following definition, the ", (OP *) op" is just to make the compiler - * think the expression is of the right type: croak actually does a longjmp. - */ -#define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \ - (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \ - : (*check[type])((OP *) op)) -#else -#define CHECKOP(type,op) (*check[type])(op) -#endif /* USE_OP_MASK */ - -static I32 list_assignment _((OP *op)); -static OP *bad_type _((I32 n, char *t, char *name, OP *kid)); -static OP *modkids _((OP *op, I32 type)); -static OP *no_fh_allowed _((OP *op)); -static OP *scalarboolean _((OP *op)); -static OP *too_few_arguments _((OP *op, char* name)); -static OP *too_many_arguments _((OP *op, char* name)); -static void null _((OP* op)); -static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq, - CV* startcv, I32 cx_ix)); - -static char* -CvNAME(cv) -CV* cv; -{ - SV* tmpsv = sv_newmortal(); - gv_efullname(tmpsv, CvGV(cv)); - return SvPV(tmpsv,na); -} - -static OP * -no_fh_allowed(op) -OP *op; -{ - sprintf(tokenbuf,"Missing comma after first argument to %s function", - op_name[op->op_type]); - yyerror(tokenbuf); - return op; -} - -static OP * -too_few_arguments(op, name) -OP* op; -char* name; -{ - sprintf(tokenbuf,"Not enough arguments for %s", name); - yyerror(tokenbuf); - return op; -} - -static OP * -too_many_arguments(op, name) -OP *op; -char* name; -{ - sprintf(tokenbuf,"Too many arguments for %s", name); - yyerror(tokenbuf); - return op; -} - -static OP * -bad_type(n, t, name, kid) -I32 n; -char *t; -char *name; -OP *kid; -{ - sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", - (int) n, name, t, op_name[kid->op_type]); - yyerror(tokenbuf); - return op; -} - -void -assertref(op) -OP *op; -{ - int type = op->op_type; - if (type != OP_AELEM && type != OP_HELEM) { - sprintf(tokenbuf, "Can't use subscript on %s", - op_name[type]); - yyerror(tokenbuf); - if (type == OP_RV2HV || type == OP_ENTERSUB) - warn("(Did you mean $ or @ instead of %c?)\n", - type == OP_RV2HV ? '%' : '&'); - } -} - -/* "register" allocation */ - -PADOFFSET -pad_allocmy(name) -char *name; -{ - PADOFFSET off; - SV *sv; - - if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) { - if (!isprint(name[1])) - sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */ - croak("Can't use global %s in \"my\"",name); - } - off = pad_alloc(OP_PADSV, SVs_PADMY); - sv = NEWSV(1102,0); - sv_upgrade(sv, SVt_PVNV); - sv_setpv(sv, name); - av_store(comppad_name, off, sv); - SvNVX(sv) = (double)999999999; - SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ - if (!min_intro_pending) - min_intro_pending = off; - max_intro_pending = off; - if (*name == '@') - av_store(comppad, off, (SV*)newAV()); - else if (*name == '%') - av_store(comppad, off, (SV*)newHV()); - SvPADMY_on(curpad[off]); - return off; -} - -static PADOFFSET -#ifndef CAN_PROTOTYPE -pad_findlex(name, newoff, seq, startcv, cx_ix) -char *name; -PADOFFSET newoff; -I32 seq; -CV* startcv; -I32 cx_ix; -#else -pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) -#endif -{ - CV *cv; - I32 off; - SV *sv; - register I32 i; - register CONTEXT *cx; - int saweval; - - for (cv = startcv; cv; cv = CvOUTSIDE(cv)) { - AV* curlist = CvPADLIST(cv); - SV** svp = av_fetch(curlist, 0, FALSE); - AV *curname; - if (!svp || *svp == &sv_undef) - continue; - curname = (AV*)*svp; - svp = AvARRAY(curname); - for (off = AvFILL(curname); off > 0; off--) { - if ((sv = svp[off]) && - sv != &sv_undef && - seq <= SvIVX(sv) && - seq > (I32)SvNVX(sv) && - strEQ(SvPVX(sv), name)) - { - I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; - AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE); - SV *oldsv = *av_fetch(oldpad, off, TRUE); - if (!newoff) { /* Not a mere clone operation. */ - SV *sv = NEWSV(1103,0); - newoff = pad_alloc(OP_PADSV, SVs_PADMY); - sv_upgrade(sv, SVt_PVNV); - sv_setpv(sv, name); - av_store(comppad_name, newoff, sv); - SvNVX(sv) = (double)curcop->cop_seq; - SvIVX(sv) = 999999999; /* A ref, intro immediately */ - SvFLAGS(sv) |= SVf_FAKE; - } - av_store(comppad, newoff, SvREFCNT_inc(oldsv)); - SvFLAGS(compcv) |= SVpcv_CLONE; - return newoff; - } - } - } - - /* Nothing in current lexical context--try eval's context, if any. - * This is necessary to let the perldb get at lexically scoped variables. - * XXX This will also probably interact badly with eval tree caching. - */ - - saweval = 0; - for (i = cx_ix; i >= 0; i--) { - cx = &cxstack[i]; - switch (cx->cx_type) { - default: - if (i == 0 && saweval) { - seq = cxstack[saweval].blk_oldcop->cop_seq; - return pad_findlex(name, newoff, seq, main_cv, 0); - } - break; - case CXt_EVAL: - if (cx->blk_eval.old_op_type != OP_ENTEREVAL) - return 0; /* require must have its own scope */ - saweval = i; - break; - case CXt_SUB: - if (!saweval) - return 0; - cv = cx->blk_sub.cv; - if (debstash && CvSTASH(cv) == debstash) { /* ignore DB'* scope */ - saweval = i; /* so we know where we were called from */ - continue; - } - seq = cxstack[saweval].blk_oldcop->cop_seq; - return pad_findlex(name, newoff, seq, cv, i-1); - } - } - - return 0; -} - -PADOFFSET -pad_findmy(name) -char *name; -{ - I32 off; - SV *sv; - SV **svp = AvARRAY(comppad_name); - I32 seq = cop_seqmax; - - /* The one we're looking for is probably just before comppad_name_fill. */ - for (off = AvFILL(comppad_name); off > 0; off--) { - if ((sv = svp[off]) && - sv != &sv_undef && - seq <= SvIVX(sv) && - seq > (I32)SvNVX(sv) && - strEQ(SvPVX(sv), name)) - { - return (PADOFFSET)off; - } - } - - /* See if it's in a nested scope */ - off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix); - if (off) - return off; - - return 0; -} - -void -pad_leavemy(fill) -I32 fill; -{ - I32 off; - SV **svp = AvARRAY(comppad_name); - SV *sv; - if (min_intro_pending && fill < min_intro_pending) { - for (off = max_intro_pending; off >= min_intro_pending; off--) { - if ((sv = svp[off]) && sv != &sv_undef) - warn("%s never introduced", SvPVX(sv)); - } - } - /* "Deintroduce" my variables that are leaving with this scope. */ - for (off = AvFILL(comppad_name); off > fill; off--) { - if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999) - SvIVX(sv) = cop_seqmax; - } -} - -PADOFFSET -pad_alloc(optype,tmptype) -I32 optype; -U32 tmptype; -{ - SV *sv; - I32 retval; - - if (AvARRAY(comppad) != curpad) - croak("panic: pad_alloc"); - if (pad_reset_pending) - pad_reset(); - if (tmptype & SVs_PADMY) { - do { - sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE); - } while (SvPADBUSY(sv)); /* need a fresh one */ - retval = AvFILL(comppad); - } - else { - do { - sv = *av_fetch(comppad, ++padix, TRUE); - } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)); - retval = padix; - } - SvFLAGS(sv) |= tmptype; - curpad = AvARRAY(comppad); - DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype])); - return (PADOFFSET)retval; -} - -SV * -#ifndef CAN_PROTOTYPE -pad_sv(po) -PADOFFSET po; -#else -pad_sv(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ -{ - if (!po) - croak("panic: pad_sv po"); - DEBUG_X(fprintf(stderr, "Pad sv %d\n", po)); - return curpad[po]; /* eventually we'll turn this into a macro */ -} - -void -#ifndef CAN_PROTOTYPE -pad_free(po) -PADOFFSET po; -#else -pad_free(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ -{ - if (!curpad) - return; - if (AvARRAY(comppad) != curpad) - croak("panic: pad_free curpad"); - if (!po) - croak("panic: pad_free po"); - DEBUG_X(fprintf(stderr, "Pad free %d\n", po)); - if (curpad[po] && curpad[po] != &sv_undef) - SvPADTMP_off(curpad[po]); - if ((I32)po < padix) - padix = po - 1; -} - -void -#ifndef CAN_PROTOTYPE -pad_swipe(po) -PADOFFSET po; -#else -pad_swipe(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ -{ - if (AvARRAY(comppad) != curpad) - croak("panic: pad_swipe curpad"); - if (!po) - croak("panic: pad_swipe po"); - DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po)); - SvPADTMP_off(curpad[po]); - curpad[po] = NEWSV(1107,0); - SvPADTMP_on(curpad[po]); - if ((I32)po < padix) - padix = po - 1; -} - -void -pad_reset() -{ - register I32 po; - - if (AvARRAY(comppad) != curpad) - croak("panic: pad_reset curpad"); - DEBUG_X(fprintf(stderr, "Pad reset\n")); - if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */ - for (po = AvMAX(comppad); po > padix_floor; po--) { - if (curpad[po] && curpad[po] != &sv_undef) - SvPADTMP_off(curpad[po]); - } - padix = padix_floor; - } - pad_reset_pending = FALSE; -} - -/* Destructor */ - -void -op_free(op) -OP *op; -{ - register OP *kid, *nextkid; - - if (!op) - return; - - if (op->op_flags & OPf_KIDS) { - for (kid = cUNOP->op_first; kid; kid = nextkid) { - nextkid = kid->op_sibling; /* Get before next freeing kid */ - op_free(kid); - } - } - - switch (op->op_type) { - case OP_NULL: - op->op_targ = 0; /* Was holding old type, if any. */ - break; - case OP_ENTEREVAL: - op->op_targ = 0; /* Was holding hints. */ - break; - case OP_GVSV: - case OP_GV: - SvREFCNT_dec(cGVOP->op_gv); - break; - case OP_NEXTSTATE: - case OP_DBSTATE: - SvREFCNT_dec(cCOP->cop_filegv); - break; - case OP_CONST: - SvREFCNT_dec(cSVOP->op_sv); - break; - case OP_GOTO: - case OP_NEXT: - case OP_LAST: - case OP_REDO: - if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) - break; - /* FALL THROUGH */ - case OP_TRANS: - Safefree(cPVOP->op_pv); - break; - case OP_SUBST: - op_free(cPMOP->op_pmreplroot); - /* FALL THROUGH */ - case OP_PUSHRE: - case OP_MATCH: - pregfree(cPMOP->op_pmregexp); - SvREFCNT_dec(cPMOP->op_pmshort); - break; - default: - break; - } - - if (op->op_targ > 0) - pad_free(op->op_targ); - - Safefree(op); -} - -static void -null(op) -OP* op; -{ - if (op->op_type != OP_NULL && op->op_targ > 0) - pad_free(op->op_targ); - op->op_targ = op->op_type; - op->op_type = OP_NULL; - op->op_ppaddr = ppaddr[OP_NULL]; -} - -/* Contextualizers */ - -#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) - -OP * -linklist(op) -OP *op; -{ - register OP *kid; - - if (op->op_next) - return op->op_next; - - /* establish postfix order */ - if (cUNOP->op_first) { - op->op_next = LINKLIST(cUNOP->op_first); - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_sibling) - kid->op_next = LINKLIST(kid->op_sibling); - else - kid->op_next = op; - } - } - else - op->op_next = op; - - return op->op_next; -} - -OP * -scalarkids(op) -OP *op; -{ - OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - scalar(kid); - } - return op; -} - -static OP * -scalarboolean(op) -OP *op; -{ - if (dowarn && - op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) { - line_t oldline = curcop->cop_line; - - if (copline != NOLINE) - curcop->cop_line = copline; - warn("Found = in conditional, should be =="); - curcop->cop_line = oldline; - } - return scalar(op); -} - -OP * -scalar(op) -OP *op; -{ - OP *kid; - - /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) - return op; - - op->op_flags &= ~OPf_LIST; - op->op_flags |= OPf_KNOW; - - switch (op->op_type) { - case OP_REPEAT: - if (op->op_private & OPpREPEAT_DOLIST) - null(((LISTOP*)cBINOP->op_first)->op_first); - scalar(cBINOP->op_first); - break; - case OP_OR: - case OP_AND: - case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - scalar(kid); - break; - case OP_SPLIT: - if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplroot) - deprecate("implicit split to @_"); - } - /* FALL THROUGH */ - case OP_MATCH: - case OP_SUBST: - case OP_NULL: - default: - if (op->op_flags & OPf_KIDS) { - for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) - scalar(kid); - } - break; - case OP_LEAVE: - case OP_LEAVETRY: - scalar(cLISTOP->op_first); - /* FALL THROUGH */ - case OP_SCOPE: - case OP_LINESEQ: - case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_sibling) - scalarvoid(kid); - else - scalar(kid); - } - curcop = &compiling; - break; - } - return op; -} - -OP * -scalarvoid(op) -OP *op; -{ - OP *kid; - char* useless = 0; - SV* sv; - - if (!op || error_count) - return op; - if (op->op_flags & OPf_LIST) - return op; - - op->op_flags |= OPf_KNOW; - - switch (op->op_type) { - default: - if (!(opargs[op->op_type] & OA_FOLDCONST)) - break; - if (op->op_flags & OPf_STACKED) - break; - /* FALL THROUGH */ - case OP_GVSV: - case OP_WANTARRAY: - case OP_GV: - case OP_PADSV: - case OP_PADAV: - case OP_PADHV: - case OP_PADANY: - case OP_AV2ARYLEN: - case OP_SV2LEN: - case OP_REF: - case OP_REFGEN: - case OP_SREFGEN: - case OP_DEFINED: - case OP_HEX: - case OP_OCT: - case OP_LENGTH: - case OP_SUBSTR: - case OP_VEC: - case OP_INDEX: - case OP_RINDEX: - case OP_SPRINTF: - case OP_AELEM: - case OP_AELEMFAST: - case OP_ASLICE: - case OP_VALUES: - case OP_KEYS: - case OP_HELEM: - case OP_HSLICE: - case OP_UNPACK: - case OP_PACK: - case OP_JOIN: - case OP_LSLICE: - case OP_ANONLIST: - case OP_ANONHASH: - case OP_SORT: - case OP_REVERSE: - case OP_RANGE: - case OP_FLIP: - case OP_FLOP: - case OP_CALLER: - case OP_FILENO: - case OP_EOF: - case OP_TELL: - case OP_GETSOCKNAME: - case OP_GETPEERNAME: - case OP_READLINK: - case OP_TELLDIR: - case OP_GETPPID: - case OP_GETPGRP: - case OP_GETPRIORITY: - case OP_TIME: - case OP_TMS: - case OP_LOCALTIME: - case OP_GMTIME: - case OP_GHBYNAME: - case OP_GHBYADDR: - case OP_GHOSTENT: - case OP_GNBYNAME: - case OP_GNBYADDR: - case OP_GNETENT: - case OP_GPBYNAME: - case OP_GPBYNUMBER: - case OP_GPROTOENT: - case OP_GSBYNAME: - case OP_GSBYPORT: - case OP_GSERVENT: - case OP_GPWNAM: - case OP_GPWUID: - case OP_GGRNAM: - case OP_GGRGID: - case OP_GETLOGIN: - if (!(op->op_private & OPpLVAL_INTRO)) - useless = op_name[op->op_type]; - break; - - case OP_RV2GV: - case OP_RV2SV: - case OP_RV2AV: - case OP_RV2HV: - if (!(op->op_private & OPpLVAL_INTRO) && - (!op->op_sibling || op->op_sibling->op_type != OP_READLINE)) - useless = "a variable"; - break; - - case OP_NEXTSTATE: - case OP_DBSTATE: - curcop = ((COP*)op); /* for warning below */ - break; - - case OP_CONST: - sv = cSVOP->op_sv; - if (dowarn) { - useless = "a constant"; - if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) - useless = 0; - else if (SvPOK(sv)) { - if (strnEQ(SvPVX(sv), "di", 2) || - strnEQ(SvPVX(sv), "ds", 2) || - strnEQ(SvPVX(sv), "ig", 2)) - useless = 0; - } - } - null(op); /* don't execute a constant */ - SvREFCNT_dec(sv); /* don't even remember it */ - break; - - case OP_POSTINC: - op->op_type = OP_PREINC; /* pre-increment is faster */ - op->op_ppaddr = ppaddr[OP_PREINC]; - break; - - case OP_POSTDEC: - op->op_type = OP_PREDEC; /* pre-decrement is faster */ - op->op_ppaddr = ppaddr[OP_PREDEC]; - break; - - case OP_REPEAT: - scalarvoid(cBINOP->op_first); - useless = op_name[op->op_type]; - break; - - case OP_OR: - case OP_AND: - case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - scalarvoid(kid); - break; - case OP_NULL: - if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE) - curcop = ((COP*)op); /* for warning below */ - if (op->op_flags & OPf_STACKED) - break; - case OP_ENTERTRY: - case OP_ENTER: - case OP_SCALAR: - if (!(op->op_flags & OPf_KIDS)) - break; - case OP_SCOPE: - case OP_LEAVE: - case OP_LEAVETRY: - case OP_LEAVELOOP: - op->op_private |= OPpLEAVE_VOID; - case OP_LINESEQ: - case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - scalarvoid(kid); - break; - case OP_SPLIT: - if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplroot) - deprecate("implicit split to @_"); - } - break; - case OP_DELETE: - op->op_private |= OPpLEAVE_VOID; - break; - } - if (useless && dowarn) - warn("Useless use of %s in void context", useless); - return op; -} - -OP * -listkids(op) -OP *op; -{ - OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - list(kid); - } - return op; -} - -OP * -list(op) -OP *op; -{ - OP *kid; - - /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) - return op; - - op->op_flags |= (OPf_KNOW | OPf_LIST); - - switch (op->op_type) { - case OP_FLOP: - case OP_REPEAT: - list(cBINOP->op_first); - break; - case OP_OR: - case OP_AND: - case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - list(kid); - break; - default: - case OP_MATCH: - case OP_SUBST: - case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) - break; - if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) { - list(cBINOP->op_first); - return gen_constant_list(op); - } - case OP_LIST: - listkids(op); - break; - case OP_LEAVE: - case OP_LEAVETRY: - list(cLISTOP->op_first); - /* FALL THROUGH */ - case OP_SCOPE: - case OP_LINESEQ: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_sibling) - scalarvoid(kid); - else - list(kid); - } - curcop = &compiling; - break; - } - return op; -} - -OP * -scalarseq(op) -OP *op; -{ - OP *kid; - - if (op) { - if (op->op_type == OP_LINESEQ || - op->op_type == OP_SCOPE || - op->op_type == OP_LEAVE || - op->op_type == OP_LEAVETRY) - { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_sibling) { - scalarvoid(kid); - } - } - curcop = &compiling; - } - op->op_flags &= ~OPf_PARENS; - if (hints & HINT_BLOCK_SCOPE) - op->op_flags |= OPf_PARENS; - } - else - op = newOP(OP_STUB, 0); - return op; -} - -static OP * -modkids(op, type) -OP *op; -I32 type; -{ - OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - mod(kid, type); - } - return op; -} - -static I32 modcount; - -OP * -mod(op, type) -OP *op; -I32 type; -{ - OP *kid; - SV *sv; - char mtype; - - if (!op || error_count) - return op; - - switch (op->op_type) { - case OP_CONST: - if (!(op->op_private & (OPpCONST_ARYBASE))) - goto nomod; - if (eval_start && eval_start->op_type == OP_CONST) { - compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv); - eval_start = 0; - } - else if (!type) { - SAVEI32(compiling.cop_arybase); - compiling.cop_arybase = 0; - } - else if (type == OP_REFGEN) - goto nomod; - else - croak("That use of $[ is unsupported"); - break; - case OP_ENTERSUB: - if ((type == OP_UNDEF || type == OP_REFGEN) && - !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersub => rv2cv */ - op->op_ppaddr = ppaddr[OP_RV2CV]; - assert(cUNOP->op_first->op_type == OP_NULL); - null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ - break; - } - /* FALL THROUGH */ - default: - nomod: - /* grep, foreach, subcalls, refgen */ - if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) - break; - sprintf(tokenbuf, "Can't modify %s in %s", - op_name[op->op_type], - type ? op_name[type] : "local"); - yyerror(tokenbuf); - return op; - - case OP_PREINC: - case OP_PREDEC: - case OP_POW: - case OP_MULTIPLY: - case OP_DIVIDE: - case OP_MODULO: - case OP_REPEAT: - case OP_ADD: - case OP_SUBTRACT: - case OP_CONCAT: - case OP_LEFT_SHIFT: - case OP_RIGHT_SHIFT: - case OP_BIT_AND: - case OP_BIT_XOR: - case OP_BIT_OR: - case OP_I_MULTIPLY: - case OP_I_DIVIDE: - case OP_I_MODULO: - case OP_I_ADD: - case OP_I_SUBTRACT: - if (!(op->op_flags & OPf_STACKED)) - goto nomod; - modcount++; - break; - - case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - mod(kid, type); - break; - - case OP_RV2AV: - case OP_RV2HV: - if (type == OP_REFGEN && op->op_flags & OPf_PARENS) { - modcount = 10000; - return op; /* Treat \(@foo) like ordinary list. */ - } - /* FALL THROUGH */ - case OP_RV2GV: - ref(cUNOP->op_first, op->op_type); - /* FALL THROUGH */ - case OP_AASSIGN: - case OP_ASLICE: - case OP_HSLICE: - case OP_NEXTSTATE: - case OP_DBSTATE: - case OP_REFGEN: - case OP_CHOMP: - modcount = 10000; - break; - case OP_RV2SV: - if (!type && cUNOP->op_first->op_type != OP_GV) - croak("Can't localize a reference"); - ref(cUNOP->op_first, op->op_type); - /* FALL THROUGH */ - case OP_UNDEF: - case OP_GV: - case OP_AV2ARYLEN: - case OP_SASSIGN: - case OP_AELEMFAST: - modcount++; - break; - - case OP_PADAV: - case OP_PADHV: - modcount = 10000; - /* FALL THROUGH */ - case OP_PADSV: - modcount++; - if (!type) - croak("Can't localize lexical variable %s", - SvPV(*av_fetch(comppad_name, op->op_targ, 4), na)); - break; - - case OP_PUSHMARK: - break; - - case OP_POS: - mtype = '.'; - goto makelv; - case OP_VEC: - mtype = 'v'; - goto makelv; - case OP_SUBSTR: - mtype = 'x'; - makelv: - pad_free(op->op_targ); - op->op_targ = pad_alloc(op->op_type, SVs_PADMY); - sv = PAD_SV(op->op_targ); - sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, Nullsv, mtype, Nullch, 0); - curpad[op->op_targ] = sv; - if (op->op_flags & OPf_KIDS) - mod(cBINOP->op_first->op_sibling, type); - break; - - case OP_AELEM: - case OP_HELEM: - ref(cBINOP->op_first, op->op_type); - modcount++; - break; - - case OP_SCOPE: - case OP_LEAVE: - case OP_ENTER: - if (op->op_flags & OPf_KIDS) - mod(cLISTOP->op_last, type); - break; - - case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) - break; - if (op->op_targ != OP_LIST) { - mod(cBINOP->op_first, type); - break; - } - /* FALL THROUGH */ - case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - mod(kid, type); - break; - } - op->op_flags |= OPf_MOD; - - if (type == OP_AASSIGN || type == OP_SASSIGN) - op->op_flags |= OPf_SPECIAL|OPf_REF; - else if (!type) { - op->op_private |= OPpLVAL_INTRO; - op->op_flags &= ~OPf_SPECIAL; - } - else if (type != OP_GREPSTART && type != OP_ENTERSUB) - op->op_flags |= OPf_REF; - return op; -} - -OP * -refkids(op, type) -OP *op; -I32 type; -{ - OP *kid; - if (op && op->op_flags & OPf_KIDS) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - ref(kid, type); - } - return op; -} - -OP * -ref(op, type) -OP *op; -I32 type; -{ - OP *kid; - - if (!op || error_count) - return op; - - switch (op->op_type) { - case OP_ENTERSUB: - if ((type == OP_DEFINED) && - !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersub => rv2cv */ - op->op_ppaddr = ppaddr[OP_RV2CV]; - assert(cUNOP->op_first->op_type == OP_NULL); - null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ - op->op_flags |= OPf_SPECIAL; - } - break; - - case OP_COND_EXPR: - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - ref(kid, type); - break; - case OP_RV2SV: - ref(cUNOP->op_first, op->op_type); - /* FALL THROUGH */ - case OP_PADSV: - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); - op->op_flags |= OPf_MOD; - } - break; - - case OP_RV2AV: - case OP_RV2HV: - op->op_flags |= OPf_REF; - /* FALL THROUGH */ - case OP_RV2GV: - ref(cUNOP->op_first, op->op_type); - break; - - case OP_PADAV: - case OP_PADHV: - op->op_flags |= OPf_REF; - break; - - case OP_SCALAR: - case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) - break; - ref(cBINOP->op_first, type); - break; - case OP_AELEM: - case OP_HELEM: - ref(cBINOP->op_first, op->op_type); - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); - op->op_flags |= OPf_MOD; - } - break; - - case OP_SCOPE: - case OP_LEAVE: - case OP_ENTER: - case OP_LIST: - if (!(op->op_flags & OPf_KIDS)) - break; - ref(cLISTOP->op_last, type); - break; - default: - break; - } - return scalar(op); - -} - -OP * -my(op) -OP *op; -{ - OP *kid; - I32 type; - - if (!op || error_count) - return op; - - type = op->op_type; - if (type == OP_LIST) { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - my(kid); - } - else if (type != OP_PADSV && - type != OP_PADAV && - type != OP_PADHV && - type != OP_PUSHMARK) - { - sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]); - yyerror(tokenbuf); - return op; - } - op->op_flags |= OPf_MOD; - op->op_private |= OPpLVAL_INTRO; - return op; -} - -OP * -sawparens(o) -OP *o; -{ - if (o) - o->op_flags |= OPf_PARENS; - return o; -} - -OP * -bind_match(type, left, right) -I32 type; -OP *left; -OP *right; -{ - OP *op; - - if (right->op_type == OP_MATCH || - right->op_type == OP_SUBST || - right->op_type == OP_TRANS) { - right->op_flags |= OPf_STACKED; - if (right->op_type != OP_MATCH) - left = mod(left, right->op_type); - if (right->op_type == OP_TRANS) - op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); - else - op = prepend_elem(right->op_type, scalar(left), right); - if (type == OP_NOT) - return newUNOP(OP_NOT, 0, scalar(op)); - return op; - } - else - return bind_match(type, left, - pmruntime(newPMOP(OP_MATCH, 0), right, Nullop)); -} - -OP * -invert(op) -OP *op; -{ - if (!op) - return op; - /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */ - return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op)); -} - -OP * -scope(o) -OP *o; -{ - if (o) { - if (o->op_flags & OPf_PARENS || perldb || tainting) { - o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); - o->op_type = OP_LEAVE; - o->op_ppaddr = ppaddr[OP_LEAVE]; - } - else { - if (o->op_type == OP_LINESEQ) { - OP *kid; - o->op_type = OP_SCOPE; - o->op_ppaddr = ppaddr[OP_SCOPE]; - kid = ((LISTOP*)o)->op_first; - if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){ - SvREFCNT_dec(((COP*)kid)->cop_filegv); - null(kid); - } - } - else - o = newLISTOP(OP_SCOPE, 0, o, Nullop); - } - } - return o; -} - -int -block_start() -{ - int retval = savestack_ix; - comppad_name_fill = AvFILL(comppad_name); - SAVEINT(min_intro_pending); - SAVEINT(max_intro_pending); - min_intro_pending = 0; - SAVEINT(comppad_name_fill); - SAVEINT(padix_floor); - padix_floor = padix; - pad_reset_pending = FALSE; - SAVEINT(hints); - hints &= ~HINT_BLOCK_SCOPE; - return retval; -} - -OP* -block_end(line, floor, seq) -int line; -int floor; -OP* seq; -{ - int needblockscope = hints & HINT_BLOCK_SCOPE; - OP* retval = scalarseq(seq); - if (copline > (line_t)line) - copline = line; - LEAVE_SCOPE(floor); - pad_reset_pending = FALSE; - if (needblockscope) - hints |= HINT_BLOCK_SCOPE; /* propagate out */ - pad_leavemy(comppad_name_fill); - return retval; -} - -void -newPROG(op) -OP *op; -{ - if (in_eval) { - eval_root = newUNOP(OP_LEAVEEVAL, 0, op); - eval_start = linklist(eval_root); - eval_root->op_next = 0; - peep(eval_start); - } - else { - if (!op) { - main_start = 0; - return; - } - main_root = scope(sawparens(scalarvoid(op))); - curcop = &compiling; - main_start = LINKLIST(main_root); - main_root->op_next = 0; - peep(main_start); - main_cv = compcv; - compcv = 0; - } -} - -OP * -localize(o, lex) -OP *o; -I32 lex; -{ - if (o->op_flags & OPf_PARENS) - list(o); - else { - scalar(o); - if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') { - char *s; - for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ; - if (*s == ';' || *s == '=') - warn("Parens missing around \"%s\" list", lex ? "my" : "local"); - } - } - in_my = FALSE; - if (lex) - return my(o); - else - return mod(o, OP_NULL); /* a bit kludgey */ -} - -OP * -jmaybe(o) -OP *o; -{ - if (o->op_type == OP_LIST) { - o = convert(OP_JOIN, 0, - prepend_elem(OP_LIST, - newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))), - o)); - } - return o; -} - -OP * -fold_constants(o) -register OP *o; -{ - register OP *curop; - I32 type = o->op_type; - SV *sv; - - if (opargs[type] & OA_RETSCALAR) - scalar(o); - if (opargs[type] & OA_TARGET) - o->op_targ = pad_alloc(type, SVs_PADTMP); - - if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER)) - o->op_ppaddr = ppaddr[type = ++(o->op_type)]; - - if (!(opargs[type] & OA_FOLDCONST)) - goto nope; - - if (error_count) - goto nope; /* Don't try to run w/ errors */ - - for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { - if (curop->op_type != OP_CONST && - curop->op_type != OP_LIST && - curop->op_type != OP_SCALAR && - curop->op_type != OP_NULL && - curop->op_type != OP_PUSHMARK) { - goto nope; - } - } - - curop = LINKLIST(o); - o->op_next = 0; - op = curop; - run(); - sv = *(stack_sp--); - if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ - pad_swipe(o->op_targ); - else if (SvTEMP(sv)) { /* grab mortal temp? */ - (void)SvREFCNT_inc(sv); - SvTEMP_off(sv); - } - op_free(o); - if (type == OP_RV2GV) - return newGVOP(OP_GV, 0, sv); - else { - if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) { - IV iv = SvIV(sv); - if ((double)iv == SvNV(sv)) { /* can we smush double to int */ - SvREFCNT_dec(sv); - sv = newSViv(iv); - } - } - return newSVOP(OP_CONST, 0, sv); - } - - nope: - if (!(opargs[type] & OA_OTHERINT)) - return o; - - if (!(hints & HINT_INTEGER)) { - if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) - return o; - - for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { - if (curop->op_type == OP_CONST) { - if (SvIOK(((SVOP*)curop)->op_sv)) - continue; - return o; - } - if (opargs[curop->op_type] & OA_RETINTEGER) - continue; - return o; - } - o->op_ppaddr = ppaddr[++(o->op_type)]; - } - - return o; -} - -OP * -gen_constant_list(o) -register OP *o; -{ - register OP *curop; - I32 oldtmps_floor = tmps_floor; - - list(o); - if (error_count) - return o; /* Don't attempt to run with errors */ - - op = curop = LINKLIST(o); - o->op_next = 0; - pp_pushmark(); - run(); - op = curop; - pp_anonlist(); - tmps_floor = oldtmps_floor; - - o->op_type = OP_RV2AV; - o->op_ppaddr = ppaddr[OP_RV2AV]; - curop = ((UNOP*)o)->op_first; - ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--)); - op_free(curop); - linklist(o); - return list(o); -} - -OP * -convert(type, flags, op) -I32 type; -I32 flags; -OP* op; -{ - OP *kid; - OP *last = 0; - - if (!op || op->op_type != OP_LIST) - op = newLISTOP(OP_LIST, 0, op, Nullop); - else - op->op_flags &= ~(OPf_KNOW|OPf_LIST); - - if (!(opargs[type] & OA_MARK)) - null(cLISTOP->op_first); - - op->op_type = type; - op->op_ppaddr = ppaddr[type]; - op->op_flags |= flags; - - op = CHECKOP(type, op); - if (op->op_type != type) - return op; - - if (cLISTOP->op_children < 7) { - /* XXX do we really need to do this if we're done appending?? */ - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - last = kid; - cLISTOP->op_last = last; /* in case check substituted last arg */ - } - - return fold_constants(op); -} - -/* List constructors */ - -OP * -append_elem(type, first, last) -I32 type; -OP* first; -OP* last; -{ - if (!first) - return last; - - if (!last) - return first; - - if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS) - return newLISTOP(type, 0, first, last); - - if (first->op_flags & OPf_KIDS) - ((LISTOP*)first)->op_last->op_sibling = last; - else { - first->op_flags |= OPf_KIDS; - ((LISTOP*)first)->op_first = last; - } - ((LISTOP*)first)->op_last = last; - ((LISTOP*)first)->op_children++; - return first; -} - -OP * -append_list(type, first, last) -I32 type; -LISTOP* first; -LISTOP* last; -{ - if (!first) - return (OP*)last; - - if (!last) - return (OP*)first; - - if (first->op_type != type) - return prepend_elem(type, (OP*)first, (OP*)last); - - if (last->op_type != type) - return append_elem(type, (OP*)first, (OP*)last); - - first->op_last->op_sibling = last->op_first; - first->op_last = last->op_last; - first->op_children += last->op_children; - if (first->op_children) - last->op_flags |= OPf_KIDS; - - Safefree(last); - return (OP*)first; -} - -OP * -prepend_elem(type, first, last) -I32 type; -OP* first; -OP* last; -{ - if (!first) - return last; - - if (!last) - return first; - - if (last->op_type == type) { - if (type == OP_LIST) { /* already a PUSHMARK there */ - first->op_sibling = ((LISTOP*)last)->op_first->op_sibling; - ((LISTOP*)last)->op_first->op_sibling = first; - } - else { - if (!(last->op_flags & OPf_KIDS)) { - ((LISTOP*)last)->op_last = first; - last->op_flags |= OPf_KIDS; - } - first->op_sibling = ((LISTOP*)last)->op_first; - ((LISTOP*)last)->op_first = first; - } - ((LISTOP*)last)->op_children++; - return last; - } - - return newLISTOP(type, 0, first, last); -} - -/* Constructors */ - -OP * -newNULLLIST() -{ - return newOP(OP_STUB, 0); -} - -OP * -force_list(op) -OP* op; -{ - if (!op || op->op_type != OP_LIST) - op = newLISTOP(OP_LIST, 0, op, Nullop); - null(op); - return op; -} - -OP * -newLISTOP(type, flags, first, last) -I32 type; -I32 flags; -OP* first; -OP* last; -{ - LISTOP *listop; - - Newz(1101, listop, 1, LISTOP); - - listop->op_type = type; - listop->op_ppaddr = ppaddr[type]; - listop->op_children = (first != 0) + (last != 0); - listop->op_flags = flags; - - if (!last && first) - last = first; - else if (!first && last) - first = last; - else if (first) - first->op_sibling = last; - listop->op_first = first; - listop->op_last = last; - if (type == OP_LIST) { - OP* pushop; - pushop = newOP(OP_PUSHMARK, 0); - pushop->op_sibling = first; - listop->op_first = pushop; - listop->op_flags |= OPf_KIDS; - if (!last) - listop->op_last = pushop; - } - else if (listop->op_children) - listop->op_flags |= OPf_KIDS; - - return (OP*)listop; -} - -OP * -newOP(type, flags) -I32 type; -I32 flags; -{ - OP *op; - Newz(1101, op, 1, OP); - op->op_type = type; - op->op_ppaddr = ppaddr[type]; - op->op_flags = flags; - - op->op_next = op; - /* op->op_private = 0; */ - if (opargs[type] & OA_RETSCALAR) - scalar(op); - if (opargs[type] & OA_TARGET) - op->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, op); -} - -OP * -newUNOP(type, flags, first) -I32 type; -I32 flags; -OP* first; -{ - UNOP *unop; - - if (!first) - first = newOP(OP_STUB, 0); - if (opargs[type] & OA_MARK) - first = force_list(first); - - Newz(1101, unop, 1, UNOP); - unop->op_type = type; - unop->op_ppaddr = ppaddr[type]; - unop->op_first = first; - unop->op_flags = flags | OPf_KIDS; - unop->op_private = 1; - - unop = (UNOP*) CHECKOP(type, unop); - if (unop->op_next) - return (OP*)unop; - - return fold_constants((OP *) unop); -} - -OP * -newBINOP(type, flags, first, last) -I32 type; -I32 flags; -OP* first; -OP* last; -{ - BINOP *binop; - Newz(1101, binop, 1, BINOP); - - if (!first) - first = newOP(OP_NULL, 0); - - binop->op_type = type; - binop->op_ppaddr = ppaddr[type]; - binop->op_first = first; - binop->op_flags = flags | OPf_KIDS; - if (!last) { - last = first; - binop->op_private = 1; - } - else { - binop->op_private = 2; - first->op_sibling = last; - } - - binop = (BINOP*)CHECKOP(type, binop); - if (binop->op_next) - return (OP*)binop; - - binop->op_last = last = binop->op_first->op_sibling; - - return fold_constants((OP *)binop); -} - -OP * -pmtrans(op, expr, repl) -OP *op; -OP *expr; -OP *repl; -{ - SV *tstr = ((SVOP*)expr)->op_sv; - SV *rstr = ((SVOP*)repl)->op_sv; - STRLEN tlen; - STRLEN rlen; - register char *t = SvPV(tstr, tlen); - register char *r = SvPV(rstr, rlen); - register I32 i; - register I32 j; - I32 delete; - I32 complement; - register short *tbl; - - tbl = (short*)cPVOP->op_pv; - complement = op->op_private & OPpTRANS_COMPLEMENT; - delete = op->op_private & OPpTRANS_DELETE; - /* squash = op->op_private & OPpTRANS_SQUASH; */ - - if (complement) { - Zero(tbl, 256, short); - for (i = 0; i < tlen; i++) - tbl[t[i] & 0377] = -1; - for (i = 0, j = 0; i < 256; i++) { - if (!tbl[i]) { - if (j >= rlen) { - if (delete) - tbl[i] = -2; - else if (rlen) - tbl[i] = r[j-1] & 0377; - else - tbl[i] = i; - } - else - tbl[i] = r[j++] & 0377; - } - } - } - else { - if (!rlen && !delete) { - r = t; rlen = tlen; - } - for (i = 0; i < 256; i++) - tbl[i] = -1; - for (i = 0, j = 0; i < tlen; i++,j++) { - if (j >= rlen) { - if (delete) { - if (tbl[t[i] & 0377] == -1) - tbl[t[i] & 0377] = -2; - continue; - } - --j; - } - if (tbl[t[i] & 0377] == -1) - tbl[t[i] & 0377] = r[j] & 0377; - } - } - op_free(expr); - op_free(repl); - - return op; -} - -OP * -newPMOP(type, flags) -I32 type; -I32 flags; -{ - PMOP *pmop; - - Newz(1101, pmop, 1, PMOP); - pmop->op_type = type; - pmop->op_ppaddr = ppaddr[type]; - pmop->op_flags = flags; - pmop->op_private = 0; - - /* link into pm list */ - if (type != OP_TRANS && curstash) { - pmop->op_pmnext = HvPMROOT(curstash); - HvPMROOT(curstash) = pmop; - } - - return (OP*)pmop; -} - -OP * -pmruntime(op, expr, repl) -OP *op; -OP *expr; -OP *repl; -{ - PMOP *pm; - LOGOP *rcop; - - if (op->op_type == OP_TRANS) - return pmtrans(op, expr, repl); - - pm = (PMOP*)op; - - if (expr->op_type == OP_CONST) { - STRLEN plen; - SV *pat = ((SVOP*)expr)->op_sv; - char *p = SvPV(pat, plen); - if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) { - sv_setpvn(pat, "\\s+", 3); - p = SvPV(pat, plen); - pm->op_pmflags |= PMf_SKIPWHITE; - } - pm->op_pmregexp = pregcomp(p, p + plen, pm); - if (strEQ("\\s+", pm->op_pmregexp->precomp)) - pm->op_pmflags |= PMf_WHITE; - hoistmust(pm); - op_free(expr); - } - else { - if (pm->op_pmflags & PMf_KEEP) - expr = newUNOP(OP_REGCMAYBE,0,expr); - - Newz(1101, rcop, 1, LOGOP); - rcop->op_type = OP_REGCOMP; - rcop->op_ppaddr = ppaddr[OP_REGCOMP]; - rcop->op_first = scalar(expr); - rcop->op_flags |= OPf_KIDS; - rcop->op_private = 1; - rcop->op_other = op; - - /* establish postfix order */ - if (pm->op_pmflags & PMf_KEEP) { - LINKLIST(expr); - rcop->op_next = expr; - ((UNOP*)expr)->op_first->op_next = (OP*)rcop; - } - else { - rcop->op_next = LINKLIST(expr); - expr->op_next = (OP*)rcop; - } - - prepend_elem(op->op_type, scalar((OP*)rcop), op); - } - - if (repl) { - OP *curop; - if (pm->op_pmflags & PMf_EVAL) - curop = 0; - else if (repl->op_type == OP_CONST) - curop = repl; - else { - OP *lastop = 0; - for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) { - if (opargs[curop->op_type] & OA_DANGEROUS) { - if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; - if (strchr("&`'123456789+", *GvENAME(gv))) - break; - } - else if (curop->op_type == OP_RV2CV) - break; - else if (curop->op_type == OP_RV2SV || - curop->op_type == OP_RV2AV || - curop->op_type == OP_RV2HV || - curop->op_type == OP_RV2GV) { - if (lastop && lastop->op_type != OP_GV) /*funny deref?*/ - break; - } - else if (curop->op_type == OP_PADSV || - curop->op_type == OP_PADAV || - curop->op_type == OP_PADHV || - curop->op_type == OP_PADANY) { - /* is okay */ - } - else - break; - } - lastop = curop; - } - } - if (curop == repl) { - pm->op_pmflags |= PMf_CONST; /* const for long enough */ - pm->op_pmpermflags |= PMf_CONST; /* const for long enough */ - prepend_elem(op->op_type, scalar(repl), op); - } - else { - Newz(1101, rcop, 1, LOGOP); - rcop->op_type = OP_SUBSTCONT; - rcop->op_ppaddr = ppaddr[OP_SUBSTCONT]; - rcop->op_first = scalar(repl); - rcop->op_flags |= OPf_KIDS; - rcop->op_private = 1; - rcop->op_other = op; - - /* establish postfix order */ - rcop->op_next = LINKLIST(repl); - repl->op_next = (OP*)rcop; - - pm->op_pmreplroot = scalar((OP*)rcop); - pm->op_pmreplstart = LINKLIST(rcop); - rcop->op_next = 0; - } - } - - return (OP*)pm; -} - -OP * -newSVOP(type, flags, sv) -I32 type; -I32 flags; -SV *sv; -{ - SVOP *svop; - Newz(1101, svop, 1, SVOP); - svop->op_type = type; - svop->op_ppaddr = ppaddr[type]; - svop->op_sv = sv; - svop->op_next = (OP*)svop; - svop->op_flags = flags; - if (opargs[type] & OA_RETSCALAR) - scalar((OP*)svop); - if (opargs[type] & OA_TARGET) - svop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, svop); -} - -OP * -newGVOP(type, flags, gv) -I32 type; -I32 flags; -GV *gv; -{ - GVOP *gvop; - Newz(1101, gvop, 1, GVOP); - gvop->op_type = type; - gvop->op_ppaddr = ppaddr[type]; - gvop->op_gv = (GV*)SvREFCNT_inc(gv); - gvop->op_next = (OP*)gvop; - gvop->op_flags = flags; - if (opargs[type] & OA_RETSCALAR) - scalar((OP*)gvop); - if (opargs[type] & OA_TARGET) - gvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, gvop); -} - -OP * -newPVOP(type, flags, pv) -I32 type; -I32 flags; -char *pv; -{ - PVOP *pvop; - Newz(1101, pvop, 1, PVOP); - pvop->op_type = type; - pvop->op_ppaddr = ppaddr[type]; - pvop->op_pv = pv; - pvop->op_next = (OP*)pvop; - pvop->op_flags = flags; - if (opargs[type] & OA_RETSCALAR) - scalar((OP*)pvop); - if (opargs[type] & OA_TARGET) - pvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, pvop); -} - -OP * -newCVOP(type, flags, cv, cont) -I32 type; -I32 flags; -CV *cv; -OP *cont; -{ - CVOP *cvop; - Newz(1101, cvop, 1, CVOP); - cvop->op_type = type; - cvop->op_ppaddr = ppaddr[type]; - cvop->op_cv = cv; - cvop->op_cont = cont; - cvop->op_next = (OP*)cvop; - cvop->op_flags = flags; - if (opargs[type] & OA_RETSCALAR) - scalar((OP*)cvop); - if (opargs[type] & OA_TARGET) - cvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, cvop); -} - -void -package(op) -OP *op; -{ - SV *sv; - - save_hptr(&curstash); - save_item(curstname); - if (op) { - STRLEN len; - char *name; - sv = cSVOP->op_sv; - name = SvPV(sv, len); - curstash = gv_stashpv(name,TRUE); - sv_setpvn(curstname, name, len); - op_free(op); - } - else { - sv_setpv(curstname,"<none>"); - curstash = Nullhv; - } - copline = NOLINE; - expect = XSTATE; -} - -void -utilize(aver, id, arg) -int aver; -OP *id; -OP *arg; -{ - OP *pack; - OP *meth; - OP *rqop; - OP *imop; - - if (id->op_type != OP_CONST) - croak("Module name must be constant"); - - /* Fake up an import/unimport */ - if (arg && arg->op_type == OP_STUB) - imop = arg; /* no import on explicit () */ - else { - /* Make copy of id so we don't free it twice */ - pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); - - meth = newSVOP(OP_CONST, 0, - aver - ? newSVpv("import", 6) - : newSVpv("unimport", 8) - ); - imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, - append_elem(OP_LIST, - prepend_elem(OP_LIST, pack, list(arg)), - newUNOP(OP_METHOD, 0, meth))); - } - - /* Fake up a require */ - rqop = newUNOP(OP_REQUIRE, 0, id); - - /* Fake up the BEGIN {}, which does its thing immediately. */ - newSUB(start_subparse(), - newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), - Nullop, - append_elem(OP_LINESEQ, - newSTATEOP(0, Nullch, rqop), - newSTATEOP(0, Nullch, imop) )); - - copline = NOLINE; - expect = XSTATE; -} - -OP * -newSLICEOP(flags, subscript, listval) -I32 flags; -OP *subscript; -OP *listval; -{ - return newBINOP(OP_LSLICE, flags, - list(force_list(subscript)), - list(force_list(listval)) ); -} - -static I32 -list_assignment(op) -register OP *op; -{ - if (!op) - return TRUE; - - if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS) - op = cUNOP->op_first; - - if (op->op_type == OP_COND_EXPR) { - I32 t = list_assignment(cCONDOP->op_first->op_sibling); - I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling); - - if (t && f) - return TRUE; - if (t || f) - yyerror("Assignment to both a list and a scalar"); - return FALSE; - } - - if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS || - op->op_type == OP_RV2AV || op->op_type == OP_RV2HV || - op->op_type == OP_ASLICE || op->op_type == OP_HSLICE) - return TRUE; - - if (op->op_type == OP_PADAV || op->op_type == OP_PADHV) - return TRUE; - - if (op->op_type == OP_RV2SV) - return FALSE; - - return FALSE; -} - -OP * -newASSIGNOP(flags, left, optype, right) -I32 flags; -OP *left; -I32 optype; -OP *right; -{ - OP *op; - - if (optype) { - if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) { - return newLOGOP(optype, 0, - mod(scalar(left), optype), - newUNOP(OP_SASSIGN, 0, scalar(right))); - } - else { - return newBINOP(optype, OPf_STACKED, - mod(scalar(left), optype), scalar(right)); - } - } - - if (list_assignment(left)) { - modcount = 0; - eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ - left = mod(left, OP_AASSIGN); - if (eval_start) - eval_start = 0; - else { - op_free(left); - op_free(right); - return Nullop; - } - if (right && right->op_type == OP_SPLIT) { - if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) { - PMOP *pm = (PMOP*)op; - if (left->op_type == OP_RV2AV && - !(left->op_private & OPpLVAL_INTRO) ) - { - op = ((UNOP*)left)->op_first; - if (op->op_type == OP_GV && !pm->op_pmreplroot) { - pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv; - pm->op_pmflags |= PMf_ONCE; - op_free(left); - return right; - } - } - else { - if (modcount < 10000) { - SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv; - if (SvIVX(sv) == 0) - sv_setiv(sv, modcount+1); - } - } - } - } - op = newBINOP(OP_AASSIGN, flags, - list(force_list(right)), - list(force_list(left)) ); - op->op_private = 0; - if (!(left->op_private & OPpLVAL_INTRO)) { - static int generation = 100; - OP *curop; - OP *lastop = op; - generation++; - for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) { - if (opargs[curop->op_type] & OA_DANGEROUS) { - if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; - if (gv == defgv || SvCUR(gv) == generation) - break; - SvCUR(gv) = generation; - } - else if (curop->op_type == OP_PADSV || - curop->op_type == OP_PADAV || - curop->op_type == OP_PADHV || - curop->op_type == OP_PADANY) { - SV **svp = AvARRAY(comppad_name); - SV *sv = svp[curop->op_targ]; - if (SvCUR(sv) == generation) - break; - SvCUR(sv) = generation; /* (SvCUR not used any more) */ - } - else if (curop->op_type == OP_RV2CV) - break; - else if (curop->op_type == OP_RV2SV || - curop->op_type == OP_RV2AV || - curop->op_type == OP_RV2HV || - curop->op_type == OP_RV2GV) { - if (lastop->op_type != OP_GV) /* funny deref? */ - break; - } - else - break; - } - lastop = curop; - } - if (curop != op) - op->op_private = OPpASSIGN_COMMON; - } - return op; - } - if (!right) - right = newOP(OP_UNDEF, 0); - if (right->op_type == OP_READLINE) { - right->op_flags |= OPf_STACKED; - return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right)); - } - else { - eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ - op = newBINOP(OP_SASSIGN, flags, - scalar(right), mod(scalar(left), OP_SASSIGN) ); - if (eval_start) - eval_start = 0; - else { - op_free(op); - return Nullop; - } - } - return op; -} - -OP * -newSTATEOP(flags, label, op) -I32 flags; -char *label; -OP *op; -{ - register COP *cop; - - /* Introduce my variables. */ - if (min_intro_pending) { - SV **svp = AvARRAY(comppad_name); - I32 i; - SV *sv; - for (i = min_intro_pending; i <= max_intro_pending; i++) { - if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) { - SvIVX(sv) = 999999999; /* Don't know scope end yet. */ - SvNVX(sv) = (double)cop_seqmax; - } - } - min_intro_pending = 0; - comppad_name_fill = max_intro_pending; /* Needn't search higher */ - } - - Newz(1101, cop, 1, COP); - if (perldb && curcop->cop_line && curstash != debstash) { - cop->op_type = OP_DBSTATE; - cop->op_ppaddr = ppaddr[ OP_DBSTATE ]; - } - else { - cop->op_type = OP_NEXTSTATE; - cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ]; - } - cop->op_flags = flags; - cop->op_private = 0; - cop->op_next = (OP*)cop; - - if (label) { - cop->cop_label = label; - hints |= HINT_BLOCK_SCOPE; - } - cop->cop_seq = cop_seqmax++; - cop->cop_arybase = curcop->cop_arybase; - - if (copline == NOLINE) - cop->cop_line = curcop->cop_line; - else { - cop->cop_line = copline; - copline = NOLINE; - } - cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv); - cop->cop_stash = curstash; - - if (perldb && curstash != debstash) { - SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); - if (svp && *svp != &sv_undef && !SvIOK(*svp)) { - SvIVX(*svp) = 1; - (void)SvIOK_on(*svp); - SvSTASH(*svp) = (HV*)cop; - } - } - - return prepend_elem(OP_LINESEQ, (OP*)cop, op); -} - -OP * -newLOGOP(type, flags, first, other) -I32 type; -I32 flags; -OP* first; -OP* other; -{ - LOGOP *logop; - OP *op; - - if (type == OP_XOR) /* Not short circuit, but here by precedence. */ - return newBINOP(type, flags, scalar(first), scalar(other)); - - scalarboolean(first); - /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ - if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) { - if (type == OP_AND || type == OP_OR) { - if (type == OP_AND) - type = OP_OR; - else - type = OP_AND; - op = first; - first = cUNOP->op_first; - if (op->op_next) - first->op_next = op->op_next; - cUNOP->op_first = Nullop; - op_free(op); - } - } - if (first->op_type == OP_CONST) { - if (dowarn && (first->op_private & OPpCONST_BARE)) - warn("Probable precedence problem on %s", op_name[type]); - if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { - op_free(first); - return other; - } - else { - op_free(other); - return first; - } - } - else if (first->op_type == OP_WANTARRAY) { - if (type == OP_AND) - list(other); - else - scalar(other); - } - - if (!other) - return first; - - if (type == OP_ANDASSIGN || type == OP_ORASSIGN) - other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */ - - Newz(1101, logop, 1, LOGOP); - - logop->op_type = type; - logop->op_ppaddr = ppaddr[type]; - logop->op_first = first; - logop->op_flags = flags | OPf_KIDS; - logop->op_other = LINKLIST(other); - logop->op_private = 1; - - /* establish postfix order */ - logop->op_next = LINKLIST(first); - first->op_next = (OP*)logop; - first->op_sibling = other; - - op = newUNOP(OP_NULL, 0, (OP*)logop); - other->op_next = op; - - return op; -} - -OP * -newCONDOP(flags, first, true, false) -I32 flags; -OP* first; -OP* true; -OP* false; -{ - CONDOP *condop; - OP *op; - - if (!false) - return newLOGOP(OP_AND, 0, first, true); - if (!true) - return newLOGOP(OP_OR, 0, first, false); - - scalarboolean(first); - if (first->op_type == OP_CONST) { - if (SvTRUE(((SVOP*)first)->op_sv)) { - op_free(first); - op_free(false); - return true; - } - else { - op_free(first); - op_free(true); - return false; - } - } - else if (first->op_type == OP_WANTARRAY) { - list(true); - scalar(false); - } - Newz(1101, condop, 1, CONDOP); - - condop->op_type = OP_COND_EXPR; - condop->op_ppaddr = ppaddr[OP_COND_EXPR]; - condop->op_first = first; - condop->op_flags = flags | OPf_KIDS; - condop->op_true = LINKLIST(true); - condop->op_false = LINKLIST(false); - condop->op_private = 1; - - /* establish postfix order */ - condop->op_next = LINKLIST(first); - first->op_next = (OP*)condop; - - first->op_sibling = true; - true->op_sibling = false; - op = newUNOP(OP_NULL, 0, (OP*)condop); - - true->op_next = op; - false->op_next = op; - - return op; -} - -OP * -newRANGE(flags, left, right) -I32 flags; -OP *left; -OP *right; -{ - CONDOP *condop; - OP *flip; - OP *flop; - OP *op; - - Newz(1101, condop, 1, CONDOP); - - condop->op_type = OP_RANGE; - condop->op_ppaddr = ppaddr[OP_RANGE]; - condop->op_first = left; - condop->op_flags = OPf_KIDS; - condop->op_true = LINKLIST(left); - condop->op_false = LINKLIST(right); - condop->op_private = 1; - - left->op_sibling = right; - - condop->op_next = (OP*)condop; - flip = newUNOP(OP_FLIP, flags, (OP*)condop); - flop = newUNOP(OP_FLOP, 0, flip); - op = newUNOP(OP_NULL, 0, flop); - linklist(flop); - - left->op_next = flip; - right->op_next = flop; - - condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); - sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV); - flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); - sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV); - - flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; - flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; - - flip->op_next = op; - if (!flip->op_private || !flop->op_private) - linklist(op); /* blow off optimizer unless constant */ - - return op; -} - -OP * -newLOOPOP(flags, debuggable, expr, block) -I32 flags; -I32 debuggable; -OP *expr; -OP *block; -{ - OP* listop; - OP* op; - int once = block && block->op_flags & OPf_SPECIAL && - (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL); - - if (expr) { - if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) - return block; /* do {} while 0 does once */ - else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr); - } - - listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); - op = newLOGOP(OP_AND, 0, expr, listop); - - ((LISTOP*)listop)->op_last->op_next = LINKLIST(op); - - if (once && op != listop) - op->op_next = ((LOGOP*)cUNOP->op_first)->op_other; - - if (op == listop) - op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */ - - op->op_flags |= flags; - op = scope(op); - op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/ - return op; -} - -OP * -newWHILEOP(flags, debuggable, loop, expr, block, cont) -I32 flags; -I32 debuggable; -LOOP *loop; -OP *expr; -OP *block; -OP *cont; -{ - OP *redo; - OP *next = 0; - OP *listop; - OP *op; - OP *condop; - - if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) { - expr = newUNOP(OP_DEFINED, 0, - newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) ); - } - - if (!block) - block = newOP(OP_NULL, 0); - - if (cont) - next = LINKLIST(cont); - if (expr) - cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0)); - - listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont); - redo = LINKLIST(listop); - - if (expr) { - op = newLOGOP(OP_AND, 0, expr, scalar(listop)); - if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) { - op_free(expr); /* oops, it's a while (0) */ - op_free((OP*)loop); - return Nullop; /* (listop already freed by newLOGOP) */ - } - ((LISTOP*)listop)->op_last->op_next = condop = - (op == listop ? redo : LINKLIST(op)); - if (!next) - next = condop; - } - else - op = listop; - - if (!loop) { - Newz(1101,loop,1,LOOP); - loop->op_type = OP_ENTERLOOP; - loop->op_ppaddr = ppaddr[OP_ENTERLOOP]; - loop->op_private = 0; - loop->op_next = (OP*)loop; - } - - op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op); - - loop->op_redoop = redo; - loop->op_lastop = op; - - if (next) - loop->op_nextop = next; - else - loop->op_nextop = op; - - op->op_flags |= flags; - return op; -} - -OP * -#ifndef CAN_PROTOTYPE -newFOROP(flags,label,forline,sv,expr,block,cont) -I32 flags; -char *label; -line_t forline; -OP* sv; -OP* expr; -OP*block; -OP*cont; -#else -newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) -#endif /* CAN_PROTOTYPE */ -{ - LOOP *loop; - int padoff = 0; - I32 iterflags = 0; - - copline = forline; - if (sv) { - if (sv->op_type == OP_RV2SV) { /* symbol table variable */ - sv->op_type = OP_RV2GV; - sv->op_ppaddr = ppaddr[OP_RV2GV]; - } - else if (sv->op_type == OP_PADSV) { /* private variable */ - padoff = sv->op_targ; - op_free(sv); - sv = Nullop; - } - else - croak("Can't use %s for loop variable", op_name[sv->op_type]); - } - else { - sv = newGVOP(OP_GV, 0, defgv); - } - if (expr->op_type == OP_RV2AV) { - expr = scalar(ref(expr, OP_ITER)); - iterflags |= OPf_STACKED; - } - loop = (LOOP*)list(convert(OP_ENTERITER, iterflags, - append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART), - scalar(sv)))); - assert(!loop->op_next); - Renew(loop, 1, LOOP); - loop->op_targ = padoff; - return newSTATEOP(0, label, newWHILEOP(flags, 1, loop, - newOP(OP_ITER, 0), block, cont)); -} - -OP* -newLOOPEX(type, label) -I32 type; -OP* label; -{ - OP *op; - if (type != OP_GOTO || label->op_type == OP_CONST) { - op = newPVOP(type, 0, savepv( - label->op_type == OP_CONST - ? SvPVx(((SVOP*)label)->op_sv, na) - : "" )); - op_free(label); - } - else { - if (label->op_type == OP_ENTERSUB) - label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN)); - op = newUNOP(type, OPf_STACKED, label); - } - hints |= HINT_BLOCK_SCOPE; - return op; -} - -void -cv_undef(cv) -CV *cv; -{ - if (!CvXSUB(cv) && CvROOT(cv)) { - if (CvDEPTH(cv)) - croak("Can't undef active subroutine"); - ENTER; - - SAVESPTR(curpad); - curpad = 0; - - if (!(SvFLAGS(cv) & SVpcv_CLONED)) - op_free(CvROOT(cv)); - CvROOT(cv) = Nullop; - LEAVE; - } - SvREFCNT_dec(CvGV(cv)); - CvGV(cv) = Nullgv; - SvREFCNT_dec(CvOUTSIDE(cv)); - CvOUTSIDE(cv) = Nullcv; - if (CvPADLIST(cv)) { - I32 i = AvFILL(CvPADLIST(cv)); - while (i >= 0) { - SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); - if (svp) - SvREFCNT_dec(*svp); - } - SvREFCNT_dec((SV*)CvPADLIST(cv)); - CvPADLIST(cv) = Nullav; - } -} - -CV * -cv_clone(proto) -CV* proto; -{ - AV* av; - I32 ix; - AV* protopadlist = CvPADLIST(proto); - AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE); - AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE); - SV** svp = AvARRAY(protopad); - AV* comppadlist; - CV* cv; - - ENTER; - SAVESPTR(curpad); - SAVESPTR(comppad); - SAVESPTR(compcv); - - cv = compcv = (CV*)NEWSV(1104,0); - sv_upgrade((SV *)cv, SVt_PVCV); - SvFLAGS(cv) |= SVpcv_CLONED; - - CvFILEGV(cv) = CvFILEGV(proto); - CvGV(cv) = SvREFCNT_inc(CvGV(proto)); - CvSTASH(cv) = CvSTASH(proto); - CvROOT(cv) = CvROOT(proto); - CvSTART(cv) = CvSTART(proto); - if (CvOUTSIDE(proto)) - CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto)); - - comppad = newAV(); - - comppadlist = newAV(); - AvREAL_off(comppadlist); - av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name)); - av_store(comppadlist, 1, (SV*)comppad); - CvPADLIST(cv) = comppadlist; - av_extend(comppad, AvFILL(protopad)); - curpad = AvARRAY(comppad); - - av = newAV(); /* will be @_ */ - av_extend(av, 0); - av_store(comppad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; - - svp = AvARRAY(protopad_name); - for ( ix = AvFILL(protopad); ix > 0; ix--) { - SV *sv; - if (svp[ix] != &sv_undef) { - char *name = SvPVX(svp[ix]); /* XXX */ - if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */ - I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), - cxstack_ix); - if (off != ix) - croak("panic: cv_clone: %s", name); - } - else { /* our own lexical */ - if (*name == '@') - av_store(comppad, ix, sv = (SV*)newAV()); - else if (*name == '%') - av_store(comppad, ix, sv = (SV*)newHV()); - else - av_store(comppad, ix, sv = NEWSV(0,0)); - SvPADMY_on(sv); - } - } - else { - av_store(comppad, ix, sv = NEWSV(0,0)); - SvPADTMP_on(sv); - } - } - - LEAVE; - return cv; -} - -CV * -newSUB(floor,op,proto,block) -I32 floor; -OP *op; -OP *proto; -OP *block; -{ - register CV *cv; - char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; - GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); - AV* av; - char *s; - I32 ix; - - if (op) - sub_generation++; - if (cv = GvCV(gv)) { - if (GvCVGEN(gv)) - cv = 0; /* just a cached method */ - else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) { - if (dowarn) { /* already defined (or promised)? */ - line_t oldline = curcop->cop_line; - - curcop->cop_line = copline; - warn("Subroutine %s redefined",name); - curcop->cop_line = oldline; - } - SvREFCNT_dec(cv); - cv = 0; - } - } - if (cv) { /* must reuse cv if autoloaded */ - cv_undef(cv); - CvOUTSIDE(cv) = CvOUTSIDE(compcv); - CvOUTSIDE(compcv) = 0; - CvPADLIST(cv) = CvPADLIST(compcv); - CvPADLIST(compcv) = 0; - if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */ - CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv); - SvREFCNT_dec(compcv); - } - else { - cv = compcv; - } - GvCV(gv) = cv; - GvCVGEN(gv) = 0; - CvFILEGV(cv) = curcop->cop_filegv; - CvGV(cv) = SvREFCNT_inc(gv); - CvSTASH(cv) = curstash; - - if (proto) { - char *p = SvPVx(((SVOP*)proto)->op_sv, na); - if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p)) - warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p); - sv_setpv((SV*)cv, p); - } - - if (!block) { - CvROOT(cv) = 0; - op_free(op); - copline = NOLINE; - LEAVE_SCOPE(floor); - return cv; - } - - av = newAV(); /* Will be @_ */ - av_extend(av, 0); - av_store(comppad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; - - for (ix = AvFILL(comppad); ix > 0; ix--) { - if (!SvPADMY(curpad[ix])) - SvPADTMP_on(curpad[ix]); - } - - if (AvFILL(comppad_name) < AvFILL(comppad)) - av_store(comppad_name, AvFILL(comppad), Nullsv); - - CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); - CvSTART(cv) = LINKLIST(CvROOT(cv)); - CvROOT(cv)->op_next = 0; - peep(CvSTART(cv)); - if (s = strrchr(name,':')) - s++; - else - s = name; - if (strEQ(s, "BEGIN") && !error_count) { - line_t oldline = compiling.cop_line; - - ENTER; - SAVESPTR(compiling.cop_filegv); - SAVEI32(perldb); - if (!beginav) - beginav = newAV(); - av_push(beginav, (SV *)cv); - DEBUG_x( dump_sub(gv) ); - rs = nrs; - rslen = nrslen; - rschar = nrschar; - rspara = (nrslen == 2); - GvCV(gv) = 0; - calllist(beginav); - rs = "\n"; - rslen = 1; - rschar = '\n'; - rspara = 0; - curcop = &compiling; - curcop->cop_line = oldline; /* might have recursed to yylex */ - LEAVE; - } - else if (strEQ(s, "END") && !error_count) { - if (!endav) - endav = newAV(); - av_unshift(endav, 1); - av_store(endav, 0, SvREFCNT_inc(cv)); - } - if (perldb && curstash != debstash) { - SV *sv; - SV *tmpstr = sv_newmortal(); - - sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline); - sv = newSVpv(buf,0); - sv_catpv(sv,"-"); - sprintf(buf,"%ld",(long)curcop->cop_line); - sv_catpv(sv,buf); - gv_efullname(tmpstr,gv); - hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); - } - op_free(op); - copline = NOLINE; - LEAVE_SCOPE(floor); - if (!op) { - GvCV(gv) = 0; /* Will remember in SVOP instead. */ - SvFLAGS(cv) |= SVpcv_ANON; - } - return cv; -} - -#ifdef DEPRECATED -CV * -newXSUB(name, ix, subaddr, filename) -char *name; -I32 ix; -I32 (*subaddr)(); -char *filename; -{ - CV* cv = newXS(name, (void(*)())subaddr, filename); - CvOLDSTYLE(cv) = TRUE; - CvXSUBANY(cv).any_i32 = ix; - return cv; -} -#endif - -CV * -newXS(name, subaddr, filename) -char *name; -void (*subaddr) _((CV*)); -char *filename; -{ - register CV *cv; - GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV); - char *s; - - if (name) - sub_generation++; - if (cv = GvCV(gv)) { - if (GvCVGEN(gv)) - cv = 0; /* just a cached method */ - else if (CvROOT(cv) || CvXSUB(cv)) { /* already defined? */ - if (dowarn) { - line_t oldline = curcop->cop_line; - - curcop->cop_line = copline; - warn("Subroutine %s redefined",name); - curcop->cop_line = oldline; - } - SvREFCNT_dec(cv); - cv = 0; - } - } - if (cv) { /* must reuse cv if autoloaded */ - assert(SvREFCNT(CvGV(cv)) > 1); - SvREFCNT_dec(CvGV(cv)); - } - else { - cv = (CV*)NEWSV(1105,0); - sv_upgrade((SV *)cv, SVt_PVCV); - } - GvCV(gv) = cv; - CvGV(cv) = SvREFCNT_inc(gv); - GvCVGEN(gv) = 0; - CvFILEGV(cv) = gv_fetchfile(filename); - CvXSUB(cv) = subaddr; - if (!name) - s = "__ANON__"; - else if (s = strrchr(name,':')) - s++; - else - s = name; - if (strEQ(s, "BEGIN")) { - if (!beginav) - beginav = newAV(); - av_push(beginav, SvREFCNT_inc(gv)); - } - else if (strEQ(s, "END")) { - if (!endav) - endav = newAV(); - av_unshift(endav, 1); - av_store(endav, 0, SvREFCNT_inc(gv)); - } - if (!name) { - GvCV(gv) = 0; /* Will remember elsewhere instead. */ - SvFLAGS(cv) |= SVpcv_ANON; - } - return cv; -} - -void -newFORM(floor,op,block) -I32 floor; -OP *op; -OP *block; -{ - register CV *cv; - char *name; - GV *gv; - I32 ix; - - if (op) - name = SvPVx(cSVOP->op_sv, na); - else - name = "STDOUT"; - gv = gv_fetchpv(name,TRUE, SVt_PVFM); - SvMULTI_on(gv); - if (cv = GvFORM(gv)) { - if (dowarn) { - line_t oldline = curcop->cop_line; - - curcop->cop_line = copline; - warn("Format %s redefined",name); - curcop->cop_line = oldline; - } - SvREFCNT_dec(cv); - } - cv = compcv; - GvFORM(gv) = cv; - CvGV(cv) = SvREFCNT_inc(gv); - CvFILEGV(cv) = curcop->cop_filegv; - - for (ix = AvFILL(comppad); ix > 0; ix--) { - if (!SvPADMY(curpad[ix])) - SvPADTMP_on(curpad[ix]); - } - - CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); - CvSTART(cv) = LINKLIST(CvROOT(cv)); - CvROOT(cv)->op_next = 0; - peep(CvSTART(cv)); - FmLINES(cv) = 0; - op_free(op); - copline = NOLINE; - LEAVE_SCOPE(floor); -} - -OP * -newMETHOD(ref,name) -OP *ref; -OP *name; -{ - LOGOP* mop; - Newz(1101, mop, 1, LOGOP); - mop->op_type = OP_METHOD; - mop->op_ppaddr = ppaddr[OP_METHOD]; - mop->op_first = scalar(ref); - mop->op_flags |= OPf_KIDS; - mop->op_private = 1; - mop->op_other = LINKLIST(name); - mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP); - mop->op_next = LINKLIST(ref); - ref->op_next = (OP*)mop; - return scalar((OP*)mop); -} - -OP * -newANONLIST(op) -OP* op; -{ - return newUNOP(OP_REFGEN, 0, - mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); -} - -OP * -newANONHASH(op) -OP* op; -{ - return newUNOP(OP_REFGEN, 0, - mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); -} - -OP * -newANONSUB(floor, proto, block) -I32 floor; -OP *proto; -OP *block; -{ - return newUNOP(OP_REFGEN, 0, - newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block))); -} - -OP * -oopsAV(o) -OP *o; -{ - switch (o->op_type) { - case OP_PADSV: - o->op_type = OP_PADAV; - o->op_ppaddr = ppaddr[OP_PADAV]; - return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV); - - case OP_RV2SV: - o->op_type = OP_RV2AV; - o->op_ppaddr = ppaddr[OP_RV2AV]; - ref(o, OP_RV2AV); - break; - - default: - warn("oops: oopsAV"); - break; - } - return o; -} - -OP * -oopsHV(o) -OP *o; -{ - switch (o->op_type) { - case OP_PADSV: - case OP_PADAV: - o->op_type = OP_PADHV; - o->op_ppaddr = ppaddr[OP_PADHV]; - return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV); - - case OP_RV2SV: - case OP_RV2AV: - o->op_type = OP_RV2HV; - o->op_ppaddr = ppaddr[OP_RV2HV]; - ref(o, OP_RV2HV); - break; - - default: - warn("oops: oopsHV"); - break; - } - return o; -} - -OP * -newAVREF(o) -OP *o; -{ - if (o->op_type == OP_PADANY) { - o->op_type = OP_PADAV; - o->op_ppaddr = ppaddr[OP_PADAV]; - return o; - } - return newUNOP(OP_RV2AV, 0, scalar(o)); -} - -OP * -newGVREF(type,o) -I32 type; -OP *o; -{ - if (type == OP_MAPSTART) - return newUNOP(OP_NULL, 0, o); - return ref(newUNOP(OP_RV2GV, OPf_REF, o), type); -} - -OP * -newHVREF(o) -OP *o; -{ - if (o->op_type == OP_PADANY) { - o->op_type = OP_PADHV; - o->op_ppaddr = ppaddr[OP_PADHV]; - return o; - } - return newUNOP(OP_RV2HV, 0, scalar(o)); -} - -OP * -oopsCV(o) -OP *o; -{ - croak("NOT IMPL LINE %d",__LINE__); - /* STUB */ - return o; -} - -OP * -newCVREF(o) -OP *o; -{ - return newUNOP(OP_RV2CV, 0, scalar(o)); -} - -OP * -newSVREF(o) -OP *o; -{ - if (o->op_type == OP_PADANY) { - o->op_type = OP_PADSV; - o->op_ppaddr = ppaddr[OP_PADSV]; - return o; - } - return newUNOP(OP_RV2SV, 0, scalar(o)); -} - -/* Check routines. */ - -OP * -ck_concat(op) -OP *op; -{ - if (cUNOP->op_first->op_type == OP_CONCAT) - op->op_flags |= OPf_STACKED; - return op; -} - -OP * -ck_spair(op) -OP *op; -{ - if (op->op_flags & OPf_KIDS) { - OP* newop; - OP* kid; - op = modkids(ck_fun(op), op->op_type); - kid = cUNOP->op_first; - newop = kUNOP->op_first->op_sibling; - if (newop && - (newop->op_sibling || - !(opargs[newop->op_type] & OA_RETSCALAR) || - newop->op_type == OP_PADAV || newop->op_type == OP_PADHV || - newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) { - - return op; - } - op_free(kUNOP->op_first); - kUNOP->op_first = newop; - } - op->op_ppaddr = ppaddr[++op->op_type]; - return ck_fun(op); -} - -OP * -ck_delete(op) -OP *op; -{ - op = ck_fun(op); - if (op->op_flags & OPf_KIDS) { - OP *kid = cUNOP->op_first; - if (kid->op_type != OP_HELEM) - croak("%s argument is not a HASH element", op_name[op->op_type]); - null(kid); - } - return op; -} - -OP * -ck_eof(op) -OP *op; -{ - I32 type = op->op_type; - - if (op->op_flags & OPf_KIDS) { - if (cLISTOP->op_first->op_type == OP_STUB) { - op_free(op); - op = newUNOP(type, OPf_SPECIAL, - newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV))); - } - return ck_fun(op); - } - return op; -} - -OP * -ck_eval(op) -OP *op; -{ - hints |= HINT_BLOCK_SCOPE; - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; - - if (!kid) { - op->op_flags &= ~OPf_KIDS; - null(op); - } - else if (kid->op_type == OP_LINESEQ) { - LOGOP *enter; - - kid->op_next = op->op_next; - cUNOP->op_first = 0; - op_free(op); - - Newz(1101, enter, 1, LOGOP); - enter->op_type = OP_ENTERTRY; - enter->op_ppaddr = ppaddr[OP_ENTERTRY]; - enter->op_private = 0; - - /* establish postfix order */ - enter->op_next = (OP*)enter; - - op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid); - op->op_type = OP_LEAVETRY; - op->op_ppaddr = ppaddr[OP_LEAVETRY]; - enter->op_other = op; - return op; - } - } - else { - op_free(op); - op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); - } - op->op_targ = (PADOFFSET)hints; - return op; -} - -OP * -ck_exec(op) -OP *op; -{ - OP *kid; - if (op->op_flags & OPf_STACKED) { - op = ck_fun(op); - kid = cUNOP->op_first->op_sibling; - if (kid->op_type == OP_RV2GV) - null(kid); - } - else - op = listkids(op); - return op; -} - -OP * -ck_gvconst(o) -register OP *o; -{ - o = fold_constants(o); - if (o->op_type == OP_CONST) - o->op_type = OP_GV; - return o; -} - -OP * -ck_rvconst(op) -register OP *op; -{ - SVOP *kid = (SVOP*)cUNOP->op_first; - - op->op_private = (hints & HINT_STRICT_REFS); - if (kid->op_type == OP_CONST) { - int iscv = (op->op_type==OP_RV2CV)*2; - GV *gv = 0; - kid->op_type = OP_GV; - for (gv = 0; !gv; iscv++) { - /* - * This is a little tricky. We only want to add the symbol if we - * didn't add it in the lexer. Otherwise we get duplicate strict - * warnings. But if we didn't add it in the lexer, we must at - * least pretend like we wanted to add it even if it existed before, - * or we get possible typo warnings. OPpCONST_ENTERED says - * whether the lexer already added THIS instance of this symbol. - */ - gv = gv_fetchpv(SvPVx(kid->op_sv, na), - iscv | !(kid->op_private & OPpCONST_ENTERED), - iscv - ? SVt_PVCV - : op->op_type == OP_RV2SV - ? SVt_PV - : op->op_type == OP_RV2AV - ? SVt_PVAV - : op->op_type == OP_RV2HV - ? SVt_PVHV - : SVt_PVGV); - } - SvREFCNT_dec(kid->op_sv); - kid->op_sv = SvREFCNT_inc(gv); - } - return op; -} - -OP * -ck_formline(op) -OP *op; -{ - return ck_fun(op); -} - -OP * -ck_ftst(op) -OP *op; -{ - I32 type = op->op_type; - - if (op->op_flags & OPf_REF) - return op; - - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; - - if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(type, OPf_REF, - gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO)); - op_free(op); - return newop; - } - } - else { - op_free(op); - if (type == OP_FTTTY) - return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, - SVt_PVIO)); - else - return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); - } - return op; -} - -OP * -ck_fun(op) -OP *op; -{ - register OP *kid; - OP **tokid; - OP *sibl; - I32 numargs = 0; - int type = op->op_type; - register I32 oa = opargs[type] >> OASHIFT; - - if (op->op_flags & OPf_STACKED) { - if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL)) - oa &= ~OA_OPTIONAL; - else - return no_fh_allowed(op); - } - - if (op->op_flags & OPf_KIDS) { - tokid = &cLISTOP->op_first; - kid = cLISTOP->op_first; - if (kid->op_type == OP_PUSHMARK || - kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK) - { - tokid = &kid->op_sibling; - kid = kid->op_sibling; - } - if (!kid && opargs[type] & OA_DEFGV) - *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv)); - - while (oa && kid) { - numargs++; - sibl = kid->op_sibling; - switch (oa & 7) { - case OA_SCALAR: - scalar(kid); - break; - case OA_LIST: - if (oa < 16) { - kid = 0; - continue; - } - else - list(kid); - break; - case OA_AVREF: - if (kid->op_type == OP_CONST && - (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, na); - OP *newop = newAVREF(newGVOP(OP_GV, 0, - gv_fetchpv(name, TRUE, SVt_PVAV) )); - if (dowarn) - warn("Array @%s missing the @ in argument %d of %s()", - name, numargs, op_name[type]); - op_free(kid); - kid = newop; - kid->op_sibling = sibl; - *tokid = kid; - } - else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) - bad_type(numargs, "array", op_name[op->op_type], kid); - mod(kid, type); - break; - case OA_HVREF: - if (kid->op_type == OP_CONST && - (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, na); - OP *newop = newHVREF(newGVOP(OP_GV, 0, - gv_fetchpv(name, TRUE, SVt_PVHV) )); - if (dowarn) - warn("Hash %%%s missing the %% in argument %d of %s()", - name, numargs, op_name[type]); - op_free(kid); - kid = newop; - kid->op_sibling = sibl; - *tokid = kid; - } - else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) - bad_type(numargs, "hash", op_name[op->op_type], kid); - mod(kid, type); - break; - case OA_CVREF: - { - OP *newop = newUNOP(OP_NULL, 0, kid); - kid->op_sibling = 0; - linklist(kid); - newop->op_next = newop; - kid = newop; - kid->op_sibling = sibl; - *tokid = kid; - } - break; - case OA_FILEREF: - if (kid->op_type != OP_GV) { - if (kid->op_type == OP_CONST && - (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(OP_GV, 0, - gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE, - SVt_PVIO) ); - op_free(kid); - kid = newop; - } - else { - kid->op_sibling = 0; - kid = newUNOP(OP_RV2GV, 0, scalar(kid)); - } - kid->op_sibling = sibl; - *tokid = kid; - } - scalar(kid); - break; - case OA_SCALARREF: - mod(scalar(kid), type); - break; - } - oa >>= 4; - tokid = &kid->op_sibling; - kid = kid->op_sibling; - } - op->op_private = numargs; - if (kid) - return too_many_arguments(op,op_name[op->op_type]); - listkids(op); - } - else if (opargs[type] & OA_DEFGV) { - op_free(op); - return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); - } - - if (oa) { - while (oa & OA_OPTIONAL) - oa >>= 4; - if (oa && oa != OA_LIST) - return too_few_arguments(op,op_name[op->op_type]); - } - return op; -} - -OP * -ck_glob(op) -OP *op; -{ - GV *gv = newGVgen("main"); - gv_IOadd(gv); - append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv)); - scalarkids(op); - return ck_fun(op); -} - -OP * -ck_grep(op) -OP *op; -{ - LOGOP *gwop; - OP *kid; - OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; - - op->op_ppaddr = ppaddr[OP_GREPSTART]; - Newz(1101, gwop, 1, LOGOP); - - if (op->op_flags & OPf_STACKED) { - OP* k; - op = ck_sort(op); - kid = cLISTOP->op_first->op_sibling; - for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) { - kid = k; - } - kid->op_next = (OP*)gwop; - op->op_flags &= ~OPf_STACKED; - } - kid = cLISTOP->op_first->op_sibling; - if (type == OP_MAPWHILE) - list(kid); - else - scalar(kid); - op = ck_fun(op); - if (error_count) - return op; - kid = cLISTOP->op_first->op_sibling; - if (kid->op_type != OP_NULL) - croak("panic: ck_grep"); - kid = kUNOP->op_first; - - gwop->op_type = type; - gwop->op_ppaddr = ppaddr[type]; - gwop->op_first = listkids(op); - gwop->op_flags |= OPf_KIDS; - gwop->op_private = 1; - gwop->op_other = LINKLIST(kid); - gwop->op_targ = pad_alloc(type, SVs_PADTMP); - kid->op_next = (OP*)gwop; - - kid = cLISTOP->op_first->op_sibling; - if (!kid || !kid->op_sibling) - return too_few_arguments(op,op_name[op->op_type]); - for (kid = kid->op_sibling; kid; kid = kid->op_sibling) - mod(kid, OP_GREPSTART); - - return (OP*)gwop; -} - -OP * -ck_index(op) -OP *op; -{ - if (op->op_flags & OPf_KIDS) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - if (kid && kid->op_type == OP_CONST) - fbm_compile(((SVOP*)kid)->op_sv, 0); - } - return ck_fun(op); -} - -OP * -ck_lengthconst(op) -OP *op; -{ - /* XXX length optimization goes here */ - return ck_fun(op); -} - -OP * -ck_lfun(op) -OP *op; -{ - return modkids(ck_fun(op), op->op_type); -} - -OP * -ck_rfun(op) -OP *op; -{ - return refkids(ck_fun(op), op->op_type); -} - -OP * -ck_listiob(op) -OP *op; -{ - register OP *kid; - - kid = cLISTOP->op_first; - if (!kid) { - op = force_list(op); - kid = cLISTOP->op_first; - } - if (kid->op_type == OP_PUSHMARK) - kid = kid->op_sibling; - if (kid && op->op_flags & OPf_STACKED) - kid = kid->op_sibling; - else if (kid && !kid->op_sibling) { /* print HANDLE; */ - if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) { - op->op_flags |= OPf_STACKED; /* make it a filehandle */ - kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid)); - cLISTOP->op_first->op_sibling = kid; - cLISTOP->op_last = kid; - kid = kid->op_sibling; - } - } - - if (!kid) - append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) ); - - return listkids(op); -} - -OP * -ck_match(op) -OP *op; -{ - cPMOP->op_pmflags |= PMf_RUNTIME; - cPMOP->op_pmpermflags |= PMf_RUNTIME; - return op; -} - -OP * -ck_null(op) -OP *op; -{ - return op; -} - -OP * -ck_repeat(op) -OP *op; -{ - if (cBINOP->op_first->op_flags & OPf_PARENS) { - op->op_private = OPpREPEAT_DOLIST; - cBINOP->op_first = force_list(cBINOP->op_first); - } - else - scalar(op); - return op; -} - -OP * -ck_require(op) -OP *op; -{ - if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ - SVOP *kid = (SVOP*)cUNOP->op_first; - - if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *s; - for (s = SvPVX(kid->op_sv); *s; s++) { - if (*s == ':' && s[1] == ':') { - *s = '/'; - Move(s+2, s+1, strlen(s+2)+1, char); - --SvCUR(kid->op_sv); - } - } - sv_catpvn(kid->op_sv, ".pm", 3); - } - } - return ck_fun(op); -} - -OP * -ck_retarget(op) -OP *op; -{ - croak("NOT IMPL LINE %d",__LINE__); - /* STUB */ - return op; -} - -OP * -ck_select(op) -OP *op; -{ - if (op->op_flags & OPf_KIDS) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - if (kid && kid->op_sibling) { - op->op_type = OP_SSELECT; - op->op_ppaddr = ppaddr[OP_SSELECT]; - op = ck_fun(op); - return fold_constants(op); - } - } - return ck_fun(op); -} - -OP * -ck_shift(op) -OP *op; -{ - I32 type = op->op_type; - - if (!(op->op_flags & OPf_KIDS)) { - op_free(op); - return newUNOP(type, 0, - scalar(newUNOP(OP_RV2AV, 0, - scalar(newGVOP(OP_GV, 0, - gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) ))))); - } - return scalar(modkids(ck_fun(op), type)); -} - -OP * -ck_sort(op) -OP *op; -{ - if (op->op_flags & OPf_STACKED) { - OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - OP *k; - kid = kUNOP->op_first; /* get past rv2gv */ - - if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) { - linklist(kid); - if (kid->op_type == OP_SCOPE) { - k = kid->op_next; - kid->op_next = 0; - } - else if (kid->op_type == OP_LEAVE) { - if (op->op_type == OP_SORT) { - null(kid); /* wipe out leave */ - kid->op_next = kid; - - for (k = kLISTOP->op_first->op_next; k; k = k->op_next) { - if (k->op_next == kid) - k->op_next = 0; - } - } - else - kid->op_next = 0; /* just disconnect the leave */ - k = kLISTOP->op_first; - } - peep(k); - - kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - null(kid); /* wipe out rv2gv */ - if (op->op_type == OP_SORT) - kid->op_next = kid; - else - kid->op_next = k; - op->op_flags |= OPf_SPECIAL; - } - } - return op; -} - -OP * -ck_split(op) -OP *op; -{ - register OP *kid; - PMOP* pm; - - if (op->op_flags & OPf_STACKED) - return no_fh_allowed(op); - - kid = cLISTOP->op_first; - if (kid->op_type != OP_NULL) - croak("panic: ck_split"); - kid = kid->op_sibling; - op_free(cLISTOP->op_first); - cLISTOP->op_first = kid; - if (!kid) { - cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1)); - cLISTOP->op_last = kid; /* There was only one element previously */ - } - - if (kid->op_type != OP_MATCH) { - OP *sibl = kid->op_sibling; - kid->op_sibling = 0; - kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop); - if (cLISTOP->op_first == cLISTOP->op_last) - cLISTOP->op_last = kid; - cLISTOP->op_first = kid; - kid->op_sibling = sibl; - } - pm = (PMOP*)kid; - if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) { - SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */ - pm->op_pmshort = 0; - } - - kid->op_type = OP_PUSHRE; - kid->op_ppaddr = ppaddr[OP_PUSHRE]; - scalar(kid); - - if (!kid->op_sibling) - append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) ); - - kid = kid->op_sibling; - scalar(kid); - - if (!kid->op_sibling) - append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0))); - - kid = kid->op_sibling; - scalar(kid); - - if (kid->op_sibling) - return too_many_arguments(op,op_name[op->op_type]); - - return op; -} - -OP * -ck_subr(op) -OP *op; -{ - OP *prev = ((cUNOP->op_first->op_sibling) - ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first; - OP *o = prev->op_sibling; - OP *cvop; - char *proto = 0; - CV *cv = 0; - int optional = 0; - I32 arg = 0; - - for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ; - if (cvop->op_type == OP_RV2CV) { - SVOP* tmpop; - null(cvop); /* disable rv2cv */ - tmpop = (SVOP*)((UNOP*)cvop)->op_first; - if (tmpop->op_type == OP_GV) { - cv = GvCV(tmpop->op_sv); - if (cv && SvPOK(cv) && (op->op_flags & OPf_STACKED)) - proto = SvPV((SV*)cv,na); - } - } - op->op_private = (hints & HINT_STRICT_REFS); - if (perldb && curstash != debstash) - op->op_private |= OPpDEREF_DB; - while (o != cvop) { - if (proto) { - switch (*proto) { - case '\0': - return too_many_arguments(op, CvNAME(cv)); - case ';': - optional = 1; - proto++; - continue; - case '$': - proto++; - arg++; - scalar(o); - break; - case '%': - case '@': - list(o); - arg++; - break; - case '&': - proto++; - arg++; - if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF) - bad_type(arg, "block", CvNAME(cv), o); - break; - case '*': - proto++; - arg++; - if (o->op_type == OP_RV2GV) - goto wrapref; - { - OP* kid = o; - o = newUNOP(OP_RV2GV, 0, kid); - o->op_sibling = kid->op_sibling; - kid->op_sibling = 0; - prev->op_sibling = o; - } - goto wrapref; - case '\\': - proto++; - arg++; - switch (*proto++) { - case '*': - if (o->op_type != OP_RV2GV) - bad_type(arg, "symbol", CvNAME(cv), o); - goto wrapref; - case '&': - if (o->op_type != OP_RV2CV) - bad_type(arg, "sub", CvNAME(cv), o); - goto wrapref; - case '$': - if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV) - bad_type(arg, "scalar", CvNAME(cv), o); - goto wrapref; - case '@': - if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV) - bad_type(arg, "array", CvNAME(cv), o); - goto wrapref; - case '%': - if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV) - bad_type(arg, "hash", CvNAME(cv), o); - wrapref: - { - OP* kid = o; - o = newUNOP(OP_REFGEN, 0, kid); - o->op_sibling = kid->op_sibling; - kid->op_sibling = 0; - prev->op_sibling = o; - } - break; - default: goto oops; - } - break; - default: - oops: - croak("Malformed prototype for %s: %s", - CvNAME(cv),SvPV((SV*)cv,na)); - } - } - else - list(o); - mod(o, OP_ENTERSUB); - prev = o; - o = o->op_sibling; - } - if (proto && !optional && *proto == '$') - return too_few_arguments(op, CvNAME(cv)); - return op; -} - -OP * -ck_svconst(op) -OP *op; -{ - SvREADONLY_on(cSVOP->op_sv); - return op; -} - -OP * -ck_trunc(op) -OP *op; -{ - if (op->op_flags & OPf_KIDS) { - SVOP *kid = (SVOP*)cUNOP->op_first; - - if (kid->op_type == OP_NULL) - kid = (SVOP*)kid->op_sibling; - if (kid && - kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) - op->op_flags |= OPf_SPECIAL; - } - return ck_fun(op); -} - -/* A peephole optimizer. We visit the ops in the order they're to execute. */ - -void -peep(o) -register OP* o; -{ - register OP* oldop = 0; - if (!o || o->op_seq) - return; - ENTER; - SAVESPTR(op); - SAVESPTR(curcop); - for (; o; o = o->op_next) { - if (o->op_seq) - break; - op = o; - switch (o->op_type) { - case OP_NEXTSTATE: - case OP_DBSTATE: - curcop = ((COP*)o); /* for warnings */ - o->op_seq = ++op_seqmax; - break; - - case OP_CONCAT: - case OP_CONST: - case OP_JOIN: - case OP_UC: - case OP_UCFIRST: - case OP_LC: - case OP_LCFIRST: - case OP_QUOTEMETA: - if (o->op_next->op_type == OP_STRINGIFY) - null(o->op_next); - o->op_seq = ++op_seqmax; - break; - case OP_STUB: - if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { - o->op_seq = ++op_seqmax; - break; /* Scalar stub must produce undef. List stub is noop */ - } - goto nothin; - case OP_NULL: - if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) - curcop = ((COP*)op); - goto nothin; - case OP_SCALAR: - case OP_LINESEQ: - case OP_SCOPE: - nothin: - if (oldop && o->op_next) { - oldop->op_next = o->op_next; - continue; - } - o->op_seq = ++op_seqmax; - break; - - case OP_GV: - if (o->op_next->op_type == OP_RV2SV) { - if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { - null(o->op_next); - o->op_private |= o->op_next->op_private & OPpLVAL_INTRO; - o->op_next = o->op_next->op_next; - o->op_type = OP_GVSV; - o->op_ppaddr = ppaddr[OP_GVSV]; - } - } - else if (o->op_next->op_type == OP_RV2AV) { - OP* pop = o->op_next->op_next; - IV i; - if (pop->op_type == OP_CONST && - (op = pop->op_next) && - pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & - (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) && - (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) - <= 255 && - i >= 0) - { - SvREFCNT_dec(((SVOP*)pop)->op_sv); - null(o->op_next); - null(pop->op_next); - null(pop); - o->op_flags |= pop->op_next->op_flags & OPf_MOD; - o->op_next = pop->op_next->op_next; - o->op_type = OP_AELEMFAST; - o->op_ppaddr = ppaddr[OP_AELEMFAST]; - o->op_private = (U8)i; - GvAVn((GV*)(((SVOP*)o)->op_sv)); - } - } - o->op_seq = ++op_seqmax; - break; - - case OP_MAPWHILE: - case OP_GREPWHILE: - case OP_AND: - case OP_OR: - o->op_seq = ++op_seqmax; - peep(cLOGOP->op_other); - break; - - case OP_COND_EXPR: - o->op_seq = ++op_seqmax; - peep(cCONDOP->op_true); - peep(cCONDOP->op_false); - break; - - case OP_ENTERLOOP: - o->op_seq = ++op_seqmax; - peep(cLOOP->op_redoop); - peep(cLOOP->op_nextop); - peep(cLOOP->op_lastop); - break; - - case OP_MATCH: - case OP_SUBST: - o->op_seq = ++op_seqmax; - peep(cPMOP->op_pmreplstart); - break; - - case OP_EXEC: - o->op_seq = ++op_seqmax; - if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { - if (o->op_next->op_sibling && - o->op_next->op_sibling->op_type != OP_DIE) { - line_t oldline = curcop->cop_line; - - curcop->cop_line = ((COP*)o->op_next)->cop_line; - warn("Statement unlikely to be reached"); - warn("(Maybe you meant system() when you said exec()?)\n"); - curcop->cop_line = oldline; - } - } - break; - default: - o->op_seq = ++op_seqmax; - break; - } - oldop = o; - } - LEAVE; -} @@ -83,7 +83,8 @@ typedef U32 PADOFFSET; /* Private for OP_ENTERSUB, OP_RV2?V, OP_?ELEM */ /* (lower bits carry hints) */ -#define OPpDEREF_DB 16 /* Debug subroutine. */ +#define OPpENTERSUB_AMPER 8 /* Used & form to call. */ +#define OPpENTERSUB_DB 16 /* Debug subroutine. */ #define OPpDEREF_AV 32 /* Want ref to AV. */ #define OPpDEREF_HV 64 /* Want ref to HV. */ @@ -183,12 +184,6 @@ struct pvop { char * op_pv; }; -struct cvop { - BASEOP - CV * op_cv; - OP * op_cont; -}; - struct loop { BASEOP OP * op_first; @@ -208,7 +203,6 @@ struct loop { #define cSVOP ((SVOP*)op) #define cGVOP ((GVOP*)op) #define cPVOP ((PVOP*)op) -#define cCVOP ((CVOP*)op) #define cCOP ((COP*)op) #define cLOOP ((LOOP*)op) @@ -221,7 +215,6 @@ struct loop { #define kSVOP ((SVOP*)kid) #define kGVOP ((GVOP*)kid) #define kPVOP ((PVOP*)kid) -#define kCVOP ((CVOP*)kid) #define kCOP ((COP*)kid) #define kLOOP ((LOOP*)kid) @@ -12,347 +12,700 @@ typedef enum { OP_CONST, /* 5 */ OP_GVSV, /* 6 */ OP_GV, /* 7 */ - OP_PADSV, /* 8 */ - OP_PADAV, /* 9 */ - OP_PADHV, /* 10 */ - OP_PADANY, /* 11 */ - OP_PUSHRE, /* 12 */ - OP_RV2GV, /* 13 */ - OP_SV2LEN, /* 14 */ + OP_GELEM, /* 8 */ + OP_PADSV, /* 9 */ + OP_PADAV, /* 10 */ + OP_PADHV, /* 11 */ + OP_PADANY, /* 12 */ + OP_PUSHRE, /* 13 */ + OP_RV2GV, /* 14 */ OP_RV2SV, /* 15 */ OP_AV2ARYLEN, /* 16 */ OP_RV2CV, /* 17 */ OP_ANONCODE, /* 18 */ - OP_REFGEN, /* 19 */ - OP_SREFGEN, /* 20 */ - OP_REF, /* 21 */ - OP_BLESS, /* 22 */ - OP_BACKTICK, /* 23 */ - OP_GLOB, /* 24 */ - OP_READLINE, /* 25 */ - OP_RCATLINE, /* 26 */ - OP_REGCMAYBE, /* 27 */ - OP_REGCOMP, /* 28 */ - OP_MATCH, /* 29 */ - OP_SUBST, /* 30 */ - OP_SUBSTCONT, /* 31 */ - OP_TRANS, /* 32 */ - OP_SASSIGN, /* 33 */ - OP_AASSIGN, /* 34 */ - OP_CHOP, /* 35 */ - OP_SCHOP, /* 36 */ - OP_CHOMP, /* 37 */ - OP_SCHOMP, /* 38 */ - OP_DEFINED, /* 39 */ - OP_UNDEF, /* 40 */ - OP_STUDY, /* 41 */ - OP_POS, /* 42 */ - OP_PREINC, /* 43 */ - OP_I_PREINC, /* 44 */ - OP_PREDEC, /* 45 */ - OP_I_PREDEC, /* 46 */ - OP_POSTINC, /* 47 */ - OP_I_POSTINC, /* 48 */ - OP_POSTDEC, /* 49 */ - OP_I_POSTDEC, /* 50 */ - OP_POW, /* 51 */ - OP_MULTIPLY, /* 52 */ - OP_I_MULTIPLY, /* 53 */ - OP_DIVIDE, /* 54 */ - OP_I_DIVIDE, /* 55 */ - OP_MODULO, /* 56 */ - OP_I_MODULO, /* 57 */ - OP_REPEAT, /* 58 */ - OP_ADD, /* 59 */ - OP_I_ADD, /* 60 */ - OP_SUBTRACT, /* 61 */ - OP_I_SUBTRACT, /* 62 */ - OP_CONCAT, /* 63 */ - OP_STRINGIFY, /* 64 */ - OP_LEFT_SHIFT, /* 65 */ - OP_RIGHT_SHIFT, /* 66 */ - OP_LT, /* 67 */ - OP_I_LT, /* 68 */ - OP_GT, /* 69 */ - OP_I_GT, /* 70 */ - OP_LE, /* 71 */ - OP_I_LE, /* 72 */ - OP_GE, /* 73 */ - OP_I_GE, /* 74 */ - OP_EQ, /* 75 */ - OP_I_EQ, /* 76 */ - OP_NE, /* 77 */ - OP_I_NE, /* 78 */ - OP_NCMP, /* 79 */ - OP_I_NCMP, /* 80 */ - OP_SLT, /* 81 */ - OP_SGT, /* 82 */ - OP_SLE, /* 83 */ - OP_SGE, /* 84 */ - OP_SEQ, /* 85 */ - OP_SNE, /* 86 */ - OP_SCMP, /* 87 */ - OP_BIT_AND, /* 88 */ - OP_BIT_XOR, /* 89 */ - OP_BIT_OR, /* 90 */ - OP_NEGATE, /* 91 */ - OP_I_NEGATE, /* 92 */ - OP_NOT, /* 93 */ - OP_COMPLEMENT, /* 94 */ - OP_ATAN2, /* 95 */ - OP_SIN, /* 96 */ - OP_COS, /* 97 */ - OP_RAND, /* 98 */ - OP_SRAND, /* 99 */ - OP_EXP, /* 100 */ - OP_LOG, /* 101 */ - OP_SQRT, /* 102 */ - OP_INT, /* 103 */ - OP_HEX, /* 104 */ - OP_OCT, /* 105 */ - OP_ABS, /* 106 */ - OP_LENGTH, /* 107 */ - OP_SUBSTR, /* 108 */ - OP_VEC, /* 109 */ - OP_INDEX, /* 110 */ - OP_RINDEX, /* 111 */ - OP_SPRINTF, /* 112 */ - OP_FORMLINE, /* 113 */ - OP_ORD, /* 114 */ - OP_CHR, /* 115 */ - OP_CRYPT, /* 116 */ - OP_UCFIRST, /* 117 */ - OP_LCFIRST, /* 118 */ - OP_UC, /* 119 */ - OP_LC, /* 120 */ - OP_QUOTEMETA, /* 121 */ - OP_RV2AV, /* 122 */ - OP_AELEMFAST, /* 123 */ - OP_AELEM, /* 124 */ - OP_ASLICE, /* 125 */ - OP_EACH, /* 126 */ - OP_VALUES, /* 127 */ - OP_KEYS, /* 128 */ - OP_DELETE, /* 129 */ - OP_EXISTS, /* 130 */ - OP_RV2HV, /* 131 */ - OP_HELEM, /* 132 */ - OP_HSLICE, /* 133 */ - OP_UNPACK, /* 134 */ - OP_PACK, /* 135 */ - OP_SPLIT, /* 136 */ - OP_JOIN, /* 137 */ - OP_LIST, /* 138 */ - OP_LSLICE, /* 139 */ - OP_ANONLIST, /* 140 */ - OP_ANONHASH, /* 141 */ - OP_SPLICE, /* 142 */ - OP_PUSH, /* 143 */ - OP_POP, /* 144 */ - OP_SHIFT, /* 145 */ - OP_UNSHIFT, /* 146 */ - OP_SORT, /* 147 */ - OP_REVERSE, /* 148 */ - OP_GREPSTART, /* 149 */ - OP_GREPWHILE, /* 150 */ - OP_MAPSTART, /* 151 */ - OP_MAPWHILE, /* 152 */ - OP_RANGE, /* 153 */ - OP_FLIP, /* 154 */ - OP_FLOP, /* 155 */ - OP_AND, /* 156 */ - OP_OR, /* 157 */ - OP_XOR, /* 158 */ - OP_COND_EXPR, /* 159 */ - OP_ANDASSIGN, /* 160 */ - OP_ORASSIGN, /* 161 */ - OP_METHOD, /* 162 */ - OP_ENTERSUB, /* 163 */ - OP_LEAVESUB, /* 164 */ - OP_CALLER, /* 165 */ - OP_WARN, /* 166 */ - OP_DIE, /* 167 */ - OP_RESET, /* 168 */ - OP_LINESEQ, /* 169 */ - OP_NEXTSTATE, /* 170 */ - OP_DBSTATE, /* 171 */ - OP_UNSTACK, /* 172 */ - OP_ENTER, /* 173 */ - OP_LEAVE, /* 174 */ - OP_SCOPE, /* 175 */ - OP_ENTERITER, /* 176 */ - OP_ITER, /* 177 */ - OP_ENTERLOOP, /* 178 */ - OP_LEAVELOOP, /* 179 */ - OP_RETURN, /* 180 */ - OP_LAST, /* 181 */ - OP_NEXT, /* 182 */ - OP_REDO, /* 183 */ - OP_DUMP, /* 184 */ - OP_GOTO, /* 185 */ - OP_EXIT, /* 186 */ - OP_OPEN, /* 187 */ - OP_CLOSE, /* 188 */ - OP_PIPE_OP, /* 189 */ - OP_FILENO, /* 190 */ - OP_UMASK, /* 191 */ - OP_BINMODE, /* 192 */ - OP_TIE, /* 193 */ - OP_UNTIE, /* 194 */ - OP_DBMOPEN, /* 195 */ - OP_DBMCLOSE, /* 196 */ - OP_SSELECT, /* 197 */ - OP_SELECT, /* 198 */ - OP_GETC, /* 199 */ - OP_READ, /* 200 */ - OP_ENTERWRITE, /* 201 */ - OP_LEAVEWRITE, /* 202 */ - OP_PRTF, /* 203 */ - OP_PRINT, /* 204 */ - OP_SYSREAD, /* 205 */ - OP_SYSWRITE, /* 206 */ - OP_SEND, /* 207 */ - OP_RECV, /* 208 */ - OP_EOF, /* 209 */ - OP_TELL, /* 210 */ - OP_SEEK, /* 211 */ - OP_TRUNCATE, /* 212 */ - OP_FCNTL, /* 213 */ - OP_IOCTL, /* 214 */ - OP_FLOCK, /* 215 */ - OP_SOCKET, /* 216 */ - OP_SOCKPAIR, /* 217 */ - OP_BIND, /* 218 */ - OP_CONNECT, /* 219 */ - OP_LISTEN, /* 220 */ - OP_ACCEPT, /* 221 */ - OP_SHUTDOWN, /* 222 */ - OP_GSOCKOPT, /* 223 */ - OP_SSOCKOPT, /* 224 */ - OP_GETSOCKNAME, /* 225 */ - OP_GETPEERNAME, /* 226 */ - OP_LSTAT, /* 227 */ - OP_STAT, /* 228 */ - OP_FTRREAD, /* 229 */ - OP_FTRWRITE, /* 230 */ - OP_FTREXEC, /* 231 */ - OP_FTEREAD, /* 232 */ - OP_FTEWRITE, /* 233 */ - OP_FTEEXEC, /* 234 */ - OP_FTIS, /* 235 */ - OP_FTEOWNED, /* 236 */ - OP_FTROWNED, /* 237 */ - OP_FTZERO, /* 238 */ - OP_FTSIZE, /* 239 */ - OP_FTMTIME, /* 240 */ - OP_FTATIME, /* 241 */ - OP_FTCTIME, /* 242 */ - OP_FTSOCK, /* 243 */ - OP_FTCHR, /* 244 */ - OP_FTBLK, /* 245 */ - OP_FTFILE, /* 246 */ - OP_FTDIR, /* 247 */ - OP_FTPIPE, /* 248 */ - OP_FTLINK, /* 249 */ - OP_FTSUID, /* 250 */ - OP_FTSGID, /* 251 */ - OP_FTSVTX, /* 252 */ - OP_FTTTY, /* 253 */ - OP_FTTEXT, /* 254 */ - OP_FTBINARY, /* 255 */ - OP_CHDIR, /* 256 */ - OP_CHOWN, /* 257 */ - OP_CHROOT, /* 258 */ - OP_UNLINK, /* 259 */ - OP_CHMOD, /* 260 */ - OP_UTIME, /* 261 */ - OP_RENAME, /* 262 */ - OP_LINK, /* 263 */ - OP_SYMLINK, /* 264 */ - OP_READLINK, /* 265 */ - OP_MKDIR, /* 266 */ - OP_RMDIR, /* 267 */ - OP_OPEN_DIR, /* 268 */ - OP_READDIR, /* 269 */ - OP_TELLDIR, /* 270 */ - OP_SEEKDIR, /* 271 */ - OP_REWINDDIR, /* 272 */ - OP_CLOSEDIR, /* 273 */ - OP_FORK, /* 274 */ - OP_WAIT, /* 275 */ - OP_WAITPID, /* 276 */ - OP_SYSTEM, /* 277 */ - OP_EXEC, /* 278 */ - OP_KILL, /* 279 */ - OP_GETPPID, /* 280 */ - OP_GETPGRP, /* 281 */ - OP_SETPGRP, /* 282 */ - OP_GETPRIORITY, /* 283 */ - OP_SETPRIORITY, /* 284 */ - OP_TIME, /* 285 */ - OP_TMS, /* 286 */ - OP_LOCALTIME, /* 287 */ - OP_GMTIME, /* 288 */ - OP_ALARM, /* 289 */ - OP_SLEEP, /* 290 */ - OP_SHMGET, /* 291 */ - OP_SHMCTL, /* 292 */ - OP_SHMREAD, /* 293 */ - OP_SHMWRITE, /* 294 */ - OP_MSGGET, /* 295 */ - OP_MSGCTL, /* 296 */ - OP_MSGSND, /* 297 */ - OP_MSGRCV, /* 298 */ - OP_SEMGET, /* 299 */ - OP_SEMCTL, /* 300 */ - OP_SEMOP, /* 301 */ - OP_REQUIRE, /* 302 */ - OP_DOFILE, /* 303 */ - OP_ENTEREVAL, /* 304 */ - OP_LEAVEEVAL, /* 305 */ - OP_ENTERTRY, /* 306 */ - OP_LEAVETRY, /* 307 */ - OP_GHBYNAME, /* 308 */ - OP_GHBYADDR, /* 309 */ - OP_GHOSTENT, /* 310 */ - OP_GNBYNAME, /* 311 */ - OP_GNBYADDR, /* 312 */ - OP_GNETENT, /* 313 */ - OP_GPBYNAME, /* 314 */ - OP_GPBYNUMBER, /* 315 */ - OP_GPROTOENT, /* 316 */ - OP_GSBYNAME, /* 317 */ - OP_GSBYPORT, /* 318 */ - OP_GSERVENT, /* 319 */ - OP_SHOSTENT, /* 320 */ - OP_SNETENT, /* 321 */ - OP_SPROTOENT, /* 322 */ - OP_SSERVENT, /* 323 */ - OP_EHOSTENT, /* 324 */ - OP_ENETENT, /* 325 */ - OP_EPROTOENT, /* 326 */ - OP_ESERVENT, /* 327 */ - OP_GPWNAM, /* 328 */ - OP_GPWUID, /* 329 */ - OP_GPWENT, /* 330 */ - OP_SPWENT, /* 331 */ - OP_EPWENT, /* 332 */ - OP_GGRNAM, /* 333 */ - OP_GGRGID, /* 334 */ - OP_GGRENT, /* 335 */ - OP_SGRENT, /* 336 */ - OP_EGRENT, /* 337 */ - OP_GETLOGIN, /* 338 */ - OP_SYSCALL, /* 339 */ + OP_PROTOTYPE, /* 19 */ + OP_REFGEN, /* 20 */ + OP_SREFGEN, /* 21 */ + OP_REF, /* 22 */ + OP_BLESS, /* 23 */ + OP_BACKTICK, /* 24 */ + OP_GLOB, /* 25 */ + OP_READLINE, /* 26 */ + OP_RCATLINE, /* 27 */ + OP_REGCMAYBE, /* 28 */ + OP_REGCOMP, /* 29 */ + OP_MATCH, /* 30 */ + OP_SUBST, /* 31 */ + OP_SUBSTCONT, /* 32 */ + OP_TRANS, /* 33 */ + OP_SASSIGN, /* 34 */ + OP_AASSIGN, /* 35 */ + OP_CHOP, /* 36 */ + OP_SCHOP, /* 37 */ + OP_CHOMP, /* 38 */ + OP_SCHOMP, /* 39 */ + OP_DEFINED, /* 40 */ + OP_UNDEF, /* 41 */ + OP_STUDY, /* 42 */ + OP_POS, /* 43 */ + OP_PREINC, /* 44 */ + OP_I_PREINC, /* 45 */ + OP_PREDEC, /* 46 */ + OP_I_PREDEC, /* 47 */ + OP_POSTINC, /* 48 */ + OP_I_POSTINC, /* 49 */ + OP_POSTDEC, /* 50 */ + OP_I_POSTDEC, /* 51 */ + OP_POW, /* 52 */ + OP_MULTIPLY, /* 53 */ + OP_I_MULTIPLY, /* 54 */ + OP_DIVIDE, /* 55 */ + OP_I_DIVIDE, /* 56 */ + OP_MODULO, /* 57 */ + OP_I_MODULO, /* 58 */ + OP_REPEAT, /* 59 */ + OP_ADD, /* 60 */ + OP_I_ADD, /* 61 */ + OP_SUBTRACT, /* 62 */ + OP_I_SUBTRACT, /* 63 */ + OP_CONCAT, /* 64 */ + OP_STRINGIFY, /* 65 */ + OP_LEFT_SHIFT, /* 66 */ + OP_RIGHT_SHIFT, /* 67 */ + OP_LT, /* 68 */ + OP_I_LT, /* 69 */ + OP_GT, /* 70 */ + OP_I_GT, /* 71 */ + OP_LE, /* 72 */ + OP_I_LE, /* 73 */ + OP_GE, /* 74 */ + OP_I_GE, /* 75 */ + OP_EQ, /* 76 */ + OP_I_EQ, /* 77 */ + OP_NE, /* 78 */ + OP_I_NE, /* 79 */ + OP_NCMP, /* 80 */ + OP_I_NCMP, /* 81 */ + OP_SLT, /* 82 */ + OP_SGT, /* 83 */ + OP_SLE, /* 84 */ + OP_SGE, /* 85 */ + OP_SEQ, /* 86 */ + OP_SNE, /* 87 */ + OP_SCMP, /* 88 */ + OP_BIT_AND, /* 89 */ + OP_BIT_XOR, /* 90 */ + OP_BIT_OR, /* 91 */ + OP_NEGATE, /* 92 */ + OP_I_NEGATE, /* 93 */ + OP_NOT, /* 94 */ + OP_COMPLEMENT, /* 95 */ + OP_ATAN2, /* 96 */ + OP_SIN, /* 97 */ + OP_COS, /* 98 */ + OP_RAND, /* 99 */ + OP_SRAND, /* 100 */ + OP_EXP, /* 101 */ + OP_LOG, /* 102 */ + OP_SQRT, /* 103 */ + OP_INT, /* 104 */ + OP_HEX, /* 105 */ + OP_OCT, /* 106 */ + OP_ABS, /* 107 */ + OP_LENGTH, /* 108 */ + OP_SUBSTR, /* 109 */ + OP_VEC, /* 110 */ + OP_INDEX, /* 111 */ + OP_RINDEX, /* 112 */ + OP_SPRINTF, /* 113 */ + OP_FORMLINE, /* 114 */ + OP_ORD, /* 115 */ + OP_CHR, /* 116 */ + OP_CRYPT, /* 117 */ + OP_UCFIRST, /* 118 */ + OP_LCFIRST, /* 119 */ + OP_UC, /* 120 */ + OP_LC, /* 121 */ + OP_QUOTEMETA, /* 122 */ + OP_RV2AV, /* 123 */ + OP_AELEMFAST, /* 124 */ + OP_AELEM, /* 125 */ + OP_ASLICE, /* 126 */ + OP_EACH, /* 127 */ + OP_VALUES, /* 128 */ + OP_KEYS, /* 129 */ + OP_DELETE, /* 130 */ + OP_EXISTS, /* 131 */ + OP_RV2HV, /* 132 */ + OP_HELEM, /* 133 */ + OP_HSLICE, /* 134 */ + OP_UNPACK, /* 135 */ + OP_PACK, /* 136 */ + OP_SPLIT, /* 137 */ + OP_JOIN, /* 138 */ + OP_LIST, /* 139 */ + OP_LSLICE, /* 140 */ + OP_ANONLIST, /* 141 */ + OP_ANONHASH, /* 142 */ + OP_SPLICE, /* 143 */ + OP_PUSH, /* 144 */ + OP_POP, /* 145 */ + OP_SHIFT, /* 146 */ + OP_UNSHIFT, /* 147 */ + OP_SORT, /* 148 */ + OP_REVERSE, /* 149 */ + OP_GREPSTART, /* 150 */ + OP_GREPWHILE, /* 151 */ + OP_MAPSTART, /* 152 */ + OP_MAPWHILE, /* 153 */ + OP_RANGE, /* 154 */ + OP_FLIP, /* 155 */ + OP_FLOP, /* 156 */ + OP_AND, /* 157 */ + OP_OR, /* 158 */ + OP_XOR, /* 159 */ + OP_COND_EXPR, /* 160 */ + OP_ANDASSIGN, /* 161 */ + OP_ORASSIGN, /* 162 */ + OP_METHOD, /* 163 */ + OP_ENTERSUB, /* 164 */ + OP_LEAVESUB, /* 165 */ + OP_CALLER, /* 166 */ + OP_WARN, /* 167 */ + OP_DIE, /* 168 */ + OP_RESET, /* 169 */ + OP_LINESEQ, /* 170 */ + OP_NEXTSTATE, /* 171 */ + OP_DBSTATE, /* 172 */ + OP_UNSTACK, /* 173 */ + OP_ENTER, /* 174 */ + OP_LEAVE, /* 175 */ + OP_SCOPE, /* 176 */ + OP_ENTERITER, /* 177 */ + OP_ITER, /* 178 */ + OP_ENTERLOOP, /* 179 */ + OP_LEAVELOOP, /* 180 */ + OP_RETURN, /* 181 */ + OP_LAST, /* 182 */ + OP_NEXT, /* 183 */ + OP_REDO, /* 184 */ + OP_DUMP, /* 185 */ + OP_GOTO, /* 186 */ + OP_EXIT, /* 187 */ + OP_OPEN, /* 188 */ + OP_CLOSE, /* 189 */ + OP_PIPE_OP, /* 190 */ + OP_FILENO, /* 191 */ + OP_UMASK, /* 192 */ + OP_BINMODE, /* 193 */ + OP_TIE, /* 194 */ + OP_UNTIE, /* 195 */ + OP_TIED, /* 196 */ + OP_DBMOPEN, /* 197 */ + OP_DBMCLOSE, /* 198 */ + OP_SSELECT, /* 199 */ + OP_SELECT, /* 200 */ + OP_GETC, /* 201 */ + OP_READ, /* 202 */ + OP_ENTERWRITE, /* 203 */ + OP_LEAVEWRITE, /* 204 */ + OP_PRTF, /* 205 */ + OP_PRINT, /* 206 */ + OP_SYSOPEN, /* 207 */ + OP_SYSREAD, /* 208 */ + OP_SYSWRITE, /* 209 */ + OP_SEND, /* 210 */ + OP_RECV, /* 211 */ + OP_EOF, /* 212 */ + OP_TELL, /* 213 */ + OP_SEEK, /* 214 */ + OP_TRUNCATE, /* 215 */ + OP_FCNTL, /* 216 */ + OP_IOCTL, /* 217 */ + OP_FLOCK, /* 218 */ + OP_SOCKET, /* 219 */ + OP_SOCKPAIR, /* 220 */ + OP_BIND, /* 221 */ + OP_CONNECT, /* 222 */ + OP_LISTEN, /* 223 */ + OP_ACCEPT, /* 224 */ + OP_SHUTDOWN, /* 225 */ + OP_GSOCKOPT, /* 226 */ + OP_SSOCKOPT, /* 227 */ + OP_GETSOCKNAME, /* 228 */ + OP_GETPEERNAME, /* 229 */ + OP_LSTAT, /* 230 */ + OP_STAT, /* 231 */ + OP_FTRREAD, /* 232 */ + OP_FTRWRITE, /* 233 */ + OP_FTREXEC, /* 234 */ + OP_FTEREAD, /* 235 */ + OP_FTEWRITE, /* 236 */ + OP_FTEEXEC, /* 237 */ + OP_FTIS, /* 238 */ + OP_FTEOWNED, /* 239 */ + OP_FTROWNED, /* 240 */ + OP_FTZERO, /* 241 */ + OP_FTSIZE, /* 242 */ + OP_FTMTIME, /* 243 */ + OP_FTATIME, /* 244 */ + OP_FTCTIME, /* 245 */ + OP_FTSOCK, /* 246 */ + OP_FTCHR, /* 247 */ + OP_FTBLK, /* 248 */ + OP_FTFILE, /* 249 */ + OP_FTDIR, /* 250 */ + OP_FTPIPE, /* 251 */ + OP_FTLINK, /* 252 */ + OP_FTSUID, /* 253 */ + OP_FTSGID, /* 254 */ + OP_FTSVTX, /* 255 */ + OP_FTTTY, /* 256 */ + OP_FTTEXT, /* 257 */ + OP_FTBINARY, /* 258 */ + OP_CHDIR, /* 259 */ + OP_CHOWN, /* 260 */ + OP_CHROOT, /* 261 */ + OP_UNLINK, /* 262 */ + OP_CHMOD, /* 263 */ + OP_UTIME, /* 264 */ + OP_RENAME, /* 265 */ + OP_LINK, /* 266 */ + OP_SYMLINK, /* 267 */ + OP_READLINK, /* 268 */ + OP_MKDIR, /* 269 */ + OP_RMDIR, /* 270 */ + OP_OPEN_DIR, /* 271 */ + OP_READDIR, /* 272 */ + OP_TELLDIR, /* 273 */ + OP_SEEKDIR, /* 274 */ + OP_REWINDDIR, /* 275 */ + OP_CLOSEDIR, /* 276 */ + OP_FORK, /* 277 */ + OP_WAIT, /* 278 */ + OP_WAITPID, /* 279 */ + OP_SYSTEM, /* 280 */ + OP_EXEC, /* 281 */ + OP_KILL, /* 282 */ + OP_GETPPID, /* 283 */ + OP_GETPGRP, /* 284 */ + OP_SETPGRP, /* 285 */ + OP_GETPRIORITY, /* 286 */ + OP_SETPRIORITY, /* 287 */ + OP_TIME, /* 288 */ + OP_TMS, /* 289 */ + OP_LOCALTIME, /* 290 */ + OP_GMTIME, /* 291 */ + OP_ALARM, /* 292 */ + OP_SLEEP, /* 293 */ + OP_SHMGET, /* 294 */ + OP_SHMCTL, /* 295 */ + OP_SHMREAD, /* 296 */ + OP_SHMWRITE, /* 297 */ + OP_MSGGET, /* 298 */ + OP_MSGCTL, /* 299 */ + OP_MSGSND, /* 300 */ + OP_MSGRCV, /* 301 */ + OP_SEMGET, /* 302 */ + OP_SEMCTL, /* 303 */ + OP_SEMOP, /* 304 */ + OP_REQUIRE, /* 305 */ + OP_DOFILE, /* 306 */ + OP_ENTEREVAL, /* 307 */ + OP_LEAVEEVAL, /* 308 */ + OP_ENTERTRY, /* 309 */ + OP_LEAVETRY, /* 310 */ + OP_GHBYNAME, /* 311 */ + OP_GHBYADDR, /* 312 */ + OP_GHOSTENT, /* 313 */ + OP_GNBYNAME, /* 314 */ + OP_GNBYADDR, /* 315 */ + OP_GNETENT, /* 316 */ + OP_GPBYNAME, /* 317 */ + OP_GPBYNUMBER, /* 318 */ + OP_GPROTOENT, /* 319 */ + OP_GSBYNAME, /* 320 */ + OP_GSBYPORT, /* 321 */ + OP_GSERVENT, /* 322 */ + OP_SHOSTENT, /* 323 */ + OP_SNETENT, /* 324 */ + OP_SPROTOENT, /* 325 */ + OP_SSERVENT, /* 326 */ + OP_EHOSTENT, /* 327 */ + OP_ENETENT, /* 328 */ + OP_EPROTOENT, /* 329 */ + OP_ESERVENT, /* 330 */ + OP_GPWNAM, /* 331 */ + OP_GPWUID, /* 332 */ + OP_GPWENT, /* 333 */ + OP_SPWENT, /* 334 */ + OP_EPWENT, /* 335 */ + OP_GGRNAM, /* 336 */ + OP_GGRGID, /* 337 */ + OP_GGRENT, /* 338 */ + OP_SGRENT, /* 339 */ + OP_EGRENT, /* 340 */ + OP_GETLOGIN, /* 341 */ + OP_SYSCALL, /* 342 */ OP_max } opcode; -#define MAXO 340 +#define MAXO 343 #ifndef DOINIT EXT char *op_name[]; #else EXT char *op_name[] = { + "null", + "stub", + "scalar", + "pushmark", + "wantarray", + "const", + "gvsv", + "gv", + "gelem", + "padsv", + "padav", + "padhv", + "padany", + "pushre", + "rv2gv", + "rv2sv", + "av2arylen", + "rv2cv", + "anoncode", + "prototype", + "refgen", + "srefgen", + "ref", + "bless", + "backtick", + "glob", + "readline", + "rcatline", + "regcmaybe", + "regcomp", + "match", + "subst", + "substcont", + "trans", + "sassign", + "aassign", + "chop", + "schop", + "chomp", + "schomp", + "defined", + "undef", + "study", + "pos", + "preinc", + "i_preinc", + "predec", + "i_predec", + "postinc", + "i_postinc", + "postdec", + "i_postdec", + "pow", + "multiply", + "i_multiply", + "divide", + "i_divide", + "modulo", + "i_modulo", + "repeat", + "add", + "i_add", + "subtract", + "i_subtract", + "concat", + "stringify", + "left_shift", + "right_shift", + "lt", + "i_lt", + "gt", + "i_gt", + "le", + "i_le", + "ge", + "i_ge", + "eq", + "i_eq", + "ne", + "i_ne", + "ncmp", + "i_ncmp", + "slt", + "sgt", + "sle", + "sge", + "seq", + "sne", + "scmp", + "bit_and", + "bit_xor", + "bit_or", + "negate", + "i_negate", + "not", + "complement", + "atan2", + "sin", + "cos", + "rand", + "srand", + "exp", + "log", + "sqrt", + "int", + "hex", + "oct", + "abs", + "length", + "substr", + "vec", + "index", + "rindex", + "sprintf", + "formline", + "ord", + "chr", + "crypt", + "ucfirst", + "lcfirst", + "uc", + "lc", + "quotemeta", + "rv2av", + "aelemfast", + "aelem", + "aslice", + "each", + "values", + "keys", + "delete", + "exists", + "rv2hv", + "helem", + "hslice", + "unpack", + "pack", + "split", + "join", + "list", + "lslice", + "anonlist", + "anonhash", + "splice", + "push", + "pop", + "shift", + "unshift", + "sort", + "reverse", + "grepstart", + "grepwhile", + "mapstart", + "mapwhile", + "range", + "flip", + "flop", + "and", + "or", + "xor", + "cond_expr", + "andassign", + "orassign", + "method", + "entersub", + "leavesub", + "caller", + "warn", + "die", + "reset", + "lineseq", + "nextstate", + "dbstate", + "unstack", + "enter", + "leave", + "scope", + "enteriter", + "iter", + "enterloop", + "leaveloop", + "return", + "last", + "next", + "redo", + "dump", + "goto", + "exit", + "open", + "close", + "pipe_op", + "fileno", + "umask", + "binmode", + "tie", + "untie", + "tied", + "dbmopen", + "dbmclose", + "sselect", + "select", + "getc", + "read", + "enterwrite", + "leavewrite", + "prtf", + "print", + "sysopen", + "sysread", + "syswrite", + "send", + "recv", + "eof", + "tell", + "seek", + "truncate", + "fcntl", + "ioctl", + "flock", + "socket", + "sockpair", + "bind", + "connect", + "listen", + "accept", + "shutdown", + "gsockopt", + "ssockopt", + "getsockname", + "getpeername", + "lstat", + "stat", + "ftrread", + "ftrwrite", + "ftrexec", + "fteread", + "ftewrite", + "fteexec", + "ftis", + "fteowned", + "ftrowned", + "ftzero", + "ftsize", + "ftmtime", + "ftatime", + "ftctime", + "ftsock", + "ftchr", + "ftblk", + "ftfile", + "ftdir", + "ftpipe", + "ftlink", + "ftsuid", + "ftsgid", + "ftsvtx", + "fttty", + "fttext", + "ftbinary", + "chdir", + "chown", + "chroot", + "unlink", + "chmod", + "utime", + "rename", + "link", + "symlink", + "readlink", + "mkdir", + "rmdir", + "open_dir", + "readdir", + "telldir", + "seekdir", + "rewinddir", + "closedir", + "fork", + "wait", + "waitpid", + "system", + "exec", + "kill", + "getppid", + "getpgrp", + "setpgrp", + "getpriority", + "setpriority", + "time", + "tms", + "localtime", + "gmtime", + "alarm", + "sleep", + "shmget", + "shmctl", + "shmread", + "shmwrite", + "msgget", + "msgctl", + "msgsnd", + "msgrcv", + "semget", + "semctl", + "semop", + "require", + "dofile", + "entereval", + "leaveeval", + "entertry", + "leavetry", + "ghbyname", + "ghbyaddr", + "ghostent", + "gnbyname", + "gnbyaddr", + "gnetent", + "gpbyname", + "gpbynumber", + "gprotoent", + "gsbyname", + "gsbyport", + "gservent", + "shostent", + "snetent", + "sprotoent", + "sservent", + "ehostent", + "enetent", + "eprotoent", + "eservent", + "gpwnam", + "gpwuid", + "gpwent", + "spwent", + "epwent", + "ggrnam", + "ggrgid", + "ggrent", + "sgrent", + "egrent", + "getlogin", + "syscall", +}; +#endif + +#ifndef DOINIT +EXT char *op_desc[]; +#else +EXT char *op_desc[] = { "null operation", "stub", "scalar", @@ -361,17 +714,18 @@ EXT char *op_name[] = { "constant item", "scalar variable", "glob value", + "glob elem", "private variable", "private array", "private hash", "private something", "push regexp", "ref-to-glob cast", - "scalar value length", "scalar deref", "array length", "subroutine deref", "anonymous subroutine", + "subroutine prototype", "reference constructor", "scalar ref constructor", "reference-type operator", @@ -548,6 +902,7 @@ EXT char *op_name[] = { "binmode", "tie", "untie", + "tied", "dbmopen", "dbmclose", "select system call", @@ -558,6 +913,7 @@ EXT char *op_name[] = { "write exit", "printf", "print", + "sysopen", "sysread", "syswrite", "send", @@ -733,17 +1089,18 @@ OP * pp_wantarray _((void)); OP * pp_const _((void)); OP * pp_gvsv _((void)); OP * pp_gv _((void)); +OP * pp_gelem _((void)); OP * pp_padsv _((void)); OP * pp_padav _((void)); OP * pp_padhv _((void)); OP * pp_padany _((void)); OP * pp_pushre _((void)); OP * pp_rv2gv _((void)); -OP * pp_sv2len _((void)); OP * pp_rv2sv _((void)); OP * pp_av2arylen _((void)); OP * pp_rv2cv _((void)); OP * pp_anoncode _((void)); +OP * pp_prototype _((void)); OP * pp_refgen _((void)); OP * pp_srefgen _((void)); OP * pp_ref _((void)); @@ -920,6 +1277,7 @@ OP * pp_umask _((void)); OP * pp_binmode _((void)); OP * pp_tie _((void)); OP * pp_untie _((void)); +OP * pp_tied _((void)); OP * pp_dbmopen _((void)); OP * pp_dbmclose _((void)); OP * pp_sselect _((void)); @@ -930,6 +1288,7 @@ OP * pp_enterwrite _((void)); OP * pp_leavewrite _((void)); OP * pp_prtf _((void)); OP * pp_print _((void)); +OP * pp_sysopen _((void)); OP * pp_sysread _((void)); OP * pp_syswrite _((void)); OP * pp_send _((void)); @@ -1078,17 +1437,18 @@ EXT OP * (*ppaddr[])() = { pp_const, pp_gvsv, pp_gv, + pp_gelem, pp_padsv, pp_padav, pp_padhv, pp_padany, pp_pushre, pp_rv2gv, - pp_sv2len, pp_rv2sv, pp_av2arylen, pp_rv2cv, pp_anoncode, + pp_prototype, pp_refgen, pp_srefgen, pp_ref, @@ -1265,6 +1625,7 @@ EXT OP * (*ppaddr[])() = { pp_binmode, pp_tie, pp_untie, + pp_tied, pp_dbmopen, pp_dbmclose, pp_sselect, @@ -1275,6 +1636,7 @@ EXT OP * (*ppaddr[])() = { pp_leavewrite, pp_prtf, pp_print, + pp_sysopen, pp_sysread, pp_syswrite, pp_send, @@ -1425,17 +1787,18 @@ EXT OP * (*check[])() = { ck_svconst, /* const */ ck_null, /* gvsv */ ck_null, /* gv */ + ck_null, /* gelem */ ck_null, /* padsv */ ck_null, /* padav */ ck_null, /* padhv */ ck_null, /* padany */ ck_null, /* pushre */ ck_rvconst, /* rv2gv */ - ck_null, /* sv2len */ ck_rvconst, /* rv2sv */ ck_null, /* av2arylen */ ck_rvconst, /* rv2cv */ ck_null, /* anoncode */ + ck_null, /* prototype */ ck_spair, /* refgen */ ck_null, /* srefgen */ ck_fun, /* ref */ @@ -1612,6 +1975,7 @@ EXT OP * (*check[])() = { ck_fun, /* binmode */ ck_fun, /* tie */ ck_fun, /* untie */ + ck_fun, /* tied */ ck_fun, /* dbmopen */ ck_fun, /* dbmclose */ ck_select, /* sselect */ @@ -1622,6 +1986,7 @@ EXT OP * (*check[])() = { ck_null, /* leavewrite */ ck_listiob, /* prtf */ ck_listiob, /* print */ + ck_fun, /* sysopen */ ck_fun, /* sysread */ ck_fun, /* syswrite */ ck_fun, /* send */ @@ -1772,17 +2137,18 @@ EXT U32 opargs[] = { 0x00000004, /* const */ 0x00000044, /* gvsv */ 0x00000044, /* gv */ + 0x00001140, /* gelem */ 0x00000044, /* padsv */ 0x00000040, /* padav */ 0x00000040, /* padhv */ 0x00000040, /* padany */ 0x00000000, /* pushre */ 0x00000044, /* rv2gv */ - 0x0000001c, /* sv2len */ 0x00000044, /* rv2sv */ 0x00000014, /* av2arylen */ 0x00000040, /* rv2cv */ 0x00000000, /* anoncode */ + 0x00000104, /* prototype */ 0x00000201, /* refgen */ 0x00000106, /* srefgen */ 0x0000098c, /* ref */ @@ -1805,7 +2171,7 @@ EXT U32 opargs[] = { 0x0000098c, /* schomp */ 0x00000994, /* defined */ 0x00000904, /* undef */ - 0x0000098c, /* study */ + 0x00000984, /* study */ 0x0000098c, /* pos */ 0x00000164, /* preinc */ 0x00000154, /* i_preinc */ @@ -1959,6 +2325,7 @@ EXT U32 opargs[] = { 0x00000604, /* binmode */ 0x00021755, /* tie */ 0x00000714, /* untie */ + 0x0000070c, /* tied */ 0x00011414, /* dbmopen */ 0x00000414, /* dbmclose */ 0x00111108, /* sselect */ @@ -1969,6 +2336,7 @@ EXT U32 opargs[] = { 0x00000000, /* leavewrite */ 0x00002e15, /* prtf */ 0x00002e15, /* print */ + 0x0091160c, /* sysopen */ 0x0091761d, /* sysread */ 0x0091161d, /* syswrite */ 0x0091161d, /* send */ @@ -9,9 +9,15 @@ while (<DATA>) { chop; next unless $_; next if /^#/; - ($key, $name, $check, $flags, $args) = split(/\t+/, $_, 5); + ($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5); + + warn qq[Description "$desc" duplicates $seen{$desc}\n] if $seen{$desc}; + die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key}; + $seen{$desc} = qq[description of opcode "$key"]; + $seen{$key} = qq[opcode "$key"]; + push(@ops, $key); - $name{$key} = $name; + $desc{$key} = $desc; $check{$key} = $check; $ckname{$check}++; $flags{$key} = $flags; @@ -36,7 +42,7 @@ print "\t", &tab(3,"OP_max"), "\n"; print "} opcode;\n"; print "\n#define MAXO ", scalar @ops, "\n\n"; -# Emit opnames. +# Emit op names and descriptions. print <<END; #ifndef DOINIT @@ -46,7 +52,24 @@ EXT char *op_name[] = { END for (@ops) { - print qq(\t"$name{$_}",\n); + print qq(\t"$_",\n); +} + +print <<END; +}; +#endif + +END + +print <<END; +#ifndef DOINIT +EXT char *op_desc[]; +#else +EXT char *op_desc[] = { +END + +for (@ops) { + print qq(\t"$desc{$_}",\n); } print <<END; @@ -176,6 +199,7 @@ const constant item ck_svconst s gvsv scalar variable ck_null ds gv glob value ck_null ds +gelem glob elem ck_null d S S padsv private variable ck_null ds padav private array ck_null d padhv private hash ck_null d @@ -186,11 +210,11 @@ pushre push regexp ck_null 0 # References and stuff. rv2gv ref-to-glob cast ck_rvconst ds -sv2len scalar value length ck_null ist rv2sv scalar deref ck_rvconst ds av2arylen array length ck_null is rv2cv subroutine deref ck_rvconst d anoncode anonymous subroutine ck_null 0 +prototype subroutine prototype ck_null s S refgen reference constructor ck_spair m L srefgen scalar ref constructor ck_null fs S ref reference-type operator ck_fun stu S? @@ -223,7 +247,7 @@ chomp safe chop ck_spair mts L schomp scalar safe chop ck_null stu S? defined defined operator ck_rfun isu S? undef undef operator ck_lfun s S? -study study ck_fun stu S? +study study ck_fun su S? pos match position ck_lfun stu S? preinc preincrement ck_lfun dIs S @@ -428,6 +452,7 @@ binmode binmode ck_fun s F tie tie ck_fun idms R S L untie untie ck_fun is R +tied tied ck_fun st R dbmopen dbmopen ck_fun is H S S dbmclose dbmclose ck_fun is H @@ -442,6 +467,7 @@ leavewrite write exit ck_null 0 prtf printf ck_listiob ims F? L print print ck_listiob ims F? L +sysopen sysopen ck_fun st F S S S? sysread sysread ck_fun imst F R S S? syswrite syswrite ck_fun imst F S S S? diff --git a/os2/os2ish.h b/os2/os2ish.h index 2dca64a9c8..20e92b0845 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -23,6 +23,8 @@ #endif #define ABORT() kill(getpid(),SIGABRT); +#define BIT_BUCKET "/dev/null" /* Will this work? */ + #define PERL_SYS_INIT(argcp, argvp) do { \ _response(argcp, argvp); \ _wildcard(argcp, argvp); } while (0) @@ -84,6 +84,9 @@ register PerlInterpreter *sv_interp; SvNV(&sv_yes); SvREADONLY_on(&sv_yes); + nrs = newSVpv("\n", 1); + rs = SvREFCNT_inc(nrs); + #ifdef MSDOS /* * There is no way we can refer to them from Perl so close them to save @@ -105,13 +108,7 @@ register PerlInterpreter *sv_interp; laststype = OP_STAT; maxscream = -1; maxsysfd = MAXSYSFD; - nrs = "\n"; - nrschar = '\n'; - nrslen = 1; - rs = "\n"; - rschar = '\n'; rsfp = Nullfp; - rslen = 1; statname = Nullsv; tmps_floor = -1; #endif @@ -379,7 +376,7 @@ setuid perl scripts securely.\n"); s += strlen(s); } av_push(preambleav, Sv); - scriptname = "/dev/null"; /* don't look for script or read stdin */ + scriptname = BIT_BUCKET; /* don't look for script or read stdin */ goto reswitch; case 'x': doextract = TRUE; @@ -473,12 +470,9 @@ setuid perl scripts securely.\n"); } /* now that script is parsed, we can modify record separator */ - - rs = nrs; - rslen = nrslen; - rschar = nrschar; - rspara = (nrslen == 2); - sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs, rslen); + SvREFCNT_dec(rs); + rs = SvREFCNT_inc(nrs); + sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs); if (do_undump) my_unexec(); @@ -488,6 +482,12 @@ setuid perl scripts securely.\n"); LEAVE; FREETMPS; + +#ifdef DEBUGGING_MSTATS + if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) + dump_mstats("after compilation:"); +#endif + ENTER; restartop = 0; return 0; @@ -508,6 +508,10 @@ PerlInterpreter *sv_interp; if (endav) calllist(endav); FREETMPS; +#ifdef DEBUGGING_MSTATS + if (getenv("PERL_DEBUG_MSTATS")) + dump_mstats("after execution: "); +#endif return(statusvalue); /* my_exit() was called */ case 3: if (!restartop) { @@ -986,20 +990,19 @@ moreswitches(s) char *s; { I32 numlen; + U32 rschar; switch (*s) { case '0': - nrschar = scan_oct(s, 4, &numlen); - nrs = savepvn("\n",1); - *nrs = nrschar; - if (nrschar > 0377) { - nrslen = 0; - nrs = ""; - } - else if (!nrschar && numlen >= 2) { - nrslen = 2; - nrs = "\n\n"; - nrschar = '\n'; + rschar = scan_oct(s, 4, &numlen); + SvREFCNT_dec(nrs); + if (rschar & ~((U8)~0)) + nrs = &sv_undef; + else if (!rschar && numlen >= 2) + nrs = newSVpv("", 0); + else { + char ch = rschar; + nrs = newSVpv(&ch, 1); } return s + numlen; case 'F': @@ -1018,7 +1021,7 @@ char *s; case 'd': taint_not("-d"); s++; - if (*s == ':') { + if (*s == ':' || *s == '=') { sprintf(buf, "use Devel::%s;", ++s); s += strlen(s); my_setenv("PERL5DB",buf); @@ -1084,8 +1087,12 @@ char *s; s += numlen; } else { - ors = savepvn(nrs,nrslen); - orslen = nrslen; + if (RsPARA(nrs)) { + ors = savepvn("\n\n", 2); + orslen = 2; + } + else + ors = SvPV(nrs, orslen); } return s; case 'M': @@ -1094,16 +1101,27 @@ char *s; case 'm': taint_not("-m"); /* XXX ? */ if (*++s) { - char tmpbuf[90]; - if (preambleav == NULL) - preambleav = newAV(); + char *start = s; + Sv = newSVpv("use ",4); /* We allow -M'Module qw(Foo Bar)' */ - if (*(s-1) == 'M') - sprintf(tmpbuf, "use %s;", s); - else - sprintf(tmpbuf, "use %s ();", s); - av_push(preambleav, newSVpv(tmpbuf,0)); + while(isALNUM(*s) || *s==':') ++s; + if (*s != '=') { + sv_catpv(Sv, start); + if (*(start-1) == 'm') { + if (*s != '\0') + croak("Can't use '%c' after -mname", *s); + sv_catpv( Sv, " ()"); + } + } else { + sv_catpvn(Sv, start, s-start); + sv_catpv(Sv, " qw("); + sv_catpv(Sv, ++s); + sv_catpv(Sv, ")"); + } s += strlen(s); + if (preambleav == NULL) + preambleav = newAV(); + av_push(preambleav, Sv); } else croak("No space allowed after -%c", *(s-1)); @@ -1134,7 +1152,7 @@ char *s; s++; return s; case 'v': - printf("\nThis is perl, version %s beta2",patchlevel); + printf("\nThis is perl, version %s beta3",patchlevel); #if defined(DEBUGGING) || defined(EMBED) || defined(MULTIPLICITY) fputs(" with", stdout); @@ -1254,6 +1272,13 @@ SV *sv; register char *s; I32 len; +#ifdef VMS + if (dosearch && !strpbrk(scriptname,":[</") && (my_getenv("DCL$PATH"))) { + int idx = 0; + + while (my_trnlnm("DCL$PATH",tokenbuf,idx++)) { + strcat(tokenbuf,scriptname); +#else /* !VMS */ if (dosearch && !strchr(scriptname, '/') && (s = getenv("PATH"))) { bufend = s + strlen(s); @@ -1282,6 +1307,7 @@ SV *sv; #endif (void)strcat(tokenbuf+len,"/"); (void)strcat(tokenbuf+len,scriptname); +#endif /* !VMS */ DEBUG_p(fprintf(stderr,"Looking for %s\n",tokenbuf)); if (Stat(tokenbuf,&statbuf) < 0) /* not there? */ continue; @@ -1660,8 +1686,11 @@ init_debugger() DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV); DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV)); DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV))); + sv_setiv(DBsingle, 0); DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV))); + sv_setiv(DBtrace, 0); DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV))); + sv_setiv(DBsignal, 0); curstash = defstash; } @@ -9,7 +9,6 @@ #ifndef H_PERL #define H_PERL 1 #define OVERLOAD -#define STRANGE_MALLOC #include "embed.h" @@ -57,16 +56,22 @@ #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) #define TAINT_ENV() if (tainting) taint_env() -#ifdef HAS_GETPGRP2 +#if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2) +# define getpgrp getpgrp2 +# define setpgrp setpgrp2 # ifndef HAS_GETPGRP # define HAS_GETPGRP # endif -#endif - -#ifdef HAS_SETPGRP2 # ifndef HAS_SETPGRP # define HAS_SETPGRP # endif +# ifndef USE_BSDPGRP +# define USE_BSDPGRP +# endif +#else +# if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2) + #include "Gack, you have one but not both of getpgrp2() and setpgrp2()." +# endif #endif #include <stdio.h> @@ -499,7 +504,6 @@ typedef struct pmop PMOP; typedef struct svop SVOP; typedef struct gvop GVOP; typedef struct pvop PVOP; -typedef struct cvop CVOP; typedef struct loop LOOP; typedef struct Outrec Outrec; @@ -828,6 +832,9 @@ I32 unlnk _((char*)); # ifndef register # define register # endif +# ifdef MYMALLOC +# define DEBUGGING_MSTATS +# endif # define PAD_SV(po) pad_sv(po) #else # define PAD_SV(po) curpad[po] @@ -849,7 +856,7 @@ EXT int egid; /* current effective group id */ EXT bool nomemok; /* let malloc context handle nomem */ EXT U32 an; /* malloc sequence number */ EXT U32 cop_seqmax; /* statement sequence number */ -EXT U32 op_seqmax; /* op sequence number */ +EXT U16 op_seqmax; /* op sequence number */ EXT U32 evalseq; /* eval sequence number */ EXT U32 sub_generation; /* inc to force methods to be looked up again */ EXT char ** origenviron; @@ -863,6 +870,8 @@ EXT double * xnv_root; /* free xnv list--shared by interpreters */ EXT XRV * xrv_root; /* free xrv list--shared by interpreters */ EXT XPV * xpv_root; /* free xpv list--shared by interpreters */ EXT HE * he_root; /* free he list--shared by interpreters */ +EXT char * nice_chunk; /* a nice chunk of memory to reuse */ +EXT U32 nice_chunk_size;/* how nice the chunk of memory is */ /* Stack for currently executing thread--context switch must handle this. */ EXT SV ** stack_base; /* stack->array_ary */ @@ -1191,13 +1200,16 @@ IEXT SV * Idiehook; IEXT SV * Iwarnhook; IEXT SV * Iparsehook; +/* Various states of an input record separator SV (rs, nrs) */ +#define RsSNARF(sv) (! SvOK(sv)) +#define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) +#define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) + /* switches */ IEXT char * Icddir; IEXT bool Iminus_c; IEXT char Ipatchlevel[6]; -IEXT char * Inrs IINIT("\n"); -IEXT U32 Inrschar IINIT('\n'); /* final char of rs, or 0777 if none */ -IEXT I32 Inrslen IINIT(1); +IEXT SV * Inrs; IEXT char * Isplitstr IINIT(" "); IEXT bool Ipreprocess; IEXT bool Iminus_n; @@ -1226,10 +1238,7 @@ IEXT int Iperl_destruct_level; /* 0=none, 1=full, 2=full with checks */ IEXT Time_t Ibasetime; /* $^T */ IEXT SV * Iformfeed; /* $^L */ IEXT char * Ichopset IINIT(" \n-"); /* $: */ -IEXT char * Irs IINIT("\n"); /* $/ */ -IEXT U32 Irschar IINIT('\n'); /* final char of rs, or 0777 if none */ -IEXT STRLEN Irslen IINIT(1); -IEXT bool Irspara; +IEXT SV * Irs; /* $/ */ IEXT char * Iofs; /* $, */ IEXT STRLEN Iofslen; IEXT char * Iors; /* $\ */ @@ -19,17 +19,17 @@ short yylhs[] = { -1, 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, 13, 12, 12, - 12, 26, 26, 26, 26, 26, 26, 26, 26, 27, - 27, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 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, 22, 22, 23, 23, 23, 20, 15, - 16, 17, 18, 19, 24, 24, 24, 24, + 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, }; short yylen[] = { 2, 0, 2, 4, 0, 0, 2, 2, 2, 1, 2, @@ -37,1038 +37,1080 @@ short yylen[] = { 2, 6, 6, 4, 4, 0, 2, 7, 7, 5, 5, 8, 7, 10, 3, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 4, 3, 5, 5, 0, 1, - 0, 3, 2, 4, 3, 3, 2, 1, 2, 3, - 1, 3, 5, 6, 3, 5, 2, 4, 4, 1, - 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 5, 3, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 3, 2, 3, 2, 4, - 3, 4, 1, 1, 4, 5, 4, 1, 1, 1, + 0, 3, 2, 5, 3, 3, 1, 2, 3, 1, + 3, 5, 6, 3, 5, 2, 4, 4, 1, 1, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 5, 3, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 3, 2, 3, 2, 4, 3, + 4, 1, 5, 1, 4, 5, 4, 1, 1, 1, 5, 6, 5, 6, 5, 4, 5, 1, 1, 3, 4, 3, 2, 2, 4, 5, 4, 5, 1, 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, + 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, }; short yydefred[] = { 1, - 0, 5, 0, 40, 51, 51, 0, 0, 6, 41, + 0, 5, 0, 40, 51, 51, 0, 51, 6, 41, 7, 9, 0, 42, 43, 44, 0, 0, 0, 53, - 0, 12, 4, 142, 0, 0, 118, 0, 137, 0, + 0, 12, 4, 143, 0, 0, 118, 0, 138, 0, 51, 51, 0, 0, 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, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, 0, - 0, 108, 110, 104, 0, 0, 143, 0, 46, 0, - 52, 0, 0, 5, 155, 158, 157, 156, 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, 0, 153, 0, - 124, 0, 0, 0, 0, 0, 0, 57, 0, 0, - 67, 0, 132, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 99, 0, 149, 150, 151, 152, 154, + 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, 91, 92, 0, 0, 0, 0, - 0, 0, 0, 11, 45, 50, 0, 54, 0, 65, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 36, 0, 136, 138, 0, - 0, 0, 0, 0, 0, 101, 0, 122, 0, 0, - 0, 98, 26, 0, 0, 0, 0, 0, 0, 55, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 70, 0, 71, 0, - 0, 0, 0, 0, 0, 120, 0, 48, 47, 3, - 0, 140, 0, 69, 102, 0, 29, 0, 30, 0, - 0, 0, 23, 0, 24, 0, 0, 0, 139, 148, - 68, 0, 125, 0, 127, 0, 100, 0, 0, 0, - 0, 0, 0, 0, 107, 0, 105, 0, 116, 121, - 66, 0, 0, 0, 0, 19, 0, 0, 0, 0, - 0, 63, 126, 128, 115, 0, 113, 0, 0, 106, - 0, 111, 117, 141, 27, 28, 21, 0, 22, 0, - 32, 0, 114, 112, 64, 0, 0, 31, 0, 0, - 20, 33, + 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, 54, 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, 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, }; short yydgoto[] = { 1, - 9, 10, 84, 17, 87, 3, 11, 12, 66, 194, - 263, 67, 201, 69, 70, 71, 72, 73, 74, 75, - 196, 83, 202, 89, 186, 77, 240, 177, 13, 142, + 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, }; short yysindex[] = { 0, - 0, 0, -82, 0, 0, 0, -54, -205, 0, 0, - 0, 0, 592, 0, 0, 0, -110, -186, 25, 0, - 2094, 0, 0, 0, -35, -35, 0, 46, 0, 2094, - 0, 0, -12, -9, 1, 6, 36, 2094, 51, 68, - 76, -35, 1800, 2094, 979, -140, 1860, 1042, 1975, 2094, - 2094, 2094, 2094, 2094, 1276, 0, 2094, 2094, 1332, -35, - -35, -35, -35, -35, -151, 0, 86, 303, 1106, -65, - -59, 0, 0, 0, 92, 80, 0, 10, 0, -120, - 0, 86, 85, 0, 0, 0, 0, 0, 2094, 105, - 2094, 1106, 10, -120, 1860, 10, 1860, 10, 1860, 10, - 1860, 10, 1391, 109, 1106, 111, 1451, 923, 0, 110, - 0, 1357, -25, 1357, 28, -42, 2094, 0, 0, -65, - 0, 2094, 0, 1357, 788, 788, 788, -83, -83, 64, - -32, 788, 788, 0, -90, 0, 0, 0, 0, 0, - 10, 0, 2094, 1860, 1860, 1860, 1860, 1860, 1860, 1860, - 2094, 2094, 2094, 2094, 2094, 2094, 2094, 2094, 2094, 2094, - 2094, 2094, 2094, 2094, 0, 0, -30, 1860, 1860, 1860, - 1860, 1860, 1566, 0, 0, 0, -41, 0, -91, 0, - 1860, 2862, 2094, 10, -256, 113, -151, -29, -151, 2, - -157, 4, -157, 98, -39, 0, 1860, 0, 0, 16, - 77, 126, 1860, 1685, 1741, 0, 47, 0, 86, 1860, - 82, 0, 0, 1106, -256, -256, -256, -256, -117, 0, - 115, 754, 1357, 381, 888, 467, 1106, 1164, 807, 1893, - 2031, 1239, 739, 788, 788, 1860, 0, 1860, 0, 141, - -79, 142, -77, 149, 133, 0, 21, 0, 0, 0, - 150, 0, 2094, 0, 0, 10, 0, 10, 0, 10, - 10, 143, 0, 10, 0, 1860, 10, 49, 0, 0, - 0, 58, 0, 60, 0, 72, 0, 164, 1860, 69, - 2094, 161, 219, 1860, 0, 70, 0, 71, 0, 0, - 0, 359, -151, -151, -157, 0, 1860, -157, 138, -151, - 10, 0, 0, 0, 0, 236, 0, 3114, 73, 0, - 158, 0, 0, 0, 0, 0, 0, 74, 0, 1391, - 0, -151, 0, 0, 0, 10, 159, 0, -157, 10, - 0, 0, + 0, 0, -82, 0, 0, 0, -52, 0, 0, 0, + 0, 0, 853, 0, 0, 0, -80, -256, -19, 0, + -245, 0, 0, 0, 19, 19, 0, 20, 0, 2177, + 0, 0, -2, 1, 28, 41, 133, 2177, 27, 33, + 52, 19, 1028, 2177, 1303, -210, 19, 2177, 965, 1359, + 2177, 2177, 2177, 2177, 2177, 1415, 0, 2177, 2177, 1478, + 19, 19, 19, 19, -225, 0, 71, 209, 1535, -49, + -30, 0, 0, 8, 101, 42, 0, 30, 0, -112, + 0, 2177, 0, 0, 0, 0, 0, 2177, 127, 2177, + 1535, 30, -112, 2177, 30, 2177, 30, 2177, 30, 2177, + 30, 1712, 128, 1535, 139, 1768, 965, 0, 141, 0, + 1485, -14, 1485, 65, -42, 2177, 0, 71, 0, 71, + -49, 0, 2177, 0, 1485, 334, 334, 334, -47, -47, + 92, -26, 334, 334, 0, 63, 0, 0, 0, 0, + 30, 0, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 0, 0, -27, 2177, 2177, 2177, + 2177, 2177, 2177, 1824, 0, 0, 0, -48, 137, -92, + 0, 2177, 221, 2177, 30, -191, 151, -225, -22, -225, + -12, -147, 7, -147, 138, 5, 0, 2177, 0, 0, + 9, -39, 160, 2177, 1887, 2121, 0, 77, 0, 71, + 2177, 113, 0, 0, 1535, -191, -191, -191, -191, -86, + 0, -20, 395, 1485, 1566, 461, -88, 1535, 4122, 1064, + 679, 364, 1120, 728, 334, 334, 2177, 0, 2177, 0, + 174, 89, 51, 98, 55, 118, 57, 0, 11, 0, + 0, 0, 0, 175, 0, 2177, 0, 0, 30, 0, + 30, 0, 30, 30, 178, 0, 30, 0, 2177, 30, + 15, 0, 0, 0, 22, 0, 25, 0, 29, 0, + 152, 2177, 94, 2177, 59, 177, 2177, 0, 96, 0, + 97, 0, 102, 0, 0, 1190, -225, -225, -147, 0, + 2177, -147, 176, -225, 30, 0, 0, 0, 0, 205, + 0, 3039, 111, 0, 206, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 1712, 0, -225, 0, 0, 0, + 30, 208, 0, -147, 30, 0, 0, }; short yyrindex[] = { 0, - 0, 0, 123, 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, - 147, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2287, 2133, 0, - 0, 0, 0, 0, 0, 0, 0, 2773, 2817, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 11, 0, 332, 14, 1236, 2908, - 3038, 0, 0, 0, 2184, 0, 0, 0, 0, -17, - 0, 2331, 0, 0, 0, 0, 0, 0, 2460, 0, - 0, 1645, 0, 79, 168, 0, 0, 0, 0, 0, - 0, 0, 152, 0, 1914, 0, 0, 172, 0, 2239, - 0, 3740, 2908, 3784, 0, 0, 2460, 0, 448, 524, - 0, 0, 0, 3830, 3207, 3303, 3345, 3083, 3170, 2552, - 0, 3390, 3455, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 2596, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2253, 505, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 2847, 2935, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 107, 0, -35, 10, 53, 3109, + 3156, 0, 0, 2298, 1976, 0, 0, 0, 0, -23, + 0, 230, 0, 0, 0, 0, 0, 2385, 0, 0, + 1004, 0, 168, 253, 0, 0, 0, 0, 0, 0, + 0, 254, 0, 2242, 0, 0, 274, 0, 2032, 0, + 3844, 3109, 3902, 0, 0, 2385, 0, 2440, 452, 2554, + 572, 0, 0, 0, 3981, 3274, 3312, 3421, 3200, 3237, + 2661, 0, 3560, 3596, 0, 0, 0, 0, 0, 0, + 0, 0, 2714, 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, 867, 0, - 172, 0, 2460, 0, 19, 0, 11, 0, 11, 0, - 67, 0, 67, 0, 160, 0, 0, 0, 0, 0, - 180, 0, 0, 0, 0, 0, 0, 0, 2646, 0, - 2722, 0, 0, 2282, 22, 33, 38, 84, 349, 0, - 0, -34, 3872, 3904, 166, 3610, 2422, 0, 496, 4003, - 3959, 3914, 3652, 3492, 3565, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 909, + 0, 274, 0, 2385, 0, 39, 0, 107, 0, 107, + 0, 170, 0, 170, 0, 262, 0, 0, 0, 0, + 0, 288, 0, 0, 0, 0, 0, 0, 0, 2805, + 0, 2757, 0, 0, 2650, 49, 58, 61, 64, 365, + 0, 0, -31, 4018, 4028, 3719, 630, 2995, 0, 1623, + 4106, 4096, 4064, 3756, 3640, 3683, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 173, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 172, 0, 0, 0, 0, 0, 0, - 0, 0, 11, 11, 67, 0, 0, 67, 0, 11, - 0, 0, 0, 0, 0, 0, 0, 404, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 182, - 0, 11, 0, 0, 0, 0, 0, 0, 67, 0, - 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 277, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 274, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 107, 107, 170, 0, + 0, 170, 0, 107, 0, 0, 0, 0, 0, 0, + 0, 13, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 300, 0, 107, 0, 0, 0, + 0, 0, 0, 170, 0, 0, 0, }; short yygindex[] = { 0, - 0, 0, 0, 63, -13, 153, 0, 0, 0, -89, - -160, 29, 376, 4192, 890, 0, 0, 0, 0, 0, - 229, -21, -162, 880, -22, 0, 0, 156, 0, -152, + 0, 0, 0, 506, -13, 255, 0, 0, 0, 18, + -180, 839, -11, 4398, 2162, 0, 0, 0, 0, 0, + 342, -57, -174, 1032, 90, 0, 0, 267, 0, -172, 0, 0, 0, 0, }; -#define YYTABLESIZE 4473 +#define YYTABLESIZE 4682 short yytable[] = { 65, - 61, 267, 212, 79, 20, 61, 81, 168, 211, 81, - 25, 258, 23, 285, 205, 287, 207, 248, 251, 96, - 98, 100, 102, 81, 81, 170, 121, 95, 81, 111, - 97, 172, 265, 250, 257, 123, 259, 148, 149, 150, - 99, 49, 260, 25, 264, 101, 25, 25, 25, 82, - 25, 21, 25, 25, 13, 25, 269, 169, 81, 38, - 238, 290, 16, 171, 175, 170, 18, 180, 18, 25, - 80, 61, 13, 17, 25, 103, 82, 38, 14, 183, - 16, 23, 187, 81, 189, 91, 191, 23, 193, 301, - 106, 17, 236, 93, 94, 208, 14, 169, 302, 18, - 303, 25, 18, 18, 18, 49, 18, 107, 18, 18, - 23, 18, 304, 23, 326, 108, 117, 82, 261, 262, - 270, 311, 2, 23, 15, 18, 141, 213, 23, 143, - 18, 173, 23, 25, 317, 25, 25, 319, 174, 176, - 315, 316, 15, 178, 181, 82, 78, 321, 197, 204, - 209, 198, 206, 256, 210, 39, 266, 18, 39, 39, - 39, 254, 39, 249, 39, 39, 271, 39, 331, 328, - 255, 277, 279, 280, 4, 5, 6, 149, 7, 8, - 284, 39, 297, 4, 5, 6, 39, 7, 8, 18, - 291, 18, 18, 307, 312, 313, 320, 324, 325, 330, - 286, 49, 19, 148, 149, 144, 74, 288, 37, 74, - 35, 82, 146, 39, 148, 149, 148, 149, 13, 309, - 147, 85, 35, 74, 74, 289, 86, 237, 74, 167, - 327, 37, 144, 145, 146, 147, 179, 81, 81, 81, - 81, 76, 293, 299, 294, 39, 295, 296, 39, 184, - 298, 148, 149, 300, 148, 149, 305, 0, 74, 81, - 81, 148, 149, 81, 148, 149, 25, 25, 25, 25, - 25, 25, 0, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 25, 0, 322, 0, 25, - 25, 0, 25, 25, 25, 148, 149, 148, 149, 25, - 25, 25, 25, 25, 0, 0, 25, 25, 0, 148, - 149, 310, 329, 25, 148, 149, 332, 25, 0, 25, - 25, 0, 18, 18, 18, 18, 18, 18, 323, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 148, 149, 0, 18, 18, 0, 18, 18, - 18, 148, 149, 148, 149, 18, 18, 18, 18, 18, - 0, 0, 18, 18, 0, 148, 149, 148, 149, 18, - 148, 149, 58, 18, 0, 18, 18, 0, 39, 39, - 39, 39, 39, 39, 0, 39, 39, 39, 68, 56, - 58, 39, 56, 0, 39, 39, 39, 39, 0, 314, - 0, 39, 39, 0, 39, 39, 39, 56, 148, 149, - 0, 39, 39, 39, 39, 39, 0, 0, 39, 39, - 116, 157, 118, 0, 58, 39, 148, 149, 0, 39, - 131, 39, 39, 0, 135, 148, 149, 74, 74, 74, - 74, 56, 148, 149, 84, 0, 74, 84, 0, 168, - 74, 74, 74, 74, 148, 149, 0, 148, 149, 74, - 74, 84, 84, 74, 74, 74, 74, 74, 0, 74, - 185, 168, 188, 0, 190, 0, 192, 0, 195, 0, - 155, 150, 200, 155, 155, 155, 0, 155, 142, 155, - 155, 142, 155, 0, 0, 0, 84, 0, 0, 0, - 0, 0, 0, 150, 0, 142, 142, 0, 0, 0, - 142, 155, 148, 149, 0, 0, 0, 0, 0, 215, - 216, 217, 218, 219, 220, 221, 0, 0, 0, 148, - 149, 0, 0, 0, 0, 0, 83, 0, 142, 83, - 142, 0, 0, 241, 242, 243, 244, 245, 247, 0, - 0, 0, 0, 83, 83, 0, 156, 168, 83, 156, - 156, 156, 0, 156, 103, 156, 156, 103, 156, 0, - 142, 0, 268, 155, 144, 145, 146, 147, 272, 274, - 276, 103, 103, 0, 0, 278, 103, 156, 83, 150, - 0, 0, 0, 0, 0, 0, 148, 149, 0, 0, - 0, 0, 0, 58, 58, 58, 58, 0, 0, 0, - 0, 282, 0, 283, 0, 0, 103, 0, 0, 0, - 56, 56, 56, 56, 50, 58, 58, 61, 63, 60, - 0, 55, 0, 64, 58, 0, 57, 0, 0, 151, - 0, 185, 56, 152, 153, 154, 155, 0, 0, 156, - 56, 0, 0, 0, 306, 62, 156, 158, 159, 160, - 161, 0, 162, 163, 0, 152, 164, 154, 155, 165, - 166, 167, 318, 0, 0, 84, 84, 84, 84, 0, - 0, 0, 59, 0, 162, 163, 0, 0, 164, 0, - 0, 165, 166, 167, 0, 68, 0, 84, 84, 0, - 0, 84, 0, 0, 155, 155, 155, 155, 155, 0, - 155, 155, 155, 0, 23, 0, 155, 51, 0, 142, - 142, 142, 142, 0, 0, 0, 0, 155, 142, 155, - 155, 155, 142, 142, 142, 142, 155, 155, 155, 155, - 155, 142, 142, 155, 155, 142, 142, 142, 142, 142, - 155, 142, 142, 154, 155, 142, 155, 155, 142, 142, - 142, 0, 0, 0, 0, 0, 0, 83, 83, 83, - 83, 163, 0, 0, 164, 0, 83, 165, 166, 167, - 156, 156, 156, 156, 156, 0, 156, 156, 156, 83, - 83, 0, 156, 83, 83, 103, 103, 103, 103, 0, - 0, 0, 0, 156, 103, 156, 156, 156, 103, 103, - 103, 103, 156, 156, 156, 156, 156, 103, 103, 156, - 156, 103, 103, 103, 103, 103, 156, 103, 103, 168, - 156, 103, 156, 156, 103, 103, 103, 0, 0, 0, - 0, 0, 0, 0, 168, 0, 0, 22, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 0, 0, 0, - 32, 150, 0, 33, 34, 35, 36, 0, 0, 0, - 37, 38, 0, 39, 40, 41, 150, 0, 168, 0, - 42, 43, 44, 45, 46, 0, 0, 47, 48, 0, - 0, 0, 0, 0, 49, 0, 0, 168, 52, 39, - 53, 54, 39, 39, 39, 90, 39, 0, 39, 39, - 150, 39, 0, 0, 88, 88, 0, 0, 0, 0, - 0, 109, 0, 0, 0, 39, 104, 122, 0, 150, - 39, 88, 113, 0, 0, 0, 0, 120, 0, 136, - 137, 138, 139, 140, 0, 0, 0, 0, 0, 88, - 88, 88, 88, 88, 0, 50, 0, 39, 61, 63, - 60, 0, 55, 0, 64, 58, 0, 57, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 168, 0, - 0, 0, 0, 0, 0, 0, 62, 203, 0, 39, - 0, 0, 39, 0, 0, 0, 0, 120, 0, 0, + 80, 68, 168, 79, 273, 57, 20, 254, 61, 80, + 250, 82, 80, 268, 212, 260, 208, 262, 261, 95, + 97, 99, 101, 57, 179, 206, 80, 80, 263, 110, + 181, 80, 253, 115, 150, 49, 124, 94, 283, 81, + 96, 170, 23, 168, 132, 270, 116, 267, 136, 272, + 13, 294, 141, 83, 61, 305, 83, 57, 209, 90, + 172, 80, 306, 239, 176, 307, 105, 98, 13, 308, + 83, 83, 106, 169, 23, 150, 170, 331, 184, 38, + 100, 188, 186, 190, 189, 192, 191, 194, 193, 16, + 196, 107, 171, 60, 201, 237, 60, 38, 17, 49, + 175, 14, 148, 149, 15, 83, 25, 16, 169, 289, + 60, 60, 315, 291, 143, 293, 17, 313, 322, 14, + 23, 324, 15, 23, 320, 321, 257, 214, 264, 265, + 173, 326, 216, 217, 218, 219, 220, 221, 222, 25, + 174, 23, 25, 25, 25, 60, 25, 177, 25, 25, + 23, 25, 23, 336, 333, 213, 242, 243, 244, 245, + 246, 247, 249, 23, 251, 25, 182, 198, 61, 18, + 25, 258, 102, 4, 5, 6, 78, 7, 8, 199, + 205, 288, 211, 4, 5, 6, 271, 7, 8, 207, + 290, 259, 275, 277, 279, 252, 269, 25, 154, 281, + 274, 280, 18, 282, 19, 18, 18, 18, 149, 18, + 292, 18, 18, 287, 18, 295, 163, 301, 311, 164, + 316, 317, 165, 166, 167, 285, 318, 286, 18, 25, + 238, 25, 25, 18, 325, 329, 57, 57, 57, 57, + 80, 80, 80, 80, 309, 297, 330, 298, 335, 299, + 300, 148, 149, 302, 148, 149, 304, 186, 57, 57, + 18, 255, 80, 80, 256, 167, 80, 148, 149, 314, + 310, 148, 149, 148, 149, 84, 144, 145, 146, 147, + 85, 148, 149, 157, 83, 83, 83, 83, 145, 323, + 49, 327, 18, 37, 18, 18, 2, 328, 148, 149, + 148, 149, 148, 149, 148, 149, 83, 83, 148, 149, + 83, 168, 35, 68, 147, 148, 149, 334, 148, 149, + 13, 337, 148, 149, 60, 60, 60, 60, 148, 39, + 148, 149, 39, 39, 39, 37, 39, 180, 39, 39, + 35, 39, 332, 150, 148, 149, 60, 60, 148, 149, + 148, 149, 148, 149, 76, 39, 148, 149, 303, 185, + 39, 0, 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, 39, 25, 25, + 25, 148, 149, 0, 0, 25, 25, 25, 25, 25, + 0, 0, 25, 25, 0, 56, 0, 0, 56, 25, + 0, 148, 149, 25, 0, 25, 25, 0, 0, 39, + 0, 0, 39, 56, 168, 18, 18, 18, 18, 18, + 18, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 148, 149, 0, 18, 18, + 0, 18, 18, 18, 168, 0, 150, 56, 18, 18, + 18, 18, 18, 0, 0, 18, 18, 0, 0, 0, + 148, 149, 18, 0, 0, 0, 18, 0, 18, 18, + 144, 145, 146, 147, 156, 168, 150, 156, 156, 156, + 0, 156, 143, 156, 156, 143, 156, 0, 148, 149, + 0, 151, 148, 149, 0, 152, 153, 154, 155, 143, + 143, 18, 0, 21, 143, 156, 0, 150, 156, 158, + 159, 160, 161, 0, 162, 163, 0, 0, 164, 0, + 0, 165, 166, 167, 0, 0, 92, 93, 0, 0, + 0, 0, 143, 0, 143, 136, 0, 0, 136, 0, + 0, 168, 39, 39, 39, 39, 39, 39, 0, 39, + 39, 39, 136, 136, 0, 39, 0, 136, 39, 39, + 39, 39, 0, 0, 143, 39, 39, 156, 39, 39, + 39, 0, 0, 150, 0, 39, 39, 39, 39, 39, + 0, 0, 39, 39, 0, 136, 0, 136, 0, 39, + 0, 0, 0, 39, 157, 39, 39, 157, 157, 157, + 0, 157, 102, 157, 157, 102, 157, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 136, 0, 102, + 102, 0, 0, 0, 102, 157, 56, 56, 56, 56, + 0, 164, 0, 0, 165, 166, 167, 0, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 56, 0, + 0, 0, 0, 0, 102, 161, 0, 162, 163, 0, + 74, 164, 0, 74, 165, 166, 167, 0, 0, 152, + 153, 154, 155, 0, 0, 0, 0, 74, 74, 0, + 0, 0, 74, 158, 159, 160, 161, 157, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 156, 156, + 156, 156, 156, 0, 156, 156, 156, 0, 0, 0, + 156, 0, 74, 143, 143, 143, 143, 0, 0, 0, + 0, 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, 163, 0, 0, 164, 168, + 0, 165, 166, 167, 0, 0, 136, 136, 136, 136, + 0, 0, 0, 0, 0, 136, 0, 0, 0, 136, + 136, 136, 136, 0, 0, 0, 0, 0, 136, 136, + 0, 150, 136, 136, 136, 136, 136, 0, 136, 136, + 0, 0, 136, 0, 0, 136, 136, 136, 168, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 157, 157, + 157, 157, 157, 0, 157, 157, 157, 0, 0, 0, + 157, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 150, 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, 51, 118, 120, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 0, 0, + 0, 74, 74, 74, 74, 0, 0, 0, 0, 0, + 74, 57, 0, 0, 74, 74, 62, 74, 0, 0, + 120, 0, 0, 74, 74, 0, 120, 74, 74, 74, + 74, 74, 0, 74, 0, 0, 0, 0, 0, 0, + 0, 39, 0, 60, 39, 39, 39, 0, 39, 0, + 39, 39, 0, 39, 120, 0, 0, 0, 0, 0, + 0, 210, 0, 152, 153, 154, 155, 39, 0, 0, + 0, 0, 39, 0, 0, 23, 0, 0, 52, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 0, 0, 0, 0, 0, 51, 0, 39, + 61, 63, 47, 0, 56, 0, 64, 59, 0, 58, + 0, 0, 0, 0, 154, 155, 0, 0, 0, 0, + 0, 0, 120, 0, 0, 0, 0, 0, 62, 0, + 0, 39, 163, 0, 39, 164, 0, 0, 165, 166, + 167, 0, 0, 0, 135, 0, 0, 135, 0, 0, + 0, 0, 0, 0, 0, 60, 0, 89, 0, 0, + 51, 135, 135, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 108, 0, 0, 0, 0, 117, 0, + 123, 0, 0, 0, 0, 0, 0, 23, 0, 0, + 52, 62, 137, 138, 139, 140, 135, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 22, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 0, 32, 0, 0, 33, 34, 35, 36, 0, 0, + 0, 37, 38, 0, 39, 40, 41, 0, 204, 0, + 0, 42, 43, 44, 45, 46, 0, 0, 48, 49, + 23, 0, 0, 52, 168, 50, 0, 0, 0, 53, + 0, 54, 55, 0, 39, 39, 39, 39, 39, 39, + 0, 39, 39, 39, 0, 0, 0, 39, 0, 0, + 39, 39, 39, 39, 0, 0, 150, 39, 39, 0, + 39, 39, 39, 0, 0, 0, 0, 39, 39, 39, + 39, 39, 0, 0, 39, 39, 0, 0, 0, 0, + 168, 39, 0, 0, 0, 39, 0, 39, 39, 0, + 0, 119, 25, 26, 27, 28, 85, 29, 30, 31, + 319, 0, 0, 32, 0, 0, 0, 0, 0, 0, + 0, 0, 150, 0, 38, 0, 39, 40, 41, 0, + 0, 0, 157, 42, 43, 44, 45, 46, 0, 0, + 48, 49, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 53, 0, 54, 55, 135, 135, 135, 135, 0, + 168, 0, 0, 0, 109, 25, 26, 27, 28, 0, + 29, 30, 31, 0, 0, 0, 32, 135, 135, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 39, + 40, 41, 150, 0, 0, 0, 42, 43, 44, 45, + 46, 0, 0, 48, 49, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 51, 54, 55, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 114, 0, 159, 160, 161, 62, 162, 163, 0, + 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 150, 50, 0, 59, 61, 63, 60, 0, 55, 0, - 64, 58, 0, 57, 0, 154, 155, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 115, 152, 153, - 154, 155, 62, 163, 0, 23, 164, 0, 51, 165, - 166, 167, 158, 159, 160, 161, 239, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 0, 59, - 0, 0, 0, 0, 50, 0, 0, 61, 63, 60, - 0, 55, 0, 64, 58, 0, 57, 0, 0, 0, - 0, 152, 153, 154, 155, 164, 0, 0, 165, 166, - 167, 0, 0, 0, 51, 62, 159, 160, 161, 0, - 162, 163, 0, 0, 164, 0, 0, 165, 166, 167, - 0, 0, 39, 39, 39, 39, 39, 39, 0, 39, - 39, 39, 59, 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, 23, 0, 0, 51, 157, 39, - 0, 0, 0, 39, 0, 39, 39, 0, 0, 119, - 25, 26, 27, 28, 86, 29, 30, 31, 0, 0, - 0, 32, 163, 0, 0, 164, 168, 0, 165, 166, - 167, 0, 38, 0, 39, 40, 41, 0, 0, 0, - 0, 42, 43, 44, 45, 46, 0, 0, 47, 48, - 0, 281, 0, 0, 0, 49, 157, 0, 150, 52, - 0, 53, 54, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 0, 0, 0, 32, 0, 0, - 0, 0, 0, 0, 168, 0, 0, 0, 38, 0, - 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, - 45, 46, 0, 0, 47, 48, 61, 0, 0, 61, - 0, 49, 0, 0, 0, 52, 150, 53, 54, 0, - 0, 0, 0, 61, 61, 0, 0, 0, 119, 25, - 26, 27, 28, 86, 29, 30, 31, 0, 50, 0, - 32, 61, 63, 60, 0, 55, 130, 64, 58, 0, - 57, 38, 0, 39, 40, 41, 0, 0, 61, 168, - 42, 43, 44, 45, 46, 0, 0, 0, 48, 62, - 0, 0, 0, 0, 49, 0, 0, 0, 52, 0, - 53, 54, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 150, 0, 0, 50, 0, 59, 61, 63, 60, - 0, 55, 0, 64, 58, 0, 57, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 151, 0, 0, 0, - 152, 153, 154, 155, 0, 62, 0, 0, 0, 0, - 0, 51, 0, 156, 158, 159, 160, 161, 0, 162, - 163, 0, 0, 164, 0, 0, 165, 166, 167, 0, - 0, 0, 59, 50, 134, 0, 61, 63, 60, 0, - 55, 0, 64, 58, 0, 57, 0, 0, 0, 0, - 0, 0, 0, 0, 151, 0, 0, 168, 152, 153, - 154, 155, 0, 0, 62, 0, 0, 51, 0, 0, - 0, 156, 158, 159, 160, 161, 0, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 0, 150, - 0, 59, 0, 50, 0, 0, 61, 63, 60, 0, - 55, 199, 64, 58, 0, 57, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 61, 61, 61, - 61, 0, 0, 0, 62, 0, 51, 0, 0, 0, - 0, 0, 0, 152, 153, 154, 155, 0, 0, 61, - 61, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 59, 162, 163, 32, 0, 164, 0, 0, 165, - 166, 167, 0, 0, 0, 38, 0, 39, 40, 41, - 0, 0, 0, 0, 42, 43, 44, 45, 46, 0, - 0, 47, 48, 0, 0, 0, 51, 0, 49, 0, - 0, 0, 52, 0, 53, 54, 0, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 0, 50, 0, - 32, 61, 63, 60, 0, 55, 246, 64, 58, 0, - 57, 38, 0, 39, 40, 41, 0, 0, 0, 0, - 42, 43, 44, 45, 46, 0, 0, 47, 48, 62, - 0, 0, 0, 0, 49, 0, 0, 0, 52, 0, - 53, 54, 0, 154, 155, 0, 22, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 59, 0, 0, 32, - 162, 163, 0, 0, 164, 0, 0, 165, 166, 167, - 38, 0, 39, 40, 41, 0, 0, 0, 0, 42, - 43, 44, 45, 46, 0, 134, 47, 48, 134, 0, - 0, 51, 0, 49, 0, 0, 0, 52, 0, 53, - 54, 0, 134, 134, 0, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 0, 50, 0, 32, - 61, 63, 60, 0, 55, 273, 64, 58, 0, 57, - 38, 0, 39, 40, 41, 0, 0, 134, 0, 42, - 43, 44, 45, 46, 0, 0, 47, 48, 62, 0, - 0, 0, 0, 49, 0, 0, 0, 52, 0, 53, - 54, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 59, 61, 63, 60, 0, - 55, 275, 64, 58, 0, 57, 0, 0, 0, 0, + 0, 51, 0, 60, 61, 63, 47, 0, 56, 0, + 64, 59, 0, 58, 152, 153, 154, 155, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 62, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 59, 50, 0, 32, 61, 63, 60, 0, 55, - 0, 64, 58, 0, 57, 38, 0, 39, 40, 41, - 0, 0, 0, 0, 42, 43, 44, 45, 46, 0, - 0, 47, 48, 62, 0, 0, 51, 0, 49, 0, - 0, 0, 52, 0, 53, 54, 0, 0, 0, 0, + 0, 0, 62, 162, 163, 0, 0, 164, 52, 0, + 165, 166, 167, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 60, + 61, 63, 47, 0, 56, 131, 64, 59, 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 59, 0, 50, 0, 0, 61, 63, 60, 0, 55, - 0, 64, 58, 0, 57, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 134, 134, 134, 134, - 0, 0, 23, 62, 0, 51, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 134, 134, + 151, 0, 0, 0, 152, 153, 154, 155, 62, 0, + 0, 23, 0, 0, 52, 0, 0, 156, 158, 159, + 160, 161, 0, 162, 163, 0, 0, 164, 0, 0, + 165, 166, 167, 0, 0, 60, 0, 0, 0, 0, + 51, 0, 0, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 52, 62, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 135, 32, 0, 0, 0, 168, 0, 0, 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, 52, 0, 50, 0, 150, 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, 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, - 59, 0, 0, 32, 130, 0, 0, 130, 0, 0, + 82, 82, 0, 32, 0, 82, 0, 0, 150, 0, 0, 0, 0, 0, 38, 0, 39, 40, 41, 0, - 0, 130, 130, 42, 43, 44, 45, 46, 0, 0, - 47, 48, 0, 168, 0, 51, 0, 49, 0, 0, - 0, 52, 0, 53, 54, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 130, 50, 0, 32, - 61, 63, 60, 0, 55, 150, 64, 58, 0, 57, - 38, 0, 39, 40, 41, 0, 0, 0, 0, 42, - 43, 44, 45, 46, 0, 0, 47, 48, 62, 0, - 0, 0, 0, 49, 0, 0, 0, 52, 0, 53, - 54, 0, 0, 0, 0, 0, 110, 25, 26, 27, - 28, 0, 29, 30, 31, 59, 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, 0, 48, 23, 0, 0, - 51, 0, 49, 0, 0, 0, 52, 0, 53, 54, - 0, 0, 0, 0, 0, 0, 24, 25, 26, 27, - 28, 168, 29, 30, 31, 0, 50, 0, 32, 61, - 63, 60, 0, 55, 0, 64, 58, 0, 57, 38, - 0, 39, 40, 41, 0, 0, 0, 0, 42, 43, - 44, 45, 46, 150, 0, 47, 48, 62, 0, 0, - 0, 0, 49, 0, 0, 0, 52, 0, 53, 54, - 0, 0, 0, 135, 0, 0, 135, 152, 153, 154, - 155, 0, 0, 0, 59, 130, 130, 130, 130, 0, - 135, 135, 0, 160, 161, 135, 162, 163, 0, 0, - 164, 0, 0, 165, 166, 167, 0, 130, 130, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 0, 0, 0, 135, 119, 135, 0, 119, 0, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 0, 119, 119, 32, 0, 0, 119, 0, 0, 0, - 0, 0, 0, 0, 38, 135, 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, 0, 0, - 0, 48, 0, 0, 119, 0, 119, 49, 0, 142, - 0, 52, 142, 53, 54, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 142, 142, 0, 0, - 0, 142, 0, 0, 0, 0, 119, 0, 0, 0, - 0, 0, 0, 0, 0, 152, 153, 154, 155, 0, - 0, 0, 60, 0, 0, 60, 0, 129, 0, 142, - 129, 142, 161, 0, 162, 163, 0, 0, 164, 60, - 60, 165, 166, 167, 129, 129, 0, 0, 0, 129, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 0, - 0, 142, 32, 0, 0, 0, 0, 0, 0, 0, - 0, 145, 0, 38, 60, 39, 40, 41, 0, 129, - 0, 0, 42, 43, 44, 45, 46, 0, 145, 145, - 48, 0, 0, 145, 0, 0, 49, 0, 0, 0, - 52, 0, 53, 54, 135, 135, 135, 135, 0, 129, - 0, 0, 0, 135, 0, 0, 0, 135, 135, 135, - 135, 145, 0, 145, 0, 0, 135, 135, 0, 0, - 135, 135, 135, 135, 135, 0, 135, 135, 0, 0, - 135, 0, 0, 135, 135, 135, 0, 0, 0, 0, - 0, 0, 0, 145, 0, 119, 119, 119, 119, 0, - 0, 0, 72, 0, 119, 72, 0, 0, 119, 119, - 119, 119, 0, 0, 0, 0, 0, 119, 119, 72, - 72, 119, 119, 119, 119, 119, 0, 119, 119, 0, - 0, 119, 0, 0, 119, 119, 119, 0, 0, 0, - 144, 0, 0, 144, 0, 0, 0, 0, 0, 0, - 142, 142, 142, 142, 72, 0, 0, 144, 144, 142, - 0, 0, 144, 142, 142, 142, 142, 0, 0, 0, - 0, 0, 142, 142, 0, 0, 142, 142, 142, 142, - 142, 0, 142, 142, 0, 0, 142, 0, 0, 142, - 142, 142, 144, 60, 60, 60, 60, 0, 129, 129, - 129, 129, 0, 0, 0, 0, 0, 129, 0, 0, - 0, 129, 129, 129, 129, 60, 60, 0, 0, 0, - 129, 129, 144, 0, 129, 129, 129, 129, 129, 0, - 129, 129, 97, 0, 129, 97, 0, 129, 129, 129, - 0, 0, 145, 145, 145, 145, 0, 0, 0, 97, - 97, 145, 0, 0, 97, 145, 145, 145, 145, 0, - 0, 0, 0, 0, 145, 145, 0, 0, 145, 145, - 145, 145, 145, 0, 145, 145, 59, 0, 145, 59, - 0, 145, 145, 145, 97, 0, 0, 0, 0, 0, - 0, 0, 0, 59, 59, 0, 0, 0, 59, 0, + 48, 49, 0, 0, 0, 82, 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, 0, 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, 154, 155, 48, 49, 62, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 0, 54, 55, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 0, 0, + 51, 0, 60, 61, 63, 47, 0, 56, 200, 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, + 152, 0, 154, 155, 0, 0, 51, 0, 60, 61, + 63, 47, 0, 56, 248, 64, 59, 0, 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, 276, 64, 59, + 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, + 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 22, 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, 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, 0, 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, 143, 0, 53, 143, 54, 55, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 143, + 143, 0, 32, 0, 143, 0, 0, 0, 119, 0, + 0, 0, 0, 38, 0, 39, 40, 41, 0, 0, + 0, 0, 42, 43, 44, 45, 46, 0, 0, 48, + 49, 0, 143, 0, 143, 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, 143, 32, 61, 63, 47, 0, + 56, 278, 64, 59, 0, 58, 38, 0, 39, 40, + 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, + 0, 0, 48, 49, 62, 0, 87, 87, 0, 50, + 0, 0, 0, 53, 0, 54, 55, 0, 103, 0, + 0, 0, 0, 87, 112, 0, 0, 0, 87, 51, + 121, 60, 61, 63, 47, 0, 56, 0, 64, 59, + 0, 58, 87, 87, 87, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 97, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 62, 0, 59, 0, - 0, 0, 0, 72, 72, 72, 72, 0, 0, 0, - 0, 0, 0, 62, 62, 0, 0, 0, 62, 0, - 0, 0, 0, 0, 0, 72, 72, 0, 59, 0, + 62, 0, 0, 0, 0, 0, 52, 119, 119, 119, + 119, 0, 0, 0, 0, 0, 119, 0, 0, 0, + 119, 119, 119, 119, 0, 0, 0, 60, 121, 119, + 119, 0, 0, 119, 119, 119, 119, 119, 0, 119, + 119, 0, 130, 119, 0, 130, 119, 119, 119, 0, + 0, 0, 0, 129, 0, 0, 129, 0, 0, 130, + 130, 0, 52, 143, 143, 143, 143, 0, 0, 0, + 129, 129, 143, 0, 0, 129, 143, 143, 143, 143, + 0, 0, 0, 0, 0, 143, 143, 0, 240, 143, + 143, 143, 143, 143, 130, 143, 143, 0, 104, 143, + 0, 104, 143, 143, 143, 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, 39, 40, 41, 0, 0, 0, 0, 42, + 43, 44, 45, 46, 0, 0, 48, 49, 0, 0, + 0, 0, 0, 50, 0, 145, 0, 53, 145, 54, + 55, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 145, 145, 0, 32, 0, 145, 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, 145, 0, 50, + 131, 0, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 131, 131, 0, + 0, 0, 131, 0, 0, 0, 0, 145, 0, 0, + 0, 0, 0, 130, 130, 130, 130, 0, 0, 0, + 0, 0, 0, 0, 129, 129, 129, 129, 0, 0, + 131, 0, 131, 129, 0, 130, 130, 129, 129, 129, + 129, 0, 0, 0, 0, 0, 129, 129, 0, 0, + 129, 129, 129, 129, 129, 0, 129, 129, 0, 0, + 129, 0, 131, 129, 129, 129, 0, 0, 0, 104, + 104, 104, 104, 0, 0, 0, 0, 0, 104, 0, + 0, 0, 104, 104, 104, 104, 0, 0, 0, 0, + 0, 104, 104, 0, 146, 104, 104, 104, 104, 104, + 0, 104, 104, 0, 0, 104, 0, 0, 104, 104, + 104, 146, 146, 0, 0, 0, 146, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 144, 144, 144, 144, 0, 62, 0, 62, 0, - 144, 0, 0, 0, 144, 144, 144, 144, 0, 0, - 0, 0, 0, 144, 144, 0, 0, 144, 144, 144, - 144, 144, 96, 144, 144, 96, 0, 144, 62, 0, - 144, 144, 144, 0, 0, 0, 0, 0, 0, 96, - 96, 0, 0, 0, 96, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 146, 0, 146, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 145, 145, 145, 145, + 0, 0, 0, 0, 0, 145, 0, 0, 0, 145, + 145, 145, 145, 0, 0, 0, 146, 0, 145, 145, + 0, 0, 145, 145, 145, 145, 145, 0, 145, 145, + 59, 0, 145, 59, 0, 145, 145, 145, 0, 0, + 0, 96, 0, 0, 96, 0, 0, 59, 59, 0, + 0, 131, 131, 131, 131, 0, 0, 0, 96, 96, + 131, 0, 0, 96, 131, 131, 131, 131, 0, 0, + 0, 0, 0, 131, 131, 0, 0, 131, 131, 131, + 131, 131, 59, 131, 131, 0, 0, 131, 0, 0, + 131, 131, 131, 96, 58, 0, 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 144, 96, 0, 144, 0, 0, 0, - 0, 0, 0, 97, 97, 97, 97, 0, 0, 0, - 144, 144, 97, 0, 0, 144, 97, 97, 97, 97, - 0, 0, 0, 0, 96, 97, 97, 0, 0, 97, - 97, 97, 97, 97, 0, 97, 97, 131, 0, 97, - 131, 0, 97, 97, 97, 144, 0, 59, 59, 59, - 59, 0, 0, 0, 131, 131, 59, 0, 0, 131, - 59, 59, 59, 59, 0, 0, 0, 0, 0, 59, - 59, 0, 0, 59, 59, 59, 59, 59, 0, 59, - 59, 0, 252, 59, 0, 253, 59, 59, 59, 131, - 0, 0, 0, 0, 0, 0, 0, 62, 62, 62, - 62, 0, 0, 0, 157, 0, 62, 0, 0, 0, - 62, 62, 62, 62, 0, 0, 0, 0, 0, 62, - 62, 0, 0, 62, 62, 62, 62, 62, 103, 62, - 62, 103, 168, 62, 0, 0, 62, 62, 62, 0, - 0, 0, 0, 0, 0, 103, 103, 0, 0, 0, - 103, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 150, 0, 0, 0, 0, 0, - 0, 0, 0, 96, 96, 96, 96, 0, 0, 0, - 103, 0, 96, 0, 0, 0, 96, 96, 96, 96, - 0, 0, 0, 0, 0, 96, 96, 0, 0, 96, - 96, 96, 96, 96, 0, 96, 96, 0, 0, 96, - 0, 0, 96, 96, 96, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 144, 144, 144, 144, 0, 0, - 0, 0, 0, 144, 0, 0, 0, 144, 144, 144, - 144, 0, 0, 0, 0, 0, 144, 144, 0, 0, - 144, 144, 144, 144, 144, 0, 144, 144, 109, 0, - 144, 109, 0, 144, 144, 144, 0, 0, 131, 131, - 131, 131, 0, 0, 0, 109, 109, 131, 0, 0, - 109, 131, 131, 131, 131, 0, 0, 0, 0, 0, - 131, 131, 0, 0, 131, 131, 131, 131, 131, 0, - 131, 131, 0, 93, 131, 0, 93, 131, 131, 131, - 109, 0, 0, 0, 0, 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, 157, 0, 0, 103, - 103, 103, 103, 0, 0, 0, 0, 0, 103, 0, - 0, 0, 103, 103, 103, 103, 0, 0, 0, 0, - 0, 103, 103, 0, 168, 103, 103, 103, 103, 103, - 94, 103, 103, 94, 0, 103, 0, 0, 103, 103, - 103, 0, 0, 0, 0, 0, 0, 94, 94, 0, - 0, 0, 94, 0, 0, 0, 150, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 88, 0, 0, - 88, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 94, 0, 88, 88, 0, 0, 0, 88, + 0, 58, 58, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 96, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 95, 0, 0, + 95, 0, 0, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 0, 95, 95, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 146, 146, 146, 146, 0, + 0, 0, 0, 0, 146, 0, 58, 0, 146, 146, + 146, 146, 0, 0, 0, 61, 0, 146, 146, 95, + 0, 146, 146, 146, 146, 146, 0, 146, 146, 0, + 0, 146, 61, 61, 146, 146, 146, 61, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 0, 0, 145, 0, 0, + 145, 0, 0, 0, 0, 61, 0, 61, 0, 0, + 0, 0, 0, 0, 145, 145, 0, 0, 0, 145, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 59, 59, 59, 59, 0, 0, 61, 0, 0, + 0, 0, 96, 96, 96, 96, 0, 0, 0, 145, + 0, 96, 0, 59, 59, 96, 96, 96, 96, 0, + 0, 0, 0, 0, 96, 96, 0, 0, 96, 96, + 96, 96, 96, 0, 96, 96, 0, 0, 96, 0, + 0, 96, 96, 96, 0, 132, 0, 0, 132, 0, + 0, 0, 0, 0, 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, 95, 95, + 95, 95, 0, 0, 0, 71, 0, 95, 71, 0, + 0, 95, 95, 95, 95, 0, 0, 0, 0, 0, + 95, 95, 71, 71, 95, 95, 95, 95, 95, 0, + 95, 95, 0, 0, 95, 0, 0, 95, 95, 95, + 0, 0, 0, 0, 0, 0, 61, 61, 61, 61, + 0, 0, 0, 0, 0, 61, 0, 71, 0, 61, + 61, 61, 61, 0, 0, 0, 0, 0, 61, 61, + 0, 157, 61, 61, 61, 61, 61, 0, 61, 61, + 0, 0, 61, 0, 0, 61, 61, 61, 145, 145, + 145, 145, 0, 0, 0, 0, 0, 145, 0, 168, + 0, 145, 145, 145, 145, 0, 0, 0, 0, 0, + 145, 145, 0, 0, 145, 145, 145, 145, 145, 102, + 145, 145, 102, 0, 145, 0, 0, 145, 145, 145, + 0, 150, 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, 0, 0, 0, 0, 0, 0, 88, - 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, 0, 0, 0, - 0, 109, 109, 0, 0, 109, 109, 109, 109, 109, - 0, 109, 109, 89, 0, 109, 89, 0, 109, 109, - 109, 0, 0, 0, 93, 93, 93, 93, 0, 0, - 89, 89, 0, 93, 0, 89, 0, 93, 93, 93, - 93, 0, 0, 0, 0, 0, 93, 93, 0, 0, - 93, 93, 93, 93, 93, 90, 93, 93, 90, 0, - 93, 0, 0, 0, 151, 89, 0, 0, 152, 153, - 154, 155, 90, 90, 0, 0, 0, 90, 0, 0, - 0, 0, 158, 159, 160, 161, 0, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, - 86, 0, 0, 86, 0, 0, 0, 90, 0, 0, - 0, 94, 94, 94, 94, 0, 0, 86, 86, 0, - 94, 0, 86, 0, 94, 94, 94, 94, 0, 0, - 0, 0, 0, 94, 94, 0, 0, 94, 94, 94, - 94, 94, 0, 94, 94, 0, 0, 94, 88, 88, - 88, 88, 86, 0, 0, 0, 0, 88, 0, 0, - 0, 88, 88, 88, 88, 87, 0, 0, 87, 0, - 88, 88, 0, 0, 88, 88, 88, 88, 88, 0, - 88, 88, 87, 87, 0, 0, 0, 87, 0, 0, + 0, 0, 0, 0, 0, 0, 109, 0, 0, 109, + 0, 102, 0, 0, 0, 0, 132, 132, 132, 132, + 0, 0, 0, 109, 109, 132, 0, 0, 109, 132, + 132, 132, 132, 0, 0, 0, 0, 0, 132, 132, + 0, 0, 132, 132, 132, 132, 132, 0, 132, 132, + 92, 0, 132, 92, 0, 132, 132, 132, 109, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 92, 0, + 0, 0, 92, 0, 0, 0, 71, 71, 71, 71, + 0, 0, 0, 0, 0, 0, 0, 93, 0, 0, + 93, 0, 0, 0, 0, 0, 0, 0, 71, 71, + 0, 0, 92, 0, 93, 93, 0, 0, 0, 93, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 87, 0, 0, 87, 0, 151, + 0, 0, 0, 152, 153, 154, 155, 0, 0, 93, + 0, 87, 87, 0, 0, 0, 87, 158, 159, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 88, 0, 0, 88, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 87, 0, 0, 88, + 88, 0, 0, 0, 88, 0, 0, 0, 0, 0, + 102, 102, 102, 102, 0, 0, 0, 0, 0, 102, + 0, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 0, 0, 102, 102, 88, 0, 102, 102, 102, 102, + 102, 0, 102, 102, 0, 0, 102, 0, 0, 102, + 102, 102, 0, 0, 0, 0, 0, 109, 109, 109, + 109, 0, 0, 0, 0, 0, 109, 0, 0, 0, + 109, 109, 109, 109, 0, 0, 0, 0, 0, 109, + 109, 0, 0, 109, 109, 109, 109, 109, 0, 109, + 109, 89, 0, 109, 89, 0, 109, 109, 109, 0, + 0, 92, 92, 92, 92, 0, 0, 0, 89, 89, + 92, 0, 0, 89, 92, 92, 92, 92, 0, 0, + 0, 0, 0, 92, 92, 0, 0, 92, 92, 92, + 92, 92, 0, 92, 92, 0, 0, 92, 93, 93, + 93, 93, 0, 89, 0, 0, 0, 93, 0, 0, + 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, + 93, 93, 0, 0, 93, 93, 93, 93, 93, 0, + 93, 93, 0, 0, 93, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 87, 0, 0, 0, 87, 87, + 87, 87, 0, 0, 0, 0, 0, 87, 87, 0, + 0, 87, 87, 87, 87, 87, 0, 87, 87, 0, + 0, 0, 0, 88, 88, 88, 88, 0, 0, 0, + 0, 0, 88, 0, 0, 0, 88, 88, 88, 88, + 85, 0, 0, 85, 0, 88, 88, 0, 0, 88, + 88, 88, 88, 88, 0, 88, 88, 85, 85, 0, + 0, 0, 85, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 86, 0, 0, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 85, 0, 0, 85, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 87, 0, 85, - 85, 0, 0, 0, 85, 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, 0, 0, 89, 89, 89, 89, 0, 0, - 0, 0, 0, 89, 85, 0, 0, 89, 89, 89, - 89, 0, 0, 0, 0, 0, 89, 89, 0, 0, - 89, 89, 89, 89, 89, 73, 89, 89, 73, 0, - 0, 0, 0, 0, 0, 0, 90, 90, 90, 90, - 0, 0, 73, 73, 0, 90, 0, 73, 0, 90, - 90, 90, 90, 0, 0, 0, 0, 0, 90, 90, - 0, 0, 90, 90, 90, 90, 90, 0, 90, 90, - 75, 0, 0, 75, 0, 0, 0, 73, 0, 0, - 0, 86, 86, 86, 86, 0, 0, 75, 75, 0, - 86, 0, 75, 0, 86, 86, 86, 86, 0, 0, - 0, 0, 0, 86, 86, 0, 0, 86, 86, 86, - 86, 86, 76, 86, 86, 76, 0, 0, 0, 0, - 0, 0, 75, 0, 0, 0, 0, 0, 0, 76, - 76, 0, 0, 0, 76, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 87, 87, 87, 87, - 0, 0, 0, 0, 0, 87, 0, 0, 0, 87, - 87, 87, 87, 0, 76, 0, 0, 0, 87, 87, - 0, 0, 87, 87, 87, 87, 87, 0, 87, 87, - 0, 0, 0, 85, 85, 85, 85, 0, 0, 0, - 0, 0, 85, 0, 0, 0, 85, 85, 85, 85, - 123, 0, 0, 123, 0, 85, 85, 0, 0, 85, - 85, 85, 85, 85, 0, 85, 85, 123, 123, 0, - 0, 0, 123, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 95, 0, 0, 95, 0, 0, - 0, 0, 123, 0, 0, 0, 73, 73, 73, 73, - 0, 95, 95, 0, 0, 73, 95, 0, 0, 73, - 73, 73, 73, 0, 0, 0, 0, 0, 73, 73, - 0, 0, 73, 73, 73, 73, 73, 0, 73, 73, - 133, 0, 0, 133, 0, 0, 95, 0, 0, 0, - 0, 75, 75, 75, 75, 0, 0, 133, 133, 0, - 75, 0, 133, 0, 75, 75, 0, 75, 0, 0, - 0, 0, 0, 75, 75, 0, 0, 75, 75, 75, - 75, 75, 77, 75, 0, 77, 0, 0, 0, 0, - 0, 0, 133, 76, 76, 76, 76, 0, 0, 77, - 77, 0, 76, 0, 77, 0, 76, 76, 0, 0, - 0, 0, 0, 0, 78, 76, 76, 78, 0, 76, - 76, 76, 76, 76, 79, 76, 0, 79, 0, 0, - 0, 78, 78, 0, 77, 0, 78, 0, 0, 0, - 0, 79, 79, 0, 0, 0, 79, 0, 0, 0, + 84, 0, 0, 84, 0, 0, 0, 0, 86, 0, + 0, 0, 89, 89, 89, 89, 0, 84, 84, 0, + 0, 89, 84, 0, 0, 89, 89, 89, 89, 0, + 0, 0, 0, 0, 89, 89, 0, 0, 89, 89, + 89, 89, 89, 72, 89, 89, 72, 0, 0, 0, + 0, 0, 84, 0, 0, 0, 0, 0, 0, 0, + 72, 72, 0, 0, 0, 72, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 73, + 0, 0, 73, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 72, 73, 73, 0, 0, + 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 75, 0, 0, 75, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 78, 0, 0, 80, - 0, 0, 80, 0, 0, 0, 79, 0, 0, 0, - 0, 123, 123, 123, 123, 0, 80, 80, 0, 0, - 123, 80, 0, 0, 123, 123, 0, 0, 0, 0, - 0, 0, 0, 123, 123, 0, 0, 123, 123, 123, - 123, 123, 0, 82, 0, 0, 82, 0, 0, 0, - 0, 80, 0, 0, 0, 95, 95, 95, 95, 0, - 82, 82, 0, 0, 95, 82, 0, 0, 95, 95, - 0, 0, 0, 0, 0, 0, 0, 95, 95, 0, - 0, 95, 95, 95, 95, 95, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 82, 0, 0, 0, 0, - 0, 133, 133, 133, 133, 0, 0, 0, 0, 0, - 133, 0, 0, 0, 133, 133, 0, 0, 0, 0, - 0, 0, 0, 133, 133, 0, 0, 133, 133, 133, - 133, 133, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 77, 77, 77, 77, 0, 0, 0, - 0, 0, 77, 0, 0, 0, 0, 77, 0, 0, - 0, 0, 0, 0, 0, 77, 77, 0, 0, 77, - 77, 77, 77, 77, 0, 78, 78, 78, 78, 0, - 0, 0, 0, 0, 78, 79, 79, 79, 79, 0, - 0, 0, 0, 0, 79, 0, 0, 78, 78, 0, - 0, 78, 78, 78, 78, 78, 0, 79, 79, 0, - 0, 79, 79, 79, 79, 79, 0, 0, 0, 0, - 0, 92, 0, 0, 0, 0, 0, 0, 0, 105, - 80, 80, 80, 80, 112, 114, 0, 0, 0, 80, - 124, 125, 126, 127, 128, 129, 0, 0, 132, 133, - 0, 0, 80, 80, 0, 0, 80, 80, 80, 80, + 0, 73, 0, 75, 75, 0, 0, 0, 75, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 82, 82, 82, 82, 0, 0, - 0, 0, 182, 82, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 82, 82, 0, 0, - 82, 82, 82, 0, 0, 0, 0, 0, 0, 0, + 0, 85, 85, 85, 85, 0, 0, 0, 0, 0, + 85, 0, 0, 0, 85, 85, 85, 85, 75, 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, 123, 0, 0, 123, 0, 86, + 86, 0, 0, 86, 86, 86, 86, 86, 0, 86, + 86, 123, 123, 0, 0, 0, 123, 0, 0, 0, + 0, 84, 84, 84, 84, 0, 0, 0, 0, 0, + 84, 0, 0, 0, 84, 84, 84, 84, 0, 0, + 0, 0, 0, 84, 84, 0, 123, 84, 84, 84, + 84, 84, 94, 84, 84, 94, 0, 0, 0, 0, + 0, 0, 0, 0, 72, 72, 72, 72, 0, 94, + 94, 0, 0, 72, 94, 0, 0, 72, 72, 72, + 72, 0, 0, 0, 0, 0, 72, 72, 0, 0, + 72, 72, 72, 72, 72, 0, 72, 72, 0, 0, + 73, 73, 73, 73, 94, 0, 0, 0, 0, 73, + 0, 0, 0, 73, 73, 73, 73, 0, 0, 0, + 0, 0, 73, 73, 0, 0, 73, 73, 73, 73, + 73, 134, 73, 0, 134, 0, 0, 75, 75, 75, + 75, 0, 0, 0, 0, 0, 75, 0, 134, 134, + 75, 75, 0, 134, 0, 0, 0, 0, 0, 75, + 75, 0, 0, 75, 75, 75, 75, 75, 76, 75, + 0, 76, 0, 0, 0, 0, 0, 0, 77, 0, + 0, 77, 0, 134, 0, 76, 76, 0, 0, 0, + 76, 0, 0, 0, 0, 77, 77, 0, 0, 0, + 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 78, 0, 0, 78, 0, 0, + 76, 0, 0, 0, 0, 123, 123, 123, 123, 0, + 77, 78, 78, 0, 123, 0, 78, 0, 123, 123, + 0, 0, 0, 0, 0, 0, 79, 123, 123, 79, + 0, 123, 123, 123, 123, 123, 81, 0, 0, 81, + 0, 0, 0, 79, 79, 0, 78, 0, 79, 0, + 0, 0, 0, 81, 81, 0, 0, 0, 81, 0, + 0, 0, 0, 94, 94, 94, 94, 0, 0, 284, + 0, 0, 94, 0, 157, 0, 94, 94, 79, 0, + 0, 0, 0, 0, 0, 94, 94, 0, 81, 94, + 94, 94, 94, 94, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 214, 0, 0, 0, 0, 0, - 0, 0, 222, 223, 224, 225, 226, 227, 228, 229, - 230, 231, 232, 233, 234, 235, 0, 0, 0, 0, + 0, 0, 0, 0, 150, 0, 0, 0, 0, 0, + 0, 0, 134, 134, 134, 134, 0, 0, 0, 0, + 0, 134, 0, 0, 0, 134, 134, 0, 0, 0, + 0, 0, 0, 0, 134, 134, 0, 0, 134, 134, + 134, 134, 134, 0, 0, 0, 0, 0, 0, 76, + 76, 76, 76, 0, 0, 0, 0, 0, 76, 77, + 77, 77, 77, 76, 0, 0, 0, 0, 77, 0, + 0, 76, 76, 0, 0, 76, 76, 76, 76, 76, + 0, 77, 77, 0, 0, 77, 77, 77, 77, 77, + 0, 0, 0, 0, 0, 78, 78, 78, 78, 0, + 0, 0, 0, 0, 78, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 78, 78, 0, + 0, 78, 78, 78, 78, 78, 0, 79, 79, 79, + 79, 0, 0, 0, 0, 0, 79, 81, 81, 81, + 81, 0, 0, 0, 0, 0, 81, 0, 0, 79, + 79, 0, 0, 79, 79, 79, 79, 0, 0, 81, + 81, 0, 151, 81, 81, 81, 152, 153, 154, 155, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 156, + 158, 159, 160, 161, 0, 162, 163, 91, 0, 164, + 0, 0, 165, 166, 167, 104, 0, 0, 0, 0, + 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 183, 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, + 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, 292, 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, 308, + 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, 296, 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, 312, }; short yycheck[] = { 13, - 36, 41, 93, 17, 59, 36, 41, 91, 41, 44, - 0, 41, 123, 93, 40, 93, 59, 59, 181, 33, - 34, 35, 36, 58, 59, 91, 48, 40, 63, 43, - 40, 91, 193, 125, 187, 49, 189, 294, 295, 123, - 40, 59, 41, 33, 41, 40, 36, 37, 38, 21, - 40, 257, 42, 43, 41, 45, 41, 123, 93, 41, - 91, 41, 41, 123, 78, 91, 0, 89, 6, 59, - 257, 36, 59, 41, 64, 40, 48, 59, 41, 93, - 59, 123, 96, 59, 98, 40, 100, 123, 102, 41, - 40, 59, 123, 31, 32, 117, 59, 123, 41, 33, - 41, 91, 36, 37, 38, 123, 40, 40, 42, 43, - 123, 45, 41, 123, 41, 40, 257, 89, 276, 277, - 44, 284, 0, 123, 41, 59, 278, 141, 123, 44, - 64, 40, 123, 123, 295, 125, 126, 298, 59, 260, - 293, 294, 59, 59, 40, 117, 257, 300, 40, 40, - 122, 41, 125, 41, 91, 33, 59, 91, 36, 37, - 38, 183, 40, 177, 42, 43, 41, 45, 329, 322, - 184, 125, 91, 59, 266, 267, 268, 295, 270, 271, - 40, 59, 40, 266, 267, 268, 64, 270, 271, 123, - 41, 125, 126, 125, 125, 125, 59, 125, 41, 41, - 59, 123, 257, 294, 295, 59, 41, 59, 41, 44, - 59, 183, 41, 91, 294, 295, 294, 295, 59, 59, - 41, 257, 41, 58, 59, 93, 262, 258, 63, 313, - 320, 59, 272, 273, 274, 275, 84, 272, 273, 274, - 275, 13, 256, 266, 258, 123, 260, 261, 126, 94, - 264, 294, 295, 267, 294, 295, 93, -1, 93, 294, - 295, 294, 295, 298, 294, 295, 256, 257, 258, 259, - 260, 261, -1, 263, 264, 265, 266, 267, 268, 269, - 270, 271, 272, 273, 274, 275, -1, 301, -1, 279, - 280, -1, 282, 283, 284, 294, 295, 294, 295, 289, - 290, 291, 292, 293, -1, -1, 296, 297, -1, 294, - 295, 93, 326, 303, 294, 295, 330, 307, -1, 309, - 310, -1, 256, 257, 258, 259, 260, 261, 93, 263, + 257, 13, 91, 17, 44, 41, 59, 182, 36, 41, + 59, 257, 44, 194, 41, 188, 59, 190, 41, 33, + 34, 35, 36, 59, 82, 40, 58, 59, 41, 43, + 88, 63, 125, 45, 123, 59, 50, 40, 59, 59, + 40, 91, 123, 91, 56, 41, 257, 41, 60, 41, + 41, 41, 278, 41, 36, 41, 44, 93, 116, 40, + 91, 93, 41, 91, 78, 41, 40, 40, 59, 41, + 58, 59, 40, 123, 123, 123, 91, 41, 92, 41, + 40, 95, 94, 97, 96, 99, 98, 101, 100, 41, + 102, 40, 123, 41, 106, 123, 44, 59, 41, 123, + 59, 41, 294, 295, 41, 93, 0, 59, 123, 59, + 58, 59, 287, 59, 44, 59, 59, 59, 299, 59, + 123, 302, 59, 123, 297, 298, 184, 141, 276, 277, + 123, 304, 144, 145, 146, 147, 148, 149, 150, 33, + 40, 123, 36, 37, 38, 93, 40, 260, 42, 43, + 123, 45, 123, 334, 327, 93, 168, 169, 170, 171, + 172, 173, 174, 123, 178, 59, 40, 40, 36, 0, + 64, 185, 40, 266, 267, 268, 257, 270, 271, 41, + 40, 93, 91, 266, 267, 268, 198, 270, 271, 125, + 93, 41, 204, 205, 206, 59, 59, 91, 287, 211, + 41, 125, 33, 91, 257, 36, 37, 38, 295, 40, + 93, 42, 43, 40, 45, 41, 305, 40, 125, 308, + 125, 125, 311, 312, 313, 237, 125, 239, 59, 123, + 258, 125, 126, 64, 59, 125, 272, 273, 274, 275, + 272, 273, 274, 275, 93, 259, 41, 261, 41, 263, + 264, 294, 295, 267, 294, 295, 270, 269, 294, 295, + 91, 41, 294, 295, 44, 313, 298, 294, 295, 93, + 282, 294, 295, 294, 295, 257, 272, 273, 274, 275, + 262, 294, 295, 63, 272, 273, 274, 275, 59, 301, + 123, 305, 123, 41, 125, 126, 0, 93, 294, 295, + 294, 295, 294, 295, 294, 295, 294, 295, 294, 295, + 298, 91, 59, 325, 41, 294, 295, 331, 294, 295, + 59, 335, 294, 295, 272, 273, 274, 275, 41, 33, + 294, 295, 36, 37, 38, 59, 40, 83, 42, 43, + 41, 45, 325, 123, 294, 295, 294, 295, 294, 295, + 294, 295, 294, 295, 13, 59, 294, 295, 269, 93, + 64, -1, 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, 294, 295, 294, 295, 289, 290, 291, 292, 293, - -1, -1, 296, 297, -1, 294, 295, 294, 295, 303, - 294, 295, 41, 307, -1, 309, 310, -1, 256, 257, - 258, 259, 260, 261, -1, 263, 264, 265, 13, 41, - 59, 269, 44, -1, 272, 273, 274, 275, -1, 41, - -1, 279, 280, -1, 282, 283, 284, 59, 294, 295, - -1, 289, 290, 291, 292, 293, -1, -1, 296, 297, - 45, 63, 47, -1, 93, 303, 294, 295, -1, 307, - 55, 309, 310, -1, 59, 294, 295, 272, 273, 274, - 275, 93, 294, 295, 41, -1, 281, 44, -1, 91, - 285, 286, 287, 288, 294, 295, -1, 294, 295, 294, - 295, 58, 59, 298, 299, 300, 301, 302, -1, 304, - 95, 91, 97, -1, 99, -1, 101, -1, 103, -1, - 33, 123, 107, 36, 37, 38, -1, 40, 41, 42, - 43, 44, 45, -1, -1, -1, 93, -1, -1, -1, - -1, -1, -1, 123, -1, 58, 59, -1, -1, -1, - 63, 64, 294, 295, -1, -1, -1, -1, -1, 144, - 145, 146, 147, 148, 149, 150, -1, -1, -1, 294, - 295, -1, -1, -1, -1, -1, 41, -1, 91, 44, - 93, -1, -1, 168, 169, 170, 171, 172, 173, -1, - -1, -1, -1, 58, 59, -1, 33, 91, 63, 36, - 37, 38, -1, 40, 41, 42, 43, 44, 45, -1, - 123, -1, 197, 126, 272, 273, 274, 275, 203, 204, - 205, 58, 59, -1, -1, 210, 63, 64, 93, 123, - -1, -1, -1, -1, -1, -1, 294, 295, -1, -1, - -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, - -1, 236, -1, 238, -1, -1, 93, -1, -1, -1, - 272, 273, 274, 275, 33, 294, 295, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, -1, -1, 281, - -1, 266, 294, 285, 286, 287, 288, -1, -1, 126, - 59, -1, -1, -1, 279, 64, 298, 299, 300, 301, - 302, -1, 304, 305, -1, 285, 308, 287, 288, 311, - 312, 313, 297, -1, -1, 272, 273, 274, 275, -1, - -1, -1, 91, -1, 304, 305, -1, -1, 308, -1, - -1, 311, 312, 313, -1, 320, -1, 294, 295, -1, - -1, 298, -1, -1, 257, 258, 259, 260, 261, -1, - 263, 264, 265, -1, 123, -1, 269, 126, -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, 287, 307, 308, 309, 310, 311, 312, - 313, -1, -1, -1, -1, -1, -1, 272, 273, 274, - 275, 305, -1, -1, 308, -1, 281, 311, 312, 313, - 257, 258, 259, 260, 261, -1, 263, 264, 265, 294, - 295, -1, 269, 298, 299, 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, 91, - 307, 308, 309, 310, 311, 312, 313, -1, -1, -1, - -1, -1, -1, -1, 91, -1, -1, 256, 257, 258, + 274, 275, 294, 295, -1, 279, 280, 91, 282, 283, + 284, 294, 295, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 41, -1, -1, 44, 303, + -1, 294, 295, 307, -1, 309, 310, -1, -1, 123, + -1, -1, 126, 59, 91, 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, 91, -1, 123, 93, 289, 290, + 291, 292, 293, -1, -1, 296, 297, -1, -1, -1, + 294, 295, 303, -1, -1, -1, 307, -1, 309, 310, + 272, 273, 274, 275, 33, 91, 123, 36, 37, 38, + -1, 40, 41, 42, 43, 44, 45, -1, 294, 295, + -1, 281, 294, 295, -1, 285, 286, 287, 288, 58, + 59, 6, -1, 8, 63, 64, -1, 123, 298, 299, + 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, + -1, 311, 312, 313, -1, -1, 31, 32, -1, -1, + -1, -1, 91, -1, 93, 41, -1, -1, 44, -1, + -1, 91, 256, 257, 258, 259, 260, 261, -1, 263, + 264, 265, 58, 59, -1, 269, -1, 63, 272, 273, + 274, 275, -1, -1, 123, 279, 280, 126, 282, 283, + 284, -1, -1, 123, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 91, -1, 93, -1, 303, + -1, -1, -1, 307, 33, 309, 310, 36, 37, 38, + -1, 40, 41, 42, 43, 44, 45, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 123, -1, 58, + 59, -1, -1, -1, 63, 64, 272, 273, 274, 275, + -1, 308, -1, -1, 311, 312, 313, -1, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, 294, -1, + -1, -1, -1, -1, 93, 302, -1, 304, 305, -1, + 41, 308, -1, 44, 311, 312, 313, -1, -1, 285, + 286, 287, 288, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, 299, 300, 301, 302, 126, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, - 269, 123, -1, 272, 273, 274, 275, -1, -1, -1, - 279, 280, -1, 282, 283, 284, 123, -1, 91, -1, - 289, 290, 291, 292, 293, -1, -1, 296, 297, -1, - -1, -1, -1, -1, 303, -1, -1, 91, 307, 33, - 309, 310, 36, 37, 38, 26, 40, -1, 42, 43, - 123, 45, -1, -1, 25, 26, -1, -1, -1, -1, - -1, 42, -1, -1, -1, 59, 37, 48, -1, 123, - 64, 42, 43, -1, -1, -1, -1, 48, -1, 60, - 61, 62, 63, 64, -1, -1, -1, -1, -1, 60, - 61, 62, 63, 64, -1, 33, -1, 91, 36, 37, + 269, -1, 93, 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, 305, -1, -1, 308, 91, + -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, 123, 298, 299, 300, 301, 302, -1, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 91, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, + 123, 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, 33, 48, 49, 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 91, -1, - -1, -1, -1, -1, -1, -1, 64, 108, -1, 123, - -1, -1, 126, -1, -1, -1, -1, 108, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 123, 33, -1, 91, 36, 37, 38, -1, 40, -1, - 42, 43, -1, 45, -1, 287, 288, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 59, 285, 286, - 287, 288, 64, 305, -1, 123, 308, -1, 126, 311, - 312, 313, 299, 300, 301, 302, 167, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, -1, 91, - -1, -1, -1, -1, 33, -1, -1, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, - -1, 285, 286, 287, 288, 308, -1, -1, 311, 312, - 313, -1, -1, -1, 126, 64, 300, 301, 302, -1, - 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, - -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, 123, -1, -1, 126, 63, 303, - -1, -1, -1, 307, -1, 309, 310, -1, -1, 257, - 258, 259, 260, 261, 262, 263, 264, 265, -1, -1, - -1, 269, 305, -1, -1, 308, 91, -1, 311, 312, - 313, -1, 280, -1, 282, 283, 284, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, 59, -1, -1, 285, 286, 64, 288, -1, -1, + 82, -1, -1, 294, 295, -1, 88, 298, 299, 300, + 301, 302, -1, 304, -1, -1, -1, -1, -1, -1, + -1, 33, -1, 91, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 116, -1, -1, -1, -1, -1, + -1, 123, -1, 285, 286, 287, 288, 59, -1, -1, + -1, -1, 64, -1, -1, 123, -1, -1, 126, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -1, -1, -1, -1, -1, 33, -1, 91, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -1, -1, -1, -1, 287, 288, -1, -1, -1, -1, + -1, -1, 184, -1, -1, -1, -1, -1, 64, -1, + -1, 123, 305, -1, 126, 308, -1, -1, 311, 312, + 313, -1, -1, -1, 41, -1, -1, 44, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 26, -1, -1, + 33, 58, 59, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, 42, -1, -1, -1, -1, 47, -1, + 49, -1, -1, -1, -1, -1, -1, 123, -1, -1, + 126, 64, 61, 62, 63, 64, 93, -1, -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, 107, -1, -1, 289, 290, 291, 292, 293, -1, -1, 296, 297, - -1, 58, -1, -1, -1, 303, 63, -1, 123, 307, - -1, 309, 310, -1, -1, 257, 258, 259, 260, 261, + 123, -1, -1, 126, 91, 303, -1, -1, -1, 307, + -1, 309, 310, -1, 256, 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, 269, -1, -1, - -1, -1, -1, -1, 91, -1, -1, -1, 280, -1, + 272, 273, 274, 275, -1, -1, 123, 279, 280, -1, 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, - 292, 293, -1, -1, 296, 297, 41, -1, -1, 44, - -1, 303, -1, -1, -1, 307, 123, 309, 310, -1, - -1, -1, -1, 58, 59, -1, -1, -1, 257, 258, - 259, 260, 261, 262, 263, 264, 265, -1, 33, -1, - 269, 36, 37, 38, -1, 40, 41, 42, 43, -1, - 45, 280, -1, 282, 283, 284, -1, -1, 93, 91, - 289, 290, 291, 292, 293, -1, -1, -1, 297, 64, - -1, -1, -1, -1, 303, -1, -1, -1, 307, -1, - 309, 310, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 123, -1, -1, 33, -1, 91, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 281, -1, -1, -1, - 285, 286, 287, 288, -1, 64, -1, -1, -1, -1, - -1, 126, -1, 298, 299, 300, 301, 302, -1, 304, - 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, - -1, -1, 91, 33, 93, -1, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, - -1, -1, -1, -1, 281, -1, -1, 91, 285, 286, - 287, 288, -1, -1, 64, -1, -1, 126, -1, -1, - -1, 298, 299, 300, 301, 302, -1, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, -1, 123, - -1, 91, -1, 33, -1, -1, 36, 37, 38, -1, - 40, 41, 42, 43, -1, 45, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 272, 273, 274, - 275, -1, -1, -1, 64, -1, 126, -1, -1, -1, - -1, -1, -1, 285, 286, 287, 288, -1, -1, 294, - 295, -1, 257, 258, 259, 260, 261, -1, 263, 264, - 265, 91, 304, 305, 269, -1, 308, -1, -1, 311, - 312, 313, -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, - -1, -1, 307, -1, 309, 310, -1, -1, 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, -1, - 289, 290, 291, 292, 293, -1, -1, 296, 297, 64, - -1, -1, -1, -1, 303, -1, -1, -1, 307, -1, - 309, 310, -1, 287, 288, -1, 256, 257, 258, 259, - 260, 261, -1, 263, 264, 265, 91, -1, -1, 269, - 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, - 280, -1, 282, 283, 284, -1, -1, -1, -1, 289, - 290, 291, 292, 293, -1, 41, 296, 297, 44, -1, - -1, 126, -1, 303, -1, -1, -1, 307, -1, 309, - 310, -1, 58, 59, -1, -1, -1, 257, 258, 259, - 260, 261, -1, 263, 264, 265, -1, 33, -1, 269, + 292, 293, -1, -1, 296, 297, -1, -1, -1, -1, + 91, 303, -1, -1, -1, 307, -1, 309, 310, -1, + -1, 257, 258, 259, 260, 261, 262, 263, 264, 265, + 41, -1, -1, 269, -1, -1, -1, -1, -1, -1, + -1, -1, 123, -1, 280, -1, 282, 283, 284, -1, + -1, -1, 63, 289, 290, 291, 292, 293, -1, -1, + 296, 297, -1, -1, -1, -1, -1, 303, -1, -1, + -1, 307, -1, 309, 310, 272, 273, 274, 275, -1, + 91, -1, -1, -1, 257, 258, 259, 260, 261, -1, + 263, 264, 265, -1, -1, -1, 269, 294, 295, -1, + -1, -1, -1, -1, -1, -1, -1, 280, -1, 282, + 283, 284, 123, -1, -1, -1, 289, 290, 291, 292, + 293, -1, -1, 296, 297, -1, -1, -1, -1, -1, + 303, -1, -1, -1, 307, 33, 309, 310, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 59, -1, 300, 301, 302, 64, 304, 305, -1, + -1, 308, -1, -1, 311, 312, 313, -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, 285, 286, 287, 288, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 64, 304, 305, -1, -1, 308, 126, -1, + 311, 312, 313, -1, -1, -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, - 280, -1, 282, 283, 284, -1, -1, 93, -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, -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, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 64, -1, -1, -1, -1, -1, - 126, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 257, 258, 259, 260, 261, -1, 263, 264, - 265, 91, 33, -1, 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, 126, -1, 303, -1, - -1, -1, 307, -1, 309, 310, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, 64, -1, + -1, 123, -1, -1, 126, -1, -1, 298, 299, 300, + 301, 302, -1, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, -1, -1, 91, -1, -1, -1, -1, + 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 91, -1, 33, -1, -1, 36, 37, 38, -1, 40, - -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, 123, 64, -1, 126, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 294, 295, + 126, 64, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 257, + 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, + 93, 269, -1, -1, -1, 91, -1, -1, -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, 126, -1, 303, -1, 123, -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, 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, - 91, -1, -1, 269, 41, -1, -1, 44, -1, -1, + 58, 59, -1, 269, -1, 63, -1, -1, 123, -1, -1, -1, -1, -1, 280, -1, 282, 283, 284, -1, - -1, 58, 59, 289, 290, 291, 292, 293, -1, -1, - 296, 297, -1, 91, -1, 126, -1, 303, -1, -1, - -1, 307, -1, 309, 310, -1, -1, 257, 258, 259, - 260, 261, -1, 263, 264, 265, 93, 33, -1, 269, - 36, 37, 38, -1, 40, 123, 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, 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, -1, 297, 123, -1, -1, - 126, -1, 303, -1, -1, -1, 307, -1, 309, 310, - -1, -1, -1, -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, -1, -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, 41, -1, -1, 44, 285, 286, 287, - 288, -1, -1, -1, 91, 272, 273, 274, 275, -1, - 58, 59, -1, 301, 302, 63, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, -1, 294, 295, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 126, - -1, -1, -1, 91, 41, 93, -1, 44, -1, -1, - -1, 257, 258, 259, 260, 261, -1, 263, 264, 265, - -1, 58, 59, 269, -1, -1, 63, -1, -1, -1, - -1, -1, -1, -1, 280, 123, 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, -1, -1, - -1, 297, -1, -1, 91, -1, 93, 303, -1, 41, - -1, 307, 44, 309, 310, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 58, 59, -1, -1, - -1, 63, -1, -1, -1, -1, 123, -1, -1, -1, - -1, -1, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, 41, -1, -1, 44, -1, 41, -1, 91, - 44, 93, 302, -1, 304, 305, -1, -1, 308, 58, - 59, 311, 312, 313, 58, 59, -1, -1, -1, 63, - 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, - -1, 123, 269, -1, -1, -1, -1, -1, -1, -1, - -1, 41, -1, 280, 93, 282, 283, 284, -1, 93, - -1, -1, 289, 290, 291, 292, 293, -1, 58, 59, - 297, -1, -1, 63, -1, -1, 303, -1, -1, -1, - 307, -1, 309, 310, 272, 273, 274, 275, -1, 123, - -1, -1, -1, 281, -1, -1, -1, 285, 286, 287, - 288, 91, -1, 93, -1, -1, 294, 295, -1, -1, - 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, -1, -1, -1, -1, - -1, -1, -1, 123, -1, 272, 273, 274, 275, -1, - -1, -1, 41, -1, 281, 44, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, 294, 295, 58, - 59, 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, 93, -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, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, 287, 288, 294, 295, -1, -1, -1, - 294, 295, 123, -1, 298, 299, 300, 301, 302, -1, - 304, 305, 41, -1, 308, 44, -1, 311, 312, 313, - -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, -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, 41, -1, 93, -1, - -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, - -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, - -1, -1, -1, -1, -1, 294, 295, -1, 123, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 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, 41, 304, 305, 44, -1, 308, 123, -1, - 311, 312, 313, -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, + 296, 297, -1, -1, -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, -1, 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, 287, 288, 296, 297, 64, -1, -1, -1, -1, + 303, -1, -1, -1, 307, -1, 309, 310, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, -1, -1, + 33, -1, 91, 36, 37, 38, -1, 40, 41, 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, + 285, -1, 287, 288, -1, -1, 33, -1, 91, 36, + 37, 38, -1, 40, 41, 42, 43, -1, 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, -1, -1, -1, -1, -1, 126, + 64, -1, -1, -1, -1, -1, -1, -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, -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, 41, 42, 43, -1, 45, 280, -1, 282, 283, + 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, 64, -1, 25, 26, -1, 303, + -1, -1, -1, 307, -1, 309, 310, -1, 37, -1, + -1, -1, -1, 42, 43, -1, -1, -1, 47, 33, + 49, 91, 36, 37, 38, -1, 40, -1, 42, 43, + -1, 45, 61, 62, 63, 64, -1, -1, -1, -1, -1, -1, -1, -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, 123, 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, + 64, -1, -1, -1, -1, -1, 126, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, + 285, 286, 287, 288, -1, -1, -1, 91, 107, 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, 272, 273, 274, - 275, -1, -1, -1, 63, -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, 91, 308, -1, -1, 311, 312, 313, -1, + 305, -1, 41, 308, -1, 44, 311, 312, 313, -1, + -1, -1, -1, 41, -1, -1, 44, -1, -1, 58, + 59, -1, 126, 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, 167, 298, + 299, 300, 301, 302, 93, 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, 123, -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, 282, 283, 284, -1, -1, -1, -1, 289, + 290, 291, 292, 293, -1, -1, 296, 297, -1, -1, + -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, + -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, 93, -1, 303, + 41, -1, -1, 307, -1, 309, 310, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, 123, -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, -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, - -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, + 91, -1, 93, 281, -1, 294, 295, 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, 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, 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, 63, -1, -1, 272, + 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, + 308, -1, 123, 311, 312, 313, -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, 91, 298, 299, 300, 301, 302, - 41, 304, 305, 44, -1, 308, -1, -1, 311, 312, - 313, -1, -1, -1, -1, -1, -1, 58, 59, -1, - -1, -1, 63, -1, -1, -1, 123, -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, 93, -1, 58, 59, -1, -1, -1, 63, + -1, 294, 295, -1, 41, 298, 299, 300, 301, 302, + -1, 304, 305, -1, -1, 308, -1, -1, 311, 312, + 313, 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, -1, -1, -1, -1, -1, -1, -1, -1, 93, - -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, -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, 272, 273, 274, 275, -1, -1, - 58, 59, -1, 281, -1, 63, -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, -1, 281, 93, -1, -1, 285, 286, - 287, 288, 58, 59, -1, -1, -1, 63, -1, -1, - -1, -1, 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, 93, -1, -1, - -1, 272, 273, 274, 275, -1, -1, 58, 59, -1, - 281, -1, 63, -1, 285, 286, 287, 288, -1, -1, + -1, -1, -1, -1, 91, -1, 93, -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, -1, 123, -1, 294, 295, + -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, + 41, -1, 308, 44, -1, 311, 312, 313, -1, -1, + -1, 41, -1, -1, 44, -1, -1, 58, 59, -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, 308, 272, 273, - 274, 275, 93, -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, -1, -1, + 301, 302, 93, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, 93, 41, -1, -1, 44, -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, 93, -1, 58, - 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, + -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, 123, -1, 285, 286, + 287, 288, -1, -1, -1, 41, -1, 294, 295, 93, + -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, 123, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, 91, -1, 93, -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, 272, 273, 274, 275, -1, -1, - -1, -1, -1, 281, 93, -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, 272, 273, 274, 275, -1, -1, 123, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, 93, + -1, 281, -1, 294, 295, 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, -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, + -1, 308, -1, -1, 311, 312, 313, 93, 272, 273, + 274, 275, -1, -1, -1, 41, -1, 281, 44, -1, + -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, + 294, 295, 58, 59, 298, 299, 300, 301, 302, -1, + 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, 58, 59, -1, 281, -1, 63, -1, 285, + -1, -1, -1, -1, -1, 281, -1, 93, -1, 285, + 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, + -1, 63, 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, 91, + -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, 311, 312, 313, + -1, 123, -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, 63, 285, 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, - 41, -1, -1, 44, -1, -1, -1, 93, -1, -1, - -1, 272, 273, 274, 275, -1, -1, 58, 59, -1, - 281, -1, 63, -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, 93, -1, -1, -1, -1, -1, -1, 58, + 41, -1, 308, 44, -1, 311, 312, 313, 93, -1, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, -1, -1, 294, 295, + -1, -1, 93, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 41, -1, -1, 44, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, 93, + -1, 58, 59, -1, -1, -1, 63, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, 41, -1, -1, 44, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 93, -1, -1, 58, 59, -1, -1, -1, 63, -1, -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, 93, -1, -1, -1, 294, 295, - -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, + 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, -1, + -1, -1, 294, 295, 93, -1, 298, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -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, 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, 272, 273, + 274, 275, -1, 93, -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, 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, -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, -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, -1, 41, -1, -1, 44, -1, -1, - -1, -1, 93, -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, - -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, - 41, -1, -1, 44, -1, -1, 93, -1, -1, -1, - -1, 272, 273, 274, 275, -1, -1, 58, 59, -1, - 281, -1, 63, -1, 285, 286, -1, 288, -1, -1, - -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, 41, 304, -1, 44, -1, -1, -1, -1, - -1, -1, 93, 272, 273, 274, 275, -1, -1, 58, - 59, -1, 281, -1, 63, -1, 285, 286, -1, -1, - -1, -1, -1, -1, 41, 294, 295, 44, -1, 298, - 299, 300, 301, 302, 41, 304, -1, 44, -1, -1, - -1, 58, 59, -1, 93, -1, 63, -1, -1, -1, - -1, 58, 59, -1, -1, -1, 63, -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, + 41, -1, -1, 44, -1, -1, -1, -1, 93, -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, -1, -1, 298, 299, + 300, 301, 302, 41, 304, 305, 44, -1, -1, -1, + -1, -1, 93, -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, 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, 41, -1, -1, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 93, -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 93, -1, -1, 41, - -1, -1, 44, -1, -1, -1, 93, -1, -1, -1, - -1, 272, 273, 274, 275, -1, 58, 59, -1, -1, - 281, 63, -1, -1, 285, 286, -1, -1, -1, -1, - -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -1, 41, -1, -1, 44, -1, -1, -1, - -1, 93, -1, -1, -1, 272, 273, 274, 275, -1, - 58, 59, -1, -1, 281, 63, -1, -1, 285, 286, - -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, 93, -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, - 281, -1, -1, -1, 285, 286, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, 93, -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, - 301, 302, -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, 286, -1, -1, - -1, -1, -1, -1, -1, 294, 295, -1, -1, 298, - 299, 300, 301, 302, -1, 272, 273, 274, 275, -1, - -1, -1, -1, -1, 281, 272, 273, 274, 275, -1, - -1, -1, -1, -1, 281, -1, -1, 294, 295, -1, - -1, 298, 299, 300, 301, 302, -1, 294, 295, -1, - -1, 298, 299, 300, 301, 302, -1, -1, -1, -1, - -1, 30, -1, -1, -1, -1, -1, -1, -1, 38, - 272, 273, 274, 275, 43, 44, -1, -1, -1, 281, - 49, 50, 51, 52, 53, 54, -1, -1, 57, 58, + 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, -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, 93, 298, 299, 300, + 301, 302, 41, 304, 305, 44, -1, -1, -1, -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, -1, -1, + 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, + 272, 273, 274, 275, 93, -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, -1, 44, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, 58, 59, + 285, 286, -1, 63, -1, -1, -1, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, 302, 41, 304, + -1, 44, -1, -1, -1, -1, -1, -1, 41, -1, + -1, 44, -1, 93, -1, 58, 59, -1, -1, -1, + 63, -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, + 93, -1, -1, -1, -1, 272, 273, 274, 275, -1, + 93, 58, 59, -1, 281, -1, 63, -1, 285, 286, + -1, -1, -1, -1, -1, -1, 41, 294, 295, 44, + -1, 298, 299, 300, 301, 302, 41, -1, -1, 44, + -1, -1, -1, 58, 59, -1, 93, -1, 63, -1, + -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, 58, + -1, -1, 281, -1, 63, -1, 285, 286, 93, -1, + -1, -1, -1, -1, -1, 294, 295, -1, 93, 298, + 299, 300, 301, 302, -1, -1, -1, -1, -1, -1, + -1, -1, 91, -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, - -1, -1, 91, 281, -1, -1, -1, -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, 123, -1, -1, -1, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, -1, -1, 285, 286, -1, -1, -1, + -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, + 300, 301, 302, -1, -1, -1, -1, -1, -1, 272, + 273, 274, 275, -1, -1, -1, -1, -1, 281, 272, + 273, 274, 275, 286, -1, -1, -1, -1, 281, -1, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 294, 295, -1, + -1, 298, 299, 300, 301, 302, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, -1, -1, 294, + 295, -1, 281, 298, 299, 300, 285, 286, 287, 288, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 298, + 299, 300, 301, 302, -1, 304, 305, 30, -1, 308, + -1, -1, 311, 312, 313, 38, -1, -1, -1, -1, + 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, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 90, -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, + 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, 253, -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, 281, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 256, -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, 284, }; #define YYFINAL 1 #ifndef YYDEBUG @@ -1148,10 +1190,9 @@ char *yyrule[] = { "startsub :", "package : PACKAGE WORD ';'", "package : PACKAGE ';'", -"use : USE WORD listexpr ';'", +"use : USE startsub WORD listexpr ';'", "expr : expr ANDOP expr", "expr : expr OROP expr", -"expr : NOTOP expr", "expr : argexpr", "argexpr : argexpr ','", "argexpr : argexpr ',' term", @@ -1198,6 +1239,7 @@ char *yyrule[] = { "term : HASHBRACK ';' '}'", "term : ANONSUB startsub proto block", "term : scalar", +"term : star '{' expr ';' '}'", "term : star", "term : scalar '[' expr ']'", "term : term ARROW '[' expr ']'", @@ -1225,6 +1267,7 @@ char *yyrule[] = { "term : DO scalar '(' expr ')'", "term : LOOPEX", "term : LOOPEX term", +"term : NOTOP argexpr", "term : UNIOP", "term : UNIOP block", "term : UNIOP term", @@ -1275,9 +1318,9 @@ int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; -#line 563 "perly.y" +#line 572 "perly.y" /* PROGRAM */ -#line 1351 "y.tab.c" +#line 1394 "y.tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1742,7 +1785,7 @@ case 53: break; case 54: #line 271 "perly.y" -{ utilize(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); } +{ utilize(yyvsp[-4].ival, yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 55: #line 275 "perly.y" @@ -1752,78 +1795,78 @@ case 56: #line 277 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 57: -#line 279 "perly.y" -{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } +case 58: +#line 282 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } break; case 59: #line 284 "perly.y" -{ yyval.opval = yyvsp[-1].opval; } -break; -case 60: -#line 286 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 62: -#line 291 "perly.y" +case 61: +#line 289 "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 63: -#line 294 "perly.y" +case 62: +#line 292 "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 64: -#line 297 "perly.y" +case 63: +#line 295 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; -case 65: -#line 302 "perly.y" +case 64: +#line 300 "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 66: -#line 307 "perly.y" +case 65: +#line 305 "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" +{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } +break; case 67: #line 312 "perly.y" -{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } +{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 68: #line 314 "perly.y" -{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } -break; -case 69: -#line 316 "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" +{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } +break; case 72: #line 327 "perly.y" -{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 73: #line 329 "perly.y" -{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } -break; -case 74: -#line 331 "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" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; case 75: #line 335 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } @@ -1846,103 +1889,103 @@ case 79: break; case 80: #line 345 "perly.y" -{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 81: #line 347 "perly.y" -{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 82: #line 349 "perly.y" -{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } +{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 83: #line 351 "perly.y" -{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } +{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 84: #line 353 "perly.y" -{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } +{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 85: -#line 355 "perly.y" -{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } +#line 356 "perly.y" +{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 86: #line 358 "perly.y" -{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } +{ yyval.opval = yyvsp[0].opval; } break; case 87: #line 360 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 88: #line 362 "perly.y" -{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } +{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 89: #line 364 "perly.y" -{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} +{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 90: #line 366 "perly.y" -{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } -break; -case 91: -#line 368 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; -case 92: -#line 371 "perly.y" +case 91: +#line 369 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; -case 93: -#line 374 "perly.y" +case 92: +#line 372 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; -case 94: -#line 377 "perly.y" +case 93: +#line 375 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; +case 94: +#line 378 "perly.y" +{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } +break; case 95: #line 380 "perly.y" -{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } +{ yyval.opval = sawparens(yyvsp[-1].opval); } break; case 96: #line 382 "perly.y" -{ yyval.opval = sawparens(yyvsp[-1].opval); } +{ yyval.opval = sawparens(newNULLLIST()); } break; case 97: #line 384 "perly.y" -{ yyval.opval = sawparens(newNULLLIST()); } +{ yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 98: #line 386 "perly.y" -{ yyval.opval = newANONLIST(yyvsp[-1].opval); } +{ yyval.opval = newANONLIST(Nullop); } break; case 99: #line 388 "perly.y" -{ yyval.opval = newANONLIST(Nullop); } +{ yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 100: #line 390 "perly.y" -{ yyval.opval = newANONHASH(yyvsp[-2].opval); } +{ yyval.opval = newANONHASH(Nullop); } break; case 101: #line 392 "perly.y" -{ yyval.opval = newANONHASH(Nullop); } +{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 102: #line 394 "perly.y" -{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } +{ yyval.opval = yyvsp[0].opval; } break; case 103: #line 396 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } break; case 104: #line 398 "perly.y" @@ -2026,174 +2069,185 @@ case 118: break; case 119: #line 448 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, 0, - scalar(yyvsp[0].opval)); } +{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 120: -#line 451 "perly.y" +#line 450 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 121: -#line 453 "perly.y" +#line 452 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 122: -#line 456 "perly.y" +#line 455 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, - yyvsp[0].opval, newCVREF(scalar(yyvsp[-1].opval)))); } + yyvsp[0].opval, newCVREF(0,scalar(yyvsp[-1].opval)))); } break; case 123: -#line 460 "perly.y" +#line 459 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 124: -#line 462 "perly.y" +#line 461 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 125: -#line 464 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, +#line 463 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop)); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-2].opval) + )),Nullop)); dep();} break; case 126: -#line 468 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, +#line 471 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, - scalar(newCVREF(scalar(yyvsp[-3].opval))))); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-3].opval) + )))); dep();} break; case 127: -#line 473 "perly.y" +#line 480 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop)); dep();} + scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 128: -#line 477 "perly.y" +#line 484 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, - scalar(newCVREF(scalar(yyvsp[-3].opval))))); dep();} + scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 129: -#line 482 "perly.y" +#line 489 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } break; case 130: -#line 485 "perly.y" +#line 492 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 131: -#line 487 "perly.y" -{ yyval.opval = newOP(yyvsp[0].ival, 0); } +#line 494 "perly.y" +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 132: -#line 489 "perly.y" -{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } +#line 496 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 133: -#line 491 "perly.y" +#line 498 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 134: -#line 493 "perly.y" +#line 500 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } +break; +case 135: +#line 502 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; -case 135: -#line 496 "perly.y" +case 136: +#line 505 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; -case 136: -#line 498 "perly.y" +case 137: +#line 507 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; -case 137: -#line 500 "perly.y" +case 138: +#line 509 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; -case 138: -#line 503 "perly.y" +case 139: +#line 512 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; -case 139: -#line 505 "perly.y" +case 140: +#line 514 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; -case 140: -#line 507 "perly.y" +case 141: +#line 516 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; -case 141: -#line 509 "perly.y" +case 142: +#line 518 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; -case 144: -#line 515 "perly.y" -{ yyval.opval = Nullop; } -break; case 145: -#line 517 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 524 "perly.y" +{ yyval.opval = Nullop; } break; case 146: -#line 521 "perly.y" -{ yyval.opval = Nullop; } +#line 526 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 147: -#line 523 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 530 "perly.y" +{ yyval.opval = Nullop; } break; case 148: -#line 525 "perly.y" -{ yyval.opval = yyvsp[-1].opval; } +#line 532 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 149: -#line 529 "perly.y" -{ yyval.opval = newCVREF(yyvsp[0].opval); } +#line 534 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } break; case 150: -#line 533 "perly.y" -{ yyval.opval = newSVREF(yyvsp[0].opval); } +#line 538 "perly.y" +{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 151: -#line 537 "perly.y" -{ yyval.opval = newAVREF(yyvsp[0].opval); } +#line 542 "perly.y" +{ yyval.opval = newSVREF(yyvsp[0].opval); } break; case 152: -#line 541 "perly.y" -{ yyval.opval = newHVREF(yyvsp[0].opval); } +#line 546 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } break; case 153: -#line 545 "perly.y" -{ yyval.opval = newAVREF(yyvsp[0].opval); } +#line 550 "perly.y" +{ yyval.opval = newHVREF(yyvsp[0].opval); } break; case 154: -#line 549 "perly.y" -{ yyval.opval = newGVREF(0,yyvsp[0].opval); } +#line 554 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } break; case 155: -#line 553 "perly.y" -{ yyval.opval = scalar(yyvsp[0].opval); } +#line 558 "perly.y" +{ yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 156: -#line 555 "perly.y" -{ yyval.opval = scalar(yyvsp[0].opval); } +#line 562 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } break; case 157: -#line 557 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } +#line 564 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } break; case 158: -#line 560 "perly.y" +#line 566 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } +break; +case 159: +#line 569 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2183 "y.tab.c" +#line 2237 "y.tab.c" } yyssp -= yym; yystate = *yyssp; diff --git a/perly.c.diff b/perly.c.diff index f72163ec46..37b1b92a70 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -1,5 +1,5 @@ -*** perly.c.orig Tue Nov 14 17:16:49 1995 ---- perly.c Tue Nov 14 17:17:44 1995 +*** perly.c.orig Thu Feb 1 20:47:42 1996 +--- perly.c Thu Feb 1 20:47:43 1996 *************** *** 12,82 **** deprecate("\"do\" to call subroutines"); @@ -75,7 +75,7 @@ 31, 0, 5, 3, 6, 6, 6, 7, 7, 7, --- 12,17 ---- *************** -*** 1338,1350 **** +*** 1381,1393 **** int yynerrs; int yyerrflag; int yychar; @@ -86,13 +86,13 @@ - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE - #line 563 "perly.y" + #line 572 "perly.y" /* PROGRAM */ - #line 1351 "y.tab.c" ---- 1273,1280 ---- + #line 1394 "y.tab.c" +--- 1316,1323 ---- *************** -*** 1351,1364 **** ---- 1281,1339 ---- +*** 1394,1407 **** +--- 1324,1382 ---- #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -153,8 +153,8 @@ { yyn = *yys; *************** -*** 1371,1376 **** ---- 1346,1359 ---- +*** 1414,1419 **** +--- 1389,1402 ---- yyerrflag = 0; yychar = (-1); @@ -170,7 +170,7 @@ yyvsp = yyvs; *yyssp = yystate = 0; *************** -*** 1386,1392 **** +*** 1429,1435 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -178,7 +178,7 @@ yychar, yys); } #endif ---- 1369,1375 ---- +--- 1412,1418 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -187,7 +187,7 @@ } #endif *************** -*** 1396,1407 **** +*** 1439,1450 **** { #if YYDEBUG if (yydebug) @@ -200,7 +200,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1379,1404 ---- +--- 1422,1447 ---- { #if YYDEBUG if (yydebug) @@ -228,7 +228,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 1437,1448 **** +*** 1480,1491 **** { #if YYDEBUG if (yydebug) @@ -241,7 +241,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1434,1460 ---- +--- 1477,1503 ---- { #if YYDEBUG if (yydebug) @@ -270,7 +270,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 1452,1459 **** +*** 1495,1502 **** { #if YYDEBUG if (yydebug) @@ -279,7 +279,7 @@ #endif if (yyssp <= yyss) goto yyabort; --yyssp; ---- 1464,1472 ---- +--- 1507,1515 ---- { #if YYDEBUG if (yydebug) @@ -290,7 +290,7 @@ if (yyssp <= yyss) goto yyabort; --yyssp; *************** -*** 1470,1477 **** +*** 1513,1520 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -299,7 +299,7 @@ } #endif yychar = (-1); ---- 1483,1491 ---- +--- 1526,1534 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -310,7 +310,7 @@ #endif yychar = (-1); *************** -*** 1480,1486 **** +*** 1523,1529 **** yyreduce: #if YYDEBUG if (yydebug) @@ -318,7 +318,7 @@ yystate, yyn, yyrule[yyn]); #endif yym = yylen[yyn]; ---- 1494,1500 ---- +--- 1537,1543 ---- yyreduce: #if YYDEBUG if (yydebug) @@ -327,7 +327,7 @@ #endif yym = yylen[yyn]; *************** -*** 2189,2196 **** +*** 2243,2250 **** { #if YYDEBUG if (yydebug) @@ -336,7 +336,7 @@ #endif yystate = YYFINAL; *++yyssp = YYFINAL; ---- 2203,2211 ---- +--- 2257,2265 ---- { #if YYDEBUG if (yydebug) @@ -347,7 +347,7 @@ yystate = YYFINAL; *++yyssp = YYFINAL; *************** -*** 2204,2210 **** +*** 2258,2264 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -355,7 +355,7 @@ YYFINAL, yychar, yys); } #endif ---- 2219,2225 ---- +--- 2273,2279 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -364,7 +364,7 @@ } #endif *************** -*** 2219,2238 **** +*** 2273,2292 **** yystate = yydgoto[yym]; #if YYDEBUG if (yydebug) @@ -385,7 +385,7 @@ yyaccept: ! return (0); } ---- 2234,2268 ---- +--- 2288,2322 ---- yystate = yydgoto[yym]; #if YYDEBUG if (yydebug) @@ -45,7 +45,7 @@ dep() %token <ival> RELOP EQOP MULOP ADDOP %token <ival> DOLSHARP DO LOCAL HASHBRACK NOAMP -%type <ival> prog decl format remember startsub +%type <ival> prog decl format remember startsub '&' %type <opval> block lineseq line loop cond nexpr else argexpr %type <opval> expr term scalar ary hsh arylen star amper sideff %type <opval> listexpr listexprcom indirob @@ -55,7 +55,7 @@ dep() %left <ival> OROP %left ANDOP -%left NOTOP +%right NOTOP %nonassoc <ival> LSTOP %left ',' %right <ival> ASSIGNOP @@ -267,16 +267,14 @@ package : PACKAGE WORD ';' { package(Nullop); } ; -use : USE WORD listexpr ';' - { utilize($1, $2, $3); } +use : USE startsub WORD listexpr ';' + { utilize($1, $2, $3, $4); } ; expr : expr ANDOP expr { $$ = newLOGOP(OP_AND, 0, $1, $3); } | expr OROP expr { $$ = newLOGOP($2, 0, $1, $3); } - | NOTOP expr - { $$ = newUNOP(OP_NOT, 0, scalar($2)); } | argexpr ; @@ -394,6 +392,8 @@ term : term ASSIGNOP term { $$ = newANONSUB($2, $3, $4); } | scalar %prec '(' { $$ = $1; } + | star '{' expr ';' '}' + { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); } | star %prec '(' { $$ = $1; } | scalar '[' expr ']' %prec '(' @@ -445,8 +445,7 @@ term : term ASSIGNOP term | THING %prec '(' { $$ = $1; } | amper - { $$ = newUNOP(OP_ENTERSUB, 0, - scalar($1)); } + { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); } | amper '(' ')' { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); } | amper '(' expr ')' @@ -455,34 +454,44 @@ term : term ASSIGNOP term | NOAMP WORD listexpr { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, - $3, newCVREF(scalar($2)))); } + $3, newCVREF(0,scalar($2)))); } | DO term %prec UNIOP { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); } | DO block %prec '(' { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); } | DO WORD '(' ')' - { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + { $$ = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), Nullop)); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar($2) + )),Nullop)); dep();} | DO WORD '(' expr ')' - { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + { $$ = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, $4, - scalar(newCVREF(scalar($2))))); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar($2) + )))); dep();} | DO scalar '(' ')' { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), Nullop)); dep();} + scalar(newCVREF(0,scalar($2))), Nullop)); dep();} | DO scalar '(' expr ')' { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, $4, - scalar(newCVREF(scalar($2))))); dep();} + scalar(newCVREF(0,scalar($2))))); dep();} | LOOPEX { $$ = newOP($1, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } | LOOPEX term { $$ = newLOOPEX($1,$2); } + | NOTOP argexpr + { $$ = newUNOP(OP_NOT, 0, scalar($2)); } | UNIOP { $$ = newOP($1, 0); } | UNIOP block @@ -526,7 +535,7 @@ listexprcom: /* NULL */ ; amper : '&' indirob - { $$ = newCVREF($2); } + { $$ = newCVREF($1,$2); } ; scalar : '$' indirob diff --git a/pod/Makefile b/pod/Makefile index 810dd9ea85..ebe4f172ce 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -1,4 +1,4 @@ -CONVERTERS = pod2html pod2latex pod2man +CONVERTERS = pod2html pod2latex pod2man pod2text all: $(CONVERTERS) man PERL = ../miniperl @@ -139,44 +139,44 @@ TEX = \ perlxs.tex \ perlxstut.tex -man: pod2man -I../lib $(MAN) +man: pod2man ($MAN) # pod2html normally runs on all the pods at once in order to build up # cross-references. html: pod2html - $(PERL) pod2html -I../lib $(POD) + $(PERL) -I../lib pod2html $(POD) tex: pod2latex $(TEX) .SUFFIXES: .pm .pod .man .pm.man: pod2man - $(PERL) pod2man -I../lib $*.pm >$*.man + $(PERL) -I../lib pod2man $*.pm >$*.man .pod.man: pod2man - $(PERL) pod2man -I../lib $*.pod >$*.man + $(PERL) -I../lib pod2man $*.pod >$*.man .SUFFIXES: .mp .pod .html .pm.html: pod2html - $(PERL) pod2html -I../lib $*.pod + $(PERL) -I../lib pod2html $*.pod .pod.html: pod2html - $(PERL) pod2html -I../lib $*.pod + $(PERL) -I../lib pod2html $*.pod .SUFFIXES: .pm .pod .tex .pod.tex: pod2latex - $(PERL) pod2latex -I../lib $*.pod + $(PERL) -I../lib pod2latex $*.pod .pm.tex: pod2latex - $(PERL) pod2latex -I../lib $*.pod + $(PERL) -I../lib pod2latex $*.pod clean: rm -f $(MAN) $(HTML) $(TEX) realclean: clean - rm -f pod2man pod2latex pod2html + rm -f $(CONVERTERS) distclean: realclean @@ -189,3 +189,6 @@ pod2html: pod2html.PL ../lib/Config.pm pod2man: pod2man.PL ../lib/Config.pm $(PERL) -I ../lib pod2man.PL + +pod2text: pod2text.PL ../lib/Config.pm + $(PERL) -I ../lib pod2text.PL diff --git a/pod/buildtoc b/pod/buildtoc index 77ddcd0ead..7a9657ae29 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -119,7 +119,7 @@ podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] ); =head1 AUTHOR - Larry Wall E<lt><F<lwall\@netlabs.com>E<gt>, with the help of oodles + Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles of other folks. diff --git a/pod/perl.pod b/pod/perl.pod index 5f3918c4c9..eb6ff63370 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -4,6 +4,17 @@ perl - Practical Extraction and Report Language =head1 SYNOPSIS +B<perl> [ B<-acdhnpPsSTuUvw> ] +[ S<B<-0>[I<octal>]> ] +[ S<B<-D>I<number/list>]> ] +[ S<B<-F>I<string>> ] +[ S<B<-i>[I<extension>]> ] +[ S<B<-I>I<dir>> ] +[ S<B<-l>I<octal>> ] +[ S<B<-x>I<dir>> ] +[ I<programfile> | S<B<-e> I<command>> ] +[ I<argument> ... ] + For ease of access, the Perl manual has been split up into a number of sections: @@ -82,7 +93,7 @@ grow as necessary to prevent degraded performance. Perl uses sophisticated pattern matching techniques to scan large amounts of data very quickly. Although optimized for scanning text, Perl can also deal with binary data, and can make dbm files look like associative -arrays (where dbm is available). Setuid Perl scripts are safer than +arrays. Setuid Perl scripts are safer than C programs through a dataflow tracing mechanism which prevents many stupid security holes. If you have a problem that would ordinarily use B<sed> or B<awk> or B<sh>, but it exceeds their capabilities or must @@ -140,7 +151,7 @@ A package can function as a class. Dynamic multiple inheritance and virtual methods are supported in a straightforward manner and with very little new syntax. Filehandles may now be treated as objects. -=item * Embeddible and Extensible +=item * Embeddable and Extensible Perl may now be embedded easily in your C or C++ application, and can either call or be called by your routines through a documented @@ -239,7 +250,7 @@ honest: =head1 AUTHOR -Larry Wall E<lt><F<lwall@netlabs.com>E<gt>, with the help of oodles of other folks. +Larry Wall E<lt><F<lwall@sems.com>E<gt>, with the help of oodles of other folks. =head1 FILES @@ -291,6 +302,8 @@ See the perl bugs database at F<http://perl.com/perl/bugs/>. You may mail your bug reports (be sure to include full configuration information as output by the myconfig program in the perl source tree) to F<perlbug@perl.com>. +If you've succeeded in compiling perl, the perlbug script in the utils/ +subdirectory can be used to help mail in a bug report. Perl actually stands for Pathologically Eclectic Rubbish Lister, but don't tell anyone I said that. diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 50600f5d1c..996c9145d0 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -295,6 +295,37 @@ from the stack. See I<Using G_EVAL> for details of using G_EVAL. +=head2 G_KEEPERR + +You may have noticed that using the G_EVAL flag described above will +B<always> clear the C<$@> variable and set it to a string describing +the error iff there was an error in the called code. This unqualified +resetting of C<$@> can be problematic in the reliable identification of +errors using the C<eval {}> mechanism, because the possibility exists +that perl will call other code (end of block processing code, for +example) between the time the error causes C<$@> to be set within +C<eval {}>, and the subsequent statement which checks for the value of +C<$@> gets executed in the user's script. + +This scenario will mostly be applicable to code that is meant to be +called from within destructors, asynchronous callbacks, signal +handlers, C<__DIE__> or C<__WARN__> hooks, and C<tie> functions. In +such situations, you will not want to clear C<$@> at all, but simply to +append any new errors to any existing value of C<$@>. + +The G_KEEPERR flag is meant to be used in conjunction with G_EVAL in +I<perl_call_*> functions that are used to implement such code. This flag +has no effect when G_EVAL is not used. + +When G_KEEPERR is used, any errors in the called code will be prefixed +with the string "\t(in cleanup)", and appended to the current value +of C<$@>. + +The G_KEEPERR flag was introduced in Perl version 5.002. + +See I<Using G_KEEPERR> for an example of a situation that warrants the +use of this flag. + =head2 Determining the Context As mentioned above, you can determine the context of the currently @@ -892,7 +923,6 @@ and some C to call it { dSP ; int count ; - SV * sv ; ENTER ; SAVETMPS; @@ -907,10 +937,9 @@ and some C to call it SPAGAIN ; /* Check the eval first */ - sv = GvSV(gv_fetchpv("@", TRUE, SVt_PV)); - if (SvTRUE(sv)) + if (SvTRUE(GvSV(errgv))) { - printf ("Uh oh - %s\n", SvPV(sv, na)) ; + printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ; POPs ; } else @@ -950,10 +979,9 @@ I<Subtract>. The code - sv = GvSV(gv_fetchpv("@", TRUE, SVt_PV)); - if (SvTRUE(sv)) + if (SvTRUE(GvSV(errgv))) { - printf ("Uh oh - %s\n", SvPVx(sv, na)) ; + printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ; POPs ; } @@ -961,10 +989,14 @@ is the direct equivalent of this bit of Perl print "Uh oh - $@\n" if $@ ; +C<errgv> is a perl global of type C<GV *> that points to the +symbol table entry containing the error. C<GvSV(errgv)> therefore +refers to the C equivalent of C<$@>. + =item 3. Note that the stack is popped using C<POPs> in the block where -C<SvTRUE(sv)> is true. This is necessary because whenever a +C<SvTRUE(GvSV(errgv))> is true. This is necessary because whenever a I<perl_call_*> function invoked with G_EVAL|G_SCALAR returns an error, the top of the stack holds the value I<undef>. Since we want the program to continue after detecting this error, it is essential that @@ -973,6 +1005,39 @@ the stack is tidied up by removing the I<undef>. =back +=head2 Using G_KEEPERR + +Consider this rather facetious example, where we have used an XS +version of the call_Subtract example above inside a destructor: + + package Foo; + sub new { bless {}, $_[0] } + sub Subtract { + my($a,$b) = @_; + die "death can be fatal" if $a < $b ; + $a - $b; + } + sub DESTROY { call_Subtract(5, 4); } + sub foo { die "foo dies"; } + + package main; + eval { Foo->new->foo }; + print "Saw: $@" if $@; # should be, but isn't + +This example will fail to recognize that an error occurred inside the +C<eval {}>. Here's why: the call_Subtract code got executed while perl +was cleaning up temporaries when exiting the eval block, and since +call_Subtract is implemented with I<perl_call_pv> using the G_EVAL +flag, it promptly reset C<$@>. This results in the failure of the +outermost test for C<$@>, and thereby the failure of the error trap. + +Appending the G_KEEPERR flag, so that the I<perl_call_pv> call in +call_Subtract reads: + + count = perl_call_pv("Subtract", G_EVAL|G_SCALAR|G_KEEPERR); + +will preserve the error and restore reliable error handling. + =head2 Using perl_call_sv In all the previous examples I have 'hard-wired' the name of the Perl @@ -1829,8 +1894,9 @@ Paul Marquess <pmarquess@bfsec.bt.co.uk> Special thanks to the following people who assisted in the creation of the document. -Jeff Okamoto, Tim Bunce, Nick Gianniotis, Steve Kelem and Larry Wall. +Jeff Okamoto, Tim Bunce, Nick Gianniotis, Steve Kelem, Gurusamy Sarathy +and Larry Wall. =head1 DATE -Version 1.1, 17th May 1995 +Version 1.2, 16th Jan 1996 diff --git a/pod/perldata.pod b/pod/perldata.pod index 9b3798ffb1..90ac535e1c 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -122,7 +122,7 @@ declare a scalar variable to be of type "string", or of type "number", or type "filehandle", or anything else. Perl is a contextually polymorphic language whose scalars can be strings, numbers, or references (which includes objects). While strings and numbers are considered the pretty -much same thing for nearly all purposes, but references are strongly-typed +much same thing for nearly all purposes, references are strongly-typed uncastable pointers with built-in reference-counting and destructor invocation. @@ -315,7 +315,7 @@ first blank line--see the Merry Christmas example below.) The terminating string must appear by itself (unquoted and with no surrounding whitespace) on the terminating line. - print <<EOF; # same as above + print <<EOF; The price is $Price. EOF diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 83a30c3e1a..130bc8dca2 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -673,6 +673,14 @@ message indicates that such a conversion was attempted. of upgradability. Upgrading to undef indicates an error in the code calling sv_upgrade. +=item Can't use "my %s" in sort comparison + +(F) The global variables $a and $b are reserved for sort comparisons. +You mentioned $a or $b in the same line as the <=> or cmp operator, +and the variable had earlier been declared as a lexical variable. +Either qualify the sort variable with the package name, or rename the +lexical variable. + =item Can't use %s for loop variable (F) Only a simple scalar variable may be used as a loop variable on a foreach. diff --git a/pod/perldsc.pod b/pod/perldsc.pod index 258e9abe08..7e18e7405c 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -814,6 +814,16 @@ many different sorts: print "\n"; } +=head1 Database Ties + +You cannot easily tie a multilevel data structure (such as a hash of +hashes) to a dbm file. The first problem is that all but GDBM and +Berkeley DB have size limitations, but beyond that, you also have problems +with how references are to be represented on disk. One experimental +module that does attempt to partially address this need is the MLDBM +module. Check your nearest CPAN site as described in L<perlmod> for +source code to MLDBM. + =head1 SEE ALSO L<perlref>, L<perllol>, L<perldata>, L<perlobj> diff --git a/pod/perlembed.pod b/pod/perlembed.pod index c86f550f15..2f0e9c30fb 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -117,11 +117,11 @@ I<miniperlmain.c> containing the essentials of embedding: static PerlInterpreter *my_perl; /*** The Perl interpreter ***/ - int main(int argc, char **argv) + int main(int argc, char **argv, char **env) { my_perl = perl_alloc(); perl_construct(my_perl); - perl_parse(my_perl, NULL, argc, argv, (char **) NULL); + perl_parse(my_perl, NULL, argc, argv, env); perl_run(my_perl); perl_destruct(my_perl); perl_free(my_perl); @@ -164,12 +164,12 @@ That's shown below, in a program I'll call I<showtime.c>. static PerlInterpreter *my_perl; - int main(int argc, char **argv) + int main(int argc, char **argv, char **env) { my_perl = perl_alloc(); perl_construct(my_perl); - perl_parse(my_perl, NULL, argc, argv, (char **) NULL); + perl_parse(my_perl, NULL, argc, argv, env); /*** This replaces perl_run() ***/ perl_call_argv("showtime", G_DISCARD | G_NOARGS, argv); @@ -241,7 +241,7 @@ the first, a C<float> from the second, and a C<char *> from the third. perl_call_argv("_eval_", 0, argv); } - main (int argc, char **argv) + main (int argc, char **argv, char **env) { char *embedding[] = { "", "-e", "sub _eval_ { eval $_[0] }" }; STRLEN length; @@ -249,7 +249,7 @@ the first, a C<float> from the second, and a C<char *> from the third. my_perl = perl_alloc(); perl_construct( my_perl ); - perl_parse(my_perl, NULL, 3, embedding, (char **) NULL); + perl_parse(my_perl, NULL, 3, embedding, env); /** Treat $a as an integer **/ perl_eval("$a = 3; $a **= 2"); @@ -388,7 +388,7 @@ Here's a sample program, I<match.c>, that uses all three: return num_matches; } - main (int argc, char **argv) + main (int argc, char **argv, char **env) { char *embedding[] = { "", "-e", "sub _eval_ { eval $_[0] }" }; char *text, **matches; @@ -398,7 +398,7 @@ Here's a sample program, I<match.c>, that uses all three: my_perl = perl_alloc(); perl_construct( my_perl ); - perl_parse(my_perl, NULL, 3, embedding, (char **) NULL); + perl_parse(my_perl, NULL, 3, embedding, env); text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/ sprintf(text, "%s", "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*. He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount. The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH"); @@ -517,7 +517,7 @@ deep breath... LEAVE; /* ...and the XPUSHed "mortal" args.*/ } - int main (int argc, char **argv) + int main (int argc, char **argv, char **env) { char *my_argv[2]; @@ -527,7 +527,7 @@ deep breath... my_argv[1] = (char *) malloc(10); sprintf(my_argv[1], "power.pl"); - perl_parse(my_perl, NULL, argc, my_argv, (char **) NULL); + perl_parse(my_perl, NULL, argc, my_argv, env); PerlPower(3, 4); /*** Compute 3 ** 4 ***/ diff --git a/pod/perlform.pod b/pod/perlform.pod index 3e5dd78466..cf0bc068f1 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -5,9 +5,9 @@ perlform - Perl formats =head1 DESCRIPTION Perl has a mechanism to help you generate simple reports and charts. To -facilitate this, Perl helps you lay out your output page in your code in a -fashion that's close to how it will look when it's printed. It can keep -track of things like how many lines on a page, what page you're, when to +facilitate this, Perl helps you code up your output page +close to how it will look when it's printed. It can keep +track of things like how many lines on a page, what page you're on, when to print page headers, etc. Keywords are borrowed from FORTRAN: format() to declare and write() to execute; see their entries in L<perlfunc>. Fortunately, the layout is much more legible, more like diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index fe661aac22..a8579106b5 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -119,7 +119,7 @@ pack, read, syscall, sysread, syswrite, unpack, vec =item Functions for filehandles, files, or directories -C<-X>, chdir, chmod, chown, chroot, fcntl, glob, ioctl, link, +-X, chdir, chmod, chown, chroot, fcntl, glob, ioctl, link, lstat, mkdir, open, opendir, readlink, rename, rmdir, stat, symlink, umask, unlink, utime @@ -1561,7 +1561,7 @@ or the undefined value if there is an error. Calls the System V IPC function msgsnd to send the message MSG to the message queue ID. MSG must begin with the long integer message type, -which may be created with C<pack("L", $type)>. Returns TRUE if +which may be created with C<pack("l", $type)>. Returns TRUE if successful, or FALSE if there is an error. =item msgrcv ID,VAR,SIZE,TYPE,FLAGS @@ -1647,7 +1647,6 @@ and those that don't is their text file formats. Systems like Unix and Plan9 that delimit lines with a single character, and that encode that character in C as '\n', do not need C<binmode>. The rest need it. - Examples: $ARTICLE = 100; @@ -1751,6 +1750,24 @@ Note: on any operation which may do a fork, unflushed buffers remain unflushed in both processes, which means you may need to set $| to avoid duplicate output. +Using the FileHandle constructor from the FileHandle package, +you can generate anonymous filehandles which have the scope of whatever +variables hold references to them, and automatically close whenever +and however you leave that scope: + + use FileHandle; + ... + sub read_myfile_munged { + my $ALL = shift; + my $handle = new FileHandle; + open($handle, "myfile") or die "myfile: $!"; + $first = <$handle> + or return (); # Automatically closed here. + mung $first or die "mung failed"; # Or here. + return $first, <$handle> if $ALL; # Or here. + $first; # Or here. + } + The filename that is passed to open will have leading and trailing whitespace deleted. In order to open a file with arbitrary weird characters in it, it's necessary to protect any leading and trailing @@ -1759,19 +1776,17 @@ whitespace thusly: $file =~ s#^(\s)#./$1#; open(FOO, "< $file\0"); -If you want a "real" C open() (see L<open(2)) on your system, then -you should probably use the POSIX::open() function as found in the L<POSIX> -documents. For example: +If you want a "real" C open() (see L<open(2)> on your system), then +you should use the sysopen() function. This is another way to +protect your filenames from interpretation. For example: use FileHandle; - use POSIX qw(:fcntl_h); - $fd = POSIX::open($path, O_RDWR|O_CREAT|O_EXCL, 0700); - die "POSIX::open $path: $!" unless defined $fd; - $fh = FileHandle->new_from_fd($fd, $amode) || die "fdopen: $!"; - $fh->autoflush(1); - $fh->print("stuff $$\n"); - seek($fh, 0, SEEK_SET); - print "File contains: ", <$fh>; + sysopen(HANDLE, $path, O_RDWR|O_CREAT|O_EXCL, 0700) + or die "sysopen $path: $!"; + HANDLE->autoflush(1); + HANDLE->print("stuff $$\n"); + seek(HANDLE, 0, 0); + print "File contains: ", <HANDLE>; See L</seek()> for some details about mixing reading and writing. @@ -2326,10 +2341,13 @@ The usual idiom is: ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); -or to block until something becomes ready: +or to block until something becomes ready just do this $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); +Most systems do not both to return anything useful in $timeleft, so +calling select() in a scalar context just returns $nfound. + Any of the bitmasks can also be undef. The timeout, if specified, is in seconds, which may be fractional. Note: not all implementations are capable of returning the $timeleft. If not, they always return @@ -2525,6 +2543,10 @@ Examples: } @sortedclass = sort byage @class; + # this sorts the %age associative arrays by value + # instead of key using an inline function + @eldest = sort { $age{$b} <=> $age{$a} } keys %age; + sub backwards { $b cmp $a; } @harry = ('dog','cat','x','Cain','Abel'); @george = ('gone','chased','yz','Punished','Axed'); @@ -2732,6 +2754,25 @@ the stat fails. Typically used as follows: $atime,$mtime,$ctime,$blksize,$blocks) = stat($filename); +Not all fields are supported on all filesystem types. Here are the +meaning of the fields: + + dev device number of filesystem + ino inode number + mode file mode (type and permissions) + nlink number of (hard) links to the file + uid numeric user ID of file's owner + gid numer group ID of file's owner + rdev the device identifier (special files only) + size total size of file, in bytes + atime last access time since the epoch + mtime last modify time since the epoch + ctime inode change time (NOT creation type!) since the epoch + blksize preferred blocksize for file system I/O + blocks actual number of blocks allocated + +(The epoch was at 00:00 January 1, 1970 GMT.) + If stat is passed the special filehandle consisting of an underline, no stat is done, but the current contents of the stat structure from the last stat or filetest are returned. Example: @@ -2858,6 +2899,27 @@ like numbers. Note that Perl only supports passing of up to 14 arguments to your system call, which in practice should usually suffice. +=item sysopen FILEHANDLE,FILENAME,MODE + +=item sysopen FILEHANDLE,FILENAME,MODE,PERMS + +Opens the file whose filename is given by FILENAME, and associates it +with FILEHANDLE. If FILEHANDLE is an expression, its value is used as +the name of the real filehandle wanted. This function calls the +underlying operating system's C<open> function with the parameters +FILENAME, MODE, PERMS. + +The possible values and flag bits of the MODE parameter are +system-dependent; they are available via the standard module C<Fcntl>. +However, for historical reasons, some values are universal: zero means +read-only, one means write-only, and two means read/write. + +If the file named by FILENAME does not exist and the C<open> call +creates it (typically because MODE includes the O_CREAT flag), then +the value of PERMS specifies the permissions of the newly created +file. If PERMS is omitted, the default value is 0666, which allows +read and write for all. This default is reasonable: see C<umask>. + =item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET =item sysread FILEHANDLE,SCALAR,LENGTH @@ -3151,7 +3213,7 @@ Returns a normal array consisting of all the values of the named associative array. (In a scalar context, returns the number of values.) The values are returned in an apparently random order, but it is the same order as either the keys() or each() function would produce -on the same array. See also keys() and each(). +on the same array. See also keys(), each(), and sort(). =item vec EXPR,OFFSET,BITS diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 1a3bdad77f..ac2c5fd584 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -273,7 +273,7 @@ you opened whatever your kid writes to his STDOUT. my $sleep_count = 0; do { - $pid = open(KID, "-|"); + $pid = open(KID_TO_WRITE, "|-"); unless (defined $pid) { warn "cannot fork: $!"; die "bailing out" if $sleep_count++ > 6; @@ -282,8 +282,8 @@ you opened whatever your kid writes to his STDOUT. } until defined $pid; if ($pid) { # parent - print KID @some_data; - close(KID) || warn "kid exited $?"; + print KID_TO_WRITE @some_data; + close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child ($EUID, $EGID) = ($UID, $GID); # suid progs only open (FILE, "> /safe/file") @@ -303,13 +303,13 @@ your arguments. Instead, use lower-level control to call exec() directly. Here's a safe backtick or pipe open for read: # add error processing as above - $pid = open(KID, "-|"); + $pid = open(KID_TO_READ, "-|"); if ($pid) { # parent - while (<KID>) { + while (<KID_TO_READ>) { # do something interesting } - close(KID) || warn "kid exited $?"; + close(KID_TO_READ) || warn "kid exited $?"; } else { # child ($EUID, $EGID) = ($UID, $GID); # suid only @@ -322,14 +322,14 @@ Here's a safe backtick or pipe open for read: And here's a safe pipe open for writing: # add error processing as above - $pid = open(KID, "|-"); + $pid = open(KID_TO_WRITE, "|-"); $SIG{ALRM} = sub { die "whoops, $program pipe broke" }; if ($pid) { # parent for (@data) { - print KID; + print KID_TO_WRITE; } - close(KID) || warn "kid exited $?"; + close(KID_TO_WRITE) || warn "kid exited $?"; } else { # child ($EUID, $EGID) = ($UID, $GID); @@ -349,9 +349,9 @@ While this works reasonably well for unidirectional communication, what about bidirectional communication? The obvious thing you'd like to do doesn't actually work: - open(KID, "| some program |") + open(PROG_FOR_READING_AND_WRITING, "| some program |") -and if you forgot to use the B<-w> flag, then you'll miss out +and if you forget to use the B<-w> flag, then you'll miss out entirely on the diagnostic message: Can't do bidirectional pipe at -e line 1. @@ -458,7 +458,50 @@ Here's a sample TCP client using Internet-domain sockets: And here's a corresponding server to go along with it. We'll leave the address as INADDR_ANY so that the kernel can choose -the appropriate interface on multihomed hosts: +the appropriate interface on multihomed hosts. If you want sit +on a particular interface (like the external side of a gateway +or firewall machine), you should fill this in with your real address +instead. + + #!/usr/bin/perl -Tw + require 5.002; + use strict; + BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + use Socket; + use Carp; + + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + + my $port = shift || 2345; + my $proto = getprotobyname('tcp'); + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; + + logmsg "server started on port $port"; + + my $paddr; + + $SIG{CHLD} = \&REAPER; + + for ( ; $paddr = accept(Client,Server); close Client) { + my($port,$iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr,AF_INET); + + logmsg "connection from $name [", + inet_ntoa($iaddr), "] + at port $port"; + + print CLIENT "Hello there, $name, it's now ", + scalar localtime, "\n"; + } + +And here's a multithreaded version. It's multithreaded in that +like most typical servers, it spawns (forks) a slave server to +handle the client request so that the master server can quickly +go back to service a new client. #!/usr/bin/perl -Tw require 5.002; @@ -472,10 +515,11 @@ the appropriate interface on multihomed hosts: my $port = shift || 2345; my $proto = getprotobyname('tcp'); - socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; - setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1) || die "setsockopt: $!"; - bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; - listen(SERVER,5) || die "listen: $!"; + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; logmsg "server started on port $port"; @@ -491,8 +535,8 @@ the appropriate interface on multihomed hosts: $SIG{CHLD} = \&REAPER; for ( $waitedpid = 0; - ($paddr = accept(CLIENT,SERVER)) || $waitedpid; - $waitedpid = 0, close CLIENT) + ($paddr = accept(Client,Server)) || $waitedpid; + $waitedpid = 0, close Client) { next if $waitedpid; my($port,$iaddr) = sockaddr_in($paddr); @@ -527,8 +571,8 @@ the appropriate interface on multihomed hosts: } # else i'm the child -- go spawn - open(STDIN, "<&CLIENT") || die "can't dup client to stdin"; - open(STDOUT, ">&CLIENT") || die "can't dup client to stdout"; + open(STDIN, "<&Client") || die "can't dup client to stdin"; + open(STDOUT, ">&Client") || die "can't dup client to stdout"; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; exit &$coderef(); } @@ -628,18 +672,18 @@ And here's a corresponding server. my $uaddr = sockaddr_un($NAME); my $proto = getprotobyname('tcp'); - socket(SERVER,PF_UNIX,SOCK_STREAM,0) || die "socket: $!"; + socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!"; unlink($NAME); - bind (SERVER, $uaddr) || die "bind: $!"; - listen(SERVER,5) || die "listen: $!"; + bind (Server, $uaddr) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; logmsg "server started on $NAME"; $SIG{CHLD} = \&REAPER; for ( $waitedpid = 0; - accept(CLIENT,SERVER) || $waitedpid; - $waitedpid = 0, close CLIENT) + accept(Client,Server) || $waitedpid; + $waitedpid = 0, close Client) { next if $waitedpid; logmsg "connection on $NAME"; diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 0328bd5d9d..7a8431b15b 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -190,7 +190,7 @@ For more on this, see L<perlobj>. =head2 Perl Modules -A module is a just package that is defined in a library file of +A module is just a package that is defined in a library file of the same name, and is designed to be reusable. It may do this by providing a mechanism for exporting some of its symbols into the symbol table of any package using it. Or it may function as a class diff --git a/pod/perlop.pod b/pod/perlop.pod index 13655a7d9c..d96afc55a2 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -8,7 +8,8 @@ Perl operators have the following associativity and precedence, listed from highest precedence to lowest. Note that all operators borrowed from C keep the same precedence relationship with each other, even where C's precedence is slightly screwy. (This makes learning -Perl easier for C folks.) +Perl easier for C folks.) With very few exceptions, these all +operate on scalar values only, not array values. left terms and list operators (leftward) left -> @@ -88,7 +89,7 @@ well as subroutine and method calls, and the anonymous constructors C<[]> and C<{}>. See also L<Quote and Quotelike Operators> toward the end of this section, -as well as L<I/O Operators>. +as well as L<"I/O Operators">. =head2 The Arrow Operator @@ -157,7 +158,7 @@ thing from interpretation. =head2 Binding Operators -Binary "=~" binds an expression to a pattern match. Certain operations +Binary "=~" binds a scalar expression to a pattern match. Certain operations search or modify the string $_ by default. This operator makes that kind of operation work on some other string. The right argument is a search pattern, substitution, or translation. The left argument is what is diff --git a/pod/perlre.pod b/pod/perlre.pod index 014ee3c818..1c7855c041 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -16,7 +16,7 @@ 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 legibilty with whitespace and comments. + x Extend your pattern's legibility with whitespace and comments. 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 @@ -46,7 +46,7 @@ meanings: \ Quote the next metacharacter ^ Match the beginning of the line . Match any character (except newline) - $ Match the end of the line + $ Match the end of the line (or before newline at the end) | Alternation () Grouping [] Character class @@ -80,7 +80,7 @@ The following standard quantifiers are recognized: (If a curly bracket occurs in any other context, it is treated as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+" modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited -to integral values less than 65536. +to integral values less than 65536. By default, a quantified subpattern is "greedy", that is, it will match as many times as possible without causing the rest pattern not to match. The @@ -136,7 +136,7 @@ Perl defines the following zero-width assertions: \b Match a word boundary \B Match a non-(word boundary) \A Match only at beginning of string - \Z Match only at end of string + \Z Match only at end of string (or before newline at the end) \G Match only where previous m//g left off A word boundary (C<\b>) is defined as a spot between two characters that @@ -146,7 +146,8 @@ end of the string as matching a C<\W>. (Within character classes C<\b> represents backspace rather than a word boundary.) The C<\A> and C<\Z> are just like "^" and "$" except that they won't match multiple times when the C</m> modifier is used, while "^" and "$" will match at every internal line -boundary. +boundary. To match the actual end of the string, not ignoring newline, +you can use C<\Z(?!\n)>. When the bracketing construct C<( ... )> is used, \<digit> matches the digit'th substring. Outside of the pattern, always use "$" instead of "\" @@ -162,7 +163,7 @@ You may have as many parentheses as you wish. If you have more than 9 substrings, the variables $10, $11, ... refer to the corresponding substring. Within the pattern, \10, \11, etc. refer back to substrings if there have been at least that many left parens before -the backreference. Otherwise (for backward compatibilty) \10 is the +the backreference. Otherwise (for backward compatibility) \10 is the same as \010, a backspace, and \11 the same as \011, a tab. And so on. (\1 through \9 are always backreferences.) @@ -192,7 +193,7 @@ non-alphanumeric characters: You can also use the built-in quotemeta() function to do this. An even easier way to quote metacharacters right in the match operator -is to say +is to say /$unquoted\Q$quoted\E$unquoted/ @@ -237,10 +238,10 @@ the C<(?!foo)> is just saying that the next thing cannot be "foo"--and it's not, it's a "bar", so "foobar" will match. You would have to do something like C</(?foo)...bar/> for that. We say "like" because there's the case of your "bar" not having three characters before it. You could -cover that this way: C</(?:(?!foo)...|^..?)bar/>. Sometimes it's still +cover that this way: C</(?:(?!foo)...|^..?)bar/>. Sometimes it's still easier just to say: - if (/foo/ && $` =~ /bar$/) + if (/foo/ && $` =~ /bar$/) =item (?imsx) @@ -252,12 +253,12 @@ insensitive ones merely need to include C<(?i)> at the front of the pattern. For example: $pattern = "foobar"; - if ( /$pattern/i ) + if ( /$pattern/i ) # more flexible: $pattern = "(?i)foobar"; - if ( /$pattern/ ) + if ( /$pattern/ ) =back @@ -266,6 +267,192 @@ matching construct was because 1) question mark is pretty rare in older regular expressions, and 2) whenever you see one, you should stop and "question" exactly what is going on. That's psychology... +=head2 Backtracking + +A fundamental feature of regular expression matching involves the notion +called I<backtracking>. which is used (when needed) by all regular +expression quantifiers, namely C<*>, C<*?>, C<+>, C<+?>, C<{n,m}>, and +C<{n,m}?>. + +For a regular expression to match, the I<entire> regular expression must +match, not just part of it. So if the beginning of a pattern containing a +quantifier succeeds in a way that causes later parts in the pattern to +fail, the matching engine backs up and recalculates the beginning +part--that's why it's called backtracking. + +Here is an example of backtracking: Let's say you want to find the +word following "foo" in the string "Food is on the foo table.": + + $_ = "Food is on the foo table."; + if ( /\b(foo)\s+(\w+)/i ) { + print "$2 follows $1.\n"; + } + +When the match runs, the first part of the regular expression (C<\b(foo)>) +finds a possible match right at the beginning of the string, and loads up +$1 with "Foo". However, as soon as the matching engine sees that there's +no whitespace following the "Foo" that it had saved in $1, it realizes its +mistake and starts over again one character after where it had had the +tentative match. This time it goes all the way until the next occurrence +of "foo". The complete regular expression matches this time, and you get +the expected output of "table follows foo." + +Sometimes minimal matching can help a lot. Imagine you'd like to match +everything between "foo" and "bar". Initially, you write something +like this: + + $_ = "The food is under the bar in the barn."; + if ( /foo(.*)bar/ ) { + print "got <$1>\n"; + } + +Which perhaps unexpectedly yields: + + got <d is under the bar in the > + +That's because C<.*> was greedy, so you get everything between the +I<first> "foo" and the I<last> "bar". In this case, it's more effective +to use minimal matching to make sure you get the text between a "foo" +and the first "bar" thereafter. + + if ( /foo(.*?)bar/ ) { print "got <$1>\n" } + got <d is under the > + +Here's another example: let's say you'd like to match a number at the end +of a string, and you also want to keep the preceding part the match. +So you write this: + + $_ = "I have 2 numbers: 53147"; + if ( /(.*)(\d*)/ ) { # Wrong! + print "Beginning is <$1>, number is <$2>.\n"; + } + +That won't work at all, because C<.*> was greedy and gobbled up the +whole string. As C<\d*> can match on an empty string the complete +regular expression matched successfully. + + Beginning is <I have 2: 53147>, number is <>. + +Here are some variants, most of which don't work: + + $_ = "I have 2 numbers: 53147"; + @pats = qw{ + (.*)(\d*) + (.*)(\d+) + (.*?)(\d*) + (.*?)(\d+) + (.*)(\d+)$ + (.*?)(\d+)$ + (.*)\b(\d+)$ + (.*\D)(\d+)$ + }; + + for $pat (@pats) { + printf "%-12s ", $pat; + if ( /$pat/ ) { + print "<$1> <$2>\n"; + } else { + print "FAIL\n"; + } + } + +That will print out: + + (.*)(\d*) <I have 2 numbers: 53147> <> + (.*)(\d+) <I have 2 numbers: 5314> <7> + (.*?)(\d*) <> <> + (.*?)(\d+) <I have > <2> + (.*)(\d+)$ <I have 2 numbers: 5314> <7> + (.*?)(\d+)$ <I have 2 numbers: > <53147> + (.*)\b(\d+)$ <I have 2 numbers: > <53147> + (.*\D)(\d+)$ <I have 2 numbers: > <53147> + +As you see, this can be a bit tricky. It's important to realize that a +regular expression is merely a set of assertions that gives a definition +of success. There may be 0, 1, or several different ways that the +definition might succeed against a particular string. And if there are +multiple ways it might succeed, you need to understand backtracking in +order to know which variety of success you will achieve. + +When using lookahead assertions and negations, this can all get even +tricker. Imagine you'd like to find a sequence of nondigits not +followed by "123". You might try to write that as + + $_ = "ABC123"; + if ( /^\D*(?!123)/ ) { # Wrong! + print "Yup, no 123 in $_\n"; + } + +But that isn't going to match; at least, not the way you're hoping. It +claims that there is no 123 in the string. Here's a clearer picture of +why it that pattern matches, contrary to popular expectations: + + $x = 'ABC123' ; + $y = 'ABC445' ; + + print "1: got $1\n" if $x =~ /^(ABC)(?!123)/ ; + print "2: got $1\n" if $y =~ /^(ABC)(?!123)/ ; + + print "3: got $1\n" if $x =~ /^(\D*)(?!123)/ ; + print "4: got $1\n" if $y =~ /^(\D*)(?!123)/ ; + +This prints + + 2: got ABC + 3: got AB + 4: got ABC + +You might have expected test 3 to fail because it just seems to a more +general purpose version of test 1. The important difference between +them is that test 3 contains a quantifier (C<\D*>) and so can use +backtracking, whereas test 1 will not. What's happening is +that you've asked "Is it true that at the start of $x, following 0 or more +nondigits, you have something that's not 123?" If the pattern matcher had +let C<\D*> expand to "ABC", this would have caused the whole pattern to +fail. +The search engine will initially match C<\D*> with "ABC". Then it will +try to match C<(?!123> with "123" which, of course, fails. But because +a quantifier (C<\D*>) has been used in the regular expression, the +search engine can backtrack and retry the match differently +in the hope of matching the complete regular expression. + +Well now, +the pattern really, I<really> wants to succeed, so it uses the +standard regexp backoff-and-retry and lets C<\D*> expand to just "AB" this +time. Now there's indeed something following "AB" that is not +"123". It's in fact "C123", which suffices. + +We can deal with this by using both an assertion and a negation. We'll +say that the first part in $1 must be followed by a digit, and in fact, it +must also be followed by something that's not "123". Remember that the +lookaheads are zero-width expressions--they only look, but don't consume +any of the string in their match. So rewriting this way produces what +you'd expect; that is, case 5 will fail, but case 6 succeeds: + + print "5: got $1\n" if $x =~ /^(\D*)(?=\d)(?!123)/ ; + print "6: got $1\n" if $y =~ /^(\D*)(?=\d)(?!123)/ ; + + 6: got ABC + +In other words, the two zero-width assertions next to each other work like +they're ANDed together, just as you'd use any builtin assertions: C</^$/> +matches only if you're at the beginning of the line AND the end of the +line simultaneously. The deeper underlying truth is that juxtaposition in +regular expressions always means AND, except when you write an explicit OR +using the vertical bar. C</ab/> means match "a" AND (then) match "b", +although the attempted matches are made at different positions because "a" +is not a zero-width assertion, but a one-width assertion. + +One warning: particularly complicated regular expressions can take +exponential time to solve due to the immense number of possible ways they +can use backtracking to try match. For example this will take a very long +time to run + + /((a{0,5}){0,5}){0,5}/ + +And if you used C<*>'s instead of limiting it to 0 through 5 matches, then +it would take literally forever--or until you ran out of stack space. + =head2 Version 8 Regular Expressions In case you're not familiar with the "regular" Version 8 regexp @@ -309,7 +496,7 @@ matching C<[feio|]>. Within a pattern, you may designate subpatterns for later reference by enclosing them in parentheses, and you may refer back to the I<n>th -subpattern later in the pattern using the metacharacter \I<n>. +subpattern later in the pattern using the metacharacter \I<n>. Subpatterns are numbered based on the left to right order of their opening parenthesis. Note that a backreference matches whatever actually matched the subpattern in the string being examined, not the diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 1e1a0cb814..d684bf908e 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -4,7 +4,10 @@ perlrun - how to execute the Perl interpreter =head1 SYNOPSIS -B<perl> [switches] filename args +B<perl> [B<-acdhnpPsSTuUvw>] [B<-0[octal>]] [B<-D[number/list]>] + [B<-F regexp>] [B<-i[extension>]] [B<-I<lt>dir<gt>>] + [B<-l[octal]>] [B<-x[dir]>] + [programfile | B<-e command>] [argument ...] =head1 DESCRIPTION @@ -246,14 +249,21 @@ separator if the B<-l> switch is followed by a B<-0> switch: This sets $\ to newline and then sets $/ to the null character. +=item B<-m>I<module> + =item B<-M>I<module> -executes C<use> I<module> C<;> before executing your script. You can -also do C<-M'Foo qw(Bar Baz)'>. +C<-m>I<module> executes C<use> I<module> C<();> before executing your +script. -=item B<-m>I<module> +C<-M>I<module> executes C<use> I<module> C<;> before executing your +script. You can use quotes to add extra code after the module name, +e.g., C<-M'module qw(foo bar)'>. -executes C<use> I<module> C<();> before executing your script. +A little built-in syntactic sugar means you can also say +C<-mmodule=foo> or C<-Mmodule=foo> as a shortcut for +C<-M'module qw(foo)'>. Note that using the C<=> form +removes the distinction between -m and -M. =item B<-n> diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 8bc269de8a..e4a5aab41f 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -159,6 +159,13 @@ previous example. =item * +Avoid using grep() (or map()) or `backticks` in a void context, that is, +when you just throw away their return values. Those functions all +have return values, so use them. Otherwise use a foreach() loop or +the system() function instead. + +=item * + For portability, when using features that may not be implemented on every machine, test the construct in an eval to see if it fails. If you know what version or patchlevel a particular feature was diff --git a/pod/perlsub.pod b/pod/perlsub.pod index a893ff5478..80d02d1ca5 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -32,7 +32,8 @@ Like many languages, Perl provides for user-defined subroutines. These may be located anywhere in the main program, loaded in from other files via the C<do>, C<require>, or C<use> keywords, or even generated on the fly using C<eval> or anonymous subroutines (closures). You can even call -a function indirectly using a variable containing its name or a CODE reference. +a function indirectly using a variable containing its name or a CODE reference +to it, as in C<$var = \&function>. The Perl model for function call and return values is simple: all functions are passed as parameters one single flat list of scalars, and @@ -126,7 +127,8 @@ of changing them in place: sub upcase { my @parms = @_; for (@parms) { tr/a-z/A-Z/ } - return @parms; + # wantarray checks if we were called in list context + return wantarray ? @parms : $parms[0]; } Notice how this (unprototyped) function doesn't care whether it was passed @@ -170,6 +172,11 @@ new users may wish to avoid. &foo; # foo() get current args, like foo(@_) !! foo; # like foo() IFF sub foo pre-declared, else "foo" +Not only does the "&" form make the argument list optional, but it also +disables any prototype checking on the arguments you do provide. This +is partly for historical reasons, and partly for having a convenient way +to cheat if you know what you're doing. See the section on Prototypes below. + =head2 Private Variables via my() Synopsis: @@ -450,7 +457,8 @@ the individual arrays. For more on typeglobs, see L<perldata/"Typeglobs">. 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; see L<perlref>. +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 arrays to a function and have it pop all of then, return a new @@ -509,7 +517,7 @@ in order of how many elements they have in them: if (@$cref > @$dref) { return ($cref, $dref); } else { - return ($cref, $cref); + return ($dref, $cref); } } @@ -564,13 +572,23 @@ As of the 5.002 release of perl, if you declare sub mypush (\@@) -then mypush() takes arguments exactly like push() does. (This only works -for function calls that are visible at compile time, not indirect function -calls through a C<&$func> reference nor for method calls as described in -L<perlobj>.) +then mypush() takes arguments exactly like push() does. The declaration +of the function to be called must be visible at compile time. The prototype +only affects the interpretation of new-style calls to the function, where +new-style is defined as not using the C<&> character. In other words, +if you call it like a builtin function, then it behaves like a builtin +function. If you call it like an old-fashioned subroutine, then it +behaves like an old-fashioned subroutine. It naturally falls out from +this rule that prototypes have no influence on subroutine references +like C<\&foo> or on indirect subroutine calls like C<&{$subref}>. + +Method calls are not influenced by prototypes either, because the +function to be called is indeterminate at compile time, since it depends +on inheritance. -Here are the prototypes for some other functions that parse almost exactly -like the corresponding builtins. +Since the intent is primarily to let you define subroutines that work +like builtin commands, here are the prototypes for some other functions +that parse almost exactly like the corresponding builtins. Declared as Called as @@ -589,15 +607,21 @@ like the corresponding builtins. sub myrand ($) myrand 42 sub mytime () mytime -Any backslashed prototype character must be passed something starting -with that character. Any unbackslashed @ or % eats all the rest of the -arguments, and forces list context. An argument represented by $ -forces scalar context. An & requires an anonymous subroutine, and * -does whatever it has to do to turn the argument into a reference to a -symbol table entry. A semicolon separates mandatory arguments from -optional arguments. +Any backslashed prototype character represents an actual argument +that absolutely must start with that character. + +Unbackslashed prototype characters have special meanings. Any +unbackslashed @ or % eats all the rest of the arguments, and forces +list context. An argument represented by $ forces scalar context. An +& requires an anonymous subroutine, which, if passed as the first +argument, does not require the "sub" keyword or a subsequent comma. A +* does whatever it has to do to turn the argument into a reference to a +symbol table entry. + +A semicolon separates mandatory arguments from optional arguments. +(It is redundant before @ or %.) -Note that the last three are syntactically distinguished by the lexer. +Note how the last three examples above are treated specially by the parser. mygrep() is parsed as a true list operator, myrand() is parsed as a true unary operator with unary precedence the same as rand(), and mytime() is truly argumentless, just like time(). That is, if you diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index e41caee3ec..037ede1099 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -39,9 +39,9 @@ as the my if you expect to to be able to access those private variables. Declaring a subroutine allows a subroutine name to be used as if it were a list operator from that point forward in the program. You can declare a -subroutine without defining it by saying just +subroutine (prototyped to take one scalar parameter) without defining it by saying just: - sub myname; + sub myname ($); $me = myname $0 or die "can't get myname"; Note that it functions as a list operator though, not as a unary @@ -316,17 +316,19 @@ do it: See how much easier this is? It's cleaner, safer, and faster. It's cleaner because it's less noisy. It's safer because if code gets added -between the inner and outer loops later, you won't accidentally excecute -it because you've explicitly asked to iterate the other loop rather than -merely terminating the inner one. And it's faster because Perl executes a -C<foreach> statement more rapidly than it would the equivalent C<for> -loop. +between the inner and outer loops later on, the new code won't be +accidentally excecuted: the C<next> explicitly iterates the other loop +rather than merely terminating the inner one. And it's faster because +Perl executes a C<foreach> statement more rapidly than it would the +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. The C<continue> block +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 @@ -419,10 +421,10 @@ for a C<do> block to return the proper value: $amode = do { if ($flag & O_RDONLY) { "r" } - elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "w" : "a" } + elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } elsif ($flag & O_RDWR) { if ($flag & O_CREAT) { "w+" } - else { ($flag & O_APPEND) ? "r+" : "a+" } + else { ($flag & O_APPEND) ? "a+" : "r+" } } }; @@ -456,15 +458,15 @@ pretend that the other subroutine had been called in the first place propagated to the other subroutine.) After the C<goto>, not even caller() will be able to tell that this routine was called first. -In almost cases like this, it's usually a far, far better idea to use the -structured control flow mechanisms of C<next>, C<last>, or C<redo> insetad +In almost all cases like this, it's usually a far, far better idea to use the +structured control flow mechanisms of C<next>, C<last>, or C<redo> instead of resorting to a C<goto>. For certain applications, the catch and throw pair of C<eval{}> and die() for exception processing can also be a prudent approach. =head2 PODs: Embedded Documentation Perl has a mechanism for intermixing documentation with source code. -If while expecting the beginning of a new statement, the compiler +While it's expecting the beginning of a new statement, if the compiler encounters a line that begins with an equal sign and a word, like this =head1 Here There Be Pods! diff --git a/pod/perltie.pod b/pod/perltie.pod index 7898700f39..ad5d66ff6e 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -604,6 +604,14 @@ for the C<$#ARRAY> access (which is hard, as it's an lvalue), as well as the other obvious array functions, like push(), pop(), shift(), unshift(), and splice(). +You cannot easily tie a multilevel data structure (such as a hash of +hashes) to a dbm file. The first problem is that all but GDBM and +Berkeley DB have size limitations, but beyond that, you also have problems +with how references are to be represented on disk. One experimental +module that does attempt to partially address this need is the MLDBM +module. Check your nearest CPAN site as described in L<perlmod> for +source code to MLDBM. + =head1 AUTHOR Tom Christiansen diff --git a/pod/perltoc.pod b/pod/perltoc.pod index cf5ba8cbb7..0f8de0c88a 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -2793,7 +2793,7 @@ have man pages yet: =head1 AUTHOR -Larry Wall E<lt><F<lwall@netlabs.com>E<gt>, with the help of oodles of +Larry Wall E<lt><F<lwall@sems.com>E<gt>, with the help of oodles of other folks. diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 79e3ae5ca9..dd219c064b 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -324,6 +324,12 @@ Using local() actually gives a local value to a global variable, which leaves you open to unforeseen side-effects of dynamic scoping. +=item * + +If you localize an exported variable in a module, its exported value will +not change. The local name becomes an alias to a new value but the +external name is still an alias for the original. + =back =head2 Perl4 Traps @@ -486,6 +492,27 @@ works fine, however. =item * +The meaning of foreach has changed slightly when it is iterating over a +list which is not an array. This used to assign the list to a +temporary array, but no longer does so (for efficiency). This means +that you'll now be iterating over the actual values, not over copies of +the values. Modifications to the loop variable can change the original +values. To retain Perl 4 semantics you need to assign your list +explicitly to a temporary array and then iterate over that. For +example, you might need to change + + foreach $var (grep /x/, @list) { ... } + +to + + foreach $var (my @tmp = grep /x/, @list) { ... } + +Otherwise changing C<$var> will clobber the values of @list. (This most often +happens when you use C<$_> for the loop variable, and call subroutines in +the loop that don't properly localize C<$_>.) + +=item * + Some error messages will be different. =item * diff --git a/pod/perlxs.pod b/pod/perlxs.pod index b663dcfa2d..0c376047ba 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -129,6 +129,16 @@ separate lines. double x sin(x) double x +The function body may be indented or left-adjusted. The following example +shows a function with its body left-adjusted. Most examples in this +document will indent the body. + + CORRECT + + double + sin(x) + double x + =head2 The Argument Stack The argument stack is used to store the values which are @@ -278,10 +288,20 @@ The XSUB follows. timep RETVAL -In many of the examples shown here the CODE: block (and -other blocks) will often be contained within braces ( C<{> and -C<}> ). This protects the CODE: block from complex INPUT -typemaps and ensures the resulting C code is legal. +=head2 The INIT: Keyword + +The INIT: keyword allows initialization to be inserted into the XSUB before +the compiler generates the call to the C function. Unlike the CODE: keyword +above, this keyword does not affect the way the compiler handles RETVAL. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + INIT: + printf("# Host is %s\n", host ); + OUTPUT: + timep =head2 The NO_INIT Keyword @@ -362,6 +382,86 @@ the parameters in the correct order for that function. timep RETVAL +=head2 The PREINIT: Keyword + +The PREINIT: keyword allows extra variables to be declared before the +typemaps are expanded. If a variable is declared in a CODE: block then that +variable will follow any typemap code. This may result in a C syntax +error. To force the variable to be declared before the typemap code, place +it into a PREINIT: block. The PREINIT: keyword may be used one or more +times within an XSUB. + +The following examples are equivalent, but if the code is using complex +typemaps then the first example is safer. + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + PREINIT: + char *host = "localhost"; + CODE: + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +A correct, but error-prone example. + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + CODE: + char *host = "localhost"; + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The INPUT: Keyword + +The XSUB's parameters are usually evaluated immediately after entering the +XSUB. The INPUT: keyword can be used to force those parameters to be +evaluated a little later. The INPUT: keyword can be used multiple times +within an XSUB and can be used to list one or more input variables. This +keyword is used with the PREINIT: keyword. + +The following example shows how the input parameter C<timep> can be +evaluated late, after a PREINIT. + + bool_t + rpcb_gettime(host,timep) + char *host + PREINIT: + time_t tt; + INPUT: + time_t timep + CODE: + RETVAL = rpcb_gettime( host, &tt ); + timep = tt; + OUTPUT: + timep + RETVAL + +The next example shows each input parameter evaluated late. + + bool_t + rpcb_gettime(host,timep) + PREINIT: + time_t tt; + INPUT: + char *host + PREINIT: + char *h; + INPUT: + time_t timep + CODE: + h = host; + RETVAL = rpcb_gettime( h, &tt ); + timep = tt; + OUTPUT: + timep + RETVAL + =head2 Variable-length Parameter Lists XSUBs can have variable-length parameter lists by specifying an ellipsis @@ -385,14 +485,12 @@ The XS code, with ellipsis, follows. bool_t rpcb_gettime(timep, ...) time_t timep = NO_INIT - CODE: - { + PREINIT: char *host = "localhost"; - - if( items > 1 ) - host = (char *)SvPV(ST(1), na); - RETVAL = rpcb_gettime( host, &timep ); - } + CODE: + if( items > 1 ) + host = (char *)SvPV(ST(1), na); + RETVAL = rpcb_gettime( host, &timep ); OUTPUT: timep RETVAL @@ -414,15 +512,14 @@ Perl as a single list. void rpcb_gettime(host) char *host - PPCODE: - { + PREINIT: time_t timep; bool_t status; + PPCODE: status = rpcb_gettime( host, &timep ); EXTEND(sp, 2); PUSHs(sv_2mortal(newSViv(status))); PUSHs(sv_2mortal(newSViv(timep))); - } Notice that the programmer must supply the C code necessary to have the real rpcb_gettime() function called and to have @@ -466,14 +563,13 @@ the default return value. void rpcb_gettime(host) char * host - CODE: - { + PREINIT: time_t timep; bool_t x; + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ) sv_setnv( ST(0), (double)timep); - } The next example demonstrates how one would place an explicit undef in the return value, should the need arise. @@ -481,10 +577,10 @@ return value, should the need arise. void rpcb_gettime(host) char * host - CODE: - { + PREINIT: time_t timep; bool_t x; + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ){ sv_setnv( ST(0), (double)timep); @@ -492,7 +588,6 @@ return value, should the need arise. else{ ST(0) = &sv_undef; } - } To return an empty list one must use a PPCODE: block and then not push return values on the stack. @@ -500,16 +595,15 @@ then not push return values on the stack. void rpcb_gettime(host) char *host - PPCODE: - { + PREINIT: time_t timep; + PPCODE: if( rpcb_gettime( host, &timep ) ) PUSHs(sv_2mortal(newSViv(timep))); else{ /* Nothing pushed on stack, so an empty */ /* list is implicitly returned. */ } - } =head2 The REQUIRE: Keyword @@ -545,6 +639,186 @@ terminate the code block. # bootstrap function executes. printf("Hello from the bootstrap!\n"); +=head2 The VERSIONCHECK: Keyword + +The VERSIONCHECK: keyword corresponds to B<xsubpp>'s C<-versioncheck> and +C<-noversioncheck> options. This keyword overrides the commandline +options. Version checking is enabled by default. When version checking is +enabled the XS module will attempt to verify that its version matches the +version of the PM module. + +To enable version checking: + + VERSIONCHECK: ENABLE + +To disable version checking: + + VERSIONCHECK: DISABLE + +=head2 The PROTOTYPES: Keyword + +The PROTOTYPES: keyword corresponds to B<xsubpp>'s C<-prototypes> and +C<-noprototypes> options. This keyword overrides the commandline options. +Prototypes are enabled by default. When prototypes are enabled XSUBs will +be given Perl prototypes. This keyword may be used multiple times in an XS +module to enable and disable prototypes for different parts of the module. + +To enable prototypes: + + PROTOTYPES: ENABLE + +To disable prototypes: + + PROTOTYPES: DISABLE + +=head2 The PROTOTYPE: Keyword + +This keyword is similar to the PROTOTYPES: keyword above but can be used to +force B<xsubpp> to use a specific prototype for the XSUB. This keyword +overrides all other prototype options and keywords but affects only the +current XSUB. Consult L<perlsub/Prototypes> for information about Perl +prototypes. + + bool_t + rpcb_gettime(timep, ...) + time_t timep = NO_INIT + PROTOTYPE: $;$ + PREINIT: + char *host = "localhost"; + CODE: + if( items > 1 ) + host = (char *)SvPV(ST(1), na); + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The ALIAS: Keyword + +The ALIAS: keyword allows an XSUB to have two more more unique Perl names +and to know which of those names was used when it was invoked. The Perl +names may be fully-qualified with package names. Each alias is given an +index. The compiler will setup a variable called C<ix> which contain the +index of the alias which was used. When the XSUB is called with its +declared name C<ix> will be 0. + +The following example will create aliases C<FOO::gettime()> and +C<BAR::getit()> for this function. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + ALIAS: + FOO::gettime = 1 + BAR::getit = 2 + INIT: + printf("# ix = %d\n", ix ); + OUTPUT: + timep + +=head2 The INCLUDE: Keyword + +This keyword can be used to pull other files into the XS module. The other +files may have XS code. INCLUDE: can also be used to run a command to +generate the XS code to be pulled into the module. + +The file F<Rpcb1.xsh> contains our C<rpcb_gettime()> function: + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + +The XS module can use INCLUDE: to pull that file into it. + + INCLUDE: Rpcb1.xsh + +If the parameters to the INCLUDE: keyword are followed by a pipe (C<|>) then +the compiler will interpret the parameters as a command. + + INCLUDE: cat Rpcb1.xsh | + +=head2 The CASE: Keyword + +The CASE: keyword allows an XSUB to have multiple distinct parts with each +part acting as a virtual XSUB. CASE: is greedy and if it is used then all +other XS keywords must be contained within a CASE:. This means nothing may +precede the first CASE: in the XSUB and anything following the last CASE: is +included in that case. + +A CASE: might switch via a parameter of the XSUB, via the C<ix> ALIAS: +variable (see L<"The ALIAS: Keyword">), or maybe via the C<items> variable +(see L<"Variable-length Parameter Lists">). The last CASE: becomes the +B<default> case if it is not associated with a conditional. The following +example shows CASE switched via C<ix> with a function C<rpcb_gettime()> +having an alias C<x_gettime()>. When the function is called as +C<rpcb_gettime()> it's parameters are the usual C<(char *host, time_t +*timep)>, but when the function is called as C<x_gettime()> is parameters are +reversed, C<(time_t *timep, char *host)>. + + long + rpcb_gettime(a,b) + CASE: ix == 1 + ALIAS: + x_gettime = 1 + INPUT: + # 'a' is timep, 'b' is host + char *b + time_t a = NO_INIT + CODE: + RETVAL = rpcb_gettime( b, &a ); + OUTPUT: + a + RETVAL + CASE: + # 'a' is host, 'b' is timep + char *a + time_t &b = NO_INIT + OUTPUT: + b + RETVAL + +That function can be called with either of the following statements. Note +the different argument lists. + + $status = rpcb_gettime( $host, $timep ); + + $status = x_gettime( $timep, $host ); + +=head2 The & Unary Operator + +The & unary operator is used to tell the compiler that it should dereference +the object when it calls the C function. This is used when a CODE: block is +not used and the object is a not a pointer type (the object is an C<int> or +C<long> but not a C<int*> or C<long*>). + +The following XSUB will generate incorrect C code. The xsubpp compiler will +turn this into code which calls C<rpcb_gettime()> with parameters C<(char +*host, time_t timep)>, but the real C<rpcb_gettime()> wants the C<timep> +parameter to be of type C<time_t*> rather than C<time_t>. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t timep + OUTPUT: + timep + +That problem is corrected by using the C<&> operator. The xsubpp compiler +will now turn this into code which calls C<rpcb_gettime()> correctly with +parameters C<(char *host, time_t *timep)>. It does this by carrying the +C<&> through, so the function call looks like C<rpcb_gettime(host, &timep)>. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + =head2 Inserting Comments and C Preprocessor Directives Comments and C preprocessor directives are allowed within @@ -635,7 +909,7 @@ example. # char* having the name of the package for the blessing. O_OBJECT sv_setref_pv( $arg, CLASS, (void*)$var ); - + INPUT O_OBJECT if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) @@ -787,13 +1061,12 @@ File C<RPC.xs>: Interface to some ONC+ RPC bind library functions. void rpcb_gettime(host="localhost") char *host - CODE: - { + PREINIT: time_t timep; + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ) sv_setnv( ST(0), (double)timep ); - } Netconfig * getnetconfigent(netid="udp") @@ -840,7 +1113,11 @@ File C<rpctest.pl>: Perl test program for the RPC extension. print "netconf = $netconf\n"; +=head1 XS VERSION + +This document covers features supported by C<xsubpp> 1.931. + =head1 AUTHOR Dean Roehrich F<E<lt>roehrich@cray.comE<gt>> -Dec 10, 1995 +Jan 25, 1996 diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 082e2cd02d..16601a0c29 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -5,28 +5,81 @@ perlXStut - Tutorial for XSUB's =head1 DESCRIPTION This tutorial will educate the reader on the steps involved in creating -a Perl 5 extension. The reader is assumed to have access to L<perlguts> and +a Perl extension. The reader is assumed to have access to L<perlguts> and L<perlxs>. This tutorial starts with very simple examples and becomes more complex, -bringing in more features that are available. Thus, certain statements -towards the beginning may be incomplete. The reader is encouraged to -read the entire document before lambasting the author about apparent -mistakes. +with each new example adding new features. Certain concepts may not be +completely explained until later in the tutorial in order to slowly ease +the reader into building extensions. -This tutorial is still under construction. Constructive comments -are welcome. +=head2 VERSION CAVEAT -=head1 EXAMPLE 1 +This tutorial tries hard to keep up with the latest development versions +of Perl. This often means that it is sometimes in advance of the latest +released version of Perl, and that certain features described here might +not work on earlier versions. This section will keep track of when various +features were added to Perl 5. + +=over 4 + +=item * + +In version 5.002 before version 5.002b1h, the test.pl file was not +automatically created by xsubpp. This means that you cannot say "make test" +to run the test script. You will need to add the following line before the +"use extension" statement: + + use lib './blib'; + +=item * + +In versions 5.000 and 5.001, instead of using the above line, you will need +to use the following line: + + BEGIN { unshift(@INC, "./blib") } + +=item * + +This document assumes that the executable named "perl" is Perl version 5. +Some systems may have installed Perl version 5 as "perl5". + +=back + +=head2 DYNAMIC VERSUS STATIC + +It is commonly thought that if a system does not have the capability to +dynamically load a library, you cannot build XSUB's. This is incorrect. +You I<can> build them, but you must link the XSUB's subroutines with the +rest of Perl, creating a new executable. This situation is similar to +Perl 4. + +This tutorial can still be used on such a system. The XSUB build mechanism +will check the system and build a dynamically-loadable library if possible, +or else a static library and then, optionally, a new statically-linked +executable with that static library linked in. + +Should you wish to build a statically-linked executable on a system which +can dynamically load libraries, you may, in all the following examples, +where the command "make" with no arguments is executed, run the command +"make perl" instead. + +If you have generated such a statically-linked executable by choice, then +instead of saying "make test", you should say "make test_static". On systems +that cannot build dynamically-loadable libraries at all, simply saying "make +test" is sufficient. + +=head2 EXAMPLE 1 Our first extension will be very simple. When we call the routine in the -extension, it will print out a well-known message and terminate. +extension, it will print out a well-known message and return. -Run C<h2xs -A -n Test1>. This creates a directory named Test1, possibly under -ext/ if it exists in the current working directory. Four files will be -created in the Test1 dir: MANIFEST, Makefile.PL, Test1.pm, Test1.xs. +Run "h2xs -A -n mytest". This creates a directory named mytest, possibly under +ext/ if that directory exists in the current working directory. Several files +will be created in the mytest dir, including MANIFEST, Makefile.PL, mytest.pm, +mytest.xs, test.pl, and Changes. -The MANIFEST file should contain the names of the four files created. +The MANIFEST file contains the names of all the files created. The file Makefile.PL should look something like this: @@ -34,142 +87,162 @@ The file Makefile.PL should look something like this: # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - 'NAME' => 'Test1', - 'VERSION' => '0.1', + 'NAME' => 'mytest', + 'VERSION_FROM' => 'mytest.pm', # finds $VERSION 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' ); -The file Test1.pm should look something like this: +The file mytest.pm should start with something like this: + + package mytest; - package Test1; - require Exporter; require DynaLoader; - + @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( - + ); - bootstrap Test1; - + $VERSION = '0.01'; + + bootstrap mytest $VERSION; + # Preloaded methods go here. - + # Autoload methods go after __END__, and are processed by the autosplit program. - + 1; __END__ + # Below is the stub of documentation for your module. You better edit it! -And the Test1.xs file should look something like this: +And the mytest.xs file should look something like this: + #ifdef __cplusplus + extern "C" { + #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" + #ifdef __cplusplus + } + #endif - MODULE = Test1 PACKAGE = Test1 + MODULE = mytest PACKAGE = mytest Let's edit the .xs file by adding this to the end of the file: void hello() - CODE: printf("Hello, world!\n"); -Now we'll run C<perl Makefile.PL>. This will create a real Makefile, +Now we'll run "perl Makefile.PL". This will create a real Makefile, which make needs. It's output looks something like: % perl Makefile.PL Checking if your kit is complete... Looks good - Writing Makefile for Test1 + Writing Makefile for mytest % -Now, running make will produce output that looks something like this: +Now, running make will produce output that looks something like this +(some long lines shortened for clarity): % make - mkdir ./blib - mkdir ./blib/auto - mkdir ./blib/auto/Test1 - perl xsubpp -typemap typemap Test1.xs >Test1.tc && mv Test1.tc Test1.c - cc -c Test1.c - Running Mkbootstrap for Test1 () - chmod 644 Test1.bs - LD_RUN_PATH="" ld -o ./blib/auto/Test1/Test1.sl -b Test1.o - chmod 755 ./blib/auto/Test1/Test1.sl - cp Test1.bs ./blib/auto/Test1/Test1.bs - chmod 644 ./blib/auto/Test1/Test1.bs - cp Test1.pm ./blib/Test1.pm - chmod 644 ./blib/Test1.pm - -Now we'll create a test script, test1.pl in the Test1 directory. It should + umask 0 && cp mytest.pm ./blib/mytest.pm + perl xsubpp -typemap typemap mytest.xs >mytest.tc && mv mytest.tc mytest.c + cc -c mytest.c + Running Mkbootstrap for mytest () + chmod 644 mytest.bs + LD_RUN_PATH="" ld -o ./blib/PA-RISC1.1/auto/mytest/mytest.sl -b mytest.o + chmod 755 ./blib/PA-RISC1.1/auto/mytest/mytest.sl + cp mytest.bs ./blib/PA-RISC1.1/auto/mytest/mytest.bs + chmod 644 ./blib/PA-RISC1.1/auto/mytest/mytest.bs + +Now, although there is already a test.pl template ready for us, for this +example only, we'll create a special test script. Create a file called hello +that looks like this: + +Now we'll create a test script, test1.pl in the mytest directory. It should look like this: - #! /usr/local/bin/perl + #! /opt/perl5/bin/perl - BEGIN { unshift(@INC, "./blib") } + use lib './blib'; - use Test1; + use mytest; - Test1::hello(); + mytest::hello(); Now we run the script and we should see the following output: - % perl test1.pl + % perl hello Hello, world! % -=head1 EXAMPLE 2 +=head2 EXAMPLE 2 -Now let's create a simple extension that will take a single argument and -return 0 if the argument is even, 1 if the argument is odd. +Now let's add to our extension a subroutine that will take a single argument +and return 0 if the argument is even, 1 if the argument is odd. -Run C<h2xs -A -n Test2>. This will create a Test2 directory with a file -Test2.xs underneath it. Add the following to the end of the XS file: +Add the following to the end of mytest.xs: int is_even(input) int input - CODE: - RETVAL = input % 2; - + RETVAL = (input % 2 == 0); OUTPUT: RETVAL -(Note that the line after the declaration of is_even is indented one tab -stop. Although there is a tab between "int" and "input", this can be any -amount of white space. Also notice that there is no semi-colon following -the "declaration" of the variable input) +There must be some white space at the start of the "int input" line, and +there must not be a semi-colon at the end of the line (as you'd expect in +a C program). -Now perform the same steps before, generating a Makefile from the -Makefile.PL file, and running make. - -Our test file test2.pl will now look like: +Any white space may be between the "int" and "input". It is also okay for +the four lines starting at the "CODE:" line to not be indented. However, +for readability purposes, it is suggested that you indent them 8 spaces +(or one normal tab stop). - BEGIN { unshift(@INC, "./blib"); } - - use Test2; - - $a = &Test2::is_even(2); - $b = &Test2::is_even(3); - - print "\$a is $a, \$b is $b\n"; +Now re-run make to rebuild our new shared library. -The output should look like: +Now perform the same steps as before, generating a Makefile from the +Makefile.PL file, and running make. - % perl test2.pl - $a is 0, $b is 1 +In order to test that our extension works, we now need to look at the +file test.pl. This file is set up to imitate the same kind of testing +structure that Perl itself has. Within the test script, you perform a +number of tests to confirm the behavior of the extension, printing "ok" +when the test is correct, "not ok" when it is not. + +Let's change the print statement in the BEGIN block to print "1..4" and +add the following code to the end of the file: + + print &mytest::is_even(0) == 1 ? "ok 2" : "not ok 2", "\n"; + print &mytest::is_even(1) == 0 ? "ok 3" : "not ok 3", "\n"; + print &mytest::is_even(2) == 1 ? "ok 4" : "not ok 4", "\n"; + +We will be calling the test script through the command "make test". You +should see output that looks something like this: + + % make test + PERL_DL_NONLAZY=1 /opt/perl5.002b2/bin/perl (lots of -I arguments) test.pl + 1..4 + ok 1 + ok 2 + ok 3 + ok 4 % -=head1 WHAT HAS GONE ON? +=head2 WHAT HAS GONE ON? The program h2xs is the starting point for creating extensions. In later -examples, we'll see how we can use h2xs to read header files and generate +examples we'll see how we can use h2xs to read header files and generate templates to connect to C routines. h2xs creates a number of files in the extension directory. The file @@ -178,11 +251,25 @@ the extension. We'll take a closer look at it later. The files <extension>.pm and <extension>.xs contain the meat of the extension. The .xs file holds the C routines that make up the extension. The .pm file -contains routines that tells Perl how to load your extension. +contains routines that tell Perl how to load your extension. -Generating the invoking the Makefile created a directory blib in the current -working directory. This directory will contain the shared library that we -will build. Once we have tested it, we can install it into its final location. +Generating and invoking the Makefile created a directory blib (which stands +for "build library") in the current working directory. This directory will +contain the shared library that we will build. Once we have tested it, we +can install it into its final location. + +Invoking the test script via "make test" did something very important. It +invoked perl with all those -I arguments so that it could find the various +files that are part of the extension. + +It is I<very> important that while you are still testing extensions that +you use "make test". If you try to run the test script all by itself, you +will get a fatal error. + +Another reason it is important to use "make test" to run your test script +is that if you are testing an upgrade to an already-existing version, using +"make test" insures that you use your new extension, not the already-existing +version. Finally, our test scripts do two important things. First of all, they place the directory "blib" at the head of the @INC array. Placing this inside a @@ -191,58 +278,45 @@ before looking in the system directories. This could be important if you are upgrading an already-existing extension and do not want to disturb the system version until you are ready to install it. -Second, the test scripts tell Perl to C<use extension;>. When Perl sees this, -it searches for a .pm file of the same name in the various directories kept -in the @INC array. If it cannot be found, perl will die with an error that -will look something like: +When Perl sees a C<use extension;>, it searches for a file with the same name +as the use'd extension that has a .pm suffix. If that file cannot be found, +Perl dies with a fatal error. The default search path is contained in the +@INC array. - Can't locate Test2.pm in @INC at ./test2.pl line 5. - BEGIN failed--compilation aborted at ./test2.pl line 5. +In our case, mytest.pm tells perl that it will need the Exporter and Dynamic +Loader extensions. It then sets the @ISA and @EXPORT arrays and the $VERSION +scalar; finally it tells perl to bootstrap the module. Perl will call its +dynamic loader routine (if there is one) and load the shared library. -The .pm file tells perl that it will need the Exporter and Dynamic Loader -extensions. It then sets the @ISA array, which is used for looking up -methods that might not exist in the current package, and finally tells perl -to bootstrap the module. Perl will call its dynamic loader routine and load -the shared library. +The two arrays that are set in the .pm file are very important. The @ISA +array contains a list of other packages in which to search for methods (or +subroutines) that do not exist in the current package. The @EXPORT array +tells Perl which of the extension's routines should be placed into the +calling package's namespace. -The @EXPORT array in the .pm file tells Perl which of the extension's -routines should be placed into the calling package's namespace. In our two -examples so far, we have not modified the @EXPORT array, so our test -scripts must call the routines by their complete name (e.g., Test1::hello). -If we placed the name of the routine in the @EXPORT array, so that the -.pm file looked like: +It's important to select what to export carefully. Do NOT export method names +and do NOT export anything else I<by default> without a good reason. - @EXPORT = qw( hello ); - -Then the hello routine would also be callable from the "main" package. -We could therefore change test1.pl to look like: - - #! /usr/local/bin/perl - - BEGIN { unshift(@INC, "./blib") } - - use Test1; - - hello(); +As a general rule, if the module is trying to be object-oriented then don't +export anything. If it's just a collection of functions then you can export +any of the functions via another array, called @EXPORT_OK. -And we would get the same output, "Hello, world!". +See L<perlmod> for more information. -Most of the time you do not want to export the names of your extension's -subroutines, because they might accidentally clash with other subroutines -from other extensions or from the calling program itself. +The $VERSION variable is used to ensure that the .pm file and the shared +library are "in sync" with each other. Any time you make changes to the +.pm or .xs files, you should increment the value of this variable. -=head1 EXAMPLE 3 +=head2 EXAMPLE 3 Our third extension will take one argument as its input, round off that -value, and set the argument to the rounded value. +value, and set the I<argument> to the rounded value. -Run C<h2xs -A -n Test3>. This will create a Test3 directory with a file -Test3.xs underneath it. Add the following to the end of the XS file: +Add the following to the end of mytest.xs: void round(arg) double arg - CODE: if (arg > 0.0) { arg = floor(arg + 0.5); @@ -254,36 +328,30 @@ Test3.xs underneath it. Add the following to the end of the XS file: OUTPUT: arg -Edit the file Makefile.PL so that the corresponding line looks like this: +Edit the Makefile.PL file so that the corresponding line looks like this: 'LIBS' => ['-lm'], # e.g., '-lm' -Generate the Makefile and run make. The test script test3.pl looks like: +Generate the Makefile and run make. Change the BEGIN block to print out +"1..9" and add the following to test.pl: - #! /usr/local/bin/perl - - BEGIN { unshift(@INC, "./blib"); } - - use Test3; - - foreach $i (-1.4, -0.5, 0.0, 0.4, 0.5) { - $j = $i; - &Test3::round($j); - print "Rounding $i results in $j\n"; - } - - print STDERR "Trying to round a constant -- "; - &Test3::round(2.0); + $i = -1.5; &mytest::round($i); print $i == -2.0 ? "ok 5" : "not ok 5", "\n"; + $i = -1.1; &mytest::round($i); print $i == -1.0 ? "ok 6" : "not ok 6", "\n"; + $i = 0.0; &mytest::round($i); print $i == 0.0 ? "ok 7" : "not ok 7", "\n"; + $i = 0.5; &mytest::round($i); print $i == 1.0 ? "ok 8" : "not ok 8", "\n"; + $i = 1.2; &mytest::round($i); print $i == 1.0 ? "ok 9" : "not ok 9", "\n"; + +Running "make test" should now print out that all nine tests are okay. -Notice the output from trying to send a constant in to the routine. Perl -reports: +You might be wondering if you can round a constant. To see what happens, add +the following line to test.pl temporarily: - Modification of a read-only value attempted at ./test3.pl line 15. + &mytest::round(3); -Perl won't let you change the value of two to, say, three, unlike a FORTRAN -compiler from long, long ago! +Run "make test" and notice that Perl dies with a fatal error. Perl won't let +you change the value of constants! -=head1 WHAT'S NEW HERE? +=head2 WHAT'S NEW HERE? Two things are new here. First, we've made some changes to Makefile.PL. In this case, we've specified an extra library to link in, in this case the @@ -293,7 +361,7 @@ every routine in a library. Second, the value of the function is being passed back not as the function's return value, but through the same variable that was passed into the function. -=head1 INPUT AND OUTPUT PARAMETERS +=head2 INPUT AND OUTPUT PARAMETERS You specify the parameters that will be passed into the XSUB just after you declare the function return value and name. The list of parameters looks @@ -302,17 +370,17 @@ may not have an ending semi-colon. The list of output parameters occurs after the OUTPUT: directive. The use of RETVAL tells Perl that you wish to send this value back as the return -value of the XSUB function. Otherwise, you specify which variables used -in the XSUB function should be placed into the respective Perl variables -passed in. +value of the XSUB function. In Example 3, the value we wanted returned was +contained in the same variable we passed in, so we listed it (and not RETVAL) +in the OUTPUT: section. -=head1 THE XSUBPP COMPILER +=head2 THE XSUBPP COMPILER The compiler xsubpp takes the XS code in the .xs file and converts it into C code, placing it in a file whose suffix is .c. The C code created makes heavy use of the C functions within Perl. -=head1 THE TYPEMAP FILE +=head2 THE TYPEMAP FILE The xsubpp compiler uses rules to convert from Perl's data types (scalar, array, etc.) to C's data types (int, char *, etc.). These rules are stored @@ -325,50 +393,26 @@ C code which xsubpp uses for input parameters. The third part contains C code which xsubpp uses for output parameters. We'll talk more about the C code later. -Let's now take a look at the .c file created for the Test3 extension. +Let's now take a look at a portion of the .c file created for our extension. - /* - * This file was generated automatically by xsubpp version 1.9 from the - * contents of Test3.xs. Don't edit this file, edit Test3.xs instead. - * - * ANY CHANGES MADE HERE WILL BE LOST! - * - */ - - #include "EXTERN.h" - #include "perl.h" - #include "XSUB.h" - - - XS(XS_Test3_round) + XS(XS_mytest_round) { dXSARGS; - if (items != 1) { - croak("Usage: Test3::round(arg)"); - } + if (items != 1) + croak("Usage: mytest::round(arg)"); { - double arg = (double)SvNV(ST(0)); /* XXXXX */ - + double arg = (double)SvNV(ST(0)); /* XXXXX */ if (arg > 0.0) { arg = floor(arg + 0.5); } else if (arg < 0.0) { arg = ceil(arg - 0.5); + } else { + arg = 0.0; } - - sv_setnv(ST(0), (double)arg); /* XXXXX */ + sv_setnv(ST(0), (double)arg); /* XXXXX */ } XSRETURN(1); } - - XS(boot_Test3) - { - dXSARGS; - char* file = __FILE__; - - newXS("Test3::round", XS_Test3_round, file); - ST(0) = &sv_yes; - XSRETURN(1); - } Notice the two lines marked with "XXXXX". If you check the first section of the typemap file, you'll see that doubles are of type T_DOUBLE. In the @@ -377,153 +421,112 @@ arg by calling the routine SvNV on something, then casting it to double, then assigned to the variable arg. Similarly, in the OUTPUT section, once arg has its final value, it is passed to the sv_setnv function to be passed back to the calling subroutine. These two functions are explained -in perlguts; we'll talk more later about what that "ST(0)" means in the +in L<perlguts>; we'll talk more later about what that "ST(0)" means in the section on the argument stack. -=head1 WARNING +=head2 WARNING -In general, it's not agood idea to write extensions that modify their input +In general, it's not a good idea to write extensions that modify their input parameters, as in Example 3. However, in order to better accomodate calling pre-existing C routines, which often do modify their input parameters, -this behavior is tolerated. The next example will show to do this. - -=head1 EXAMPLE 4 +this behavior is tolerated. The next example will show how to do this. -We'll now show how we can call routines in libraries, such as the curses -screen handling package, or a DBM module like GDBM. Each of these libraries -has a header file from which we will generate an XS template that we'll then -fine-tune. +[Examples 4 and 5 have not been re-worked yet and are not included.] -Rather than attempt to find a library that exists on all systems, we'll -first create our own C library, then create an XSUB to it. +=head2 SPECIFYING ARGUMENTS TO XSUBPP -Let's create the files libtest4.h and libtest4.c as follows: +After completing Example 5, we now have an easy way to simulate some +real-life libraries whose interfaces may not be the cleanest in the world. +We shall now continue with a discussion of the arguments passed to the +xsubpp compiler. - /* libtest4.h */ +When you specify arguments in the .xs file, you are really passing three +pieces of information for each one listed. The first piece is the order +of that argument relative to the others (first, second, etc). The second +is the type of argument, and consists of the type declaration of the +argument (e.g., int, char*, etc). The third piece is the exact way in +which the argument should be used in the call to the library function +from this XSUB. This would mean whether or not to place a "&" before +the argument or not, meaning the argument expects to be passed the address +of the specified data type. - #define TESTVAL 4 +There is a difference between the two arguments in this hypothetical function: - extern int test4(int, long, const char*); - - /* libtest4.c */ - - #include <stdlib.h> - #include "./libtest4.h" - int - test4(a, b, c) - int a; - long b; - const char * c; - { - return (a + b + atof(c) + TESTVAL); - } + foo(a,b) + char &a + char * b -Now let's compile it into a library. Since we'll be eventually using this -archive to create a shared library, be sure to use the correct flags to -generate position-independent code. In HP-UX, that's: +The first argument to this function would be treated as a char and assigned +to the variable a, and its address would be passed into the function foo. +The second argument would be treated as a string pointer and assigned to the +variable b. The I<value> of b would be passed into the function foo. The +actual call to the function foo that xsubpp generates would look like this: - % cc -Aa -D_HPUX_SOURCE -c +z libtest4.c - % ar cr libtest4.a libtest4.o + foo(&a, b); -Now let's move the libtest4.h and libtest.a files into a sub-directory under -/tmp, so we don't interfere with anything. - - % mkdir /tmp/test4 - % mkdir /tmp/test4/include - % mkdir /tmp/test4/lib - % cp libtest4.h /tmp/test4/include - % cp libtest4.a /tmp/test4/lib - -Okay, now that we have a header file and a library, let's begin actually -writing the extension. - -Run C<h2xs -n Test4 /tmp/test4/include/libtest4.h> (notice we are no longer -specifying B<-A> as an argument). This will create a Test4 directory with a file -F<Test4.xs> underneath it. If we look at it now, we'll see some interesting -things have been added to the various files. - -=over 2 - -=item * - -In the .xs file, there's now a #include declaration with the full path to -the libtest4.h header file. - -=item * - -There's now some new C code that's been added to the .xs file. The purpose -of the C<constant> routine is to make the values that are #define'd in the -header file available to the Perl script by calling C<&main::TESTVAL>. -There's also some XS code to allow calls to the C<constant> routine. - -=item * - -The .pm file has exported the name TESTVAL in the @EXPORT array. This -could lead to name clashes. A good rule of thumb is that if the #define -is only going to be used by the C routines themselves, and not by the user, -they should be removed from the @EXPORT array. Alternately, if you don't -mind using the "fully qualified name" of a variable, you could remove most -or all of the items in the @EXPORT array. - -=back - -Let's now add a definition for the routine in our library. Add the following -code to the end of the .xs file: - - int - test4(a,b,c) - int a - long b - const char * c +In other words, whatever is in the last column (or the variable name) is +what is passed into the C function. -Now we also need to create a typemap file because the default Perl doesn't -currently support the const char * type. Create a file called typemap and -place the following in it: +You should take great pains to try to pass the function the type of variable +it wants, when possible. It will save you a lot of trouble in the long run. - const char * T_PV +=head2 THE ARGUMENT STACK -Now we must tell our Makefile template where our new library is. Edit the -Makefile.PL and change the following line: +If we look at any of the C code generated by any of the examples except +example 1, you will notice a number of references to ST(n), where n is +usually 0. The "ST" is actually a macro that points to the n'th argument +on the argument stack. ST(0) is thus the first argument passed to the +XSUB, ST(1) is the second argument, and so on. - 'LIBS' => ['-ltest4 -L/tmp/test4'], # e.g., '-lm' +When you list the arguments to the XSUB in the .xs file, that tell xsubpp +which argument corresponds to which of the argument stack (i.e., the first +one listed is the first argument, and so on). You invite disaster if you +do not list them in the same order as the function expects them. -This specifies that we want the library test4 linked into our XSUB, and that -it should also look in the directory /tmp/test4. +=head2 EXTENDING YOUR EXTENSION -Let's also change the following line in the Makefile.PL to this: +Sometimes you might want to provide some extra methods or subroutines +to assist in making the interface between Perl and your extension simpler +or easier to understand. These routines should live in the .pm file. +Whether they are automatically loaded when the extension itself is loaded +or only loaded when called depends on where in the .pm file the subroutine +definition is placed. - 'INC' => '-I/tmp/test/include', # e.g., '-I/usr/include/other' +=head2 DOCUMENTING YOUR EXTENSION -and also change the #include in test4.xs to be: +There is absolutely no excuse for not documenting your extension. +Documentation belongs in the .pm file. This file will be fed to pod2man, +and the documentation embedded within it converted to man page format, +then placed in the blib directory. It will be copied to Perl's man +page directory when the extension is installed. - #include <libtest4.h> +You may intersperse documentation and Perl code within the .pm file. +In fact, if you want to use method autoloading, you must do this, +as the comment inside the .pm file explains. -Now we don't have to specify the absolute path of the header file in the -.xs file, relying on the Makefile to tell the compiler where to find the -header files. This is generally considered a Good Thing. +See L<perlpod> for more information about the pod format. -Okay, let's create the Makefile, and run make. You can ignore a message that -may look like: +=head2 INSTALLING YOUR EXTENSION - Warning (non-fatal): No library found for -ltest4 +Once your extension is complete and passes all its tests, installing it +is quite simple: you simply run "make install". You will either need +to have write permission into the directories where Perl is installed, +or ask your system administrator to run the make for you. -If you forgot to create the typemap file, you might see output that looks -like this: +=head2 SEE ALSO - Error: 'const char *' not in typemap in test4.xs, line 102 +For more information, consult L<perlguts>, L<perlxs>, L<perlmod>, +and L<perlpod>. -This error means that you have used a C datatype that xsubpp doesn't know -how to convert between Perl and C. You'll have to create a typemap file to -tell xsubpp how to do the conversions. +=head2 Author -=head1 Author +Jeff Okamoto <okamoto@corp.hp.com> -Jeff Okamoto +Reviewed and assisted by Dean Roehrich, Ilya Zakharevich, Andreas Koenig, +and Tim Bunce. -=head1 Last Changed +=head2 Last Changed -1995/11/20 +1996/1/19 -Jeff Okamoto -F<E<lt>okamoto@hpcc123.corp.hp.comE<gt>> diff --git a/pod/pod2text.PL b/pod/pod2text.PL index caa6ec4b51..1402f0dbe9 100644 --- a/pod/pod2text.PL +++ b/pod/pod2text.PL @@ -1,359 +1,50 @@ #!/usr/local/bin/perl -$SCREEN = ($ARGV[0] =~ /^-(\d+)/ && (shift, $1)) - || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] - || $ENV{COLUMNS} - || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0] - || 72; +use Config; +use File::Basename qw(&basename &dirname); -$/ = ""; +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. -$FANCY = 0; +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +chdir(dirname($0)); +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// + if ($Config{'osname'} eq 'VMS' or + $Config{'osname'} eq 'OS2'); # "case-forgiving" -$cutting = 1; -$DEF_INDENT = 4; -$indent = $DEF_INDENT; -$needspace = 0; +open OUT,">$file" or die "Can't create $file: $!"; -POD_DIRECTIVE: while (<>) { - if ($cutting) { - next unless /^=/; - $cutting = 0; - } - 1 while s{^(.*?)(\t+)(.*)$}{ - $1 - . (' ' x (length($2) * 8 - length($1) % 8)) - . $3 - }me; - # Translate verbatim paragraph - if (/^\s/) { - $needspace = 1; - output($_); - next; - } +print "Extracting $file (with variable substitutions)\n"; -sub prepare_for_output { +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. - s/\s*$/\n/; - &init_noremap; +print OUT <<"!GROK!THIS!"; +$Config{'startperl'} + eval 'exec perl -S \$0 "\$@"' + if 0; +!GROK!THIS! - # need to hide E<> first; they're processed in clear_noremap - s/(E<[^<>]+>)/noremap($1)/ge; - $maxnest = 10; - while ($maxnest-- && /[A-Z]</) { - unless ($FANCY) { - s/C<(.*?)>/`$1'/g; - } else { - s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/ge; - } - # s/[IF]<(.*?)>/italic($1)/ge; - s/I<(.*?)>/*$1*/g; - # s/[CB]<(.*?)>/bold($1)/ge; - s/X<.*?>//g; - # LREF: a manpage(3f) - s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g; - # LREF: an =item on another manpage - s{ - L< - ([^/]+) - / - ( - [:\w]+ - (\(\))? - ) - > - } {the "$2" entry in the $1 manpage}gx; +# In the following, perl variables are not expanded during extraction. - # LREF: an =item on this manpage - s{ - ((?: - L< - / - ( - [:\w]+ - (\(\))? - ) - > - (,?\s+(and\s+)?)? - )+) - } { internal_lrefs($1) }gex; +print OUT <<'!NO!SUBS!'; - # LREF: a =head2 (head1?), maybe on a manpage, maybe right here - # the "func" can disambiguate - s{ - L< - (?: - ([a-zA-Z]\S+?) / - )? - "?(.*?)"? - > - }{ - do { - $1 # if no $1, assume it means on this page. - ? "the section on \"$2\" in the $1 manpage" - : "the section on \"$2\"" - } - }gex; +use Pod::Text; - s/[A-Z]<(.*?)>/$1/g; - } - clear_noremap(1); +if(@ARGV) { + pod2text($ARGV[0]); +} else { + pod2text("<&STDIN"); } - &prepare_for_output; - - if (s/^=//) { - # $needspace = 0; # Assume this. - # s/\n/ /g; - ($Cmd, $_) = split(' ', $_, 2); - # clear_noremap(1); - if ($Cmd eq 'cut') { - $cutting = 1; - } - elsif ($Cmd eq 'head1') { - makespace(); - print; - #print uc($_); - } - elsif ($Cmd eq 'head2') { - makespace(); - # s/(\w+)/\u\L$1/g; - #print ' ' x $DEF_INDENT, $_; - # print "\xA7"; - s/(\w)/\xA7 $1/ if $FANCY; - print ' ' x ($DEF_INDENT/2), $_, "\n"; - } - elsif ($Cmd eq 'over') { - push(@indent,$indent); - $indent += ($_ + 0) || $DEF_INDENT; - } - elsif ($Cmd eq 'back') { - $indent = pop(@indent); - warn "Unmatched =back\n" unless defined $indent; - $needspace = 1; - } - elsif ($Cmd eq 'item') { - makespace(); - # s/\A(\s*)\*/$1\xb7/ if $FANCY; - # s/^(\s*\*\s+)/$1 /; - { - if (length() + 3 < $indent) { - my $paratag = $_; - $_ = <>; - if (/^=/) { # tricked! - local($indent) = $indent[$#index - 1] || $DEF_INDENT; - output($paratag); - redo POD_DIRECTIVE; - } - &prepare_for_output; - IP_output($paratag, $_); - } else { - local($indent) = $indent[$#index - 1] || $DEF_INDENT; - output($_); - } - } - } - else { - warn "Unrecognized directive: $Cmd\n"; - } - } - else { - # clear_noremap(1); - makespace(); - output($_, 1); - } -} - -######################################################################### - -sub makespace { - if ($needspace) { - print "\n"; - $needspace = 0; - } -} - -sub bold { - my $line = shift; - $line =~ s/(.)/$1\b$1/g; - return $line; -} - -sub italic { - my $line = shift; - $line =~ s/(.)/_\b$1/g; - return $line; -} - -sub IP_output { - local($tag, $_) = @_; - local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT; - $tag_cols = $SCREEN - $tag_indent; - $cols = $SCREEN - $indent; - $tag =~ s/\s*$//; - s/\s+/ /g; - s/^ //; - $str = "format STDOUT = \n" - . (" " x ($tag_indent)) - . '@' . ('<' x ($indent - $tag_indent - 1)) - . "^" . ("<" x ($cols - 1)) . "\n" - . '$tag, $_' - . "\n~~" - . (" " x ($indent-2)) - . "^" . ("<" x ($cols - 5)) . "\n" - . '$_' . "\n\n.\n1"; - #warn $str; warn "tag is $tag, _ is $_"; - eval $str || die; - write; -} - -sub output { - local($_, $reformat) = @_; - if ($reformat) { - $cols = $SCREEN - $indent; - s/\s+/ /g; - s/^ //; - $str = "format STDOUT = \n~~" - . (" " x ($indent-2)) - . "^" . ("<" x ($cols - 5)) . "\n" - . '$_' . "\n\n.\n1"; - eval $str || die; - write; - } else { - s/^/' ' x $indent/gem; - s/^\s+\n$/\n/gm; - print; - } -} - -sub noremap { - local($thing_to_hide) = shift; - $thing_to_hide =~ tr/\000-\177/\200-\377/; - return $thing_to_hide; -} - -sub init_noremap { - die "unmatched init" if $mapready++; - if ( /[\200-\377]/ ) { - warn "hit bit char in input stream"; - } -} - -sub clear_noremap { - my $ready_to_print = $_[0]; - die "unmatched clear" unless $mapready--; - tr/\200-\377/\000-\177/; - # now for the E<>s, which have been hidden until now - # otherwise the interative \w<> processing would have - # been hosed by the E<gt> - s { - E< - ( [A-Za-z]+ ) - > - } { - do { - defined $HTML_Escapes{$1} - ? do { $HTML_Escapes{$1} } - : do { - warn "Unknown escape: $& in $_"; - "E<$1>"; - } - } - }egx if $ready_to_print; -} - -sub internal_lrefs { - local($_) = shift; - s{L</([^>]+)>}{$1}g; - my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); - my $retstr = "the "; - my $i; - for ($i = 0; $i <= $#items; $i++) { - $retstr .= "C<$items[$i]>"; - $retstr .= ", " if @items > 2 && $i != $#items; - $retstr .= " and " if $i+2 == @items; - } - - $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) - . " elsewhere in this document "; - - return $retstr; - -} - -BEGIN { - -%HTML_Escapes = ( - 'amp' => '&', # ampersand - 'lt' => '<', # left chevron, less-than - 'gt' => '>', # right chevron, greater-than - 'quot' => '"', # double quote - - "Aacute" => "\xC1", # capital A, acute accent - "aacute" => "\xE1", # small a, acute accent - "Acirc" => "\xC2", # capital A, circumflex accent - "acirc" => "\xE2", # small a, circumflex accent - "AElig" => "\xC6", # capital AE diphthong (ligature) - "aelig" => "\xE6", # small ae diphthong (ligature) - "Agrave" => "\xC0", # capital A, grave accent - "agrave" => "\xE0", # small a, grave accent - "Aring" => "\xC5", # capital A, ring - "aring" => "\xE5", # small a, ring - "Atilde" => "\xC3", # capital A, tilde - "atilde" => "\xE3", # small a, tilde - "Auml" => "\xC4", # capital A, dieresis or umlaut mark - "auml" => "\xE4", # small a, dieresis or umlaut mark - "Ccedil" => "\xC7", # capital C, cedilla - "ccedil" => "\xE7", # small c, cedilla - "Eacute" => "\xC9", # capital E, acute accent - "eacute" => "\xE9", # small e, acute accent - "Ecirc" => "\xCA", # capital E, circumflex accent - "ecirc" => "\xEA", # small e, circumflex accent - "Egrave" => "\xC8", # capital E, grave accent - "egrave" => "\xE8", # small e, grave accent - "ETH" => "\xD0", # capital Eth, Icelandic - "eth" => "\xF0", # small eth, Icelandic - "Euml" => "\xCB", # capital E, dieresis or umlaut mark - "euml" => "\xEB", # small e, dieresis or umlaut mark - "Iacute" => "\xCD", # capital I, acute accent - "iacute" => "\xED", # small i, acute accent - "Icirc" => "\xCE", # capital I, circumflex accent - "icirc" => "\xEE", # small i, circumflex accent - "Igrave" => "\xCD", # capital I, grave accent - "igrave" => "\xED", # small i, grave accent - "Iuml" => "\xCF", # capital I, dieresis or umlaut mark - "iuml" => "\xEF", # small i, dieresis or umlaut mark - "Ntilde" => "\xD1", # capital N, tilde - "ntilde" => "\xF1", # small n, tilde - "Oacute" => "\xD3", # capital O, acute accent - "oacute" => "\xF3", # small o, acute accent - "Ocirc" => "\xD4", # capital O, circumflex accent - "ocirc" => "\xF4", # small o, circumflex accent - "Ograve" => "\xD2", # capital O, grave accent - "ograve" => "\xF2", # small o, grave accent - "Oslash" => "\xD8", # capital O, slash - "oslash" => "\xF8", # small o, slash - "Otilde" => "\xD5", # capital O, tilde - "otilde" => "\xF5", # small o, tilde - "Ouml" => "\xD6", # capital O, dieresis or umlaut mark - "ouml" => "\xF6", # small o, dieresis or umlaut mark - "szlig" => "\xDF", # small sharp s, German (sz ligature) - "THORN" => "\xDE", # capital THORN, Icelandic - "thorn" => "\xFE", # small thorn, Icelandic - "Uacute" => "\xDA", # capital U, acute accent - "uacute" => "\xFA", # small u, acute accent - "Ucirc" => "\xDB", # capital U, circumflex accent - "ucirc" => "\xFB", # small u, circumflex accent - "Ugrave" => "\xD9", # capital U, grave accent - "ugrave" => "\xF9", # small u, grave accent - "Uuml" => "\xDC", # capital U, dieresis or umlaut mark - "uuml" => "\xFC", # small u, dieresis or umlaut mark - "Yacute" => "\xDD", # capital Y, acute accent - "yacute" => "\xFD", # small y, acute accent - "yuml" => "\xFF", # small y, dieresis or umlaut mark - - "lchevron" => "\xAB", # left chevron (double less than) - "rchevron" => "\xBB", # right chevron (double greater than) -); -} +!NO!SUBS! +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; diff --git a/pod/splitpod b/pod/splitpod index fd327d80da..fd327d80da 100644..100755 --- a/pod/splitpod +++ b/pod/splitpod @@ -148,14 +148,6 @@ PP(pp_rv2gv) RETURN; } -PP(pp_sv2len) -{ - dSP; dTARGET; - dPOPss; - PUSHi(sv_len(sv)); - RETURN; -} - PP(pp_rv2sv) { dSP; dTOPss; @@ -268,6 +260,24 @@ PP(pp_rv2cv) RETURN; } +PP(pp_prototype) +{ + dSP; + CV *cv; + HV *stash; + GV *gv; + SV *ret; + + ret = &sv_undef; + cv = sv_2cv(TOPs, &stash, &gv, FALSE); + if (cv && SvPOK(cv)) { + char *p = SvPVX(cv); + ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv))); + } + SETs(ret); + RETURN; +} + PP(pp_anoncode) { dSP; @@ -360,7 +370,7 @@ PP(pp_bless) PP(pp_study) { - dSP; dTARGET; + dSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -369,11 +379,17 @@ PP(pp_study) I32 retval; STRLEN len; - s = (unsigned char*)(SvPV(TARG, len)); + s = (unsigned char*)(SvPV(sv, len)); pos = len; - if (lastscream) - SvSCREAM_off(lastscream); - lastscream = TARG; + if (sv == lastscream) + SvSCREAM_off(sv); + else { + if (lastscream) { + SvSCREAM_off(lastscream); + SvREFCNT_dec(lastscream); + } + lastscream = SvREFCNT_inc(sv); + } if (pos <= 0) { retval = 0; goto ret; @@ -416,7 +432,7 @@ PP(pp_study) sfirst[fold[ch]] = pos; } - SvSCREAM_on(TARG); + SvSCREAM_on(sv); retval = 1; ret: XPUSHs(sv_2mortal(newSViv((I32)retval))); @@ -1386,7 +1402,8 @@ PP(pp_substr) rem = len; sv_setpvn(TARG, tmps, rem); if (lvalue) { /* it's an lvalue! */ - (void)SvPOK_only(sv); + if (!SvGMAGICAL(sv)) + (void)SvPOK_only(sv); if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, 'x', Nullch, 0); @@ -1704,7 +1721,7 @@ PP(pp_quotemeta) if (len) { (void)SvUPGRADE(TARG, SVt_PV); - SvGROW(TARG, len * 2); + SvGROW(TARG, (len * 2) + 1); d = SvPVX(TARG); while (len--) { if (!isALNUM(*s)) @@ -1772,18 +1789,24 @@ PP(pp_each) { dSP; dTARGET; HV *hash = (HV*)POPs; - HE *entry = hv_iternext(hash); + HE *entry; I32 i; char *tmps; + + PUTBACK; + entry = hv_iternext(hash); /* might clobber stack_sp */ + SPAGAIN; EXTEND(SP, 2); if (entry) { - tmps = hv_iterkey(entry, &i); + tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */ if (!i) tmps = ""; PUSHs(sv_2mortal(newSVpv(tmps, i))); if (GIMME == G_ARRAY) { - sv_setsv(TARG, hv_iterval(hash, entry)); + PUTBACK; + sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */ + SPAGAIN; PUSHs(TARG); } } @@ -3305,6 +3328,7 @@ PP(pp_split) AV *oldstack = stack; register REGEXP *rx = pm->op_pmregexp; I32 gimme = GIMME; + I32 oldsave = savestack_ix; if (!pm || !s) DIE("panic: do_split"); @@ -3332,6 +3356,11 @@ PP(pp_split) while (isSPACE(*s)) s++; } + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(multiline); + multiline = pm->op_pmflags & PMf_MULTILINE; + } + if (!limit) limit = maxiters + 2; if (pm->op_pmflags & PMf_WHITE) { @@ -3443,6 +3472,7 @@ PP(pp_split) s = rx->endp[0]; } } + LEAVE_SCOPE(oldsave); iters = (SP - stack_base) - base; if (iters > maxiters) DIE("Split loop"); @@ -102,7 +102,7 @@ PP(pp_substcont) register char *s = cx->sb_s; register char *m = cx->sb_m; char *orig = cx->sb_orig; - register REGEXP *rx = pm->op_pmregexp; + register REGEXP *rx = cx->sb_rx; if (cx->sb_iters++) { if (cx->sb_iters > cx->sb_maxiters) @@ -969,7 +969,7 @@ char *message; } } else - sv_catpv(GvSV(errgv), message); + sv_setpv(GvSV(errgv), message); cxix = dopoptoeval(cxstack_ix); if (cxix >= 0) { @@ -1980,10 +1980,8 @@ int gimme; error_count = 0; curcop = &compiling; curcop->cop_arybase = 0; - rs = "\n"; - rslen = 1; - rschar = '\n'; - rspara = 0; + SvREFCNT_dec(rs); + rs = newSVpv("\n", 1); sv_setpv(GvSV(errgv),""); if (yyparse() || error_count || !eval_root) { SV **newsp; @@ -2003,16 +2001,12 @@ int gimme; LEAVE; if (optype == OP_REQUIRE) DIE("%s", SvPVx(GvSV(errgv), na)); - rs = nrs; - rslen = nrslen; - rschar = nrschar; - rspara = (nrslen == 2); + SvREFCNT_dec(rs); + rs = SvREFCNT_inc(nrs); RETPUSHUNDEF; } - rs = nrs; - rslen = nrslen; - rschar = nrschar; - rspara = (nrslen == 2); + SvREFCNT_dec(rs); + rs = SvREFCNT_inc(nrs); compiling.cop_line = 0; SAVEFREEOP(eval_root); if (gimme & G_ARRAY) @@ -76,6 +76,64 @@ PP(pp_gv) RETURN; } +PP(pp_gelem) +{ + GV *gv; + SV *sv; + SV *ref; + char *elem; + dSP; + + sv = POPs; + elem = SvPV(sv, na); + gv = (GV*)POPs; + ref = Nullsv; + sv = Nullsv; + switch (elem ? *elem : '\0') + { + case 'A': + if (strEQ(elem, "ARRAY")) + ref = (SV*)GvAV(gv); + break; + case 'C': + if (strEQ(elem, "CODE")) + ref = (SV*)GvCV(gv); + break; + case 'F': + if (strEQ(elem, "FILEHANDLE")) + ref = (SV*)GvIOp(gv); + break; + case 'G': + if (strEQ(elem, "GLOB")) + ref = (SV*)gv; + break; + case 'H': + if (strEQ(elem, "HASH")) + ref = (SV*)GvHV(gv); + break; + case 'N': + if (strEQ(elem, "NAME")) + sv = newSVpv(GvNAME(gv), GvNAMELEN(gv)); + break; + case 'P': + if (strEQ(elem, "PACKAGE")) + sv = newSVpv(HvNAME(GvSTASH(gv)), 0); + break; + case 'S': + if (strEQ(elem, "SCALAR")) + ref = GvSV(gv); + break; + } + if (ref) + sv = newRV(ref); + if (sv) + sv_2mortal(sv); + else + sv = &sv_undef; + XPUSHs(sv); + RETURN; +} + PP(pp_and) { dSP; @@ -144,12 +202,12 @@ PP(pp_concat) dPOPTOPssrl; STRLEN len; char *s; - if (SvGMAGICAL(left)) - mg_get(left); if (TARG != left) { s = SvPV(left,len); sv_setpvn(TARG,s,len); } + else if (SvGMAGICAL(TARG)) + mg_get(TARG); else if (!SvOK(TARG)) { s = SvPV_force(TARG, len); sv_setpv(TARG, ""); /* Suppress warning. */ @@ -984,6 +1042,10 @@ do_readline() if (ok && sts != RMS$_NMF && sts != RMS$_DNF && sts != RMS$_FNF) ok = 0; if (!ok) { + if (!(sts & 1)) { + SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts); + } + fclose(tmpfp); fp = NULL; } else { @@ -1014,7 +1076,8 @@ do_readline() #endif #endif /* !CSH */ #endif /* !MSDOS */ - (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp); + (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd), + FALSE, 0, 0, Nullfp); fp = IoIFP(io); #endif /* !VMS */ LEAVE; @@ -1075,12 +1138,13 @@ do_readline() if (type == OP_GLOB) { char *tmps; - if (SvCUR(sv) > 0) - SvCUR(sv)--; - if (*SvEND(sv) == rschar) - *SvEND(sv) = '\0'; - else - SvCUR(sv)++; + if (SvCUR(sv) > 0 && SvCUR(rs) > 0) { + tmps = SvEND(sv) - 1; + if (*tmps == *SvPVX(rs)) { + *tmps = '\0'; + SvCUR(sv)--; + } + } for (tmps = SvPVX(sv); *tmps; tmps++) if (!isALPHA(*tmps) && !isDIGIT(*tmps) && strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) @@ -1664,6 +1728,8 @@ PP(pp_entersub) if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */ gv = ngv; sv_setsv(GvSV(CvGV(cv)), tmpstr); /* Set CV's $AUTOLOAD */ + if (tainting) + sv_unmagic(GvSV(CvGV(cv)), 't'); goto retry; } else @@ -1673,7 +1739,7 @@ PP(pp_entersub) } gimme = GIMME; - if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) { + if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) { sv = GvSV(DBsub); save_item(sv); if (SvFLAGS(cv) & (SVpcv_ANON | SVpcv_CLONED)) /* Is GV potentially non-unique? */ @@ -1892,7 +1958,7 @@ DIE("Can't call method \"%s\" without a package or object reference", name); SETs(gv); RETURN; } - *(stack_base + TOPMARK + 1) = iogv; + *(stack_base + TOPMARK + 1) = sv_2mortal(newRV(iogv)); } if (!ob || !SvOBJECT(ob)) { @@ -86,14 +86,6 @@ extern int h_errno; #include <sys/file.h> #endif -#ifdef HAS_GETPGRP2 -# define getpgrp getpgrp2 -#endif - -#ifdef HAS_SETPGRP2 -# define setpgrp setpgrp2 -#endif - #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) static int dooneliner _((char *cmd, char *filename)); #endif @@ -145,22 +137,18 @@ PP(pp_glob) { OP *result; ENTER; - SAVEINT(rschar); - SAVEINT(rslen); SAVESPTR(last_in_gv); /* We don't want this to be permanent. */ last_in_gv = (GV*)*stack_sp--; - rslen = 1; -#ifdef DOSISH - rschar = 0; -#else -#ifdef CSH - rschar = 0; -#else - rschar = '\n'; + SAVESPTR(rs); /* This is not permanent, either. */ + rs = sv_2mortal(newSVpv("", 1)); +#ifndef DOSISH +#ifndef CSH + *SvPVX(rs) = '\n'; #endif /* !CSH */ #endif /* !MSDOS */ + result = do_readline(); LEAVE; return result; @@ -247,7 +235,7 @@ PP(pp_open) DIE(no_usym, "filehandle"); gv = (GV*)POPs; tmps = SvPV(sv, len); - if (do_open(gv, tmps, len,Nullfp)) { + if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) { IoLINES(GvIOp(gv)) = 0; PUSHi( (I32)forkprocess ); } @@ -462,6 +450,28 @@ PP(pp_untie) RETSETYES; } +PP(pp_tied) +{ + dSP; dTARGET ; + SV * sv ; + MAGIC * mg ; + + sv = POPs; + if (SvMAGICAL(sv)) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + mg = mg_find(sv, 'P') ; + else + mg = mg_find(sv, 'q') ; + + if (mg) { + PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; + RETURN ; + } + } + + RETPUSHUNDEF; +} + PP(pp_dbmopen) { dSP; @@ -621,11 +631,13 @@ PP(pp_sselect) j = SvLEN(sv); if (j < growsize) { Sv_Grow(sv, growsize); - s = SvPVX(sv) + j; - while (++j <= growsize) { - *s++ = '\0'; - } } + j = SvCUR(sv); + s = SvPVX(sv) + j; + while (++j <= growsize) { + *s++ = '\0'; + } + #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 s = SvPVX(sv); New(403, fd_sets[i], growsize, char); @@ -968,6 +980,35 @@ PP(pp_prtf) RETURN; } +PP(pp_sysopen) +{ + dSP; dTARGET; + GV *gv; + IO *io; + SV *sv; + char *tmps; + STRLEN len; + int mode, perm; + + if (MAXARG > 3) + perm = POPi; + else + perm = 0666; + mode = POPi; + sv = POPs; + gv = (GV *)POPs; + + tmps = SvPV(sv, len); + if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) { + IoLINES(GvIOp(gv)) = 0; + PUSHs(&sv_yes); + } + else { + PUSHs(&sv_undef); + } + RETURN; +} + PP(pp_sysread) { dSP; dMARK; dORIGMARK; dTARGET; @@ -80,7 +80,8 @@ OP* do_kv _((void)); I32 do_msgrcv _((SV** mark, SV** sp)); I32 do_msgsnd _((SV** mark, SV** sp)); #endif -bool do_open _((GV* gv, char* name, I32 len, FILE* supplied_fp)); +bool do_open _((GV* gv, char* name, I32 len, + int as_raw, int rawmode, int rawperm, FILE* supplied_fp)); void do_pipe _((SV* sv, GV* rgv, GV* wgv)); bool do_print _((SV* sv, FILE* fp)); OP * do_readline _((void)); @@ -103,6 +104,7 @@ int dump_fds _((char* s)); #endif void dump_form _((GV* gv)); void dump_gv _((GV* gv)); +void dump_mstats _((char* s)); void dump_op _((OP* arg)); void dump_pm _((PMOP* pm)); void dump_packsubs _((HV* stash)); @@ -210,9 +212,6 @@ void mg_magical _((SV* sv)); int mg_set _((SV* sv)); OP* mod _((OP* op, I32 type)); char* moreswitches _((char* s)); -#ifdef MSTATS -void mstats _((char* s)); -#endif OP * my _(( OP *)); char* my_bcopy _((char* from, char* to, I32 len)); #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) @@ -243,7 +242,6 @@ OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right)); OP* newLOOPEX _((I32 type, OP* label)); OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block)); -OP* newMETHOD _((OP* ref, OP* name)); OP* newNULLLIST _((void)); OP* newOP _((I32 optype, I32 flags)); void newPROG _((OP* op)); @@ -258,8 +256,7 @@ CV* newXSUB _((char *name, I32 ix, I32 (*subaddr)(int,int,int), char *filename)) AV* newAV _((void)); OP* newAVREF _((OP* o)); OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last)); -OP* newCVREF _((OP* o)); -OP* newCVOP _((I32 type, I32 flags, CV* cv, OP* cont)); +OP* newCVREF _((I32 flags, OP* o)); OP* newGVOP _((I32 type, I32 flags, GV* gv)); GV* newGVgen _((char *pack)); OP* newGVREF _((I32 type, OP* o)); @@ -459,7 +456,7 @@ void taint_proper _((char* f, char* s)); #ifdef UNLINK_ALL_VERSIONS I32 unlnk _((char* f)); #endif -void utilize _((int aver, OP* id, OP* arg)); +void utilize _((int aver, I32 floor, OP* id, OP* arg)); I32 wait4pid _((int pid, int* statusp, int flags)); void warn _((char* pat,...)) __attribute__((format(printf,1,2))); void watch _((char **addr)); @@ -641,8 +641,9 @@ CONTEXT* cx; case CXt_EVAL: fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n", (long)cx->blk_eval.old_in_eval); - fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n", - op_name[cx->blk_eval.old_op_type]); + fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", + op_name[cx->blk_eval.old_op_type], + op_desc[cx->blk_eval.old_op_type]); fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n", cx->blk_eval.old_name); fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", @@ -14,6 +14,13 @@ #include "EXTERN.h" #include "perl.h" +#ifdef OVR_DBL_DIG +/* Use an overridden DBL_DIG */ +# ifdef DBL_DIG +# undef DBL_DIG +# endif +# define DBL_DIG OVR_DBL_DIG +#else /* The following is all to get DBL_DIG, in order to pick a nice default value for printing floating point numbers in Gconvert. (see config.h) @@ -27,6 +34,11 @@ #ifndef HAS_DBL_DIG #define DBL_DIG 15 /* A guess that works lots of places */ #endif +#endif + +#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE) +# define FAST_SV_GETS +#endif static SV *more_sv _((void)); static XPVIV *more_xiv _((void)); @@ -160,7 +172,12 @@ U32 flags; static SV* more_sv() { - sv_add_arena(safemalloc(1008), 1008, 0); + if (nice_chunk) { + sv_add_arena(nice_chunk, nice_chunk_size, 0); + nice_chunk = Nullch; + } + else + sv_add_arena(safemalloc(1008), 1008, 0); return new_sv(); } #endif @@ -1071,7 +1088,7 @@ SV *sv; *d = '\0'; if (op) - warn("Argument \"%s\" isn't numeric for %s", tmpbuf, + warn("Argument \"%s\" isn't numeric in %s", tmpbuf, op_name[op->op_type]); else warn("Argument \"%s\" isn't numeric", tmpbuf); @@ -1502,6 +1519,11 @@ register SV *sstr; case SVt_RV: if (dtype < SVt_RV) sv_upgrade(dstr, SVt_RV); + else if (dtype == SVt_PVGV && + SvTYPE(SvRV(sstr)) == SVt_PVGV) { + sstr = SvRV(sstr); + goto glob_assign; + } break; case SVt_PV: if (dtype < SVt_PV) @@ -1523,7 +1545,6 @@ register SV *sstr; case SVt_PVAV: case SVt_PVHV: case SVt_PVCV: - case SVt_PVFM: case SVt_PVIO: if (op) croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0), @@ -1534,6 +1555,7 @@ register SV *sstr; case SVt_PVGV: if (dtype <= SVt_PVGV) { + glob_assign: if (dtype == SVt_PVGV) GvFLAGS(sstr) |= GVf_IMPORTED; else { @@ -1625,7 +1647,7 @@ register SV *sstr; GvSV(dstr) = sref; break; } - if (dref != sref) + if (curcop->cop_stash != GvSTASH(dstr)) GvFLAGS(dstr) |= GVf_IMPORTED; /* crude */ if (dref) SvREFCNT_dec(dref); @@ -1734,7 +1756,11 @@ register STRLEN len; (void)SvOK_off(sv); return; } - if (!SvUPGRADE(sv, SVt_PV)) + if (SvTYPE(sv) >= SVt_PV) { + if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) + sv_unglob(sv); + } + else if (!sv_upgrade(sv, SVt_PV)) return; SvGROW(sv, len + 1); Move(ptr,SvPVX(sv),len,char); @@ -1762,7 +1788,11 @@ register char *ptr; return; } len = strlen(ptr); - if (!SvUPGRADE(sv, SVt_PV)) + if (SvTYPE(sv) >= SVt_PV) { + if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) + sv_unglob(sv); + } + else if (!sv_upgrade(sv, SVt_PV)) return; SvGROW(sv, len + 1); Move(ptr,SvPVX(sv),len+1,char); @@ -2040,7 +2070,7 @@ int type; { MAGIC* mg; MAGIC** mgp; - if (!SvMAGICAL(sv)) + if (SvTYPE(sv) < SVt_PVMG) return 0; mgp = &SvMAGIC(sv); for (mg = *mgp; mg; mg = *mgp) { @@ -2058,7 +2088,7 @@ int type; else mgp = &mg->mg_moremagic; } - if (!SvMAGIC(sv)) { + if (!SvMAGICAL(sv) && !SvMAGIC(sv)) { SvMAGICAL_off(sv); SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; } @@ -2222,7 +2252,7 @@ register SV *sv; --sv_objcount; /* XXX Might want something more general */ } } - if (SvMAGICAL(sv)) + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) mg_free(sv); switch (SvTYPE(sv)) { case SVt_PVIO: @@ -2455,15 +2485,22 @@ register SV *sv; register FILE *fp; I32 append; { - register char *bp; /* we're going to steal some values */ -#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE) - register I32 cnt; /* from the stdio struct and put EVERYTHING */ - register STDCHAR *ptr; /* in the innermost loop into registers */ + char *rsptr; + STRLEN rslen; + register STDCHAR rslast; + register STDCHAR *bp; + register I32 cnt; + I32 i; + +#ifdef FAST_SV_GETS + /* + * We're going to steal some values from the stdio struct + * and put EVERYTHING in the innermost loop into registers. + */ + register STDCHAR *ptr; STRLEN bpx; I32 shortbuffered; #endif - register I32 newline = rschar;/* (assuming >= 6 registers) */ - I32 i; if (SvTHINKFIRST(sv)) { if (SvREADONLY(sv) && curcop != &compiling) @@ -2473,7 +2510,20 @@ I32 append; } if (!SvUPGRADE(sv, SVt_PV)) return 0; - if (rspara) { /* have to do this both before and after */ + + if (RsSNARF(rs)) { + rsptr = NULL; + rslen = 0; + } + else if (RsPARA(rs)) { + rsptr = "\n\n"; + rslen = 2; + } + else + rsptr = SvPV(rs, rslen); + rslast = rslen ? rsptr[rslen - 1] : '\0'; + + if (RsPARA(rs)) { /* have to do this both before and after */ do { /* to make sure file boundaries work right */ if (feof(fp)) return 0; @@ -2486,8 +2536,11 @@ I32 append; } } while (i != EOF); } -#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE) + +#ifdef FAST_SV_GETS + /* Here is some breathtakingly efficient cheating */ + cnt = FILE_cnt(fp); /* get count into register */ (void)SvPOK_only(sv); /* validate pointer */ if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */ @@ -2502,24 +2555,31 @@ I32 append; } else shortbuffered = 0; - bp = SvPVX(sv) + append; /* move these two too to registers */ + bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */ ptr = FILE_ptr(fp); for (;;) { screamer: if (cnt > 0) { - while (--cnt >= 0) { /* this */ /* eat */ - if ((*bp++ = *ptr++) == newline) /* really */ /* dust */ - goto thats_all_folks; /* screams */ /* sed :-) */ + if (rslen) { + while (--cnt >= 0) { /* this | eat */ + if ((*bp++ = *ptr++) == rslast) /* really | dust */ + goto thats_all_folks; /* screams | sed :-) */ + } + } + else { + memcpy((char*)bp, (char*)ptr, cnt); /* this | eat */ + bp += cnt; /* screams | dust */ + ptr += cnt; /* louder | sed :-) */ } } if (shortbuffered) { /* oh well, must extend */ cnt = shortbuffered; shortbuffered = 0; - bpx = bp - SvPVX(sv); /* prepare for possible relocation */ + bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */ SvCUR_set(sv, bpx); SvGROW(sv, SvLEN(sv) + append + cnt + 2); - bp = SvPVX(sv) + bpx; /* reconstitute our pointer */ + bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */ continue; } @@ -2532,20 +2592,20 @@ I32 append; if (i == EOF) /* all done for ever? */ goto thats_really_all_folks; - bpx = bp - SvPVX(sv); /* prepare for possible relocation */ + bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */ SvCUR_set(sv, bpx); SvGROW(sv, bpx + cnt + 2); - bp = SvPVX(sv) + bpx; /* reconstitute our pointer */ + bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */ + + *bp++ = i; /* store character from _filbuf */ - if (i == newline) { /* all done for now? */ - *bp++ = i; + if (rslen && (STDCHAR)i == rslast) /* all done for now? */ goto thats_all_folks; - } - *bp++ = i; /* now go back to screaming loop */ } thats_all_folks: - if (rslen > 1 && (bp - SvPVX(sv) < rslen || bcmp(bp - rslen, rs, rslen))) + if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) || + bcmp((char*)bp - rslen, rsptr, rslen)) goto screamer; /* go back to the fray */ thats_really_all_folks: if (shortbuffered) @@ -2553,45 +2613,47 @@ thats_really_all_folks: FILE_cnt(fp) = cnt; /* put these back or we're in trouble */ FILE_ptr(fp) = ptr; *bp = '\0'; - SvCUR_set(sv, bp - SvPVX(sv)); /* set length */ + SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ + +#else /* SV_FAST_GETS */ -#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */ /*The big, slow, and stupid way */ + { - char buf[8192]; - register char * bpe = buf + sizeof(buf) - 3; + STDCHAR buf[8192]; screamer: - bp = buf; - while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ; + if (rslen) { + register STDCHAR *bpe = buf + sizeof(buf); + bp = buf; + while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe) + ; /* keep reading */ + cnt = bp - buf; + } + else { + cnt = fread((char*)buf, 1, sizeof(buf), fp); + i = (cnt == EOF) ? EOF : (U8)buf[cnt - 1]; + } if (append) - sv_catpvn(sv, buf, bp - buf); + sv_catpvn(sv, buf, cnt); else - sv_setpvn(sv, buf, bp - buf); - if (i != EOF /* joy */ - && - (i != newline - || - (rslen > 1 - && - (SvCUR(sv) < rslen - || - bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rs, rslen) - ) - ) - ) - ) + sv_setpvn(sv, buf, cnt); + + if (i != EOF && /* joy */ + (!rslen || + SvCUR(sv) < rslen || + bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen))) { append = -1; goto screamer; } } -#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */ +#endif /* SV_FAST_GETS */ - if (rspara) { - while (i != EOF) { + if (RsPARA(rs)) { /* have to do this both before and after */ + while (i != EOF) { /* to make sure file boundaries work right */ i = getc(fp); if (i != '\n') { ungetc(i,fp); @@ -2599,7 +2661,8 @@ screamer: } } } - return SvCUR(sv) - append ? SvPVX(sv) : Nullch; + + return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch; } void @@ -313,8 +313,14 @@ struct xpvio { #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) #define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK)) #define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) -#define SvPOK_only(sv) (SvOK_off(sv), \ + +#ifdef OVERLOAD +#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \ SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#else +#define SvPOK_only(sv) (SvFLAGS(sv) &= ~SVf_OK, \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#endif /* OVERLOAD */ #define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) #define SvOOK_on(sv) (SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK) @@ -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@netlabs.com. +If you come up with new tests, send them to lwall@sems.com. diff --git a/t/io/pipe.t b/t/io/pipe.t index 0133c39e49..95df4dccb6 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -5,9 +5,9 @@ $| = 1; print "1..8\n"; -open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]'); -print PIPE "OK 1\n"; -print PIPE "ok 2\n"; +open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); +print PIPE "Xk 1\n"; +print PIPE "oY 2\n"; close PIPE; if (open(PIPE, "-|")) { diff --git a/t/lib/dirhand.t b/t/lib/dirhand.t new file mode 100755 index 0000000000..8403609578 --- /dev/null +++ b/t/lib/dirhand.t @@ -0,0 +1,33 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bPOSIX\b/) { + print "1..0\n"; + exit 0; + } +} + +use DirHandle; + +print "1..5\n"; + +$dot = new DirHandle "."; +print defined($dot) ? "ok" : "not ok", " 1\n"; + +@a = <*>; +do { $first = $dot->read } while defined($first) && $first =~ /^\./; +print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n"; + +@b = sort($first, (grep {/^[^.]/} $dot->read)); +print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n"; + +$dot->rewind; +@c = sort grep {/^[^.]/} $dot->read; +print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n"; + +$dot->close; +$dot->rewind; +print defined($dot->read) ? "not ok" : "ok", " 5\n"; diff --git a/t/lib/filehand.t b/t/lib/filehand.t new file mode 100755 index 0000000000..401801c7d7 --- /dev/null +++ b/t/lib/filehand.t @@ -0,0 +1,29 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bFileHandle\b/) { + print "1..0\n"; + exit 0; + } +} + +use FileHandle; +use strict subs; + +$mystdout = new_from_fd FileHandle 1,"w"; +autoflush STDOUT; +autoflush $mystdout; +print "1..4\n"; + +print $mystdout "ok ",fileno($mystdout),"\n"; + +$fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n"; +$buffer = <$fh>; +print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n"; + +ungetc STDIN 65; +CORE::read(STDIN, $buf,1); +print $buf eq 'A' ? "ok 4\n" : "not ok 4\n"; diff --git a/t/lib/posix.t b/t/lib/posix.t index 06e209c1ba..05b1252209 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -9,66 +9,58 @@ BEGIN { exit 0; } } -use FileHandle; + use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write); use strict subs; -$mystdout = new_from_fd FileHandle 1,"w"; -autoflush STDOUT; -autoflush $mystdout; -print "1..16\n"; - -print $mystdout "ok ",fileno($mystdout),"\n"; -write(1,"ok 2\nnot ok 2\n", 5); +$| = 1; +print "1..14\n"; -$testfd = open("TEST", O_RDONLY, 0) and print "ok 3\n"; +$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n"; read($testfd, $buffer, 9) if $testfd > 2; -print $buffer eq "#!./perl\n" ? "ok 4\n" : "not ok 4\n"; +print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n"; + +write(1,"ok 3\nnot ok 3\n", 5); @fds = POSIX::pipe(); -print $fds[0] > $testfd ? "ok 5\n" : "not ok 5\n"; -$writer = FileHandle->new_from_fd($fds[1], "w"); -$reader = FileHandle->new_from_fd($fds[0], "r"); -print $writer "ok 6\n"; +print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n"; +CORE::open($reader = \*READER, "<&=".$fds[0]); +CORE::open($writer = \*WRITER, ">&=".$fds[1]); +print $writer "ok 5\n"; close $writer; print <$reader>; close $reader; $sigset = new POSIX::SigSet 1,3; delset $sigset 1; -if (!ismember $sigset 1) { print "ok 7\n" } -if (ismember $sigset 3) { print "ok 8\n" } +if (!ismember $sigset 1) { print "ok 6\n" } +if (ismember $sigset 3) { print "ok 7\n" } $mask = new POSIX::SigSet &SIGINT; $action = new POSIX::SigAction 'main::SigHUP', $mask, 0; sigaction(&SIGHUP, $action); $SIG{'INT'} = 'SigINT'; kill 'HUP', $$; sleep 1; -print "ok 12\n"; +print "ok 11\n"; sub SigHUP { - print "ok 9\n"; + print "ok 8\n"; kill 'INT', $$; sleep 2; - print "ok 10\n"; + print "ok 9\n"; } sub SigINT { - print "ok 11\n"; + print "ok 10\n"; } -print &_POSIX_OPEN_MAX > $fds[1] ? "ok 13\n" : "not ok 13\n"; +print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n"; -print getcwd() =~ m#/t$# ? "ok 14\n" : "not ok 14\n"; +print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n"; # Pick up whether we're really able to dynamically load everything. -print &POSIX::acos(1.0) == 0.0 ? "ok 15\n" : "not ok 15\n"; - -ungetc STDIN 65; -CORE::read(STDIN, $buf,1); -print $buf eq 'A' ? "ok 16\n" : "not ok 16\n"; +print &POSIX::acos(1.0) == 0.0 ? "ok 14\n" : "not ok 14\n"; -flush STDOUT; -autoflush STDOUT 0; +$| = 0; print '@#!*$@(!@#$'; _exit(0); diff --git a/t/lib/safe.t b/t/lib/safe.t index c7669a05e4..dfd6032cc7 100644..100755 --- a/t/lib/safe.t +++ b/t/lib/safe.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bSafe\b/) { + if ($Config{'extensions'} !~ /\bSafe\b/ && $Config{'osname'} ne 'VMS') { print "1..0\n"; exit 0; } @@ -81,8 +81,8 @@ push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..." print "$Root::foo\n"; print "@{$cpt->varglob('bar')}\n"; -print opname(22) eq "bless" ? "ok 19\n" : "not ok 19\n"; -print opcode("bless") == 22 ? "ok 20\n" : "not ok 20\n"; +print opname(23) eq "bless" ? "ok 19\n" : "not ok 19\n"; +print opcode("bless") == 23 ? "ok 20\n" : "not ok 20\n"; $m1 = $cpt->mask(); $cpt->trap("negate"); diff --git a/t/lib/socket.t b/t/lib/socket.t index e63c43ae4c..14c7609741 100644..100755 --- a/t/lib/socket.t +++ b/t/lib/socket.t @@ -4,7 +4,8 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib' if -d '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bSocket\b/ && $Config{'osname'} ne 'VMS') { + if ($Config{'extensions'} !~ /\bSocket\b/ && + !(($Config{'osname'} eq 'VMS') && $Config{d_has_socket})) { print "1..0\n"; exit 0; } diff --git a/t/op/overload.t b/t/op/overload.t index 183cb273f7..183cb273f7 100644..100755 --- a/t/op/overload.t +++ b/t/op/overload.t diff --git a/t/op/time.t b/t/op/time.t index 186a81cf8a..1bec442fe2 100755 --- a/t/op/time.t +++ b/t/op/time.t @@ -41,7 +41,7 @@ if ($sec != $xsec && $mday && $year) else {print "not ok 4\n";} -if (index(" :0:1:-1:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0) +if (index(" :0:1:-1:364:365:-364:-365:",':' . ($localyday - $yday) . ':') > 0) {print "ok 5\n";} else {print "not ok 5\n";} @@ -257,10 +257,8 @@ SV *line; SvTEMP_off(linestr); oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); bufend = bufptr + SvCUR(linestr); - rs = "\n"; - rslen = 1; - rschar = '\n'; - rspara = 0; + SvREFCNT_dec(rs); + rs = newSVpv("\n", 1); rsfp = 0; } @@ -1765,7 +1763,7 @@ yylex() if (*s == '}') OPERATOR(HASHBRACK); if (isALPHA(*s)) { - for (t = s; t < bufend && isALPHA(*t); t++) ; + for (t = s; t < bufend && isALNUM(*t); t++) ; } else if (*s == '\'' || *s == '"') { t = strchr(s+1,*s); @@ -1840,6 +1838,7 @@ yylex() } else PREREF('&'); + yylval.ival = (OPpENTERSUB_AMPER<<8); TERM('&'); case '|': @@ -2029,6 +2028,19 @@ yylex() } } if (tmp = pad_findmy(tokenbuf)) { + if (!tokenbuf[2] && *tokenbuf =='$' && + tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a') + { + for (d = in_eval ? oldoldbufptr : SvPVX(linestr); + d < bufend && *d != '\n'; + d++) + { + if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) { + croak("Can't use \"my %s\" in sort comparison", + tokenbuf); + } + } + } nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; force_next(PRIVATEREF); @@ -2368,6 +2380,7 @@ yylex() nextval[nexttoke].opval = yylval.opval; expect = XOPERATOR; force_next(WORD); + yylval.ival = 0; TOKEN('&'); } @@ -2392,6 +2405,7 @@ yylex() if (*s == '(') { expect = XTERM; force_next(WORD); + yylval.ival = 0; TOKEN('&'); } if (lastchar == '-') @@ -2933,6 +2947,9 @@ yylex() checkcomma(s,tokenbuf,"filehandle"); LOP(OP_PRTF,XREF); + case KEY_prototype: + UNI(OP_PROTOTYPE); + case KEY_push: LOP(OP_PUSH,XTERM); @@ -3253,6 +3270,9 @@ yylex() case KEY_syscall: LOP(OP_SYSCALL,XTERM); + case KEY_sysopen: + LOP(OP_SYSOPEN,XTERM); + case KEY_sysread: LOP(OP_SYSREAD,XTERM); @@ -3272,6 +3292,9 @@ yylex() case KEY_tie: LOP(OP_TIE,XTERM); + case KEY_tied: + UNI(OP_TIED); + case KEY_time: FUN0(OP_TIME); @@ -3744,6 +3767,8 @@ I32 len; case 7: if (strEQ(d,"package")) return KEY_package; break; + case 9: + if (strEQ(d,"prototype")) return KEY_prototype; } break; case 'q': @@ -3886,6 +3911,7 @@ I32 len; if (strEQ(d,"system")) return -KEY_system; break; case 7: + if (strEQ(d,"sysopen")) return -KEY_sysopen; if (strEQ(d,"sysread")) return -KEY_sysread; if (strEQ(d,"symlink")) return -KEY_symlink; if (strEQ(d,"syscall")) return -KEY_syscall; @@ -3907,6 +3933,7 @@ I32 len; break; case 4: if (strEQ(d,"tell")) return -KEY_tell; + if (strEQ(d,"tied")) return KEY_tied; if (strEQ(d,"time")) return -KEY_time; break; case 5: @@ -4603,6 +4630,7 @@ char *start; if (!rsfp || !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) { + sv_free(sv); curcop->cop_line = multi_start; return Nullch; } @@ -60,6 +60,9 @@ #endif #define ABORT() kill(getpid(),SIGABRT); +#define BIT_BUCKET "/dev/null" +#define PERL_SYS_INIT(c,v) + /* * fwrite1() should be a routine with the same calling sequence as fwrite(), * but which outputs all of the bytes requested as a single stream (unlike @@ -858,11 +858,12 @@ mess(pat, args) SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); s += strlen(s); } - if (GvIO(last_in_gv) && - IoLINES(GvIOp(last_in_gv)) ) { + if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) { + bool line_mode = (RsSIMPLE(rs) && + SvLEN(rs) == 1 && *SvPVX(rs) == '\n'); (void)sprintf(s,", <%s> %s %ld", last_in_gv == argvgv ? "" : GvNAME(last_in_gv), - strEQ(rs,"\n") ? "line" : "chunk", + line_mode ? "line" : "chunk", (long)IoLINES(GvIOp(last_in_gv))); s += strlen(s); } diff --git a/utils/c2ph.PL b/utils/c2ph.PL index dfe9f24db8..ece26acbc1 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -1392,5 +1392,5 @@ close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; unlink 'pstruct'; print "Linking c2ph to pstruct.\n"; -link c2ph, pstruct; +link c2ph, pstruct unless $Config{'osname'} eq 'VMS'; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 4e0dbd1910..720191ec1d 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -237,7 +237,7 @@ sub expr { } } else { - if ($inif && $new !~ /defined\($/) { + if ($inif && $new !~ /defined\s*\($/) { $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)'; } elsif (/^\[/) { diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 535ec4108f..26f10c7687 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -149,7 +149,7 @@ The usual warnings if it can't read or write the files involved. =cut -my( $H2XS_VERSION ) = '$Revision: 1.12 $' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = '$Revision: 1.14 $' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; use Getopt::Std; @@ -238,8 +238,13 @@ else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; -# quick hack, should really loop over @modparts -mkdir($modparts[0], 0777) if $nested; +if( $nested ){ + $modpath = ""; + foreach (@modparts){ + mkdir("$modpath$_", 0777); + $modpath .= "$_/"; + } +} mkdir($modpname, 0777); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; @@ -481,7 +486,7 @@ use ExtUtils::MakeMaker; END print PL "WriteMakefile(\n"; print PL " 'NAME' => '$module',\n"; -print PL " 'VERSION' => '$TEMPLATE_VERSION',\n"; +print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n"; print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n"; print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n"; print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n"; @@ -518,6 +523,14 @@ print "ok 1\n"; _END_ close(EX) || die "Can't close $ext$modpname/test.pl: $!\n"; +warn "Writing $ext$modpname/Changes\n"; +open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; +print EX "Revision history for Perl extension $module.\n\n"; +print EX "$TEMPLATE_VERSION ",scalar localtime,"\n"; +print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n"; +close(EX) || die "Can't close $ext$modpname/Changes: $!\n"; + +warn "Writing $ext$modpname/MANIFEST\n"; system '/bin/ls > MANIFEST' or system 'ls > MANIFEST'; !NO!SUBS! diff --git a/utils/perlbug.PL b/utils/perlbug.PL index e877707184..375bb78576 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -36,15 +36,35 @@ $Config{'startperl'} print OUT <<'!NO!SUBS!'; use Config; -use Mail::Send; -use Mail::Util; use Getopt::Std; +BEGIN { + eval "use Mail::Send;"; + $::HaveSend = ($@ eq ""); + eval "use Mail::Util;"; + $::HaveUtil = ($@ eq ""); +}; + + use strict; sub paraprint; -my($Version) = "1.06"; + +my($Version) = "1.11"; + +# Changed in 1.06 to skip Mail::Send and Mail::Util if not available. +# Changed in 1.07 to see more sendmail execs, and added pipe output +# Changed in 1.08 to use correct address for sendmail +# Changed in 1.09 to close the REP file before calling it up in the editor. +# Also removed some old comments duplicated elsewhere. +# Changed in 1.10 to run under VMS without Mail::Send; also fixed +# temp filename generation +# Changed in 1.11 to clean up some text and removed Mail::Send deactivator. + +# TODO: Allow the user to re-name the file on mail failure, and +# make sure failure (transmission-wise) of Mail::Send is +# accounted for. my( $file, $cc, $address, $perlbug, $testaddress, $filename, $subject, $from, $verbose, $ed, @@ -54,6 +74,8 @@ Init(); if($::opt_h) { Help(); exit; } +if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; } + Query(); Edit(); NowWhat(); @@ -67,7 +89,7 @@ sub Init { $Is_VMS = $::Config{'osname'} eq 'VMS'; - getopts("hva:s:b:f:r:e:SCc:t"); + getopts("dhva:s:b:f:r:e:SCc:t"); # This comment is needed to notify metaconfig that we are @@ -124,7 +146,7 @@ sub Query { # Explain what perlbug is paraprint <<EOF; -This program allows you to enter a bug report, +This program allows you to create a bug report, which will be sent as an e-mail message to $address once you have filled in the report. @@ -135,8 +157,8 @@ EOF if(! $subject) { paraprint <<EOF; First of all, please provide a subject for the -message. It should be concise description of the bug, -if at all possible. +message. It should be as a concise description of +the bug as is possible. EOF print "Subject: "; @@ -160,17 +182,27 @@ EOF if( !$from) { # Try and guess return address - my($domain) = Mail::Util::maildomain(); + my($domain); + + if($::HaveUtil) { + $domain = Mail::Util::maildomain(); + } elsif ($Is_VMS) { + require Sys::Hostname; + $domain = Sys::Hostname::hostname(); + } else { + $domain = `hostname`.".".`domainname`; + $domain =~ s/[\r\n]+//g; + } my($guess); if( !$domain) { $guess = ""; } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) { - $guess = "$domain$me"; + $guess = "$domain\:\:$me"; } else { - $guess = "$me\@$domain" if $domain; - $guess = "$me\@unknown.addresss" unless $domain; + $guess = "$me\@$domain" if $domain; + $guess = "$me\@unknown.addresss" unless $domain; } if( $guess ) { @@ -178,7 +210,7 @@ EOF Your e-mail address will be useful if you need to be contacted. -If the default is not your proper address, please correct it here. +If the default shown is not your proper address, please correct it. EOF } else { @@ -205,7 +237,7 @@ EOF if( $from eq $cc or $me eq $cc ) { # Try not to copy ourselves - $cc = "none"; + $cc = "yourself"; } @@ -216,7 +248,8 @@ EOF A copy of this report can be sent to your local perl administrator. If the address is wrong, please -correct it, or enter 'none' to not send a copy. +correct it, or enter 'none' or 'yourself' to not send +a copy. EOF @@ -232,7 +265,7 @@ EOF } - if($cc eq "none") { $cc = "" } + if($cc =~ /^(none|yourself|myself|ourselves)$/i) { $cc = "" } $andcc = " and $cc" if $cc; @@ -242,7 +275,7 @@ EOF paraprint <<EOF; -Now you need to enter the bug report. Try to make +Now you need to supply the bug report. Try to make the report concise but descriptive. Include any relevant detail. Some information about your local perl configuration will automatically be included @@ -253,7 +286,7 @@ the report. If "$ed" is the editor you want to use, then just press Enter, otherwise type in the name of the editor you would like to use. -If you would like to use a prepared file, just enter +If you would like to use a prepared file, type "file", and you will be asked for the filename. EOF @@ -271,8 +304,12 @@ EOF # Generate scratch file to edit report in - $filename = ($Is_VMS ? 'sys$scratch:' : '/tmp/') . "bugrep0$$"; - $filename++ while -e $filename; + { + my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/'; + $filename = "bugrep0$$"; + $filename++ while -e "$dir$filename"; + $filename = "$dir$filename"; + } # Prompt for file to read report from, if needed @@ -291,7 +328,7 @@ EOF chop($entry); if(!-f $entry or !-r $entry) { - print "\n\nUnable to read `$entry'.\nExiting.\n"; + print "\n\nUnable to read from `$entry'.\nExiting.\n"; exit; } $file = $entry; @@ -320,8 +357,16 @@ EOF } else { print REP "[Please enter your report here]\n"; } + + Dump(*REP); + close(REP); - print REP <<EOF; +} + +sub Dump { + local(*OUT) = @_; + + print OUT <<EOF; @@ -330,30 +375,29 @@ Site configuration information for perl $]: EOF if( $::Config{cf_by} and $::Config{cf_time}) { - print REP "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n"; + print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n"; } - print REP Config::myconfig; + print OUT Config::myconfig; if($verbose) { - print REP "\nComplete configuration data for perl $]:\n\n"; + print OUT "\nComplete configuration data for perl $]:\n\n"; my($value); foreach (sort keys %::Config) { $value = $::Config{$_}; $value =~ s/'/\\'/g; - print REP "$_='$value'\n"; + print OUT "$_='$value'\n"; } } - - close(REP); } sub Edit { # Edit the report if(!$file and !$body) { - if( system("$ed $filename") ) { - print "\nUnabled to run editor!\n"; + my($sts) = system("$ed $filename"); + if( $Is_VMS ? !($sts & 1) : $sts ) { + print "\nUnable to run editor!\n"; } } } @@ -422,19 +466,69 @@ EOF sub Send { # Message has been accepted for transmission -- Send the message + + if($::HaveSend) { - $msg = new Mail::Send Subject => $subject, To => $address; + $msg = new Mail::Send Subject => $subject, To => $address; - $msg->cc($cc) if $cc; - $msg->add("Reply-To",$from) if $from; + $msg->cc($cc) if $cc; + $msg->add("Reply-To",$from) if $from; - $fh = $msg->open; + $fh = $msg->open; + + open(REP,"<$filename"); + while(<REP>) { print $fh $_ } + close(REP); - open(REP,"<$filename"); - while(<REP>) { print $fh $_ } - close(REP); + $fh->close; + + } else { + if ($Is_VMS) { + if ( ($address =~ /@/ and $address !~ /^\w+%"/) or + ($cc =~ /@/ and $cc !~ /^\w+%"/) ){ + my($prefix); + foreach (qw[ IN MX SMTP UCX PONY WINS ],'') { + $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"}; + } + $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/; + $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/; + } + $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g; + my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]); + if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" } + } else { + my($sendmail) = ""; + + foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) + { + $sendmail = $_, last if -e $_; + } + + paraprint <<"EOF" and die "\n" if $sendmail eq ""; + +I am terribly sorry, but I cannot find sendmail, or a close equivalent, and +the perl package Mail::Send has not been installed, so I can't send your bug +report. We apologize for the inconveniencence. + +So you may attempt to find some way of sending your message, it has +been left in the file `$filename'. + +EOF + + open(SENDMAIL,"|$sendmail -t"); + print SENDMAIL "To: $address\n"; + print SENDMAIL "Subject: $subject\n"; + print SENDMAIL "Cc: $cc\n" if $cc; + print SENDMAIL "Reply-To: $from\n" if $from; + print SENDMAIL "\n\n"; + open(REP,"<$filename"); + while(<REP>) { print SENDMAIL $_ } + close(REP); + + close(SENDMAIL); + } - $fh->close; + } print "\nMessage sent.\n"; @@ -453,7 +547,7 @@ Usage: $0 [-v] [-a address] [-s subject] [-b body | -f file ] [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] -Simplest usage: execute "$0", and follow the prompts. +Simplest usage: run "$0", and follow the prompts. Options: @@ -472,13 +566,16 @@ Options: this if you don't give it here. -e Editor to use. -t Test mode. The target address defaults to `$testaddress'. + -d Data mode (the default if you redirect or pipe output.) + This prints out your configuration data, without mailing + anything. You can use this with -v to get more complete data. EOF } sub paraprint { my @paragraphs = split /\n{2,}/, "@_"; - print "\n"; + print "\n\n"; for (@paragraphs) { # implicit local $_ s/(\S)\s*\n/$1 /g; write; diff --git a/utils/pl2pm.PL b/utils/pl2pm.PL index 4e69036499..4e69036499 100755..100644 --- a/utils/pl2pm.PL +++ b/utils/pl2pm.PL diff --git a/vms/Makefile b/vms/Makefile index 075a6b9860..69738c7a03 100644 --- a/vms/Makefile +++ b/vms/Makefile @@ -1,15 +1,17 @@ -#> This file produced from Descrip.MMS by mms2make.pl +#> This file produced from vms/descrip.mms by vms/mms2make.pl #> Lines beginning with "#>" were commented out during the -#> conversion process. For more information, see mms2make.pl +#> conversion process. For more information, see vms/mms2make.pl #> -# Makefile. for perl5 on VMS -# Last revised 4-Dec-1995 by Charles Bailey bailey@genetics.upenn.edu +# Descrip.MMS for perl5 on VMS +# Last revised 17-Jan-1995 by Charles Bailey bailey@genetics.upenn.edu # # # tidy -- purge files generated by executing this file -# clean -- remove all files generated by executing this file -# cleansrc -- `clean' + purge *.c,*.h,Makefile. -# gcc_cld_setup -- GCC initialization; see above +# clean -- remove all intermediate (e.g. object files, C files generated +# during build) files generated by executing this file, +# but leave `installable' files (images, library) intact +# realclean -- remove all files generated by executing this file +# cleansrc -- `realclean' + purge *.c,*.h,descrip.mms # crtl.opt -- compiler-specific linker options file (made automatically) # @@ -27,6 +29,7 @@ OLB = .olb E = .exe ARCH = VMS_VAX +OBJVAL = $@ ARCHDIR = [.lib.$(ARCH)] ARCHCORE = [.lib.$(ARCH).CORE] ARCHAUTO = [.lib.$(ARCH).auto] @@ -47,7 +50,7 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion) @ If f$$TrnLnm("Sys").eqs."" Then Define/NoLog SYS sys$$Library XTRACCFLAGS = /Include=[]/Object=$(O) XTRADEF = -LIBS2 = VAXCRTL/Shareable +LIBS2 = sys$$Share:VAXCRTL/Shareable DBGCCFLAGS = /NoList @@ -71,7 +74,7 @@ CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) LINKFLAGS = $(DBGLINKFLAGS) MAKE = $(MMS) -MAKEFILE = [.VMS]Makefile. # this file +MAKEFILE = [.VMS]Descrip.MMS # this file NOOP = continue # Macros to invoke a copy of miniperl during the build. Targets which @@ -144,12 +147,31 @@ CRTLOPTS =,$(CRTL)/Options $(XSUBPP) $< >$(MMS$SOURCE_NAME).c $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c -all : base extras archcorefiles preplibrary +all : base extras archcorefiles preplibrary perlpods @ $(NOOP) base : miniperl$(E) perl$(E) @ $(NOOP) -extras : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm +extras : Safe libmods utils podxform @ $(NOOP) +libmods : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm + @ $(NOOP) +utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug + @ $(NOOP) +podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man + @ $(NOOP) + +pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod +pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod +pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod +pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod +pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod +pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod +pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod +pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod + +perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod + @ $(NOOP) + archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp @ $(NOOP) @@ -199,19 +221,215 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( [.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm + +Safe : [.lib]Safe.pm [.lib.auto]Safe$(E) + @ $(NOOP) + +[.lib]Safe.pm : [.ext.Safe]Descrip.MMS + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +[.lib.auto]Safe$(E) : [.ext.Safe]Descrip.MMS + @ Set Default [.ext.Safe] + $(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.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0: [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm @ If f$$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] Copy/Log/NoConfirm [.vms.ext]Filespec.pm $@ -[.lib.ExtUtils]MM_VMS.pm : [.vms.ext]MM_VMS.pm - Copy/Log/NoConfirm [.vms.ext]MM_VMS.pm $@ +[.lib.pod]perldoc : [.utils]perldoc.PL [.lib.$(ARCH)]Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.utils]perldoc.PL + Copy/Log [.utils]perldoc $@ + +[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c [.lib.$(ARCH)]Config.pm + $(MINIPERL) Minimod.PL >$@ + +[.utils]c2ph : [.utils]c2ph.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) [.utils]c2ph.PL + +[.utils]h2ph : [.utils]h2ph.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) [.utils]h2ph.PL -preplibrary : $(MINIPERL_EXE) [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]MM_VMS.pm $(SOCKPM) +[.utils]h2xs : [.utils]h2xs.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) [.utils]h2xs.PL + +[.lib]perlbug : [.utils]perlbug.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) [.utils]perlbug.PL + Rename/Log [.utils]perlbug $@ + +[.utils]pl2pm : [.utils]pl2pm.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) [.utils]pl2pm.PL + +[.lib.pod]pod2html : [.pod]pod2html.PL [.lib.$(ARCH)]Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2html.PL + Rename/Log [.pod]pod2html $@ + +[.lib.pod]pod2latex : [.pod]pod2latex.PL [.lib.$(ARCH)]Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2latex.PL + Rename/Log [.pod]pod2latex $@ + +[.lib.pod]pod2man : [.pod]pod2man.PL [.lib.$(ARCH)]Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2man.PL + Rename/Log [.pod]pod2man $@ + +[.lib.pod]pod2text : [.pod]pod2text.PL [.lib.$(ARCH)]Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2text.PL + Rename/Log [.pod]pod2text $@ + +preplibrary : $(MINIPERL_EXE) [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM) @ Write sys$$Output "Autosplitting Perl library . . ." @ Create/Directory [.lib.auto] @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm +[.lib.pod]perl.pod : [.pod]perl.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perl.pod $@ + +[.lib.pod]perlbook.pod : [.pod]perlbook.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlbook.pod $@ + +[.lib.pod]perlbot.pod : [.pod]perlbot.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlbot.pod $@ + +[.lib.pod]perlcall.pod : [.pod]perlcall.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlcall.pod $@ + +[.lib.pod]perldata.pod : [.pod]perldata.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldata.pod $@ + +[.lib.pod]perldebug.pod : [.pod]perldebug.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldebug.pod $@ + +[.lib.pod]perldiag.pod : [.pod]perldiag.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldiag.pod $@ + +[.lib.pod]perldsc.pod : [.pod]perldsc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldsc.pod $@ + +[.lib.pod]perlembed.pod : [.pod]perlembed.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlembed.pod $@ + +[.lib.pod]perlform.pod : [.pod]perlform.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlform.pod $@ + +[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlfunc.pod $@ + +[.lib.pod]perlguts.pod : [.pod]perlguts.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlguts.pod $@ + +[.lib.pod]perlipc.pod : [.pod]perlipc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlipc.pod $@ + +[.lib.pod]perllol.pod : [.pod]perllol.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perllol.pod $@ + +[.lib.pod]perlmod.pod : [.pod]perlmod.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlmod.pod $@ + +[.lib.pod]perlobj.pod : [.pod]perlobj.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlobj.pod $@ + +[.lib.pod]perlop.pod : [.pod]perlop.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlop.pod $@ + +[.lib.pod]perlovl.pod : [.pod]perlovl.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlovl.pod $@ + +[.lib.pod]perlpod.pod : [.pod]perlpod.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlpod.pod $@ + +[.lib.pod]perlre.pod : [.pod]perlre.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlre.pod $@ + +[.lib.pod]perlref.pod : [.pod]perlref.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlref.pod $@ + +[.lib.pod]perlrun.pod : [.pod]perlrun.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlrun.pod $@ + +[.lib.pod]perlsec.pod : [.pod]perlsec.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsec.pod $@ + +[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlstyle.pod $@ + +[.lib.pod]perlsub.pod : [.pod]perlsub.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsub.pod $@ + +[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsyn.pod $@ + +[.lib.pod]perltie.pod : [.pod]perltie.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltie.pod $@ + +[.lib.pod]perltoc.pod : [.pod]perltoc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltoc.pod $@ + +[.lib.pod]perltrap.pod : [.pod]perltrap.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltrap.pod $@ + +[.lib.pod]perlvar.pod : [.pod]perlvar.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlvar.pod $@ + +[.lib.pod]perlxs.pod : [.pod]perlxs.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlxs.pod $@ + +[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlxstut.pod $@ + +[.lib.pod]perlvms.pod : [.vms]perlvms.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.vms]perlvms.pod $@ + +printconfig : + @ $$@[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) + @ $$@[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)" + # The following three header files are generated automatically # keywords.h : keywords.pl @@ -1004,6 +1222,7 @@ tidy : cleanlis - If f$$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar - If f$$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O) - If f$$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C + - If f$$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe] - If f$$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C - If f$$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O) - If f$$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al @@ -1013,8 +1232,10 @@ tidy : cleanlis - If f$$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm - If f$$Search("[.Lib.$(ARCH)]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.$(ARCH)]Config.pm - If f$$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - - If f$$Search("[.Lib.ExtUtils]MM_VMS.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm + - If f$$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod - If f$$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* + - If f$$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If f$$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. clean : tidy - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt @@ -1036,16 +1257,27 @@ clean : tidy - If f$$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;* - If f$$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* - If f$$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* + Set Default [.ext.Safe] + - $(MMS) clean + Set Default [--] realclean : clean - 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);" - If f$$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* - - If f$$Search("[.Lib.ExtUtils]MM_VMS.pm").nes."" Then Delete/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm;* - - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* - If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* - If f$$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* + - If f$$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* + - If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If f$$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* + - If f$$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* + - If f$$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* + Set Default [.ext.Safe] + - $(MMS) realclean + Set Default [--] + - If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* cleansrc : clean - If f$$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C diff --git a/vms/config.vms b/vms/config.vms index cd8a46de3b..cdf900a9cd 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -135,7 +135,7 @@ * This symbol, if defined, indicates that the crypt routine is available * to encrypt passwords and the like. */ -#undef HAS_CRYPT /**/ +#define HAS_CRYPT /**/ /* BYTEORDER: * This symbol hold the hexadecimal constant defined in byteorder, @@ -462,6 +462,12 @@ #undef Shmat_t /**/ /* config-skip */ #undef HAS_SHMAT_PROTOTYPE /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +#undef HAS_SIGACTION /**/ + /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. @@ -1002,7 +1008,7 @@ * This symbol, if defined, indicates that the getlogin routine is * available. */ -#undef HAS_GETLOGIN /**/ +#define HAS_GETLOGIN /**/ /* HAS_GETPPID: * This symbol, if defined, indicates that the getppid routine is @@ -1357,7 +1363,7 @@ /* VMS: true for gcc, undef for VAXC/DECC. This is handled in Descrip.MMS * C. Bailey 26-Aug-1994 */ -/*#define GNUC_ATTRIBUTE_CHECK */ +/*#define GNUC_ATTRIBUTE_CHECK /**/ /* VOID_CLOSEDIR: * This symbol, if defined, indicates that the closedir() routine @@ -1486,6 +1492,13 @@ */ #define USE_DYNAMIC_LOADING /**/ +/* STARTPERL: + * This variable contains the string to put in front of a perl + * script to make sure (one hopes) that it runs with perl and not + * some shell. + */ +#define STARTPERL "" /**/ + /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this * compiler. What various bits mean: diff --git a/vms/descrip.mms b/vms/descrip.mms index 09257491cf..aac4841d64 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -1,5 +1,5 @@ # Descrip.MMS for perl5 on VMS -# Last revised 4-Dec-1995 by Charles Bailey bailey@genetics.upenn.edu +# Last revised 17-Jan-1995 by Charles Bailey bailey@genetics.upenn.edu # #: This file uses MMS syntax, and can be processed using DEC's MMS product, #: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to @@ -19,21 +19,19 @@ #: $ MMS /MACRO=("decc=1") #: Building with DEC C, on system with VAX C installed as default C compiler: #: $ MMS /MACRO=("decc=1","cc=CC/DECC") -#: Building with GNU C, on system with GCC command installed in DCLTABLES: +#: Building with GNU C #: $ MMS /MACRO=("gnuc=1") -#: Building with GNU C, on system without GCC command installed in DCLTABLES: -#: $ MMS /MACRO=("gnuc=1") gcc_cld_setup,all -#: note: `gcc_cld_setup' target must explicitly precede `all' or `[mini]perl' -#: #: To each of the above, add /Macro="__AXP__=1" if building on an AXP, #: /Macro="__DEBUG__=1" to build a debug version #: (i.e. VMS debugger, not perl -D), and #: /Macro="SOCKET=1" to include socket support. # # tidy -- purge files generated by executing this file -# clean -- remove all files generated by executing this file -# cleansrc -- `clean' + purge *.c,*.h,descrip.mms -# gcc_cld_setup -- GCC initialization; see above +# clean -- remove all intermediate (e.g. object files, C files generated +# during build) files generated by executing this file, +# but leave `installable' files (images, library) intact +# realclean -- remove all files generated by executing this file +# cleansrc -- `realclean' + purge *.c,*.h,descrip.mms # crtl.opt -- compiler-specific linker options file (made automatically) # @@ -60,8 +58,10 @@ E = .exe .ifdef __AXP__ DECC = 1 ARCH = VMS_AXP +OBJVAL = $(O) .else ARCH = VMS_VAX +OBJVAL = $(MMS$TARGET_NAME)$(O) .endif ARCHDIR = [.lib.$(ARCH)] ARCHCORE = [.lib.$(ARCH).CORE] @@ -81,7 +81,7 @@ DBGSPECFLAGS = XTRADEF = ,GNUC_ATTRIBUTE_CHECK XTRAOBJS = LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library -LIBS2 = VAXCRTL/Shareable +LIBS2 = Sys$Share:VAXCRTL/Shareable .else XTRAOBJS = LIBS1 = $(XTRAOBJS) @@ -95,14 +95,14 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion) .first @ Set Process/Privilege=(NoSYSNAM) LIBS2 = -XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(MMS$TARGET_NAME)$(O) +XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(OBJVAL) XTRADEF = .else # VAXC .first @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS Sys$Library XTRACCFLAGS = /Include=[]/Object=$(O) XTRADEF = -LIBS2 = VAXCRTL/Shareable +LIBS2 = Sys$Share:VAXCRTL/Shareable .endif .endif @@ -235,12 +235,31 @@ CRTLOPTS =,$(CRTL)/Options $(XSUBPP) $(MMS$SOURCE) >$(MMS$SOURCE_NAME).c $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c -all : base extras archcorefiles preplibrary +all : base extras archcorefiles preplibrary perlpods @ $(NOOP) base : miniperl$(E) perl$(E) @ $(NOOP) -extras : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm +extras : Safe libmods utils podxform + @ $(NOOP) +libmods : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm + @ $(NOOP) +utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug + @ $(NOOP) +podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man @ $(NOOP) + +pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod +pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod +pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod +pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod +pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod +pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod +pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod +pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod + +perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod + @ $(NOOP) + archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp @ $(NOOP) @@ -261,6 +280,9 @@ perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl perl$(E) : perlmain$(O), perlshr$(E), $(MINIPERL_EXE) @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share" +.ifdef gnuc + @ @[.vms]genopt "PerlShr.Opt/Append" "|" "$(LIBS1)|$(LIBS2)" +.endif Link $(LINKFLAGS)/Exe=$(DBG)$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts Link /NoTrace$(LINKFLAGS)/Share=$(DBG)$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option @@ -299,19 +321,215 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( [.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm + +Safe : [.lib]Safe.pm [.lib.auto]Safe$(E) + @ $(NOOP) + +[.lib]Safe.pm : [.ext.Safe]Descrip.MMS + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +[.lib.auto]Safe$(E) : [.ext.Safe]Descrip.MMS + @ Set Default [.ext.Safe] + $(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.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0: [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm @ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) -[.lib.ExtUtils]MM_VMS.pm : [.vms.ext]MM_VMS.pm - Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) +[.lib.pod]perldoc : [.utils]perldoc.PL [.lib.$(ARCH)]Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Copy/Log [.utils]perldoc $(MMS$TARGET) + +[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) >$(MMS$TARGET) -preplibrary : $(MINIPERL_EXE) [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]MM_VMS.pm $(SOCKPM) +[.utils]c2ph : [.utils]c2ph.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.utils]h2ph : [.utils]h2ph.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.utils]h2xs : [.utils]h2xs.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.lib]perlbug : [.utils]perlbug.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.utils]perlbug $(MMS$TARGET) + +[.utils]pl2pm : [.utils]pl2pm.PL [.lib.$(ARCH)]Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.lib.pod]pod2html : [.pod]pod2html.PL [.lib.$(ARCH)]Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2html $(MMS$TARGET) + +[.lib.pod]pod2latex : [.pod]pod2latex.PL [.lib.$(ARCH)]Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2latex $(MMS$TARGET) + +[.lib.pod]pod2man : [.pod]pod2man.PL [.lib.$(ARCH)]Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2man $(MMS$TARGET) + +[.lib.pod]pod2text : [.pod]pod2text.PL [.lib.$(ARCH)]Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2text $(MMS$TARGET) + +preplibrary : $(MINIPERL_EXE) [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM) @ Write Sys$Output "Autosplitting Perl library . . ." @ Create/Directory [.lib.auto] @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm +[.lib.pod]perl.pod : [.pod]perl.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlbook.pod : [.pod]perlbook.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlbot.pod : [.pod]perlbot.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlcall.pod : [.pod]perlcall.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldata.pod : [.pod]perldata.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldebug.pod : [.pod]perldebug.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldiag.pod : [.pod]perldiag.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldsc.pod : [.pod]perldsc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlembed.pod : [.pod]perlembed.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlform.pod : [.pod]perlform.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlguts.pod : [.pod]perlguts.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlipc.pod : [.pod]perlipc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perllol.pod : [.pod]perllol.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlmod.pod : [.pod]perlmod.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlobj.pod : [.pod]perlobj.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlop.pod : [.pod]perlop.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlovl.pod : [.pod]perlovl.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlpod.pod : [.pod]perlpod.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlre.pod : [.pod]perlre.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlref.pod : [.pod]perlref.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlrun.pod : [.pod]perlrun.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsec.pod : [.pod]perlsec.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsub.pod : [.pod]perlsub.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltie.pod : [.pod]perltie.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltoc.pod : [.pod]perltoc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltrap.pod : [.pod]perltrap.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlvar.pod : [.pod]perlvar.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlxs.pod : [.pod]perlxs.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlvms.pod : [.vms]perlvms.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +printconfig : + @ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) + @ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)" + .ifdef SOCKET $(SOCKOBJ) : $(SOCKC) $(SOCKH) @@ -1129,6 +1347,7 @@ tidy : cleanlis - If F$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar - If F$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O) - If F$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C + - If F$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe] - If F$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C - If F$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O) - If F$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al @@ -1138,8 +1357,10 @@ tidy : cleanlis - If F$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm - If F$Search("[.Lib.$(ARCH)]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.$(ARCH)]Config.pm - If F$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - - If F$Search("[.Lib.ExtUtils]MM_VMS.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm + - If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod - If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* + - If F$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If F$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. clean : tidy - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt @@ -1161,16 +1382,27 @@ clean : tidy - If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;* - If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* - If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* + Set Default [.ext.Safe] + - $(MMS) clean + Set Default [--] realclean : clean - 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);" - If F$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* - - If F$Search("[.Lib.ExtUtils]MM_VMS.pm").nes."" Then Delete/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm;* - - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* - If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* - If F$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* + - If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* + - If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* + - If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* + - If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* + Set Default [.ext.Safe] + - $(MMS) realclean + Set Default [--] + - If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* cleansrc : clean - If F$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C diff --git a/vms/ext/VMS/stdio/Makefile.PL b/vms/ext/stdio/Makefile.PL index d6683b4af6..d6683b4af6 100644 --- a/vms/ext/VMS/stdio/Makefile.PL +++ b/vms/ext/stdio/Makefile.PL diff --git a/vms/ext/VMS/stdio/stdio.pm b/vms/ext/stdio/stdio.pm index d8b4ec21ec..d8b4ec21ec 100644 --- a/vms/ext/VMS/stdio/stdio.pm +++ b/vms/ext/stdio/stdio.pm diff --git a/vms/ext/VMS/stdio/stdio.xs b/vms/ext/stdio/stdio.xs index 958c0400d1..737229fe0b 100644 --- a/vms/ext/VMS/stdio/stdio.xs +++ b/vms/ext/stdio/stdio.xs @@ -90,7 +90,7 @@ vmsfopen(name,...) if (c == 'a') *(name++) = '>'; } *(name++) = '&'; - if (do_open(gv,mode,name - mode,fp)) + if (do_open(gv,mode,name - mode,FALSE,0,0,fp)) sv_setsv(ST(0),newRV((SV*)gv)); } diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index 286695feb3..e2f5b287e3 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -119,8 +119,8 @@ sub scan_enum { $line =~ s/,?\s*\n?$//; print "\tfiltered to \\$line\\\n" if $debug > 1; if ($line =~ /(\w+)$/) { - print "\tvar name is \\$1\\\n" if $debug > 1; - $vars{$1}++; + print "\tconstant name is \\$1\\\n" if $debug > 1; + $enums{$1}++; } } @@ -152,6 +152,7 @@ sub scan_func { } } +$used_expectation_enum = $used_opcode_enum = 0; # avoid warnings if ($docc) { open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output ${dir}perl.h|") or die "$0: Can't preprocess ${dir}perl.h: $!\n"; @@ -190,7 +191,19 @@ LINE: while (<CPP>) { last LINE unless $_ = <CPP>; } print $_ if $debug > 3; - if (/^EXT/) { &scan_var($_); } + if (($type) = /^EXT\s+(\w+)/) { + if ($isvaxc) { + if ($type eq 'expectation') { + $used_expectation_enum++; + print "\tsaw global use of enum \"expectation\"\n" if $debug > 1; + } + if ($type eq 'opcode') { + $used_opcode_enum++; + print "\tsaw global use of enum \"opcode\"\n" if $debug > 1; + } + } + &scan_var($_); + } } close CPP; while (<DATA>) { @@ -208,6 +221,22 @@ foreach (split /\s+/, $extnames) { print "Adding boot_$pkgname to \%fcns (for extension $_)\n" if $debug; } +# If we're using VAXC, fold in the names of the constants for enums +# we've seen as the type of global vars. +if ($isvaxc) { + foreach (keys %enums) { + if (/^OP/) { + $vars{$_}++ if $used_opcode_enum; + next; + } + if (/^X/) { + $vars{$_}++ if $used_expectation_enum; + next; + } + print STDERR "Unrecognized enum constant \"$_\" ignored\n"; + } +} + # Eventually, we'll check against existing copies here, so we can add new # symbols to an existing options file in an upwardly-compatible manner. diff --git a/vms/genconfig.pl b/vms/genconfig.pl index 9200814ef0..a4721ba4b0 100644 --- a/vms/genconfig.pl +++ b/vms/genconfig.pl @@ -41,19 +41,20 @@ cf_time='$time' osname='VMS' ld='Link' lddlflags='/Share' -libc='' ranlib='' ar='' eunicefix=':' +hint='none' hintfile='' intsize='4' alignbytes='8' shrplib='define' usemymalloc='n' +spitshell='write sys\$output ' EndOfIntro $cf_by = (getpwuid($<))[0]; -print OUT "cf_by='$cf_by'\nperladmin='$cf_by'\n"; +print OUT "cf_by='$cf_by'\n"; $hw_model = `Write Sys\$Output F\$GetSyi("HW_MODEL")`; chomp $hw_model; @@ -68,46 +69,80 @@ else { $archsufx = 'VAX'; } $osvers = `Write Sys\$Output F\$GetSyi("VERSION")`; -$osvers =~ s/^V(\S+)\s*\n?$/$1/; +$osvers =~ s/^V?(\S+)\s*\n?$/$1/; print OUT "osvers='$osvers'\n"; foreach (@ARGV) { ($key,$val) = split('=',$_,2); if ($key eq 'cc') { # Figure out which C compiler we're using - if (`$val/NoObject/NoList _nla0:/Version` =~ /GNU/) { - print OUT "vms_cc_type='gcc'\n"; - print OUT "d_attribut='define'\n"; + my($cc,$ccflags) = split('/',$val,2); + my($d_attr); + $ccflags = "/$ccflags"; + if ($ccflags =~s!/DECC!!ig) { + $cc .= '/DECC'; + $cctype = 'decc'; + $d_attr = 'undef'; + } + elsif ($ccflags =~s!/VAXC!!ig) { + $cc .= '/VAXC'; + $cctype = 'vaxc'; + $d_attr = 'undef'; + } + elsif (`$val/NoObject/NoList _nla0:/Version` =~ /GNU/) { + $cctype = 'gcc'; + $d_attr = 'define'; } elsif ($archsufx eq 'VAX' && `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/) { - print OUT "vms_cc_type='vaxc'\n"; - print OUT "d_attribut='undef'\n"; + $cctype = 'vaxc'; + $d_attr = 'undef'; } else { - print OUT "vms_cc_type='decc'\n"; - print OUT "d_attribut='undef'\n"; - # DECC for VAX requires filename in /object qualifier, so we + $cctype = 'decc'; + $d_attr = 'undef'; + } + print OUT "vms_cc_type='$cctype'\n"; + print OUT "d_attribut='$d_attr'\n"; + print OUT "cc='$cc'\n"; + if ( ($cctype eq 'decc' and $archsufx eq 'VAX') || $cctype eq 'gcc') { + # gcc and DECC for VAX requires filename in /object qualifier, so we # have to remove it here. Alas, this means we lose the user's # object file suffix if it's not .obj. - $val =~ s#/obj(?:ect)?=[^/\s]+##i if $archsufx eq 'VAX';; + $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i; } + print OUT "ccflags='$ccflags'\n"; + $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and + $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i); + next; } print OUT "$key=\'$val\'\n"; - if ($val =~/VMS_DO_SOCKETS/i) { - $dosock = 1; - # Are there any other logicals which TCP/IP stacks use for the host name? - $myname = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || - $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || - $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; - if (!$myname) { - ($myname) = `hostname` =~ /^(\S+)/; - if ($myname =~ /IVVERB/) { - warn "Can't determine TCP/IP hostname; skipping \$Config{'myhostname'}"; - } - } - print OUT "myhostname='$myname'\n" if $myname; +} + +# Are there any other logicals which TCP/IP stacks use for the host name? +$myname = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || + $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || + $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; +if (!$myname) { + ($myname) = `hostname` =~ /^(\S+)/; + if ($myname =~ /IVVERB/) { + warn "Can't determine TCP/IP hostname" if $dosock; + $myname = ''; } } -if (!$dosock) { print OUT "myhostname='$ENV{'SYS$NODE'}'\n"; } +$myname = $ENV{'SYS$NODE'} unless $myname; +($myhostname,$mydomain) = split(/\./,$myname,2); +print OUT "myhostname='$myhostname'\n" if $myhostname; +if ($mydomain) { + print OUT "mydomain='.$mydomain'\n"; + print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n"; + print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n"; +} +else { + print OUT "perladmin='$cf_by'\n"; + print OUT "cf_email='$cf_by'\n"; +} +chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`); +$hwname = $archsufx if $hwname =~ /IVKEYW/; # *really* old VMS version +print OUT "myuname='VMS $myname $osvers $hwname'\n"; while (<IN>) { # roll through the comment header in Config.VMS last if /config-start/; @@ -122,12 +157,18 @@ while (<IN>) { s/^\s*//; $_ = $line . $_; } - next unless my ($blocked,$un,$token,$val) = m%(\/\*)?\s*\#\s*(un)?def\w*\s*([A-za-z0-9]\w+)\S*\s*(.*)%; + next unless my ($blocked,$un,$token,$val) = m%^(\/\*)?\s*\#\s*(un)?def\w*\s*([A-za-z0-9]\w+)\S*\s*(.*)%; next if /config-skip/; $state = ($blocked || $un) ? 'undef' : 'define'; $token =~ tr/A-Z/a-z/; $token =~ s/_exp$/exp/; # Config.pm has 'privlibexp' etc. where config.h # has 'privlib_exp' etc. + # Fixup differences between Configure vars and config.h manifests + # This isn't comprehensize; we fix 'em as we need 'em. + $token = 'castneg' if $token eq 'castnegfloat'; + $token = 'dlsymun' if $token eq 'dlsym_needs_underscore'; + $token = 'stdstdio' if $token eq 'use_stdio_ptr'; + $token = 'stdiobase' if $token eq 'use_stdio_base'; $val =~ s%/\*.*\*/\s*%%g; $val =~ s/\s*$//; # strip off trailing comment $val =~ s/^"//; $val =~ s/"$//; # remove end quotes $val =~ s/","/ /g; # make signal list look nice @@ -161,12 +202,25 @@ if (open(OPT,"${outdir}crtl.opt")) { while (<OPT>) { next unless m#/(sha|lib)#i; chomp; - push(@libs,$_); + if (/crtl/i || /gcclib/i) { push(@crtls,$_); } + else { push(@libs,$_); } } close OPT; print OUT "libs='",join(' ',@libs),"'\n"; + push(@crtls,'(DECCRTL)') if $cctype eq 'decc'; + print OUT "libc='",join(' ',@crtls),"'\n"; +} +else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; } + +if (open(PL,"${outdir}patchlevel.h")) { + while (<PL>) { + next unless /PATCHLEVEL\s+(\S+)/; + print OUT "PATCHLEVEL='$1'\n"; + last; + } + close PL; } -else { warn "Can't read ${outdir}crtl.opt - skipping \$Config{'libs'}"; } +else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; } # simple pager support for perldoc if (`most nl:` =~ /IVVERB/) { @@ -186,20 +240,16 @@ __END__ # The definitions in this block are constant across most systems, and # should only rarely need to be changed. -PATCHLEVEL=002 ccdlflags= cccdlflags= usedl=true dlobj=dl_vms.obj dlsrc=dl_vms.c -d_dlsymun=undef so=exe dlext=exe libpth=/sys$share /sys$library -d_stdstdio=undef usevfork=false castflags=0 -d_castneg=define # should be same as d_castnegfloat from config.vms signal_t=void timetype=long builddir=perl_root:[000000] @@ -209,6 +259,7 @@ privlib=perl_root:[lib] installbin=perl_root:[000000] installman1dir=perl_root:[man.man1] installman3dir=perl_root:[man.man3] -man1ext=.rno -man3ext=.rno +man1ext=rno +man3ext=rno binexp=perl_root:[000000] # should be same as installbin +useposix=false diff --git a/vms/make_command.com b/vms/make_command.com new file mode 100644 index 0000000000..c3a9da8b80 --- /dev/null +++ b/vms/make_command.com @@ -0,0 +1,21 @@ +$! MAKE_COMMAND.COM +$! Record MM[SK]/Make parameters in configuration report +$! +$! Author: Peter Prymmer <pvhp@lns62.lns.cornell.edu> +$! Version: 1.0 18-Jan-1996 +$! +$! DCL usage (choose one): +$! @MAKE_COMMAND !or +$! @MAKE_COMMAND/OUTPUT=MYCONFIG.OUT +$!------------------------------------------------ +$ $mms = "'"+p1 +$ $makeline = p2+" "+p3+" "+p4+" "+p5+" "+p6+" "+p7+" "+p8 +$quotable: +$ if f$locate("""",$makeline).lt.f$length($makeline) +$ then +$ $makeline = $makeline - """" +$ goto quotable +$ endif +$ $makeline = f$edit($makeline,"COMPRESS,TRIM") +$ write sys$output " make_cmd=''$mms'"+" ''$makeline''" +$!------------------------------------------------ diff --git a/vms/mms2make.pl b/vms/mms2make.pl index 6fdc924081..6b35e75ffb 100644 --- a/vms/mms2make.pl +++ b/vms/mms2make.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl # # mms2make.pl - convert Descrip.MMS file to Makefile -# Version 2.0 29-Sep-1994 +# Version 2.2 29-Jan-1996 # David Denholm <denholm@conmat.phys.soton.ac.uk> # # 1.0 06-Aug-1994 Charles Bailey bailey@genetics.upenn.edu @@ -18,13 +18,15 @@ # an empty @conditions [assume nesting in descrip.mms is correct] # 2.1 26-Feb-1995 Charles Bailey bailey@genetics.upenn.edu # - handle MMS macros generated by MakeMaker +# 2.2 29-Jan-1996 Charles Bailey bailey@genetics.upenn.edu +# - Fix output file name to work under Unix if ($#ARGV > -1 && $ARGV[0] =~ /^[\-\/]trim/i) { $do_trim = 1; shift @ARGV; } $infile = $#ARGV > -1 ? shift(@ARGV) : "Descrip.MMS"; -$outfile = $#ARGV > -1 ? shift(@ARGV) : "Makefile."; +$outfile = $#ARGV > -1 ? shift(@ARGV) : "Makefile"; # set any other args in %macros - set VAXC by default foreach (@ARGV) { $macros{"\U$_"}=1 } diff --git a/vms/myconfig.com b/vms/myconfig.com new file mode 100644 index 0000000000..b9f1bcd476 --- /dev/null +++ b/vms/myconfig.com @@ -0,0 +1,319 @@ +$! #!/bin/sh ---> MYCONFIG.COM + +$! # This script is designed to provide a handy summary of the configuration +$! # information being used to build perl. This is especially useful if you +$! # are requesting help from comp.lang.perl on usenet or via mail. + +$! DCL-ified by Peter Prymmer <pvhp@lns62.lns.cornell.edu> 22-DEC-1995 +$! DCL usage (choose one): +$! @MYCONFIG !or +$! @MYCONFIG/OUTPUT=MYCONFIG.OUT !or +$! @MYCONFIG [node::][which$disk:][[dir.subdir]]CONFIG.SH !or +$! @MYCONFIG/OUTPUT=MYCONFIG.OUT [node::][w$disk:][[dir]]CONFIG.SH +$! version 2: +$! Incorporates Charles Bailey's ideas about bootstrapping system info - +$! myconfig.com is now callable as a "myconfig" target in your maker and +$! may even work if miniperl.exe and config.sh files fail to be made. +$! Thus if: +$! MMK/DESCRIP=[.VMS] !(or MMS or MAKE) +$! does not work then try: +$! MMK/DESCRIP=[.VMS]/OUTPUT=MYPERLBUILD.PROBLEM !(or MMS or MAKE) +$! Then discuss the MYPERLBUILD.PROBLEM file with a local expert. +$! If that still does not work then try: +$! MMK/DESCRIP=[.VMS]/OUT=MYNONFIG.OUT MYCONFIG !(or MMS or MAKE) +$! send output (MYNONFIG.OUT) to an outside expert and ask politely for help. + +$ ECHO = "WRITE SYS$OUTPUT " +$ RATHER_LONG_DEFAULT_DIRECTORY_NAME = F$ENVIRONMENT("DEFAULT") + +$ if (p1.nes."").and.(p2.eqs."") +$ then RATHER_LONG_FILENAME_TO_FIND = p1 !no typo-checking (experts only) +$ else RATHER_LONG_FILENAME_TO_FIND = "CONFIG.SH" +$ endif +$Research: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research +$ else +$ ECHO "Can't find the perl config.sh file produced by Configure" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$! exit 3 +$ goto cannot_find_config_sh +$ endif +$ endif + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$Loop: +$ read/end_of_file = Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ name = f$extract(0,f$locate("=",line),line) +$ start = f$locate("'",line)+1 +$ stop = f$locate("'",line) +$ value = f$extract(start,stop-start,line) +$ if (f$locate("#",name).eqs.f$length(name)).and. - + (name.nes."").and. - + (name.nes."'") - !bug in genconfig.pl (vms) for osvers='' ? + then $$'name' = "'" + value !$ not necessary but looks more sh-ish +$ goto Loop + +$Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ goto spit_it_out + +$cannot_find_config_sh: +$! these parameters are assumed to be passed from make/mm[s|k]: +$! p1=$(CC), p2=$(CFLAGS), p3=$(LINKFLAGS), +$! p4=$(LIBS1), p5=$(LIBS2), p6=$(SOCKLIB), +$! p7=$(EXT), p8=$(DBG) +$! so assign to appropriate $var: +$ $cc = "'"+p1+"'" ! p1=$(CC) from make +$ $ccflags = "'"+p2+"'" ! p2=$(CFLAGS) from make +$ $ldflags = "'"+p3+"'" ! p3=$(LINKFLAGS) from make +$ $libs = "'"+p4+" "+p5+" "+p6+"'" ! p4$(LIBS1),p5$(LIBS2),p6$(SOCKLIB)frm make +$ $staticexts = "'"+p7+"'" ! p7=$(EXT) from make + +$! hard-coded stuff (for now): +$ $cppflags = "'"+"'" !(vestigal) +$ $optimize = "'"+"'" !descrip.mms has /Optimize=2 in $(XTRACCFLAGS) + +$! following assigns done via `dcl` calls in genconfig.pl anyway: +$ $osname = "'"+f$edit(f$getsyi("NODE_SWTYPE"),"COLLAPSE") !genconfig.pl has "osname='VMS'" +$ $osvers = f$edit(f$getsyi("VERSION")-"V","COLLAPSE") +$ if f$getsyi("HW_MODEL").GT.1024 +$ then $$archname = "'VMS_AXP'" !string from descrip.mms vmsperl 12-21-95 +$ else $$archname = "'VMS_VAX'" !string from descrip.mms vmsperl 12-21-95 +$ endif +$ $myname = "" +$ if $myname.eqs."" then $$myname = f$trnlnm("ARPANET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("INTERNET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("MULTINET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("UCX$INET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("TCPWARE_DOMAINNAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("NEWS_ADDRESS") +$ if $myname.eqs."" then $$myname = f$trnlnm("SYS$NODE") +$! Is this same as genconfig.pl ? (spacing/order unknown): +$ $myuname=$osname+" "+$myname+" "+$osvers+" "+F$GetSyi("HW_NAME")+"'" +$ $osname = $osname+"'" +$ $osvers = "'"+$osvers+"'" + +$look_for_patchlevel_h: +$! +$ RATHER_LONG_FILENAME_TO_FIND = "PATCHLEVEL.H" +$Research_patchlevel_h: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_patchlevel_h +$ else +$ ECHO "Can't find the header file patchlevel.h used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ goto look_for_genconfig.pl +$ endif +$ endif + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_patchlevel_h: +$ read/end_of_file = patchlevel_h_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ if f$locate("PATCHLEVEL",line).ne.f$length(line) +$ then +$ line = f$edit(line,"TRIM,COMPRESS") +$ $PATCHLEVEL = f$element(2," ",line) +$ goto patchlevel_h_Done +$ endif +$ goto read_patchlevel_h + +$patchlevel_h_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if $PATCHLEVEL.eqs."" +$ then +$ echo "warning: PATCHLEVEL was not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ endif + +$look_for_genconfig_pl: +$! +$ if f$search("VMS.DIR").nes."" then set default [.vms] +$ RATHER_LONG_FILENAME_TO_FIND = "GENCONFIG.PL" +$ genconfig_pl_dir = "" +$Research_genconfig_pl: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_genconfig_pl +$ else +$ ECHO "Can't find the perl genconfig.pl used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ goto look_for_config_vms +$ endif +$ else !genconfig.pl has been found +$ genconfig_pl_dir = f$parse(f$environment("DEFAULT"),,,"DIRECTORY",) +$ endif + +$ cnfg_keys = "package/hintfile/ld/dlext/d_stdstdio/" +$ cnfg_keys = cnfg_keys + "usevfork/usemymalloc/so/libpth/" +$ cnfg_keys = cnfg_keys + "dlsrc/cccdlflags/ccdlflags/lddlflags/" + +$ cnfg_vars = "$package/$hint/$ld/$dlext/$d_stdstdio/" +$ cnfg_vars = cnfg_vars + "$usevfork/$usemymalloc/$so/$libpth/" +$ cnfg_vars = cnfg_vars + "$dlsrc/$cccdlflags/$ccdlflags/$lddlflags/" + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_genconfig_pl: +$ read/end_of_file = Genconfig_pl_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ if f$locate("=",line).ne.f$length(line) !then may be an assigment +$ then +$ name = f$edit( f$extract(0,f$locate("=",line),line), "COLLAPSE") +$ num = 0 +$key_genconfig_pl: +$ key = f$element(num,"/",cnfg_keys) +$ if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys +$ then +$ if key.eqs.name !then is key +$ then +$ start = f$locate("=",line)+1 +$ stop = f$length(line) +$ value = f$extract(start,stop-start,line) +$ var = f$element(num,"/",cnfg_vars) +$ 'var' = value +$ cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches +$ cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches +$ endif +$ num = num + 1 +$ goto key_genconfig_pl +$ endif ! not end of cnfg_keys +$ endif ! then may be an assigment +$ goto read_genconfig_pl + +$Genconfig_pl_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if cnfg_vars.nes."" +$ then +$ echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ echo "''cnfg_vars'" +$ endif + +$ if (p8.nes."").and.($ld.nes."") then $ld = $ld + " DBG='"+p8+"'" + +$look_for_config_vms: +$ RATHER_LONG_FILENAME_TO_FIND = "''genconfig_pl_dir'CONFIG.VMS" + +$Research_config_vms: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_config_vms +$ else +$ ECHO "Can't find the perl config.vms used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ stop +$ exit 3 +$ endif +$ endif + +$ cnfg_keys = "MEM_ALIGNBYTES/CASTNEGFLOAT/CASTFLAGS/RANDBITS/STDCHAR/" +$ cnfg_keys = cnfg_keys+"CASTI32/INTSIZE/VOIDFLAGS/DLSYM_NEEDS_UNDERSCORE" + +$ cnfg_vars = "$alignbytes/$d_castneg/$castflags/$randbits/$stdchar/" +$ cnfg_vars = cnfg_vars+"$d_casti32/$intsize/$voidflags/$d_dlsymun/" + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_config_vms: +$ read/end_of_file = config_vms_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$! look for "#define" or "#undef" +$ if (f$length(line).ne.0).and.- + ((f$locate("#define",line).eq.0).or.(f$locate("#undef",line).eq.0)) +$ then +$ line = f$edit(line,"COMPRESS, TRIM") +$ name = f$element(1," ",line) !macro +$ num = 0 +$key_config_vms: +$ key = f$element(num,"/",cnfg_keys) +$ if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys +$ then +$ if key.eqs.name !then is key +$ then +$ var = f$element(num,"/",cnfg_vars) +$ cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches +$ cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches +$ if (f$locate("#undef",line).eq.0) +$ then +$ 'var' = "'undef'" +$ else !is a #define +$strip_comment: +$ start = f$locate("/*",line) +$ if start.ne.f$length(line) !comment started +$ then +$ if f$locate("*/",line).ne.f$length(line) !comment stopped +$ then stop = f$locate("*/",line)+2 +$ else stop = f$locate("*/",line) +$ endif +$ comment = f$extract(start,stop-start,line) +$ line = line - comment +$ goto strip_comment +$ endif +$ line = f$edit(line,"TRIM") +$ start = f$locate(key,line)+f$length(key) +$ stop = f$length(line) +$ value = f$edit(f$extract(start,stop-start,line),"TRIM") +$ if (value.nes."") +$ then +$ 'var' = "'"+value+"'" +$ else +$ 'var' = "'define'" +$ endif +$ endif !#define +$ endif ! is key of interest +$ num = num + 1 +$ goto key_config_vms +$ endif ! not end of cnfg_keys +$ endif ! then may be #define or #undef of interest +$ goto read_config_vms + +$config_vms_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if cnfg_vars.nes."" +$ then +$ echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ echo "''cnfg_vars'" +$ endif + +$spit_it_out: +$! $spitshell = ECHO !<<!GROK!THIS! +$ ECHO " " +$ ECHO "Summary of my ''$package' (patchlevel ''$PATCHLEVEL') configuration:" +$ ECHO " Platform:" +$ ECHO " osname=''$osname', osver=''$osvers', archname=''$archname'" +$ ECHO " uname=''$myuname'" !->d_has_uname? +$ ECHO " hint=''$hint'" !->hintfile? +$ ECHO " static exts=''$staticexts'" ! added for VMS +$ ECHO " Compiler:" +$ ECHO " cc=''$cc', optimize=''$optimize', ld=''$ld'" +$ ECHO " cppflags=''$cppflags'" +$ ECHO " ccflags =''$ccflags'" !->vms_cc_type? +$ ECHO " ldflags =''$ldflags'" +$ ECHO " stdchar=''$stdchar', d_stdstdio=''$d_stdstdio', usevfork=''$usevfork'" +$ ECHO " voidflags=''$voidflags', castflags=''$castflags', d_casti32=''$d_casti32', d_castneg=''$d_castneg'" +$ ECHO " intsize=''$intsize', alignbytes=''$alignbytes', usemymalloc=''$usemymalloc', randbits=''$randbits'" +$ ECHO " Libraries:" +$ ECHO " so=''$so'" +$ ECHO " libpth=''$libpth'" +$ ECHO " libs=''$libs'" +$ ECHO " libc=''$libc'" +$ ECHO " Dynamic Linking:" +$ ECHO " dlsrc=''$dlsrc', dlext=''$dlext', d_dlsymun=''$d_dlsymun'" +$ ECHO " cccdlflags=''$cccdlflags', ccdlflags=''$ccdlflags', lddlflags=''$lddlflags'" +$ ECHO " " +$ !GROK!THIS! +$ SET DEFAULT 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ EXIT diff --git a/vms/perlvms.pod b/vms/perlvms.pod index 87fcb5f7e0..47ee3d3afd 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -104,17 +104,23 @@ In general, the distributed kit for a Perl extension includes a file named Makefile.PL, which is a Perl program which is used to create a F<Descrip.MMS> file which can be used to build and install the files required by the extension. The kit should be -unpacked into a directory tree E<not> under the main Perl source +unpacked into a directory tree B<not> under the main Perl source directory, and the procedure for building the extension is simply -=over 4 - $ perl Makefile.PL ! Create Descrip.MMS $ mmk ! Build necessary files $ mmk test ! Run test code, if supplied $ mmk install ! Install into public Perl tree -=back +I<N.B.> The procedure by which extensions are built and +tested creates several levels (at least 4) under the +directory in which the extension's source files live. +For this reason, you shouldn't nest the source directory +too deeply in your directory structure, lest you eccedd RMS' +maximum of 8 levels of subdirectory in a filespec. (You +can use rooted logical names to get another 8 levels of +nesting, if you can't place the files near the top of +the physical directory structure.) VMS support for this process in the current release of Perl is sufficient to handle most extensions. However, it does @@ -241,10 +247,24 @@ specifications may use either VMS or Unix syntax. Reading the elements of the %ENV array returns the translation of the logical name specified by the key, according to the normal search order of access modes and -logical name tables. In addition, the keys C<home>, -C<path>,C<term>, and C<user> return the CRTL "environment -variables" of the same names. The key C<default> returns the -current default device and directory specification. +logical name tables. If you append a semicolon to the +logical name, followed by an integer, that integer is +used as the translation index for the logical name, +so that you can look up successive values for search +list logical names. For instance, if you say + + $ Define STORY once,upon,a,time,there,was + $ perl -e "for ($i = 0; $i <= 6; $i++) " - + _$ -e "{ print $ENV{'foo'.$i},' '}" + +Perl will print C<ONCE UPON A TIME THERE WAS>. + +The %ENV keys C<home>, C<path>,C<term>, and C<user> +return the CRTL "environment variables" of the same +names, if these logical names are not defined. The +key C<default> returns the current default device +and directory specification, regardless of whether +there is a logical name DEFAULT defined.. Setting an element of %ENV defines a supervisor-mode logical name in the process logical name table. C<Undef>ing or @@ -254,7 +274,8 @@ name table. If you use C<undef>, the %ENV element remains empty. If you use C<delete>, another attempt is made at logical name translation after the deletion, so an inner-mode logical name or a name in another logical name table will -replace the logical name just deleted. +replace the logical name just deleted. It is not possible +at present to define a search list logical name via %ENV. In all operations on %ENV, the key string is treated as if it were entirely uppercase, regardless of the case actually @@ -268,15 +289,15 @@ Perl functions were implemented in the VMS port of Perl file tests*, abs, alarm, atan, binmode*, bless, caller, chdir, chmod, chown, chomp, chop, chr, - close, closedir, cos, defined, delete, die, do, - each, endpwent, eof, eval, exec*, exists, exit, - exp, fileno, fork*, getc, getpwent*, getpwnam*, - getpwuid*, glob, gmtime*, goto, grep, hex, import, - index, int, join, keys, kill*, last, lc, lcfirst, - length, local, localtime, log, m//, map, mkdir, my, - next, no, oct, open, opendir, ord, pack, pipe, pop, - pos, print, printf, push, q//, qq//, qw//, qx//, - quotemeta, rand, read, readdir, redo, ref, rename, + close, closedir, cos, crypt*, defined, delete, + die, do, each, endpwent, eof, eval, exec*, exists, + exit, exp, fileno, fork*, getc, getlogin, getpwent*, + getpwnam*, getpwuid*, glob, gmtime*, goto, grep, hex, + import, index, int, join, keys, kill*, last, lc, + lcfirst, length, local, localtime, log, m//, map, + mkdir, my, next, no, oct, open, opendir, ord, pack, + pipe, pop, pos, print, printf, push, q//, qq//, qw//, + qx//, quotemeta, rand, read, readdir, redo, ref, rename, require, reset, return, reverse, rewinddir, rindex, rmdir, s///, scalar, seek, seekdir, select(internal), select (system call)*, setpwent, shift, sin, sleep, @@ -290,14 +311,12 @@ The following functions were not implemented in the VMS port, and calling them produces a fatal error (usually) or undefined behavior (rarely, we hope): - chroot, crypt, dbmclose, dbmopen, dump, fcntl, - flock, getlogin, getpgrp, getppid, getpriority, - getgrent, kill, getgrgid, getgrnam, setgrent, - endgrent, ioctl, link, lstst, msgctl, msgget, - msgsend, msgrcv, readlink, select(system call), - semctl, semget, semop, setpgrp, setpriority, shmctl, - shmget, shmread, shmwrite, socketpair, symlink, - syscall, truncate + chroot, dbmclose, dbmopen, dump, fcntl, flock, + getpgrp, getppid, getpriority, getgrent, getgrgid, + getgrnam, setgrent, endgrent, ioctl, link, lstat, + msgctl, msgget, msgsend, msgrcv, readlink, semctl, + semget, semop, setpgrp, setpriority, shmctl, shmget, + shmread, shmwrite, socketpair, symlink, syscall, truncate The following functions may or may not be implemented, depending on what type of socket support you've built into @@ -309,8 +328,8 @@ your copy of Perl: getnetent, getprotoent, getservent, sethostent, setnetent, setprotoent, setservent, endhostent, endnetent, endprotoent, endservent, getsockname, - getsockopt, listen, recv, send, setsockopt, - shutdown, socket + getsockopt, listen, recv, select(system call)*, + send, setsockopt, shutdown, socket =item File tests @@ -336,6 +355,33 @@ The C<binmode> operator has no effect under VMS. It will return TRUE whenever called, but will not affect I/O operations on the filehandle given as its argument. +=item crypt PLAINTEXT, USER + +The C<crypt> operator uses the C<sys$hash_password> system +service to generate the hashed representation of PLAINTEXT. +If USER is a valid username, the algorithm and salt values +are taken from that user's UAF record. If it is not, then +the preferred algorithm and a salt of 0 are used. The +quadword encrypted value is returned as an 8-character string. + +The value returned by C<crypt> may be compared against +the encrypted password from the UAF returned by the C<getpw*> +functions, in order to authenticate users. If you're +going to do this, remember that the encrypted password in +the UAF was generated using uppercase username and +password strings; you'll have to upcase the arguments to +C<crypt> to insure that you'll get the proper value: + + sub validate_passwd { + my($user,$passwd) = @_; + my($pwdhash); + if ( !($pwdhash = (getpwnam($user))[1]) || + $pwdhash ne crypt("\U$passwd","\U$name") ) { + intruder_alert($name); + } + return 1; + } + =item exec LIST The C<exec> operator behaves in one of two different ways. @@ -379,7 +425,9 @@ subprocess is not recommended under VMS; wherever possible, use the C<system> operator or piped filehandles instead. =item getpwent + =item getpwnam + =item getpwuid These operators obtain the information described in L<perlfunc>, diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 4cc29e3ec8..86449982b7 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1,3 +1,4 @@ +/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */ #ifndef lint static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; #endif @@ -19,17 +20,17 @@ dEXT short yylhs[] = { -1, 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, 13, 12, 12, - 12, 26, 26, 26, 26, 26, 26, 26, 26, 27, - 27, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 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, 22, 22, 23, 23, 23, 20, 15, - 16, 17, 18, 19, 24, 24, 24, 24, + 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, }; dEXT short yylen[] = { 2, 0, 2, 4, 0, 0, 2, 2, 2, 1, 2, @@ -37,983 +38,1068 @@ dEXT short yylen[] = { 2, 6, 6, 4, 4, 0, 2, 7, 7, 5, 5, 8, 7, 10, 3, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 4, 3, 5, 5, 0, 1, - 0, 3, 2, 4, 3, 3, 2, 1, 2, 3, - 1, 3, 5, 6, 3, 5, 2, 4, 4, 1, - 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 5, 3, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 3, 2, 3, 2, 4, - 3, 4, 1, 1, 4, 5, 4, 1, 1, 1, + 0, 3, 2, 5, 3, 3, 1, 2, 3, 1, + 3, 5, 6, 3, 5, 2, 4, 4, 1, 1, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 5, 3, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 3, 2, 3, 2, 4, 3, + 4, 1, 5, 1, 4, 5, 4, 1, 1, 1, 5, 6, 5, 6, 5, 4, 5, 1, 1, 3, 4, 3, 2, 2, 4, 5, 4, 5, 1, 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, + 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, }; dEXT short yydefred[] = { 1, - 0, 5, 0, 40, 51, 51, 0, 0, 6, 41, + 0, 5, 0, 40, 51, 51, 0, 51, 6, 41, 7, 9, 0, 42, 43, 44, 0, 0, 0, 53, - 0, 12, 4, 142, 0, 0, 118, 0, 51, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 137, 0, - 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, - 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, + 0, 12, 4, 143, 0, 0, 118, 0, 138, 0, + 51, 51, 0, 0, 0, 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, 104, 0, 0, 143, 0, 46, 0, - 52, 0, 0, 5, 155, 158, 157, 156, 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, 153, 0, 124, 0, - 0, 0, 0, 0, 0, 57, 0, 0, 67, 0, - 0, 132, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 99, 0, 149, 150, 151, 152, 154, + 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, 91, 92, 0, 0, 0, 0, - 0, 0, 0, 11, 45, 50, 0, 54, 0, 65, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 36, 0, 136, 138, 0, 0, - 0, 0, 0, 0, 101, 0, 122, 0, 0, 0, - 0, 98, 26, 0, 0, 0, 0, 0, 0, 55, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 70, 0, 71, 0, - 0, 0, 0, 0, 0, 120, 0, 48, 47, 3, - 0, 140, 0, 102, 0, 29, 0, 30, 0, 0, - 0, 23, 0, 24, 0, 0, 0, 139, 148, 68, - 0, 125, 0, 127, 0, 100, 69, 0, 0, 0, - 0, 0, 0, 0, 107, 0, 105, 0, 116, 121, - 66, 0, 0, 0, 0, 19, 0, 0, 0, 0, - 0, 63, 126, 128, 115, 0, 113, 0, 0, 106, - 0, 111, 117, 141, 27, 28, 21, 0, 22, 0, - 32, 0, 114, 112, 64, 0, 0, 31, 0, 0, - 20, 33, + 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, 54, 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, 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, }; dEXT short yydgoto[] = { 1, - 9, 10, 84, 17, 87, 3, 11, 12, 66, 193, - 262, 67, 200, 69, 70, 71, 72, 73, 74, 75, - 195, 83, 201, 89, 185, 77, 240, 177, 13, 142, + 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, }; dEXT short yysindex[] = { 0, - 0, 0, -105, 0, 0, 0, -47, -232, 0, 0, - 0, 0, 570, 0, 0, 0, -112, -217, 10, 0, - 2121, 0, 0, 0, -35, -35, 0, 46, 0, -3, - 1, 8, 14, 55, 2121, 56, 60, 63, 0, -35, - 1806, 2121, 941, -178, 1846, 997, 0, 1911, 2121, 2121, - 2121, 2121, 2121, 2121, 1272, 0, 2121, 2121, 1312, -35, - -35, -35, -35, -35, -183, 0, 71, 227, 3368, -55, - -49, 0, 0, 0, 89, 48, 0, 20, 0, -118, - 0, 71, 85, 0, 0, 0, 0, 0, 2121, 106, - 2121, -118, 1846, 20, 1846, 20, 1846, 20, 1846, 20, - 1371, 115, 3368, 116, 1411, 901, 0, 125, 0, 864, - -1, 864, 41, -53, 2121, 0, 0, -55, 0, 2121, - 20, 0, 864, 864, 510, 510, 510, -89, -89, 80, - -38, 510, 510, 0, -84, 0, 0, 0, 0, 0, - 20, 0, 2121, 1846, 1846, 1846, 1846, 1846, 1846, 1846, - 2121, 2121, 2121, 2121, 2121, 2121, 2121, 2121, 2121, 2121, - 2121, 2121, 2121, 2121, 0, 0, -21, 1846, 1846, 1846, - 1846, 1846, 1451, 0, 0, 0, -29, 0, -115, 0, - 1846, 614, 20, -187, 131, -183, -34, -183, -27, -140, - 4, -140, 114, 208, 0, 1846, 0, 0, 6, -6, - 135, 1846, 1726, 1766, 0, 57, 0, 71, 2121, 1846, - 94, 0, 0, 3368, -187, -187, -187, -187, -113, 0, - 67, 2023, 864, 1613, 445, 685, 3368, 3106, 363, 771, - 1082, 1235, 1465, 510, 510, 1846, 0, 1846, 0, 147, - -77, 88, -72, 95, -67, 0, 18, 0, 0, 0, - 148, 0, 2121, 0, 20, 0, 20, 0, 20, 20, - 150, 0, 20, 0, 1846, 20, 26, 0, 0, 0, - 32, 0, 69, 0, 82, 0, 0, -62, 1846, 66, - 2121, 97, -41, 1846, 0, 68, 0, 73, 0, 0, - 0, 2844, -183, -183, -140, 0, 1846, -140, 129, -183, - 20, 0, 0, 0, 0, 99, 0, 3756, 78, 0, - 153, 0, 0, 0, 0, 0, 0, 84, 0, 1371, - 0, -183, 0, 0, 0, 20, 155, 0, -140, 20, - 0, 0, + 0, 0, -82, 0, 0, 0, -52, 0, 0, 0, + 0, 0, 853, 0, 0, 0, -80, -256, -19, 0, + -245, 0, 0, 0, 19, 19, 0, 20, 0, 2177, + 0, 0, -2, 1, 28, 41, 133, 2177, 27, 33, + 52, 19, 1028, 2177, 1303, -210, 19, 2177, 965, 1359, + 2177, 2177, 2177, 2177, 2177, 1415, 0, 2177, 2177, 1478, + 19, 19, 19, 19, -225, 0, 71, 209, 1535, -49, + -30, 0, 0, 8, 101, 42, 0, 30, 0, -112, + 0, 2177, 0, 0, 0, 0, 0, 2177, 127, 2177, + 1535, 30, -112, 2177, 30, 2177, 30, 2177, 30, 2177, + 30, 1712, 128, 1535, 139, 1768, 965, 0, 141, 0, + 1485, -14, 1485, 65, -42, 2177, 0, 71, 0, 71, + -49, 0, 2177, 0, 1485, 334, 334, 334, -47, -47, + 92, -26, 334, 334, 0, 63, 0, 0, 0, 0, + 30, 0, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 0, 0, -27, 2177, 2177, 2177, + 2177, 2177, 2177, 1824, 0, 0, 0, -48, 137, -92, + 0, 2177, 221, 2177, 30, -191, 151, -225, -22, -225, + -12, -147, 7, -147, 138, 5, 0, 2177, 0, 0, + 9, -39, 160, 2177, 1887, 2121, 0, 77, 0, 71, + 2177, 113, 0, 0, 1535, -191, -191, -191, -191, -86, + 0, -20, 395, 1485, 1566, 461, -88, 1535, 4122, 1064, + 679, 364, 1120, 728, 334, 334, 2177, 0, 2177, 0, + 174, 89, 51, 98, 55, 118, 57, 0, 11, 0, + 0, 0, 0, 175, 0, 2177, 0, 0, 30, 0, + 30, 0, 30, 30, 178, 0, 30, 0, 2177, 30, + 15, 0, 0, 0, 22, 0, 25, 0, 29, 0, + 152, 2177, 94, 2177, 59, 177, 2177, 0, 96, 0, + 97, 0, 102, 0, 0, 1190, -225, -225, -147, 0, + 2177, -147, 176, -225, 30, 0, 0, 0, 0, 205, + 0, 3039, 111, 0, 206, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 1712, 0, -225, 0, 0, 0, + 30, 208, 0, -147, 30, 0, 0, }; dEXT short yyrindex[] = { 0, - 0, 0, 141, 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, - 145, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 2299, 2164, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2658, 0, 2703, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 13, 0, 58, 3, 170, 2748, - 2796, 0, 0, 0, 2209, 0, 0, 0, 0, -26, - 0, 2380, 0, 0, 0, 0, 0, 0, 2426, 0, - 0, 83, 166, 0, 0, 0, 0, 0, 0, 0, - 154, 0, 1341, 0, 0, 171, 0, 2254, 0, 3507, - 2748, 3552, 0, 0, 2426, 0, 431, 502, 0, 0, - 0, 0, 3585, 3630, 2980, 3028, 3073, 2890, 2935, 2471, - 0, 3152, 3197, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 2516, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2253, 505, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 2847, 2935, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 107, 0, -35, 10, 53, 3109, + 3156, 0, 0, 2298, 1976, 0, 0, 0, 0, -23, + 0, 230, 0, 0, 0, 0, 0, 2385, 0, 0, + 1004, 0, 168, 253, 0, 0, 0, 0, 0, 0, + 0, 254, 0, 2242, 0, 0, 274, 0, 2032, 0, + 3844, 3109, 3902, 0, 0, 2385, 0, 2440, 452, 2554, + 572, 0, 0, 0, 3981, 3274, 3312, 3421, 3200, 3237, + 2661, 0, 3560, 3596, 0, 0, 0, 0, 0, 0, + 0, 0, 2714, 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, 845, 0, - 171, 0, 0, 19, 0, 13, 0, 13, 0, 76, - 0, 76, 0, 158, 0, 0, 0, 0, 0, 177, - 0, 0, 0, 0, 0, 0, 0, 2564, 2426, 0, - 2612, 0, 0, 2080, 23, 30, 39, 52, 827, 0, - 0, -36, 3678, 1208, 3335, 3414, 2574, 0, 1049, 3739, - 3646, 3694, 3462, 3245, 3290, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 909, + 0, 274, 0, 2385, 0, 39, 0, 107, 0, 107, + 0, 170, 0, 170, 0, 262, 0, 0, 0, 0, + 0, 288, 0, 0, 0, 0, 0, 0, 0, 2805, + 0, 2757, 0, 0, 2650, 49, 58, 61, 64, 365, + 0, 0, -31, 4018, 4028, 3719, 630, 2995, 0, 1623, + 4106, 4096, 4064, 3756, 3640, 3683, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 160, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 171, 0, 0, 0, 0, 0, 0, - 0, 0, 13, 13, 76, 0, 0, 76, 0, 13, - 0, 0, 0, 0, 0, 0, 0, 776, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 182, - 0, 13, 0, 0, 0, 0, 0, 0, 76, 0, - 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 277, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 274, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 107, 107, 170, 0, + 0, 170, 0, 107, 0, 0, 0, 0, 0, 0, + 0, 13, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 300, 0, 107, 0, 0, 0, + 0, 0, 0, 170, 0, 0, 0, }; dEXT short yygindex[] = { 0, - 0, 0, 0, 37, -13, 157, 0, 0, 0, -82, - -168, 470, 360, 3971, 1933, 0, 0, 0, 0, 0, - 230, -14, -152, 1366, -20, 0, 0, 156, 0, -125, + 0, 0, 0, 506, -13, 255, 0, 0, 0, 18, + -180, 839, -11, 4398, 2162, 0, 0, 0, 0, 0, + 342, -57, -174, 1032, 90, 0, 0, 267, 0, -172, 0, 0, 0, 0, }; -#define YYTABLESIZE 4252 +#define YYTABLESIZE 4682 dEXT short yytable[] = { 65, - 61, 168, 211, 79, 81, 206, 257, 81, 212, 250, - 23, 20, 25, 259, 61, 285, 94, 96, 98, 100, - 287, 81, 81, 264, 21, 289, 81, 109, 251, 248, - 305, 119, 49, 150, 122, 170, 93, 269, 204, 80, - 95, 172, 18, 13, 263, 25, 268, 97, 25, 25, - 25, 310, 25, 99, 25, 25, 81, 25, 290, 38, - 256, 13, 258, 16, 175, 92, 301, 169, 81, 238, - 17, 25, 302, 171, 180, 18, 25, 38, 115, 14, - 186, 16, 188, 121, 190, 91, 192, 23, 17, 170, - 61, 141, 15, 23, 101, 104, 49, 14, 58, 105, - 207, 236, 106, 25, 148, 149, 174, 209, 18, 303, - 15, 18, 18, 18, 143, 18, 58, 18, 18, 23, - 18, 169, 304, 23, 326, 280, 317, 213, 173, 319, - 23, 311, 260, 261, 18, 25, 23, 25, 25, 18, - 2, 176, 23, 178, 78, 181, 286, 4, 5, 6, - 58, 7, 8, 288, 196, 309, 197, 4, 5, 6, - 331, 7, 8, 249, 203, 205, 18, 315, 316, 254, - 210, 255, 265, 39, 321, 270, 39, 39, 39, 149, - 39, 276, 39, 39, 279, 39, 284, 320, 291, 297, - 307, 323, 312, 325, 277, 330, 328, 313, 18, 39, - 18, 18, 324, 144, 39, 49, 37, 148, 149, 19, - 61, 146, 35, 61, 148, 149, 13, 147, 37, 148, - 149, 85, 35, 167, 148, 149, 86, 61, 61, 148, - 149, 39, 81, 81, 81, 81, 237, 327, 148, 149, - 179, 293, 76, 294, 299, 295, 296, 183, 266, 298, - 148, 149, 300, 148, 149, 81, 81, 148, 149, 0, - 81, 0, 61, 39, 148, 149, 39, 0, 25, 25, - 25, 25, 25, 25, 0, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 148, 149, 322, 25, 25, - 0, 25, 25, 25, 25, 148, 149, 148, 149, 25, - 25, 25, 25, 25, 0, 0, 25, 25, 25, 148, - 149, 0, 329, 0, 25, 25, 332, 148, 149, 25, - 0, 25, 25, 148, 149, 0, 58, 58, 58, 58, - 0, 18, 18, 18, 18, 18, 18, 0, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 0, 58, - 58, 18, 18, 0, 18, 18, 18, 18, 148, 149, - 148, 149, 18, 18, 18, 18, 18, 0, 0, 18, - 18, 18, 68, 148, 149, 148, 149, 18, 18, 148, - 149, 0, 18, 0, 18, 18, 148, 149, 148, 149, - 148, 149, 0, 0, 0, 0, 39, 39, 39, 39, - 39, 39, 114, 0, 116, 0, 39, 0, 0, 39, - 39, 39, 39, 0, 131, 0, 39, 39, 135, 39, - 39, 39, 39, 0, 0, 0, 0, 39, 39, 39, - 39, 39, 0, 0, 39, 39, 39, 0, 61, 61, - 61, 61, 39, 39, 0, 0, 0, 39, 0, 39, - 39, 0, 184, 168, 187, 0, 189, 0, 191, 0, - 194, 61, 61, 155, 199, 0, 155, 155, 155, 0, - 155, 142, 155, 155, 142, 155, 144, 145, 146, 147, - 0, 0, 0, 0, 0, 150, 0, 0, 142, 142, - 82, 0, 0, 142, 155, 144, 145, 146, 147, 148, - 149, 0, 0, 215, 216, 217, 218, 219, 220, 221, - 0, 0, 0, 0, 0, 82, 0, 0, 148, 149, - 0, 142, 0, 142, 0, 0, 0, 241, 242, 243, - 244, 245, 247, 0, 156, 168, 0, 156, 156, 156, - 0, 156, 103, 156, 156, 103, 156, 0, 0, 0, - 0, 0, 0, 142, 0, 267, 155, 0, 82, 103, - 103, 271, 273, 275, 103, 156, 0, 150, 0, 278, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 82, 0, 0, 0, 0, 208, - 0, 0, 0, 0, 103, 282, 0, 283, 0, 0, - 168, 0, 50, 0, 0, 61, 63, 60, 0, 55, - 0, 64, 58, 0, 57, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 184, 0, 0, 156, 56, 0, - 0, 0, 150, 62, 0, 0, 0, 0, 306, 0, - 0, 0, 0, 0, 0, 152, 153, 154, 155, 0, - 0, 0, 0, 0, 252, 0, 318, 253, 0, 0, - 59, 159, 160, 161, 0, 0, 162, 163, 0, 0, - 164, 0, 0, 165, 166, 167, 157, 0, 82, 68, - 0, 0, 0, 0, 0, 0, 0, 155, 155, 155, - 155, 155, 23, 0, 0, 51, 155, 0, 0, 142, - 142, 142, 142, 0, 168, 0, 0, 155, 142, 155, - 155, 155, 155, 142, 142, 142, 142, 155, 155, 155, - 155, 155, 142, 142, 155, 155, 155, 142, 142, 142, - 142, 142, 155, 155, 142, 142, 150, 155, 142, 155, - 155, 142, 142, 142, 0, 0, 0, 0, 0, 163, + 80, 68, 168, 79, 273, 57, 20, 254, 61, 80, + 250, 82, 80, 268, 212, 260, 208, 262, 261, 95, + 97, 99, 101, 57, 179, 206, 80, 80, 263, 110, + 181, 80, 253, 115, 150, 49, 124, 94, 283, 81, + 96, 170, 23, 168, 132, 270, 116, 267, 136, 272, + 13, 294, 141, 83, 61, 305, 83, 57, 209, 90, + 172, 80, 306, 239, 176, 307, 105, 98, 13, 308, + 83, 83, 106, 169, 23, 150, 170, 331, 184, 38, + 100, 188, 186, 190, 189, 192, 191, 194, 193, 16, + 196, 107, 171, 60, 201, 237, 60, 38, 17, 49, + 175, 14, 148, 149, 15, 83, 25, 16, 169, 289, + 60, 60, 315, 291, 143, 293, 17, 313, 322, 14, + 23, 324, 15, 23, 320, 321, 257, 214, 264, 265, + 173, 326, 216, 217, 218, 219, 220, 221, 222, 25, + 174, 23, 25, 25, 25, 60, 25, 177, 25, 25, + 23, 25, 23, 336, 333, 213, 242, 243, 244, 245, + 246, 247, 249, 23, 251, 25, 182, 198, 61, 18, + 25, 258, 102, 4, 5, 6, 78, 7, 8, 199, + 205, 288, 211, 4, 5, 6, 271, 7, 8, 207, + 290, 259, 275, 277, 279, 252, 269, 25, 154, 281, + 274, 280, 18, 282, 19, 18, 18, 18, 149, 18, + 292, 18, 18, 287, 18, 295, 163, 301, 311, 164, + 316, 317, 165, 166, 167, 285, 318, 286, 18, 25, + 238, 25, 25, 18, 325, 329, 57, 57, 57, 57, + 80, 80, 80, 80, 309, 297, 330, 298, 335, 299, + 300, 148, 149, 302, 148, 149, 304, 186, 57, 57, + 18, 255, 80, 80, 256, 167, 80, 148, 149, 314, + 310, 148, 149, 148, 149, 84, 144, 145, 146, 147, + 85, 148, 149, 157, 83, 83, 83, 83, 145, 323, + 49, 327, 18, 37, 18, 18, 2, 328, 148, 149, + 148, 149, 148, 149, 148, 149, 83, 83, 148, 149, + 83, 168, 35, 68, 147, 148, 149, 334, 148, 149, + 13, 337, 148, 149, 60, 60, 60, 60, 148, 39, + 148, 149, 39, 39, 39, 37, 39, 180, 39, 39, + 35, 39, 332, 150, 148, 149, 60, 60, 148, 149, + 148, 149, 148, 149, 76, 39, 148, 149, 303, 185, + 39, 0, 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, 39, 25, 25, + 25, 148, 149, 0, 0, 25, 25, 25, 25, 25, + 0, 0, 25, 25, 0, 56, 0, 0, 56, 25, + 0, 148, 149, 25, 0, 25, 25, 0, 0, 39, + 0, 0, 39, 56, 168, 18, 18, 18, 18, 18, + 18, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 148, 149, 0, 18, 18, + 0, 18, 18, 18, 168, 0, 150, 56, 18, 18, + 18, 18, 18, 0, 0, 18, 18, 0, 0, 0, + 148, 149, 18, 0, 0, 0, 18, 0, 18, 18, + 144, 145, 146, 147, 156, 168, 150, 156, 156, 156, + 0, 156, 143, 156, 156, 143, 156, 0, 148, 149, + 0, 151, 148, 149, 0, 152, 153, 154, 155, 143, + 143, 18, 0, 21, 143, 156, 0, 150, 156, 158, + 159, 160, 161, 0, 162, 163, 0, 0, 164, 0, + 0, 165, 166, 167, 0, 0, 92, 93, 0, 0, + 0, 0, 143, 0, 143, 136, 0, 0, 136, 0, + 0, 168, 39, 39, 39, 39, 39, 39, 0, 39, + 39, 39, 136, 136, 0, 39, 0, 136, 39, 39, + 39, 39, 0, 0, 143, 39, 39, 156, 39, 39, + 39, 0, 0, 150, 0, 39, 39, 39, 39, 39, + 0, 0, 39, 39, 0, 136, 0, 136, 0, 39, + 0, 0, 0, 39, 157, 39, 39, 157, 157, 157, + 0, 157, 102, 157, 157, 102, 157, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 136, 0, 102, + 102, 0, 0, 0, 102, 157, 56, 56, 56, 56, + 0, 164, 0, 0, 165, 166, 167, 0, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 56, 0, + 0, 0, 0, 0, 102, 161, 0, 162, 163, 0, + 74, 164, 0, 74, 165, 166, 167, 0, 0, 152, + 153, 154, 155, 0, 0, 0, 0, 74, 74, 0, + 0, 0, 74, 158, 159, 160, 161, 157, 162, 163, 0, 0, 164, 0, 0, 165, 166, 167, 156, 156, - 156, 156, 156, 0, 0, 0, 0, 156, 0, 0, - 103, 103, 103, 103, 0, 168, 0, 0, 156, 103, - 156, 156, 156, 156, 103, 103, 103, 103, 156, 156, - 156, 156, 156, 103, 103, 156, 156, 156, 103, 103, - 103, 103, 103, 156, 156, 103, 103, 150, 156, 103, - 156, 156, 103, 103, 103, 0, 84, 164, 0, 84, - 165, 166, 167, 0, 0, 22, 24, 25, 26, 27, - 28, 0, 0, 84, 84, 29, 0, 0, 30, 31, - 32, 33, 0, 0, 0, 34, 35, 0, 36, 37, - 38, 39, 0, 0, 0, 0, 40, 41, 42, 43, - 44, 168, 0, 45, 46, 47, 0, 56, 84, 0, - 56, 48, 49, 0, 0, 0, 52, 39, 53, 54, - 39, 39, 39, 0, 39, 56, 39, 39, 0, 39, - 0, 151, 0, 150, 0, 0, 152, 153, 154, 155, - 0, 0, 0, 39, 0, 0, 0, 0, 39, 0, - 156, 158, 159, 160, 161, 0, 0, 162, 163, 56, + 156, 156, 156, 0, 156, 156, 156, 0, 0, 0, + 156, 0, 74, 143, 143, 143, 143, 0, 0, 0, + 0, 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, 163, 0, 0, 164, 168, + 0, 165, 166, 167, 0, 0, 136, 136, 136, 136, + 0, 0, 0, 0, 0, 136, 0, 0, 0, 136, + 136, 136, 136, 0, 0, 0, 0, 0, 136, 136, + 0, 150, 136, 136, 136, 136, 136, 0, 136, 136, + 0, 0, 136, 0, 0, 136, 136, 136, 168, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 157, 157, + 157, 157, 157, 0, 157, 157, 157, 0, 0, 0, + 157, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 150, 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, 51, 118, 120, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 0, 0, + 0, 74, 74, 74, 74, 0, 0, 0, 0, 0, + 74, 57, 0, 0, 74, 74, 62, 74, 0, 0, + 120, 0, 0, 74, 74, 0, 120, 74, 74, 74, + 74, 74, 0, 74, 0, 0, 0, 0, 0, 0, + 0, 39, 0, 60, 39, 39, 39, 0, 39, 0, + 39, 39, 0, 39, 120, 0, 0, 0, 0, 0, + 0, 210, 0, 152, 153, 154, 155, 39, 0, 0, + 0, 0, 39, 0, 0, 23, 0, 0, 52, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 0, 0, 0, 0, 0, 51, 0, 39, + 61, 63, 47, 0, 56, 0, 64, 59, 0, 58, + 0, 0, 0, 0, 154, 155, 0, 0, 0, 0, + 0, 0, 120, 0, 0, 0, 0, 0, 62, 0, + 0, 39, 163, 0, 39, 164, 0, 0, 165, 166, + 167, 0, 0, 0, 135, 0, 0, 135, 0, 0, + 0, 0, 0, 0, 0, 60, 0, 89, 0, 0, + 51, 135, 135, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 108, 0, 0, 0, 0, 117, 0, + 123, 0, 0, 0, 0, 0, 0, 23, 0, 0, + 52, 62, 137, 138, 139, 140, 135, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 22, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 0, 32, 0, 0, 33, 34, 35, 36, 0, 0, + 0, 37, 38, 0, 39, 40, 41, 0, 204, 0, + 0, 42, 43, 44, 45, 46, 0, 0, 48, 49, + 23, 0, 0, 52, 168, 50, 0, 0, 0, 53, + 0, 54, 55, 0, 39, 39, 39, 39, 39, 39, + 0, 39, 39, 39, 0, 0, 0, 39, 0, 0, + 39, 39, 39, 39, 0, 0, 150, 39, 39, 0, + 39, 39, 39, 0, 0, 0, 0, 39, 39, 39, + 39, 39, 0, 0, 39, 39, 0, 0, 0, 0, + 168, 39, 0, 0, 0, 39, 0, 39, 39, 0, + 0, 119, 25, 26, 27, 28, 85, 29, 30, 31, + 319, 0, 0, 32, 0, 0, 0, 0, 0, 0, + 0, 0, 150, 0, 38, 0, 39, 40, 41, 0, + 0, 0, 157, 42, 43, 44, 45, 46, 0, 0, + 48, 49, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 53, 0, 54, 55, 135, 135, 135, 135, 0, + 168, 0, 0, 0, 109, 25, 26, 27, 28, 0, + 29, 30, 31, 0, 0, 0, 32, 135, 135, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 39, + 40, 41, 150, 0, 0, 0, 42, 43, 44, 45, + 46, 0, 0, 48, 49, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 51, 54, 55, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 114, 0, 159, 160, 161, 62, 162, 163, 0, 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, - 0, 0, 0, 50, 0, 39, 61, 63, 60, 0, - 55, 0, 64, 58, 0, 57, 0, 0, 0, 0, - 0, 0, 0, 0, 168, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 62, 0, 0, 39, 0, 154, - 39, 0, 0, 50, 0, 0, 61, 63, 60, 0, - 55, 0, 64, 58, 0, 57, 150, 0, 0, 163, - 0, 59, 164, 0, 0, 165, 166, 167, 0, 113, - 0, 0, 0, 0, 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 23, 0, 0, 51, 0, 0, 50, - 0, 59, 61, 63, 60, 0, 55, 0, 64, 58, - 0, 57, 0, 0, 84, 84, 84, 84, 0, 0, - 0, 0, 0, 152, 153, 154, 155, 0, 0, 0, - 62, 0, 0, 0, 0, 0, 51, 84, 84, 0, - 160, 161, 84, 0, 162, 163, 0, 0, 164, 0, - 0, 165, 166, 167, 0, 0, 0, 59, 0, 83, - 0, 0, 83, 0, 0, 56, 56, 56, 56, 0, - 39, 39, 39, 39, 39, 39, 83, 83, 0, 0, - 39, 83, 0, 39, 39, 39, 39, 0, 56, 23, - 39, 39, 51, 39, 39, 39, 39, 0, 0, 0, - 0, 39, 39, 39, 39, 39, 0, 0, 39, 39, - 39, 83, 0, 0, 0, 0, 39, 39, 154, 155, - 0, 39, 0, 39, 39, 0, 0, 117, 25, 26, - 27, 28, 86, 0, 0, 0, 29, 162, 163, 0, - 0, 164, 168, 0, 165, 166, 167, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 24, 25, 26, - 27, 28, 48, 49, 150, 0, 29, 52, 0, 53, - 54, 0, 0, 0, 0, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 0, 0, 0, - 0, 0, 48, 49, 0, 0, 0, 52, 78, 53, - 54, 78, 0, 117, 25, 26, 27, 28, 86, 0, - 0, 0, 29, 0, 0, 78, 78, 0, 0, 0, - 78, 0, 0, 35, 0, 36, 37, 38, 39, 0, - 0, 0, 0, 40, 41, 42, 43, 44, 0, 0, - 0, 46, 47, 0, 0, 0, 0, 0, 48, 49, - 78, 0, 0, 52, 50, 53, 54, 61, 63, 60, - 0, 55, 130, 64, 58, 0, 57, 83, 83, 83, - 83, 0, 0, 0, 0, 168, 83, 0, 0, 0, - 0, 0, 0, 0, 0, 62, 0, 0, 0, 0, - 83, 83, 0, 0, 50, 83, 83, 61, 63, 60, - 0, 55, 0, 64, 58, 0, 57, 150, 0, 0, - 0, 0, 59, 0, 152, 153, 154, 155, 0, 0, - 0, 0, 0, 0, 0, 62, 0, 0, 0, 0, - 0, 130, 161, 0, 130, 162, 163, 0, 0, 164, - 0, 90, 165, 166, 167, 0, 0, 51, 130, 130, - 0, 0, 59, 50, 134, 107, 61, 63, 60, 0, - 55, 120, 64, 58, 0, 57, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 136, 137, 138, 139, 140, - 0, 0, 0, 130, 62, 0, 0, 51, 0, 0, - 0, 0, 0, 50, 0, 0, 61, 63, 60, 0, - 55, 198, 64, 58, 0, 57, 0, 0, 0, 0, - 0, 59, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 202, 0, 0, 62, 0, 78, 78, 78, 78, - 0, 0, 0, 50, 0, 78, 61, 63, 60, 0, - 55, 246, 64, 58, 0, 57, 51, 0, 0, 78, - 78, 59, 0, 0, 78, 78, 78, 78, 78, 0, - 0, 0, 0, 0, 62, 0, 0, 152, 153, 154, - 155, 0, 0, 0, 0, 0, 0, 0, 24, 25, - 26, 27, 28, 0, 0, 0, 51, 29, 162, 163, - 0, 59, 164, 0, 0, 165, 166, 167, 35, 0, - 36, 37, 38, 39, 0, 168, 0, 0, 40, 41, - 42, 43, 44, 0, 0, 45, 46, 47, 24, 25, - 26, 27, 28, 48, 49, 0, 51, 29, 52, 0, - 53, 54, 0, 0, 0, 0, 0, 150, 35, 0, - 36, 37, 38, 39, 0, 0, 0, 0, 40, 41, - 42, 43, 44, 0, 0, 45, 46, 47, 0, 130, - 130, 130, 130, 48, 49, 0, 0, 0, 52, 0, - 53, 54, 0, 0, 0, 0, 22, 24, 25, 26, - 27, 28, 130, 130, 0, 0, 29, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 24, 25, 26, - 27, 28, 48, 49, 0, 0, 29, 52, 0, 53, - 54, 0, 0, 0, 0, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 168, 45, 46, 47, 24, 25, 26, - 27, 28, 48, 49, 0, 0, 29, 52, 0, 53, - 54, 0, 0, 0, 0, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 150, 0, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 0, 0, 154, - 155, 0, 48, 49, 0, 0, 0, 52, 50, 53, - 54, 61, 63, 60, 0, 55, 272, 64, 58, 163, - 57, 0, 164, 0, 0, 165, 166, 167, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 61, 63, 60, 0, 55, 274, 64, 58, 0, - 57, 0, 0, 0, 0, 0, 59, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 61, 63, 60, 0, 55, 0, 64, 58, 0, - 57, 51, 0, 0, 0, 0, 59, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 61, 63, 60, 0, 55, 0, 64, 58, 0, - 57, 51, 0, 0, 0, 152, 59, 154, 155, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 0, 0, 0, 0, 0, 0, 162, 163, 0, 0, - 164, 0, 0, 165, 166, 167, 0, 0, 23, 0, - 0, 51, 0, 0, 0, 0, 59, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 61, 63, 60, 0, - 55, 0, 64, 58, 0, 57, 0, 88, 88, 0, - 0, 0, 0, 0, 0, 0, 102, 0, 0, 0, - 0, 51, 88, 111, 62, 0, 0, 0, 118, 0, - 0, 0, 24, 25, 26, 27, 28, 0, 0, 0, - 0, 29, 88, 88, 88, 88, 88, 0, 0, 0, - 0, 59, 35, 0, 36, 37, 38, 39, 0, 0, - 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, - 46, 47, 24, 25, 26, 27, 28, 48, 49, 0, - 0, 29, 52, 23, 53, 54, 51, 0, 118, 0, - 0, 0, 35, 0, 36, 37, 38, 39, 0, 0, - 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, - 46, 47, 108, 25, 26, 27, 28, 48, 49, 0, - 0, 29, 52, 0, 53, 54, 0, 0, 0, 0, - 0, 0, 35, 0, 36, 37, 38, 39, 0, 0, - 0, 0, 40, 41, 42, 43, 44, 0, 0, 239, - 46, 47, 24, 25, 26, 27, 28, 48, 49, 0, - 0, 29, 52, 168, 53, 54, 0, 0, 0, 0, - 60, 0, 35, 60, 36, 37, 38, 39, 0, 0, - 0, 0, 40, 41, 42, 43, 44, 60, 60, 45, - 46, 47, 0, 0, 0, 150, 0, 48, 49, 0, - 0, 0, 52, 50, 53, 54, 61, 63, 60, 0, - 55, 0, 64, 58, 0, 57, 0, 24, 25, 26, - 27, 28, 60, 0, 0, 0, 29, 0, 0, 0, - 0, 0, 0, 0, 62, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 135, 46, 47, 135, 0, 0, - 0, 59, 48, 49, 0, 0, 0, 52, 0, 53, - 54, 135, 135, 0, 0, 0, 135, 0, 0, 0, + 0, 51, 0, 60, 61, 63, 47, 0, 56, 0, + 64, 59, 0, 58, 152, 153, 154, 155, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 62, 162, 163, 0, 0, 164, 52, 0, + 165, 166, 167, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 60, + 61, 63, 47, 0, 56, 131, 64, 59, 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 0, 0, 119, - 0, 0, 119, 0, 135, 0, 135, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 119, 119, 0, 0, - 0, 119, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 135, 0, 0, 0, - 0, 0, 0, 0, 142, 0, 0, 142, 0, 119, - 0, 119, 0, 0, 0, 152, 153, 154, 155, 0, - 0, 142, 142, 0, 0, 0, 142, 0, 0, 0, - 158, 159, 160, 161, 0, 0, 162, 163, 0, 0, - 164, 119, 0, 165, 166, 167, 0, 0, 0, 129, - 0, 0, 129, 0, 142, 0, 142, 0, 60, 60, - 60, 60, 0, 0, 0, 0, 129, 129, 0, 0, - 0, 129, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 60, 60, 0, 0, 0, 142, 24, 25, 26, - 27, 28, 0, 0, 0, 0, 29, 0, 0, 0, - 0, 129, 0, 0, 0, 0, 0, 35, 0, 36, - 37, 38, 39, 0, 0, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 0, 46, 47, 0, 0, 0, - 145, 129, 48, 49, 0, 0, 0, 52, 0, 53, - 54, 0, 135, 135, 135, 135, 0, 145, 145, 0, - 0, 135, 145, 0, 0, 0, 135, 135, 135, 135, - 0, 0, 0, 0, 0, 135, 135, 0, 0, 0, - 135, 135, 135, 135, 135, 0, 144, 135, 135, 144, - 145, 135, 145, 0, 135, 135, 135, 119, 119, 119, - 119, 0, 0, 144, 144, 0, 119, 0, 144, 0, - 0, 119, 119, 119, 119, 0, 0, 0, 0, 0, - 119, 119, 145, 0, 0, 119, 119, 119, 119, 119, - 0, 97, 119, 119, 97, 0, 119, 0, 144, 119, - 119, 119, 142, 142, 142, 142, 0, 0, 97, 97, - 0, 142, 0, 97, 0, 0, 142, 142, 142, 142, - 0, 0, 0, 0, 0, 142, 142, 0, 144, 0, - 142, 142, 142, 142, 142, 0, 59, 142, 142, 59, - 0, 142, 0, 97, 142, 142, 142, 129, 129, 129, - 129, 0, 0, 59, 59, 0, 129, 0, 59, 0, - 0, 129, 129, 129, 129, 0, 0, 0, 0, 0, - 129, 129, 0, 97, 0, 129, 129, 129, 129, 129, - 0, 0, 129, 129, 62, 0, 129, 0, 59, 129, - 129, 129, 0, 0, 72, 0, 0, 72, 0, 0, - 0, 62, 62, 0, 0, 0, 62, 0, 0, 0, - 0, 72, 72, 0, 0, 0, 0, 0, 59, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 145, 145, - 145, 145, 96, 0, 62, 96, 62, 145, 0, 0, - 0, 0, 145, 145, 145, 145, 72, 0, 0, 96, - 96, 145, 145, 0, 96, 0, 145, 145, 145, 145, - 145, 0, 0, 145, 145, 0, 62, 145, 0, 0, - 145, 145, 145, 0, 144, 144, 144, 144, 144, 0, - 0, 144, 0, 144, 96, 0, 0, 0, 144, 144, - 144, 144, 0, 0, 0, 144, 144, 144, 144, 0, - 144, 0, 144, 144, 144, 144, 144, 0, 0, 144, - 144, 0, 0, 144, 96, 0, 144, 144, 144, 97, - 97, 97, 97, 131, 0, 0, 131, 0, 97, 0, - 144, 0, 0, 97, 97, 97, 97, 0, 0, 0, - 131, 131, 97, 97, 0, 131, 0, 97, 97, 97, - 97, 97, 0, 0, 97, 97, 0, 0, 97, 0, - 0, 97, 97, 97, 59, 59, 59, 59, 103, 0, - 0, 103, 0, 59, 0, 131, 0, 0, 59, 59, - 59, 59, 0, 0, 0, 103, 103, 59, 59, 0, - 103, 0, 59, 59, 59, 59, 59, 0, 0, 59, - 59, 0, 0, 59, 0, 0, 59, 59, 59, 0, - 0, 0, 62, 62, 62, 62, 109, 0, 0, 109, - 103, 62, 72, 72, 72, 72, 62, 62, 62, 62, - 0, 0, 0, 109, 109, 62, 62, 0, 109, 0, - 62, 62, 62, 62, 62, 72, 72, 62, 62, 0, - 0, 62, 0, 0, 62, 62, 62, 0, 0, 0, - 96, 96, 96, 96, 314, 0, 0, 0, 109, 96, - 0, 0, 0, 0, 96, 96, 96, 96, 0, 0, - 0, 0, 0, 96, 96, 0, 157, 0, 96, 96, - 96, 96, 96, 0, 0, 96, 96, 0, 0, 96, - 0, 0, 96, 96, 96, 0, 144, 144, 144, 144, - 93, 0, 0, 93, 168, 144, 0, 0, 0, 0, - 144, 144, 144, 144, 0, 0, 0, 93, 93, 144, - 144, 0, 93, 0, 144, 144, 144, 144, 144, 0, - 0, 144, 144, 0, 0, 144, 150, 0, 144, 144, - 144, 131, 131, 131, 131, 94, 0, 0, 94, 0, - 131, 0, 93, 0, 0, 131, 131, 131, 131, 0, - 0, 0, 94, 94, 131, 131, 0, 94, 0, 131, - 131, 131, 131, 131, 0, 0, 131, 131, 0, 0, - 131, 0, 0, 131, 131, 131, 103, 103, 103, 103, - 88, 0, 0, 88, 0, 103, 0, 94, 0, 0, - 103, 103, 103, 103, 0, 0, 0, 88, 88, 103, - 103, 0, 88, 0, 103, 103, 103, 103, 103, 0, - 0, 103, 103, 0, 0, 103, 0, 0, 103, 103, - 103, 0, 0, 0, 109, 109, 109, 109, 89, 0, - 0, 89, 88, 109, 0, 0, 0, 0, 109, 109, - 109, 109, 0, 0, 0, 89, 89, 109, 109, 0, - 89, 0, 109, 109, 109, 109, 109, 0, 0, 109, - 109, 0, 0, 109, 0, 0, 109, 109, 109, 0, - 0, 0, 0, 90, 0, 0, 90, 0, 0, 0, - 89, 151, 0, 0, 0, 0, 152, 153, 154, 155, - 90, 90, 0, 0, 0, 90, 0, 0, 0, 0, - 156, 158, 159, 160, 161, 0, 0, 162, 163, 0, - 0, 164, 0, 0, 165, 166, 167, 0, 93, 93, - 93, 93, 0, 281, 0, 90, 0, 93, 157, 0, - 0, 0, 93, 93, 93, 93, 0, 0, 0, 0, - 0, 93, 93, 0, 0, 0, 93, 93, 93, 93, - 93, 0, 86, 93, 93, 86, 168, 93, 0, 0, - 0, 0, 0, 94, 94, 94, 94, 0, 0, 86, - 86, 0, 94, 0, 86, 0, 0, 94, 94, 94, - 94, 0, 0, 0, 0, 0, 94, 94, 150, 0, - 0, 94, 94, 94, 94, 94, 0, 87, 94, 94, - 87, 0, 94, 0, 86, 0, 0, 0, 88, 88, - 88, 88, 0, 0, 87, 87, 0, 88, 0, 87, - 0, 0, 88, 88, 88, 88, 0, 0, 0, 0, - 0, 88, 88, 0, 0, 0, 88, 88, 88, 88, - 88, 0, 0, 88, 88, 85, 0, 0, 85, 87, - 0, 0, 0, 0, 0, 0, 89, 89, 89, 89, - 0, 0, 85, 85, 0, 89, 0, 85, 0, 0, - 89, 89, 89, 89, 0, 0, 0, 0, 0, 89, - 89, 0, 0, 0, 89, 89, 89, 89, 89, 0, - 73, 89, 89, 73, 0, 0, 0, 85, 0, 0, - 0, 90, 90, 90, 90, 0, 0, 73, 73, 0, - 90, 0, 73, 0, 0, 90, 90, 90, 90, 0, - 0, 0, 0, 0, 90, 90, 0, 0, 0, 90, - 90, 90, 90, 90, 0, 74, 90, 90, 74, 0, - 0, 0, 73, 151, 0, 0, 0, 0, 152, 153, - 154, 155, 74, 74, 0, 0, 0, 74, 0, 0, - 0, 0, 156, 158, 159, 160, 161, 0, 0, 162, + 151, 0, 0, 0, 152, 153, 154, 155, 62, 0, + 0, 23, 0, 0, 52, 0, 0, 156, 158, 159, + 160, 161, 0, 162, 163, 0, 0, 164, 0, 0, + 165, 166, 167, 0, 0, 60, 0, 0, 0, 0, + 51, 0, 0, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 52, 62, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 135, 32, 0, 0, 0, 168, 0, 0, 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, 52, 0, 50, 0, 150, 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, 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, 0, 0, 82, 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, 0, 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, 154, 155, 48, 49, 62, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 0, 54, 55, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 0, 0, + 51, 0, 60, 61, 63, 47, 0, 56, 200, 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, + 152, 0, 154, 155, 0, 0, 51, 0, 60, 61, + 63, 47, 0, 56, 248, 64, 59, 0, 58, 162, 163, 0, 0, 164, 0, 0, 165, 166, 167, 0, - 86, 86, 86, 86, 0, 0, 0, 74, 0, 86, - 157, 0, 0, 0, 86, 86, 86, 86, 0, 0, - 0, 0, 0, 86, 86, 0, 0, 0, 86, 86, - 86, 86, 86, 0, 75, 86, 86, 75, 168, 0, - 0, 0, 0, 0, 0, 87, 87, 87, 87, 0, - 0, 75, 75, 0, 87, 0, 75, 0, 0, 87, - 87, 87, 87, 0, 0, 0, 0, 0, 87, 87, - 150, 0, 0, 87, 87, 87, 87, 87, 0, 0, - 87, 87, 76, 0, 0, 76, 75, 0, 0, 0, - 0, 0, 0, 85, 85, 85, 85, 0, 0, 76, - 76, 0, 85, 0, 76, 0, 0, 85, 85, 85, - 85, 0, 0, 0, 0, 0, 85, 85, 0, 0, - 0, 85, 85, 85, 85, 85, 0, 123, 85, 85, - 123, 0, 0, 0, 76, 0, 0, 0, 73, 73, - 73, 73, 0, 0, 123, 123, 0, 73, 0, 123, - 0, 0, 73, 73, 73, 73, 0, 0, 0, 0, - 0, 73, 73, 0, 0, 0, 73, 73, 73, 73, - 73, 0, 95, 73, 73, 95, 0, 0, 0, 123, - 0, 0, 0, 74, 74, 74, 74, 0, 0, 95, - 95, 0, 74, 0, 95, 0, 0, 74, 74, 74, - 74, 0, 0, 0, 0, 133, 74, 74, 133, 0, - 0, 74, 74, 74, 74, 74, 0, 0, 74, 0, - 0, 0, 133, 133, 95, 151, 0, 133, 0, 0, - 152, 153, 154, 155, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 156, 158, 159, 160, 161, 0, - 134, 162, 163, 134, 0, 164, 0, 133, 165, 166, - 167, 0, 75, 75, 75, 75, 80, 134, 134, 80, - 0, 75, 134, 0, 0, 0, 75, 75, 0, 75, - 0, 0, 0, 80, 80, 75, 75, 0, 80, 0, - 75, 75, 75, 75, 75, 0, 0, 75, 77, 0, - 0, 77, 134, 0, 0, 0, 0, 0, 0, 0, - 76, 76, 76, 76, 79, 77, 77, 79, 80, 76, - 77, 0, 0, 0, 76, 76, 0, 0, 0, 0, - 0, 79, 79, 76, 76, 0, 79, 0, 76, 76, - 76, 76, 76, 0, 0, 76, 0, 0, 0, 0, - 77, 0, 0, 0, 0, 123, 123, 123, 123, 82, - 0, 0, 82, 0, 123, 0, 79, 0, 0, 123, - 123, 0, 0, 0, 0, 0, 82, 82, 123, 123, - 0, 82, 0, 123, 123, 123, 123, 123, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 157, 0, - 95, 95, 95, 95, 0, 0, 0, 0, 0, 95, - 0, 82, 0, 0, 95, 95, 0, 0, 0, 0, - 0, 0, 0, 95, 95, 0, 168, 0, 95, 95, - 95, 95, 95, 133, 133, 133, 133, 0, 0, 0, - 0, 0, 133, 0, 0, 0, 0, 133, 133, 0, - 0, 0, 0, 0, 0, 0, 133, 133, 150, 0, - 0, 133, 133, 133, 133, 133, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 134, 134, - 134, 134, 0, 0, 0, 0, 0, 134, 0, 0, - 0, 0, 134, 134, 80, 80, 80, 80, 0, 0, - 0, 134, 134, 80, 0, 0, 134, 134, 134, 134, - 134, 0, 0, 0, 0, 0, 0, 80, 80, 0, - 0, 0, 80, 80, 80, 80, 77, 77, 77, 77, - 0, 0, 0, 0, 0, 77, 0, 0, 0, 0, - 0, 77, 79, 79, 79, 79, 0, 0, 0, 77, - 77, 79, 0, 0, 77, 77, 77, 77, 77, 0, - 0, 0, 0, 0, 0, 79, 79, 0, 0, 0, - 79, 79, 79, 79, 79, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 103, 0, 82, 82, 82, - 82, 110, 112, 0, 0, 0, 82, 0, 123, 124, - 125, 126, 127, 128, 129, 0, 0, 132, 133, 0, - 82, 82, 0, 151, 0, 82, 82, 82, 152, 153, - 154, 155, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 158, 159, 160, 161, 0, 0, 162, - 163, 182, 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, 276, 64, 59, + 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, + 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 22, 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, 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, 0, 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, 143, 0, 53, 143, 54, 55, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 143, + 143, 0, 32, 0, 143, 0, 0, 0, 119, 0, + 0, 0, 0, 38, 0, 39, 40, 41, 0, 0, + 0, 0, 42, 43, 44, 45, 46, 0, 0, 48, + 49, 0, 143, 0, 143, 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, 143, 32, 61, 63, 47, 0, + 56, 278, 64, 59, 0, 58, 38, 0, 39, 40, + 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, + 0, 0, 48, 49, 62, 0, 87, 87, 0, 50, + 0, 0, 0, 53, 0, 54, 55, 0, 103, 0, + 0, 0, 0, 87, 112, 0, 0, 0, 87, 51, + 121, 60, 61, 63, 47, 0, 56, 0, 64, 59, + 0, 58, 87, 87, 87, 87, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 62, 0, 0, 0, 0, 0, 52, 119, 119, 119, + 119, 0, 0, 0, 0, 0, 119, 0, 0, 0, + 119, 119, 119, 119, 0, 0, 0, 60, 121, 119, + 119, 0, 0, 119, 119, 119, 119, 119, 0, 119, + 119, 0, 130, 119, 0, 130, 119, 119, 119, 0, + 0, 0, 0, 129, 0, 0, 129, 0, 0, 130, + 130, 0, 52, 143, 143, 143, 143, 0, 0, 0, + 129, 129, 143, 0, 0, 129, 143, 143, 143, 143, + 0, 0, 0, 0, 0, 143, 143, 0, 240, 143, + 143, 143, 143, 143, 130, 143, 143, 0, 104, 143, + 0, 104, 143, 143, 143, 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, 39, 40, 41, 0, 0, 0, 0, 42, + 43, 44, 45, 46, 0, 0, 48, 49, 0, 0, + 0, 0, 0, 50, 0, 145, 0, 53, 145, 54, + 55, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 145, 145, 0, 32, 0, 145, 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, 145, 0, 50, + 131, 0, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 131, 131, 0, + 0, 0, 131, 0, 0, 0, 0, 145, 0, 0, + 0, 0, 0, 130, 130, 130, 130, 0, 0, 0, + 0, 0, 0, 0, 129, 129, 129, 129, 0, 0, + 131, 0, 131, 129, 0, 130, 130, 129, 129, 129, + 129, 0, 0, 0, 0, 0, 129, 129, 0, 0, + 129, 129, 129, 129, 129, 0, 129, 129, 0, 0, + 129, 0, 131, 129, 129, 129, 0, 0, 0, 104, + 104, 104, 104, 0, 0, 0, 0, 0, 104, 0, + 0, 0, 104, 104, 104, 104, 0, 0, 0, 0, + 0, 104, 104, 0, 146, 104, 104, 104, 104, 104, + 0, 104, 104, 0, 0, 104, 0, 0, 104, 104, + 104, 146, 146, 0, 0, 0, 146, 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, 146, 0, 146, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 145, 145, 145, 145, + 0, 0, 0, 0, 0, 145, 0, 0, 0, 145, + 145, 145, 145, 0, 0, 0, 146, 0, 145, 145, + 0, 0, 145, 145, 145, 145, 145, 0, 145, 145, + 59, 0, 145, 59, 0, 145, 145, 145, 0, 0, + 0, 96, 0, 0, 96, 0, 0, 59, 59, 0, + 0, 131, 131, 131, 131, 0, 0, 0, 96, 96, + 131, 0, 0, 96, 131, 131, 131, 131, 0, 0, + 0, 0, 0, 131, 131, 0, 0, 131, 131, 131, + 131, 131, 59, 131, 131, 0, 0, 131, 0, 0, + 131, 131, 131, 96, 58, 0, 0, 58, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 58, 58, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 96, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 95, 0, 0, + 95, 0, 0, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 0, 95, 95, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 146, 146, 146, 146, 0, + 0, 0, 0, 0, 146, 0, 58, 0, 146, 146, + 146, 146, 0, 0, 0, 61, 0, 146, 146, 95, + 0, 146, 146, 146, 146, 146, 0, 146, 146, 0, + 0, 146, 61, 61, 146, 146, 146, 61, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 0, 0, 145, 0, 0, + 145, 0, 0, 0, 0, 61, 0, 61, 0, 0, + 0, 0, 0, 0, 145, 145, 0, 0, 0, 145, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 59, 59, 59, 59, 0, 0, 61, 0, 0, + 0, 0, 96, 96, 96, 96, 0, 0, 0, 145, + 0, 96, 0, 59, 59, 96, 96, 96, 96, 0, + 0, 0, 0, 0, 96, 96, 0, 0, 96, 96, + 96, 96, 96, 0, 96, 96, 0, 0, 96, 0, + 0, 96, 96, 96, 0, 132, 0, 0, 132, 0, + 0, 0, 0, 0, 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, 95, 95, + 95, 95, 0, 0, 0, 71, 0, 95, 71, 0, + 0, 95, 95, 95, 95, 0, 0, 0, 0, 0, + 95, 95, 71, 71, 95, 95, 95, 95, 95, 0, + 95, 95, 0, 0, 95, 0, 0, 95, 95, 95, + 0, 0, 0, 0, 0, 0, 61, 61, 61, 61, + 0, 0, 0, 0, 0, 61, 0, 71, 0, 61, + 61, 61, 61, 0, 0, 0, 0, 0, 61, 61, + 0, 157, 61, 61, 61, 61, 61, 0, 61, 61, + 0, 0, 61, 0, 0, 61, 61, 61, 145, 145, + 145, 145, 0, 0, 0, 0, 0, 145, 0, 168, + 0, 145, 145, 145, 145, 0, 0, 0, 0, 0, + 145, 145, 0, 0, 145, 145, 145, 145, 145, 102, + 145, 145, 102, 0, 145, 0, 0, 145, 145, 145, + 0, 150, 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, 0, 0, 0, 109, 0, 0, 109, + 0, 102, 0, 0, 0, 0, 132, 132, 132, 132, + 0, 0, 0, 109, 109, 132, 0, 0, 109, 132, + 132, 132, 132, 0, 0, 0, 0, 0, 132, 132, + 0, 0, 132, 132, 132, 132, 132, 0, 132, 132, + 92, 0, 132, 92, 0, 132, 132, 132, 109, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 92, 0, + 0, 0, 92, 0, 0, 0, 71, 71, 71, 71, + 0, 0, 0, 0, 0, 0, 0, 93, 0, 0, + 93, 0, 0, 0, 0, 0, 0, 0, 71, 71, + 0, 0, 92, 0, 93, 93, 0, 0, 0, 93, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 87, 0, 0, 87, 0, 151, + 0, 0, 0, 152, 153, 154, 155, 0, 0, 93, + 0, 87, 87, 0, 0, 0, 87, 158, 159, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 88, 0, 0, 88, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 87, 0, 0, 88, + 88, 0, 0, 0, 88, 0, 0, 0, 0, 0, + 102, 102, 102, 102, 0, 0, 0, 0, 0, 102, + 0, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 0, 0, 102, 102, 88, 0, 102, 102, 102, 102, + 102, 0, 102, 102, 0, 0, 102, 0, 0, 102, + 102, 102, 0, 0, 0, 0, 0, 109, 109, 109, + 109, 0, 0, 0, 0, 0, 109, 0, 0, 0, + 109, 109, 109, 109, 0, 0, 0, 0, 0, 109, + 109, 0, 0, 109, 109, 109, 109, 109, 0, 109, + 109, 89, 0, 109, 89, 0, 109, 109, 109, 0, + 0, 92, 92, 92, 92, 0, 0, 0, 89, 89, + 92, 0, 0, 89, 92, 92, 92, 92, 0, 0, + 0, 0, 0, 92, 92, 0, 0, 92, 92, 92, + 92, 92, 0, 92, 92, 0, 0, 92, 93, 93, + 93, 93, 0, 89, 0, 0, 0, 93, 0, 0, + 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, + 93, 93, 0, 0, 93, 93, 93, 93, 93, 0, + 93, 93, 0, 0, 93, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 87, 0, 0, 0, 87, 87, + 87, 87, 0, 0, 0, 0, 0, 87, 87, 0, + 0, 87, 87, 87, 87, 87, 0, 87, 87, 0, + 0, 0, 0, 88, 88, 88, 88, 0, 0, 0, + 0, 0, 88, 0, 0, 0, 88, 88, 88, 88, + 85, 0, 0, 85, 0, 88, 88, 0, 0, 88, + 88, 88, 88, 88, 0, 88, 88, 85, 85, 0, + 0, 0, 85, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 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, 0, 0, 0, 0, 0, 0, 0, 0, + 84, 0, 0, 84, 0, 0, 0, 0, 86, 0, + 0, 0, 89, 89, 89, 89, 0, 84, 84, 0, + 0, 89, 84, 0, 0, 89, 89, 89, 89, 0, + 0, 0, 0, 0, 89, 89, 0, 0, 89, 89, + 89, 89, 89, 72, 89, 89, 72, 0, 0, 0, + 0, 0, 84, 0, 0, 0, 0, 0, 0, 0, + 72, 72, 0, 0, 0, 72, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 73, + 0, 0, 73, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 72, 73, 73, 0, 0, + 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 75, 0, 0, 75, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 73, 0, 75, 75, 0, 0, 0, 75, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 85, 85, 85, 85, 0, 0, 0, 0, 0, + 85, 0, 0, 0, 85, 85, 85, 85, 75, 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, 123, 0, 0, 123, 0, 86, + 86, 0, 0, 86, 86, 86, 86, 86, 0, 86, + 86, 123, 123, 0, 0, 0, 123, 0, 0, 0, + 0, 84, 84, 84, 84, 0, 0, 0, 0, 0, + 84, 0, 0, 0, 84, 84, 84, 84, 0, 0, + 0, 0, 0, 84, 84, 0, 123, 84, 84, 84, + 84, 84, 94, 84, 84, 94, 0, 0, 0, 0, + 0, 0, 0, 0, 72, 72, 72, 72, 0, 94, + 94, 0, 0, 72, 94, 0, 0, 72, 72, 72, + 72, 0, 0, 0, 0, 0, 72, 72, 0, 0, + 72, 72, 72, 72, 72, 0, 72, 72, 0, 0, + 73, 73, 73, 73, 94, 0, 0, 0, 0, 73, + 0, 0, 0, 73, 73, 73, 73, 0, 0, 0, + 0, 0, 73, 73, 0, 0, 73, 73, 73, 73, + 73, 134, 73, 0, 134, 0, 0, 75, 75, 75, + 75, 0, 0, 0, 0, 0, 75, 0, 134, 134, + 75, 75, 0, 134, 0, 0, 0, 0, 0, 75, + 75, 0, 0, 75, 75, 75, 75, 75, 76, 75, + 0, 76, 0, 0, 0, 0, 0, 0, 77, 0, + 0, 77, 0, 134, 0, 76, 76, 0, 0, 0, + 76, 0, 0, 0, 0, 77, 77, 0, 0, 0, + 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 78, 0, 0, 78, 0, 0, + 76, 0, 0, 0, 0, 123, 123, 123, 123, 0, + 77, 78, 78, 0, 123, 0, 78, 0, 123, 123, + 0, 0, 0, 0, 0, 0, 79, 123, 123, 79, + 0, 123, 123, 123, 123, 123, 81, 0, 0, 81, + 0, 0, 0, 79, 79, 0, 78, 0, 79, 0, + 0, 0, 0, 81, 81, 0, 0, 0, 81, 0, + 0, 0, 0, 94, 94, 94, 94, 0, 0, 284, + 0, 0, 94, 0, 157, 0, 94, 94, 79, 0, + 0, 0, 0, 0, 0, 94, 94, 0, 81, 94, + 94, 94, 94, 94, 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, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 150, 0, 0, 0, 0, 0, + 0, 0, 134, 134, 134, 134, 0, 0, 0, 0, + 0, 134, 0, 0, 0, 134, 134, 0, 0, 0, + 0, 0, 0, 0, 134, 134, 0, 0, 134, 134, + 134, 134, 134, 0, 0, 0, 0, 0, 0, 76, + 76, 76, 76, 0, 0, 0, 0, 0, 76, 77, + 77, 77, 77, 76, 0, 0, 0, 0, 77, 0, + 0, 76, 76, 0, 0, 76, 76, 76, 76, 76, + 0, 77, 77, 0, 0, 77, 77, 77, 77, 77, + 0, 0, 0, 0, 0, 78, 78, 78, 78, 0, + 0, 0, 0, 0, 78, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 78, 78, 0, + 0, 78, 78, 78, 78, 78, 0, 79, 79, 79, + 79, 0, 0, 0, 0, 0, 79, 81, 81, 81, + 81, 0, 0, 0, 0, 0, 81, 0, 0, 79, + 79, 0, 0, 79, 79, 79, 79, 0, 0, 81, + 81, 0, 151, 81, 81, 81, 152, 153, 154, 155, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 156, + 158, 159, 160, 161, 0, 162, 163, 91, 0, 164, + 0, 0, 165, 166, 167, 104, 0, 0, 0, 0, + 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 183, 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, 214, 0, 0, 0, 0, 0, 0, - 0, 222, 223, 224, 225, 226, 227, 228, 229, 230, - 231, 232, 233, 234, 235, 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, 292, 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, 308, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 296, 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, 312, }; dEXT short yycheck[] = { 13, - 36, 91, 41, 17, 41, 59, 41, 44, 93, 125, - 123, 59, 0, 41, 36, 93, 30, 31, 32, 33, - 93, 58, 59, 192, 257, 93, 63, 41, 181, 59, - 93, 46, 59, 123, 48, 91, 40, 44, 40, 257, - 40, 91, 6, 41, 41, 33, 41, 40, 36, 37, - 38, 93, 40, 40, 42, 43, 93, 45, 41, 41, - 186, 59, 188, 41, 78, 29, 41, 123, 59, 91, - 41, 59, 41, 123, 89, 0, 64, 59, 257, 41, - 94, 59, 96, 47, 98, 40, 100, 123, 59, 91, - 36, 275, 41, 123, 40, 40, 123, 59, 41, 40, - 115, 123, 40, 91, 292, 293, 59, 121, 33, 41, - 59, 36, 37, 38, 44, 40, 59, 42, 43, 123, - 45, 123, 41, 123, 41, 59, 295, 141, 40, 298, - 123, 284, 273, 274, 59, 123, 123, 125, 126, 64, - 0, 260, 123, 59, 257, 40, 59, 263, 264, 265, - 93, 267, 268, 59, 40, 59, 41, 263, 264, 265, - 329, 267, 268, 177, 40, 125, 91, 293, 294, 183, - 91, 41, 59, 33, 300, 41, 36, 37, 38, 293, - 40, 125, 42, 43, 91, 45, 40, 59, 41, 40, - 125, 93, 125, 41, 209, 41, 322, 125, 123, 59, - 125, 126, 125, 59, 64, 123, 41, 292, 293, 257, - 41, 41, 59, 44, 292, 293, 59, 41, 59, 292, - 293, 257, 41, 313, 292, 293, 262, 58, 59, 292, - 293, 91, 269, 270, 271, 272, 258, 320, 292, 293, - 84, 255, 13, 257, 265, 259, 260, 92, 41, 263, - 292, 293, 266, 292, 293, 292, 293, 292, 293, -1, - 297, -1, 93, 123, 292, 293, 126, -1, 256, 257, - 258, 259, 260, 261, -1, 263, 264, 265, 266, 267, - 268, 269, 270, 271, 272, 292, 293, 301, 276, 277, - -1, 279, 280, 281, 282, 292, 293, 292, 293, 287, - 288, 289, 290, 291, -1, -1, 294, 295, 296, 292, - 293, -1, 326, -1, 302, 303, 330, 292, 293, 307, - -1, 309, 310, 292, 293, -1, 269, 270, 271, 272, - -1, 256, 257, 258, 259, 260, 261, -1, 263, 264, - 265, 266, 267, 268, 269, 270, 271, 272, -1, 292, - 293, 276, 277, -1, 279, 280, 281, 282, 292, 293, - 292, 293, 287, 288, 289, 290, 291, -1, -1, 294, - 295, 296, 13, 292, 293, 292, 293, 302, 303, 292, - 293, -1, 307, -1, 309, 310, 292, 293, 292, 293, - 292, 293, -1, -1, -1, -1, 256, 257, 258, 259, - 260, 261, 43, -1, 45, -1, 266, -1, -1, 269, - 270, 271, 272, -1, 55, -1, 276, 277, 59, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, 294, 295, 296, -1, 269, 270, - 271, 272, 302, 303, -1, -1, -1, 307, -1, 309, - 310, -1, 93, 91, 95, -1, 97, -1, 99, -1, - 101, 292, 293, 33, 105, -1, 36, 37, 38, -1, - 40, 41, 42, 43, 44, 45, 269, 270, 271, 272, - -1, -1, -1, -1, -1, 123, -1, -1, 58, 59, - 21, -1, -1, 63, 64, 269, 270, 271, 272, 292, - 293, -1, -1, 144, 145, 146, 147, 148, 149, 150, - -1, -1, -1, -1, -1, 46, -1, -1, 292, 293, - -1, 91, -1, 93, -1, -1, -1, 168, 169, 170, - 171, 172, 173, -1, 33, 91, -1, 36, 37, 38, + 257, 13, 91, 17, 44, 41, 59, 182, 36, 41, + 59, 257, 44, 194, 41, 188, 59, 190, 41, 33, + 34, 35, 36, 59, 82, 40, 58, 59, 41, 43, + 88, 63, 125, 45, 123, 59, 50, 40, 59, 59, + 40, 91, 123, 91, 56, 41, 257, 41, 60, 41, + 41, 41, 278, 41, 36, 41, 44, 93, 116, 40, + 91, 93, 41, 91, 78, 41, 40, 40, 59, 41, + 58, 59, 40, 123, 123, 123, 91, 41, 92, 41, + 40, 95, 94, 97, 96, 99, 98, 101, 100, 41, + 102, 40, 123, 41, 106, 123, 44, 59, 41, 123, + 59, 41, 294, 295, 41, 93, 0, 59, 123, 59, + 58, 59, 287, 59, 44, 59, 59, 59, 299, 59, + 123, 302, 59, 123, 297, 298, 184, 141, 276, 277, + 123, 304, 144, 145, 146, 147, 148, 149, 150, 33, + 40, 123, 36, 37, 38, 93, 40, 260, 42, 43, + 123, 45, 123, 334, 327, 93, 168, 169, 170, 171, + 172, 173, 174, 123, 178, 59, 40, 40, 36, 0, + 64, 185, 40, 266, 267, 268, 257, 270, 271, 41, + 40, 93, 91, 266, 267, 268, 198, 270, 271, 125, + 93, 41, 204, 205, 206, 59, 59, 91, 287, 211, + 41, 125, 33, 91, 257, 36, 37, 38, 295, 40, + 93, 42, 43, 40, 45, 41, 305, 40, 125, 308, + 125, 125, 311, 312, 313, 237, 125, 239, 59, 123, + 258, 125, 126, 64, 59, 125, 272, 273, 274, 275, + 272, 273, 274, 275, 93, 259, 41, 261, 41, 263, + 264, 294, 295, 267, 294, 295, 270, 269, 294, 295, + 91, 41, 294, 295, 44, 313, 298, 294, 295, 93, + 282, 294, 295, 294, 295, 257, 272, 273, 274, 275, + 262, 294, 295, 63, 272, 273, 274, 275, 59, 301, + 123, 305, 123, 41, 125, 126, 0, 93, 294, 295, + 294, 295, 294, 295, 294, 295, 294, 295, 294, 295, + 298, 91, 59, 325, 41, 294, 295, 331, 294, 295, + 59, 335, 294, 295, 272, 273, 274, 275, 41, 33, + 294, 295, 36, 37, 38, 59, 40, 83, 42, 43, + 41, 45, 325, 123, 294, 295, 294, 295, 294, 295, + 294, 295, 294, 295, 13, 59, 294, 295, 269, 93, + 64, -1, 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, 91, 282, 283, + 284, 294, 295, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 41, -1, -1, 44, 303, + -1, 294, 295, 307, -1, 309, 310, -1, -1, 123, + -1, -1, 126, 59, 91, 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, 91, -1, 123, 93, 289, 290, + 291, 292, 293, -1, -1, 296, 297, -1, -1, -1, + 294, 295, 303, -1, -1, -1, 307, -1, 309, 310, + 272, 273, 274, 275, 33, 91, 123, 36, 37, 38, + -1, 40, 41, 42, 43, 44, 45, -1, 294, 295, + -1, 281, 294, 295, -1, 285, 286, 287, 288, 58, + 59, 6, -1, 8, 63, 64, -1, 123, 298, 299, + 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, + -1, 311, 312, 313, -1, -1, 31, 32, -1, -1, + -1, -1, 91, -1, 93, 41, -1, -1, 44, -1, + -1, 91, 256, 257, 258, 259, 260, 261, -1, 263, + 264, 265, 58, 59, -1, 269, -1, 63, 272, 273, + 274, 275, -1, -1, 123, 279, 280, 126, 282, 283, + 284, -1, -1, 123, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 91, -1, 93, -1, 303, + -1, -1, -1, 307, 33, 309, 310, 36, 37, 38, -1, 40, 41, 42, 43, 44, 45, -1, -1, -1, - -1, -1, -1, 123, -1, 196, 126, -1, 89, 58, - 59, 202, 203, 204, 63, 64, -1, 123, -1, 210, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 115, -1, -1, -1, -1, 120, - -1, -1, -1, -1, 93, 236, -1, 238, -1, -1, - 91, -1, 33, -1, -1, 36, 37, 38, -1, 40, - -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 265, -1, -1, 126, 59, -1, - -1, -1, 123, 64, -1, -1, -1, -1, 279, -1, - -1, -1, -1, -1, -1, 283, 284, 285, 286, -1, - -1, -1, -1, -1, 41, -1, 297, 44, -1, -1, - 91, 299, 300, 301, -1, -1, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, 63, -1, 209, 320, - -1, -1, -1, -1, -1, -1, -1, 257, 258, 259, - 260, 261, 123, -1, -1, 126, 266, -1, -1, 269, - 270, 271, 272, -1, 91, -1, -1, 277, 278, 279, - 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, 123, 307, 308, 309, - 310, 311, 312, 313, -1, -1, -1, -1, -1, 305, + -1, -1, -1, -1, -1, -1, -1, 123, -1, 58, + 59, -1, -1, -1, 63, 64, 272, 273, 274, 275, + -1, 308, -1, -1, 311, 312, 313, -1, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, 294, -1, + -1, -1, -1, -1, 93, 302, -1, 304, 305, -1, + 41, 308, -1, 44, 311, 312, 313, -1, -1, 285, + 286, 287, 288, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, 299, 300, 301, 302, 126, 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, 257, 258, - 259, 260, 261, -1, -1, -1, -1, 266, -1, -1, - 269, 270, 271, 272, -1, 91, -1, -1, 277, 278, - 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, -1, 93, 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, 123, 307, 308, - 309, 310, 311, 312, 313, -1, 41, 308, -1, 44, - 311, 312, 313, -1, -1, 256, 257, 258, 259, 260, - 261, -1, -1, 58, 59, 266, -1, -1, 269, 270, - 271, 272, -1, -1, -1, 276, 277, -1, 279, 280, - 281, 282, -1, -1, -1, -1, 287, 288, 289, 290, - 291, 91, -1, 294, 295, 296, -1, 41, 93, -1, - 44, 302, 303, -1, -1, -1, 307, 33, 309, 310, - 36, 37, 38, -1, 40, 59, 42, 43, -1, 45, - -1, 278, -1, 123, -1, -1, 283, 284, 285, 286, - -1, -1, -1, 59, -1, -1, -1, -1, 64, -1, - 297, 298, 299, 300, 301, -1, -1, 304, 305, 93, + 299, 300, 301, 302, 303, 304, 305, -1, 307, 308, + 309, 310, 311, 312, 313, 305, -1, -1, 308, 91, + -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, 123, 298, 299, 300, 301, 302, -1, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 91, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, + 123, 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, 33, 48, 49, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, 59, -1, -1, 285, 286, 64, 288, -1, -1, + 82, -1, -1, 294, 295, -1, 88, 298, 299, 300, + 301, 302, -1, 304, -1, -1, -1, -1, -1, -1, + -1, 33, -1, 91, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 116, -1, -1, -1, -1, -1, + -1, 123, -1, 285, 286, 287, 288, 59, -1, -1, + -1, -1, 64, -1, -1, 123, -1, -1, 126, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -1, -1, -1, -1, -1, 33, -1, 91, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -1, -1, -1, -1, 287, 288, -1, -1, -1, -1, + -1, -1, 184, -1, -1, -1, -1, -1, 64, -1, + -1, 123, 305, -1, 126, 308, -1, -1, 311, 312, + 313, -1, -1, -1, 41, -1, -1, 44, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 26, -1, -1, + 33, 58, 59, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, 42, -1, -1, -1, -1, 47, -1, + 49, -1, -1, -1, -1, -1, -1, 123, -1, -1, + 126, 64, 61, 62, 63, 64, 93, -1, -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, 107, -1, + -1, 289, 290, 291, 292, 293, -1, -1, 296, 297, + 123, -1, -1, 126, 91, 303, -1, -1, -1, 307, + -1, 309, 310, -1, 256, 257, 258, 259, 260, 261, + -1, 263, 264, 265, -1, -1, -1, 269, -1, -1, + 272, 273, 274, 275, -1, -1, 123, 279, 280, -1, + 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, + 292, 293, -1, -1, 296, 297, -1, -1, -1, -1, + 91, 303, -1, -1, -1, 307, -1, 309, 310, -1, + -1, 257, 258, 259, 260, 261, 262, 263, 264, 265, + 41, -1, -1, 269, -1, -1, -1, -1, -1, -1, + -1, -1, 123, -1, 280, -1, 282, 283, 284, -1, + -1, -1, 63, 289, 290, 291, 292, 293, -1, -1, + 296, 297, -1, -1, -1, -1, -1, 303, -1, -1, + -1, 307, -1, 309, 310, 272, 273, 274, 275, -1, + 91, -1, -1, -1, 257, 258, 259, 260, 261, -1, + 263, 264, 265, -1, -1, -1, 269, 294, 295, -1, + -1, -1, -1, -1, -1, -1, -1, 280, -1, 282, + 283, 284, 123, -1, -1, -1, 289, 290, 291, 292, + 293, -1, -1, 296, 297, -1, -1, -1, -1, -1, + 303, -1, -1, -1, 307, 33, 309, 310, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 59, -1, 300, 301, 302, 64, 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, -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, 91, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 64, -1, -1, 123, -1, 285, - 126, -1, -1, 33, -1, -1, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, 123, -1, -1, 305, - -1, 91, 308, -1, -1, 311, 312, 313, -1, 59, - -1, -1, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 123, -1, -1, 126, -1, -1, 33, - -1, 91, 36, 37, 38, -1, 40, -1, 42, 43, - -1, 45, -1, -1, 269, 270, 271, 272, -1, -1, - -1, -1, -1, 283, 284, 285, 286, -1, -1, -1, - 64, -1, -1, -1, -1, -1, 126, 292, 293, -1, - 300, 301, 297, -1, 304, 305, -1, -1, 308, -1, - -1, 311, 312, 313, -1, -1, -1, 91, -1, 41, - -1, -1, 44, -1, -1, 269, 270, 271, 272, -1, - 256, 257, 258, 259, 260, 261, 58, 59, -1, -1, - 266, 63, -1, 269, 270, 271, 272, -1, 292, 123, - 276, 277, 126, 279, 280, 281, 282, -1, -1, -1, - -1, 287, 288, 289, 290, 291, -1, -1, 294, 295, - 296, 93, -1, -1, -1, -1, 302, 303, 285, 286, - -1, 307, -1, 309, 310, -1, -1, 257, 258, 259, - 260, 261, 262, -1, -1, -1, 266, 304, 305, -1, - -1, 308, 91, -1, 311, 312, 313, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, 294, 295, 296, 257, 258, 259, - 260, 261, 302, 303, 123, -1, 266, 307, -1, 309, - 310, -1, -1, -1, -1, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, 294, 295, 296, -1, -1, -1, - -1, -1, 302, 303, -1, -1, -1, 307, 41, 309, - 310, 44, -1, 257, 258, 259, 260, 261, 262, -1, - -1, -1, 266, -1, -1, 58, 59, -1, -1, -1, - 63, -1, -1, 277, -1, 279, 280, 281, 282, -1, - -1, -1, -1, 287, 288, 289, 290, 291, -1, -1, - -1, 295, 296, -1, -1, -1, -1, -1, 302, 303, - 93, -1, -1, 307, 33, 309, 310, 36, 37, 38, - -1, 40, 41, 42, 43, -1, 45, 269, 270, 271, - 272, -1, -1, -1, -1, 91, 278, -1, -1, -1, - -1, -1, -1, -1, -1, 64, -1, -1, -1, -1, - 292, 293, -1, -1, 33, 297, 298, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, 123, -1, -1, - -1, -1, 91, -1, 283, 284, 285, 286, -1, -1, - -1, -1, -1, -1, -1, 64, -1, -1, -1, -1, - -1, 41, 301, -1, 44, 304, 305, -1, -1, 308, - -1, 26, 311, 312, 313, -1, -1, 126, 58, 59, - -1, -1, 91, 33, 93, 40, 36, 37, 38, -1, - 40, 46, 42, 43, -1, 45, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 60, 61, 62, 63, 64, - -1, -1, -1, 93, 64, -1, -1, 126, -1, -1, - -1, -1, -1, 33, -1, -1, 36, 37, 38, -1, - 40, 41, 42, 43, -1, 45, -1, -1, -1, -1, - -1, 91, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 106, -1, -1, 64, -1, 269, 270, 271, 272, - -1, -1, -1, 33, -1, 278, 36, 37, 38, -1, - 40, 41, 42, 43, -1, 45, 126, -1, -1, 292, - 293, 91, -1, -1, 297, 298, 299, 300, 301, -1, - -1, -1, -1, -1, 64, -1, -1, 283, 284, 285, - 286, -1, -1, -1, -1, -1, -1, -1, 257, 258, - 259, 260, 261, -1, -1, -1, 126, 266, 304, 305, - -1, 91, 308, -1, -1, 311, 312, 313, 277, -1, - 279, 280, 281, 282, -1, 91, -1, -1, 287, 288, - 289, 290, 291, -1, -1, 294, 295, 296, 257, 258, - 259, 260, 261, 302, 303, -1, 126, 266, 307, -1, - 309, 310, -1, -1, -1, -1, -1, 123, 277, -1, - 279, 280, 281, 282, -1, -1, -1, -1, 287, 288, - 289, 290, 291, -1, -1, 294, 295, 296, -1, 269, - 270, 271, 272, 302, 303, -1, -1, -1, 307, -1, - 309, 310, -1, -1, -1, -1, 256, 257, 258, 259, - 260, 261, 292, 293, -1, -1, 266, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, 294, 295, 296, 257, 258, 259, - 260, 261, 302, 303, -1, -1, 266, 307, -1, 309, - 310, -1, -1, -1, -1, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, 91, 294, 295, 296, 257, 258, 259, - 260, 261, 302, 303, -1, -1, 266, 307, -1, 309, - 310, -1, -1, -1, -1, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, 123, -1, 287, 288, 289, - 290, 291, -1, -1, 294, 295, 296, -1, -1, 285, - 286, -1, 302, 303, -1, -1, -1, 307, 33, 309, - 310, 36, 37, 38, -1, 40, 41, 42, 43, 305, - 45, -1, 308, -1, -1, 311, 312, 313, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, 41, 42, 43, -1, - 45, -1, -1, -1, -1, -1, 91, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, -1, 42, 43, -1, - 45, 126, -1, -1, -1, -1, 91, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, -1, 42, 43, -1, - 45, 126, -1, -1, -1, 283, 91, 285, 286, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, -1, -1, -1, -1, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, -1, -1, 123, -1, - -1, 126, -1, -1, -1, -1, 91, -1, -1, -1, - -1, -1, -1, 33, -1, -1, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, -1, 25, 26, -1, - -1, -1, -1, -1, -1, -1, 34, -1, -1, -1, - -1, 126, 40, 41, 64, -1, -1, -1, 46, -1, - -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, - -1, 266, 60, 61, 62, 63, 64, -1, -1, -1, - -1, 91, 277, -1, 279, 280, 281, 282, -1, -1, - -1, -1, 287, 288, 289, 290, 291, -1, -1, 294, - 295, 296, 257, 258, 259, 260, 261, 302, 303, -1, - -1, 266, 307, 123, 309, 310, 126, -1, 106, -1, - -1, -1, 277, -1, 279, 280, 281, 282, -1, -1, - -1, -1, 287, 288, 289, 290, 291, -1, -1, 294, - 295, 296, 257, 258, 259, 260, 261, 302, 303, -1, - -1, 266, 307, -1, 309, 310, -1, -1, -1, -1, - -1, -1, 277, -1, 279, 280, 281, 282, -1, -1, - -1, -1, 287, 288, 289, 290, 291, -1, -1, 167, - 295, 296, 257, 258, 259, 260, 261, 302, 303, -1, - -1, 266, 307, 91, 309, 310, -1, -1, -1, -1, - 41, -1, 277, 44, 279, 280, 281, 282, -1, -1, - -1, -1, 287, 288, 289, 290, 291, 58, 59, 294, - 295, 296, -1, -1, -1, 123, -1, 302, 303, -1, - -1, -1, 307, 33, 309, 310, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, -1, 257, 258, 259, - 260, 261, 93, -1, -1, -1, 266, -1, -1, -1, - -1, -1, -1, -1, 64, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, 41, 295, 296, 44, -1, -1, - -1, 91, 302, 303, -1, -1, -1, 307, -1, 309, - 310, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, 33, -1, 91, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 285, 286, 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 126, -1, -1, 41, - -1, -1, 44, -1, 91, -1, 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, -1, -1, - -1, -1, -1, -1, 41, -1, -1, 44, -1, 91, - -1, 93, -1, -1, -1, 283, 284, 285, 286, -1, - -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, - 298, 299, 300, 301, -1, -1, 304, 305, -1, -1, - 308, 123, -1, 311, 312, 313, -1, -1, -1, 41, - -1, -1, 44, -1, 91, -1, 93, -1, 269, 270, - 271, 272, -1, -1, -1, -1, 58, 59, -1, -1, - -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 292, 293, -1, -1, -1, 123, 257, 258, 259, - 260, 261, -1, -1, -1, -1, 266, -1, -1, -1, - -1, 93, -1, -1, -1, -1, -1, 277, -1, 279, - 280, 281, 282, -1, -1, -1, -1, 287, 288, 289, - 290, 291, -1, -1, -1, 295, 296, -1, -1, -1, - 41, 123, 302, 303, -1, -1, -1, 307, -1, 309, - 310, -1, 269, 270, 271, 272, -1, 58, 59, -1, - -1, 278, 63, -1, -1, -1, 283, 284, 285, 286, - -1, -1, -1, -1, -1, 292, 293, -1, -1, -1, - 297, 298, 299, 300, 301, -1, 41, 304, 305, 44, - 91, 308, 93, -1, 311, 312, 313, 269, 270, 271, - 272, -1, -1, 58, 59, -1, 278, -1, 63, -1, - -1, 283, 284, 285, 286, -1, -1, -1, -1, -1, - 292, 293, 123, -1, -1, 297, 298, 299, 300, 301, - -1, 41, 304, 305, 44, -1, 308, -1, 93, 311, - 312, 313, 269, 270, 271, 272, -1, -1, 58, 59, - -1, 278, -1, 63, -1, -1, 283, 284, 285, 286, - -1, -1, -1, -1, -1, 292, 293, -1, 123, -1, - 297, 298, 299, 300, 301, -1, 41, 304, 305, 44, - -1, 308, -1, 93, 311, 312, 313, 269, 270, 271, - 272, -1, -1, 58, 59, -1, 278, -1, 63, -1, - -1, 283, 284, 285, 286, -1, -1, -1, -1, -1, - 292, 293, -1, 123, -1, 297, 298, 299, 300, 301, - -1, -1, 304, 305, 41, -1, 308, -1, 93, 311, - 312, 313, -1, -1, 41, -1, -1, 44, -1, -1, - -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, - -1, 58, 59, -1, -1, -1, -1, -1, 123, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 269, 270, - 271, 272, 41, -1, 91, 44, 93, 278, -1, -1, - -1, -1, 283, 284, 285, 286, 93, -1, -1, 58, - 59, 292, 293, -1, 63, -1, 297, 298, 299, 300, - 301, -1, -1, 304, 305, -1, 123, 308, -1, -1, - 311, 312, 313, -1, 269, 270, 271, 272, 41, -1, - -1, 44, -1, 278, 93, -1, -1, -1, 283, 284, - 285, 286, -1, -1, -1, 58, 59, 292, 293, -1, - 63, -1, 297, 298, 299, 300, 301, -1, -1, 304, - 305, -1, -1, 308, 123, -1, 311, 312, 313, 269, - 270, 271, 272, 41, -1, -1, 44, -1, 278, -1, - 93, -1, -1, 283, 284, 285, 286, -1, -1, -1, - 58, 59, 292, 293, -1, 63, -1, 297, 298, 299, - 300, 301, -1, -1, 304, 305, -1, -1, 308, -1, - -1, 311, 312, 313, 269, 270, 271, 272, 41, -1, - -1, 44, -1, 278, -1, 93, -1, -1, 283, 284, - 285, 286, -1, -1, -1, 58, 59, 292, 293, -1, - 63, -1, 297, 298, 299, 300, 301, -1, -1, 304, + -1, -1, 64, 304, 305, -1, -1, 308, 126, -1, + 311, 312, 313, -1, -1, -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, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, 64, -1, + -1, 123, -1, -1, 126, -1, -1, 298, 299, 300, + 301, 302, -1, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, -1, -1, 91, -1, -1, -1, -1, + 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 126, 64, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 257, + 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, + 93, 269, -1, -1, -1, 91, -1, -1, -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, 126, -1, 303, -1, 123, -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, 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, -1, -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, -1, 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, 287, 288, 296, 297, 64, -1, -1, -1, -1, + 303, -1, -1, -1, 307, -1, 309, 310, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, -1, -1, + 33, -1, 91, 36, 37, 38, -1, 40, 41, 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, + 285, -1, 287, 288, -1, -1, 33, -1, 91, 36, + 37, 38, -1, 40, 41, 42, 43, -1, 45, 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, - -1, -1, 269, 270, 271, 272, 41, -1, -1, 44, - 93, 278, 269, 270, 271, 272, 283, 284, 285, 286, - -1, -1, -1, 58, 59, 292, 293, -1, 63, -1, - 297, 298, 299, 300, 301, 292, 293, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, -1, -1, - 269, 270, 271, 272, 41, -1, -1, -1, 93, 278, - -1, -1, -1, -1, 283, 284, 285, 286, -1, -1, - -1, -1, -1, 292, 293, -1, 63, -1, 297, 298, - 299, 300, 301, -1, -1, 304, 305, -1, -1, 308, - -1, -1, 311, 312, 313, -1, 269, 270, 271, 272, - 41, -1, -1, 44, 91, 278, -1, -1, -1, -1, - 283, 284, 285, 286, -1, -1, -1, 58, 59, 292, - 293, -1, 63, -1, 297, 298, 299, 300, 301, -1, - -1, 304, 305, -1, -1, 308, 123, -1, 311, 312, - 313, 269, 270, 271, 272, 41, -1, -1, 44, -1, - 278, -1, 93, -1, -1, 283, 284, 285, 286, -1, - -1, -1, 58, 59, 292, 293, -1, 63, -1, 297, - 298, 299, 300, 301, -1, -1, 304, 305, -1, -1, - 308, -1, -1, 311, 312, 313, 269, 270, 271, 272, - 41, -1, -1, 44, -1, 278, -1, 93, -1, -1, - 283, 284, 285, 286, -1, -1, -1, 58, 59, 292, - 293, -1, 63, -1, 297, 298, 299, 300, 301, -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, -1, -1, -1, -1, -1, 126, + 64, -1, -1, -1, -1, -1, -1, -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, -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, 41, 42, 43, -1, 45, 280, -1, 282, 283, + 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, 64, -1, 25, 26, -1, 303, + -1, -1, -1, 307, -1, 309, 310, -1, 37, -1, + -1, -1, -1, 42, 43, -1, -1, -1, 47, 33, + 49, 91, 36, 37, 38, -1, 40, -1, 42, 43, + -1, 45, 61, 62, 63, 64, -1, -1, -1, -1, + -1, -1, -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, + 285, 286, 287, 288, -1, -1, -1, 91, 107, 294, + 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, + 305, -1, 41, 308, -1, 44, 311, 312, 313, -1, + -1, -1, -1, 41, -1, -1, 44, -1, -1, 58, + 59, -1, 126, 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, 167, 298, + 299, 300, 301, 302, 93, 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, 282, 283, 284, -1, -1, -1, -1, 289, + 290, 291, 292, 293, -1, -1, 296, 297, -1, -1, + -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, + -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, 93, -1, 303, + 41, -1, -1, 307, -1, 309, 310, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, 123, -1, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, + -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, + 91, -1, 93, 281, -1, 294, 295, 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, 123, 311, 312, 313, -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, 41, 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, 312, - 313, -1, -1, -1, 269, 270, 271, 272, 41, -1, - -1, 44, 93, 278, -1, -1, -1, -1, 283, 284, - 285, 286, -1, -1, -1, 58, 59, 292, 293, -1, - 63, -1, 297, 298, 299, 300, 301, -1, -1, 304, - 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, - -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, - 93, 278, -1, -1, -1, -1, 283, 284, 285, 286, + 313, 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, -1, -1, -1, 91, -1, 93, -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, -1, 123, -1, 294, 295, + -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, + 41, -1, 308, 44, -1, 311, 312, 313, -1, -1, + -1, 41, -1, -1, 44, -1, -1, 58, 59, -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, 93, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, 93, 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, 123, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, 123, -1, 285, 286, + 287, 288, -1, -1, -1, 41, -1, 294, 295, 93, + -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, 123, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, 91, -1, 93, -1, -1, + -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, 123, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, 93, + -1, 281, -1, 294, 295, 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, -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, + -1, 308, -1, -1, 311, 312, 313, 93, 272, 273, + 274, 275, -1, -1, -1, 41, -1, 281, 44, -1, + -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, + 294, 295, 58, 59, 298, 299, 300, 301, 302, -1, + 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, 281, -1, 93, -1, 285, + 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, + -1, 63, 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, 91, + -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, 311, 312, 313, + -1, 123, -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, 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, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, -1, -1, 294, 295, + -1, -1, 93, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 41, -1, -1, 44, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, 93, + -1, 58, 59, -1, -1, -1, 63, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, 41, -1, -1, 44, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 93, -1, -1, 58, + 59, -1, -1, -1, 63, -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, 93, -1, 298, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -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, 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, 272, 273, + 274, 275, -1, 93, -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, 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, -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, -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, + 41, -1, -1, 44, -1, -1, -1, -1, 93, -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, -1, -1, 298, 299, + 300, 301, 302, 41, 304, 305, 44, -1, -1, -1, + -1, -1, 93, -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, - 297, 298, 299, 300, 301, -1, -1, 304, 305, -1, - -1, 308, -1, -1, 311, 312, 313, -1, 269, 270, - 271, 272, -1, 58, -1, 93, -1, 278, 63, -1, - -1, -1, 283, 284, 285, 286, -1, -1, -1, -1, - -1, 292, 293, -1, -1, -1, 297, 298, 299, 300, - 301, -1, 41, 304, 305, 44, 91, 308, -1, -1, - -1, -1, -1, 269, 270, 271, 272, -1, -1, 58, - 59, -1, 278, -1, 63, -1, -1, 283, 284, 285, - 286, -1, -1, -1, -1, -1, 292, 293, 123, -1, - -1, 297, 298, 299, 300, 301, -1, 41, 304, 305, - 44, -1, 308, -1, 93, -1, -1, -1, 269, 270, - 271, 272, -1, -1, 58, 59, -1, 278, -1, 63, - -1, -1, 283, 284, 285, 286, -1, -1, -1, -1, - -1, 292, 293, -1, -1, -1, 297, 298, 299, 300, - 301, -1, -1, 304, 305, 41, -1, -1, 44, 93, - -1, -1, -1, -1, -1, -1, 269, 270, 271, 272, - -1, -1, 58, 59, -1, 278, -1, 63, -1, -1, - 283, 284, 285, 286, -1, -1, -1, -1, -1, 292, - 293, -1, -1, -1, 297, 298, 299, 300, 301, -1, - 41, 304, 305, 44, -1, -1, -1, 93, -1, -1, - -1, 269, 270, 271, 272, -1, -1, 58, 59, -1, - 278, -1, 63, -1, -1, 283, 284, 285, 286, -1, - -1, -1, -1, -1, 292, 293, -1, -1, -1, 297, - 298, 299, 300, 301, -1, 41, 304, 305, 44, -1, - -1, -1, 93, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 58, 59, -1, -1, -1, 63, -1, -1, - -1, -1, 297, 298, 299, 300, 301, -1, -1, 304, - 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, - 269, 270, 271, 272, -1, -1, -1, 93, -1, 278, - 63, -1, -1, -1, 283, 284, 285, 286, -1, -1, - -1, -1, -1, 292, 293, -1, -1, -1, 297, 298, - 299, 300, 301, -1, 41, 304, 305, 44, 91, -1, - -1, -1, -1, -1, -1, 269, 270, 271, 272, -1, - -1, 58, 59, -1, 278, -1, 63, -1, -1, 283, - 284, 285, 286, -1, -1, -1, -1, -1, 292, 293, - 123, -1, -1, 297, 298, 299, 300, 301, -1, -1, - 304, 305, 41, -1, -1, 44, 93, -1, -1, -1, - -1, -1, -1, 269, 270, 271, 272, -1, -1, 58, - 59, -1, 278, -1, 63, -1, -1, 283, 284, 285, - 286, -1, -1, -1, -1, -1, 292, 293, -1, -1, - -1, 297, 298, 299, 300, 301, -1, 41, 304, 305, - 44, -1, -1, -1, 93, -1, -1, -1, 269, 270, - 271, 272, -1, -1, 58, 59, -1, 278, -1, 63, - -1, -1, 283, 284, 285, 286, -1, -1, -1, -1, - -1, 292, 293, -1, -1, -1, 297, 298, 299, 300, - 301, -1, 41, 304, 305, 44, -1, -1, -1, 93, - -1, -1, -1, 269, 270, 271, 272, -1, -1, 58, - 59, -1, 278, -1, 63, -1, -1, 283, 284, 285, - 286, -1, -1, -1, -1, 41, 292, 293, 44, -1, - -1, 297, 298, 299, 300, 301, -1, -1, 304, -1, - -1, -1, 58, 59, 93, 278, -1, 63, -1, -1, - 283, 284, 285, 286, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 297, 298, 299, 300, 301, -1, - 41, 304, 305, 44, -1, 308, -1, 93, 311, 312, - 313, -1, 269, 270, 271, 272, 41, 58, 59, 44, - -1, 278, 63, -1, -1, -1, 283, 284, -1, 286, - -1, -1, -1, 58, 59, 292, 293, -1, 63, -1, - 297, 298, 299, 300, 301, -1, -1, 304, 41, -1, - -1, 44, 93, -1, -1, -1, -1, -1, -1, -1, - 269, 270, 271, 272, 41, 58, 59, 44, 93, 278, - 63, -1, -1, -1, 283, 284, -1, -1, -1, -1, - -1, 58, 59, 292, 293, -1, 63, -1, 297, 298, - 299, 300, 301, -1, -1, 304, -1, -1, -1, -1, - 93, -1, -1, -1, -1, 269, 270, 271, 272, 41, - -1, -1, 44, -1, 278, -1, 93, -1, -1, 283, - 284, -1, -1, -1, -1, -1, 58, 59, 292, 293, - -1, 63, -1, 297, 298, 299, 300, 301, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 63, -1, - 269, 270, 271, 272, -1, -1, -1, -1, -1, 278, - -1, 93, -1, -1, 283, 284, -1, -1, -1, -1, - -1, -1, -1, 292, 293, -1, 91, -1, 297, 298, - 299, 300, 301, 269, 270, 271, 272, -1, -1, -1, - -1, -1, 278, -1, -1, -1, -1, 283, 284, -1, - -1, -1, -1, -1, -1, -1, 292, 293, 123, -1, - -1, 297, 298, 299, 300, 301, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 269, 270, - 271, 272, -1, -1, -1, -1, -1, 278, -1, -1, - -1, -1, 283, 284, 269, 270, 271, 272, -1, -1, - -1, 292, 293, 278, -1, -1, 297, 298, 299, 300, - 301, -1, -1, -1, -1, -1, -1, 292, 293, -1, - -1, -1, 297, 298, 299, 300, 269, 270, 271, 272, - -1, -1, -1, -1, -1, 278, -1, -1, -1, -1, - -1, 284, 269, 270, 271, 272, -1, -1, -1, 292, - 293, 278, -1, -1, 297, 298, 299, 300, 301, -1, - -1, -1, -1, -1, -1, 292, 293, -1, -1, -1, - 297, 298, 299, 300, 301, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 35, -1, 269, 270, 271, - 272, 41, 42, -1, -1, -1, 278, -1, 48, 49, - 50, 51, 52, 53, 54, -1, -1, 57, 58, -1, - 292, 293, -1, 278, -1, 297, 298, 299, 283, 284, - 285, 286, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 298, 299, 300, 301, -1, -1, 304, - 305, 91, -1, 308, -1, -1, 311, 312, 313, -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, 41, -1, -1, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 93, -1, 58, 59, -1, -1, -1, 63, -1, + -1, -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, 93, -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, -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, 93, 298, 299, 300, + 301, 302, 41, 304, 305, 44, -1, -1, -1, -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, -1, -1, + 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, + 272, 273, 274, 275, 93, -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, -1, 44, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, 58, 59, + 285, 286, -1, 63, -1, -1, -1, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, 302, 41, 304, + -1, 44, -1, -1, -1, -1, -1, -1, 41, -1, + -1, 44, -1, 93, -1, 58, 59, -1, -1, -1, + 63, -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, + 93, -1, -1, -1, -1, 272, 273, 274, 275, -1, + 93, 58, 59, -1, 281, -1, 63, -1, 285, 286, + -1, -1, -1, -1, -1, -1, 41, 294, 295, 44, + -1, 298, 299, 300, 301, 302, 41, -1, -1, 44, + -1, -1, -1, 58, 59, -1, 93, -1, 63, -1, + -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, 58, + -1, -1, 281, -1, 63, -1, 285, 286, 93, -1, + -1, -1, -1, -1, -1, 294, 295, -1, 93, 298, + 299, 300, 301, 302, -1, -1, -1, -1, -1, -1, + -1, -1, 91, -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, 123, -1, -1, -1, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, -1, -1, 285, 286, -1, -1, -1, + -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, + 300, 301, 302, -1, -1, -1, -1, -1, -1, 272, + 273, 274, 275, -1, -1, -1, -1, -1, 281, 272, + 273, 274, 275, 286, -1, -1, -1, -1, 281, -1, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 294, 295, -1, + -1, 298, 299, 300, 301, 302, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, -1, -1, 294, + 295, -1, 281, 298, 299, 300, 285, 286, 287, 288, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 298, + 299, 300, 301, 302, -1, 304, 305, 30, -1, 308, + -1, -1, 311, 312, 313, 38, -1, -1, -1, -1, + 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, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 90, -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, 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, + 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, @@ -1021,10 +1107,11 @@ dEXT short yycheck[] = { 13, -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, 253, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 256, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 281, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 284, }; #define YYFINAL 1 #ifndef YYDEBUG @@ -1041,13 +1128,13 @@ dEXT char * yyname[] = { 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,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING", -"PMFUNC","PRIVATEREF","LABEL","FORMAT","SUB","ANONSUB","PACKAGE","USE","WHILE", -"UNTIL","IF","UNLESS","ELSE","ELSIF","CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0", -"FUNC1","FUNC","FUNC0SUB","RELOP","EQOP","MULOP","ADDOP","DOLSHARP","DO", -"LOCAL","HASHBRACK","NOAMP","OROP","ANDOP","NOTOP","LSTOP","LSTOPSUB", -"ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP","UNIOPSUB","SHIFTOP", -"MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC","POSTDEC", -"ARROW", +"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", +"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP", +"SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC", +"POSTDEC","ARROW", }; dEXT char * yyrule[] = { "$accept : prog", @@ -1104,10 +1191,9 @@ dEXT char * yyrule[] = { "startsub :", "package : PACKAGE WORD ';'", "package : PACKAGE ';'", -"use : USE WORD listexpr ';'", +"use : USE startsub WORD listexpr ';'", "expr : expr ANDOP expr", "expr : expr OROP expr", -"expr : NOTOP expr", "expr : argexpr", "argexpr : argexpr ','", "argexpr : argexpr ',' term", @@ -1154,6 +1240,7 @@ dEXT char * yyrule[] = { "term : HASHBRACK ';' '}'", "term : ANONSUB startsub proto block", "term : scalar", +"term : star '{' expr ';' '}'", "term : star", "term : scalar '[' expr ']'", "term : term ARROW '[' expr ']'", @@ -1181,6 +1268,7 @@ dEXT char * yyrule[] = { "term : DO scalar '(' expr ')'", "term : LOOPEX", "term : LOOPEX term", +"term : NOTOP argexpr", "term : UNIOP", "term : UNIOP block", "term : UNIOP term", @@ -1231,9 +1319,9 @@ dEXT int yyerrflag; dEXT int yychar; dEXT YYSTYPE yyval; dEXT YYSTYPE yylval; -#line 562 "perly.y" +#line 572 "perly.y" /* PROGRAM */ -#line 1307 "y.tab.c" +#line 1394 "y_tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1458,7 +1546,7 @@ yyreduce: switch (yyn) { case 1: -#line 83 "perly.y" +#line 84 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (debug & 1); @@ -1467,38 +1555,38 @@ case 1: } break; case 2: -#line 90 "perly.y" +#line 91 "perly.y" { newPROG(yyvsp[0].opval); } break; case 3: -#line 94 "perly.y" +#line 95 "perly.y" { yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); } break; case 4: -#line 98 "perly.y" +#line 99 "perly.y" { yyval.ival = block_start(); } break; case 5: -#line 102 "perly.y" +#line 103 "perly.y" { yyval.opval = Nullop; } break; case 6: -#line 104 "perly.y" +#line 105 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 7: -#line 106 "perly.y" +#line 107 "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 113 "perly.y" +#line 114 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 10: -#line 116 "perly.y" +#line 117 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } @@ -1509,120 +1597,120 @@ case 10: expect = XSTATE; } break; case 11: -#line 125 "perly.y" +#line 126 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); expect = XSTATE; } break; case 12: -#line 130 "perly.y" +#line 131 "perly.y" { yyval.opval = Nullop; } break; case 13: -#line 132 "perly.y" +#line 133 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 14: -#line 134 "perly.y" +#line 135 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 15: -#line 136 "perly.y" +#line 137 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 16: -#line 138 "perly.y" +#line 139 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 17: -#line 140 "perly.y" +#line 141 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} break; case 18: -#line 144 "perly.y" +#line 145 "perly.y" { yyval.opval = Nullop; } break; case 19: -#line 146 "perly.y" +#line 147 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 20: -#line 148 "perly.y" +#line 149 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, 0, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); hints |= HINT_BLOCK_SCOPE; } break; case 21: -#line 155 "perly.y" +#line 156 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 22: -#line 158 "perly.y" +#line 159 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 23: -#line 162 "perly.y" +#line 163 "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 166 "perly.y" +#line 167 "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 173 "perly.y" +#line 174 "perly.y" { yyval.opval = Nullop; } break; case 26: -#line 175 "perly.y" +#line 176 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 27: -#line 179 "perly.y" +#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) ); } break; case 28: -#line 184 "perly.y" +#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) ); } break; case 29: -#line 189 "perly.y" +#line 190 "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 194 "perly.y" +#line 195 "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 199 "perly.y" +#line 200 "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 202 "perly.y" +#line 203 "perly.y" { yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 33: -#line 205 "perly.y" +#line 206 "perly.y" { copline = yyvsp[-8].ival; yyval.opval = append_elem(OP_LINESEQ, newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)), @@ -1631,336 +1719,336 @@ case 33: scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); } break; case 34: -#line 212 "perly.y" +#line 213 "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 218 "perly.y" +#line 219 "perly.y" { yyval.opval = Nullop; } break; case 37: -#line 223 "perly.y" +#line 224 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 39: -#line 228 "perly.y" +#line 229 "perly.y" { yyval.pval = Nullch; } break; case 41: -#line 233 "perly.y" +#line 234 "perly.y" { yyval.ival = 0; } break; case 42: -#line 235 "perly.y" +#line 236 "perly.y" { yyval.ival = 0; } break; case 43: -#line 237 "perly.y" +#line 238 "perly.y" { yyval.ival = 0; } break; case 44: -#line 239 "perly.y" +#line 240 "perly.y" { yyval.ival = 0; } break; case 45: -#line 243 "perly.y" +#line 244 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 46: -#line 245 "perly.y" +#line 246 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; case 47: -#line 249 "perly.y" +#line 250 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 48: -#line 251 "perly.y" +#line 252 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; } break; case 49: -#line 255 "perly.y" +#line 256 "perly.y" { yyval.opval = Nullop; } break; case 51: -#line 260 "perly.y" +#line 261 "perly.y" { yyval.ival = start_subparse(); } break; case 52: -#line 264 "perly.y" +#line 265 "perly.y" { package(yyvsp[-1].opval); } break; case 53: -#line 266 "perly.y" +#line 267 "perly.y" { package(Nullop); } break; case 54: -#line 270 "perly.y" -{ utilize(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); } +#line 271 "perly.y" +{ utilize(yyvsp[-4].ival, yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 55: -#line 274 "perly.y" +#line 275 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 56: -#line 276 "perly.y" +#line 277 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 57: -#line 278 "perly.y" -{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } -break; -case 59: -#line 283 "perly.y" +case 58: +#line 282 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; -case 60: -#line 285 "perly.y" +case 59: +#line 284 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 62: -#line 290 "perly.y" +case 61: +#line 289 "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 63: -#line 293 "perly.y" +case 62: +#line 292 "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 64: -#line 296 "perly.y" +case 63: +#line 295 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; -case 65: -#line 301 "perly.y" +case 64: +#line 300 "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 66: -#line 306 "perly.y" +case 65: +#line 305 "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 67: -#line 311 "perly.y" +case 66: +#line 310 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 68: -#line 313 "perly.y" +case 67: +#line 312 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; -case 69: -#line 315 "perly.y" +case 68: +#line 314 "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].ival)); } + yyvsp[-3].opval)); } break; -case 72: -#line 326 "perly.y" +case 71: +#line 325 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; -case 73: -#line 328 "perly.y" +case 72: +#line 327 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; -case 74: -#line 330 "perly.y" +case 73: +#line 329 "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" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; case 75: -#line 334 "perly.y" +#line 335 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 76: -#line 336 "perly.y" +#line 337 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 77: -#line 338 "perly.y" +#line 339 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 78: -#line 340 "perly.y" +#line 341 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 79: -#line 342 "perly.y" +#line 343 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 80: -#line 344 "perly.y" -{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } -break; -case 81: -#line 346 "perly.y" +#line 345 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; -case 82: -#line 348 "perly.y" +case 81: +#line 347 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 83: -#line 350 "perly.y" +case 82: +#line 349 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 84: -#line 352 "perly.y" +case 83: +#line 351 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 85: -#line 354 "perly.y" +case 84: +#line 353 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; -case 86: -#line 357 "perly.y" +case 85: +#line 356 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; -case 87: -#line 359 "perly.y" +case 86: +#line 358 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 88: -#line 361 "perly.y" +case 87: +#line 360 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; -case 89: -#line 363 "perly.y" +case 88: +#line 362 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; -case 90: -#line 365 "perly.y" +case 89: +#line 364 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; -case 91: -#line 367 "perly.y" +case 90: +#line 366 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; -case 92: -#line 370 "perly.y" +case 91: +#line 369 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; -case 93: -#line 373 "perly.y" +case 92: +#line 372 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; -case 94: -#line 376 "perly.y" +case 93: +#line 375 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; -case 95: -#line 379 "perly.y" +case 94: +#line 378 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; -case 96: -#line 381 "perly.y" +case 95: +#line 380 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; -case 97: -#line 383 "perly.y" +case 96: +#line 382 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; -case 98: -#line 385 "perly.y" +case 97: +#line 384 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; -case 99: -#line 387 "perly.y" +case 98: +#line 386 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; -case 100: -#line 389 "perly.y" +case 99: +#line 388 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; -case 101: -#line 391 "perly.y" +case 100: +#line 390 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; -case 102: -#line 393 "perly.y" +case 101: +#line 392 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; -case 103: -#line 395 "perly.y" +case 102: +#line 394 "perly.y" { yyval.opval = yyvsp[0].opval; } break; +case 103: +#line 396 "perly.y" +{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } +break; case 104: -#line 397 "perly.y" +#line 398 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 105: -#line 399 "perly.y" +#line 400 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 106: -#line 401 "perly.y" +#line 402 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 107: -#line 405 "perly.y" +#line 406 "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 409 "perly.y" +#line 410 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 109: -#line 411 "perly.y" +#line 412 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 110: -#line 413 "perly.y" +#line 414 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 111: -#line 415 "perly.y" +#line 416 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 112: -#line 418 "perly.y" +#line 419 "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 423 "perly.y" +#line 424 "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 428 "perly.y" +#line 429 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 115: -#line 430 "perly.y" +#line 431 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 116: -#line 432 "perly.y" +#line 433 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1968,7 +2056,7 @@ case 116: ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 117: -#line 438 "perly.y" +#line 439 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1977,13 +2065,12 @@ case 117: expect = XOPERATOR; } break; case 118: -#line 445 "perly.y" +#line 446 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 119: -#line 447 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, 0, - scalar(yyvsp[0].opval)); } +#line 448 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 120: #line 450 "perly.y" @@ -1998,7 +2085,7 @@ case 122: #line 455 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, - yyvsp[0].opval, newCVREF(scalar(yyvsp[-1].opval)))); } + yyvsp[0].opval, newCVREF(0,scalar(yyvsp[-1].opval)))); } break; case 123: #line 459 "perly.y" @@ -2010,146 +2097,158 @@ case 124: break; case 125: #line 463 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop)); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-2].opval) + )),Nullop)); dep();} break; case 126: -#line 467 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, +#line 471 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, - scalar(newCVREF(scalar(yyvsp[-3].opval))))); dep();} + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-3].opval) + )))); dep();} break; case 127: -#line 472 "perly.y" +#line 480 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop)); dep();} + scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 128: -#line 476 "perly.y" +#line 484 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, - scalar(newCVREF(scalar(yyvsp[-3].opval))))); dep();} + scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 129: -#line 481 "perly.y" +#line 489 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } break; case 130: -#line 484 "perly.y" +#line 492 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 131: -#line 486 "perly.y" -{ yyval.opval = newOP(yyvsp[0].ival, 0); } +#line 494 "perly.y" +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 132: -#line 488 "perly.y" -{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } +#line 496 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 133: -#line 490 "perly.y" +#line 498 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 134: -#line 492 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].ival))); } +#line 500 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 135: -#line 495 "perly.y" -{ yyval.opval = newOP(yyvsp[0].ival, 0); } +#line 502 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 136: -#line 497 "perly.y" -{ yyval.opval = newOP(yyvsp[-2].ival, 0); } +#line 505 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 137: -#line 499 "perly.y" -{ yyval.opval = newUNOP(OP_ENTERSUB, 0, - scalar(yyvsp[0].ival)); } +#line 507 "perly.y" +{ yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 138: -#line 502 "perly.y" -{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } +#line 509 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, 0, + scalar(yyvsp[0].opval)); } break; case 139: -#line 504 "perly.y" -{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } +#line 512 "perly.y" +{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 140: -#line 506 "perly.y" -{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } +#line 514 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 141: -#line 508 "perly.y" -{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } +#line 516 "perly.y" +{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; -case 144: -#line 514 "perly.y" -{ yyval.opval = Nullop; } +case 142: +#line 518 "perly.y" +{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 145: -#line 516 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 524 "perly.y" +{ yyval.opval = Nullop; } break; case 146: -#line 520 "perly.y" -{ yyval.opval = Nullop; } +#line 526 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 147: -#line 522 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 530 "perly.y" +{ yyval.opval = Nullop; } break; case 148: -#line 524 "perly.y" -{ yyval.opval = yyvsp[-1].opval; } +#line 532 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 149: -#line 528 "perly.y" -{ yyval.opval = newCVREF(yyvsp[0].opval); } +#line 534 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } break; case 150: -#line 532 "perly.y" -{ yyval.opval = newSVREF(yyvsp[0].opval); } +#line 538 "perly.y" +{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 151: -#line 536 "perly.y" -{ yyval.opval = newAVREF(yyvsp[0].opval); } +#line 542 "perly.y" +{ yyval.opval = newSVREF(yyvsp[0].opval); } break; case 152: -#line 540 "perly.y" -{ yyval.opval = newHVREF(yyvsp[0].opval); } +#line 546 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } break; case 153: -#line 544 "perly.y" -{ yyval.opval = newAVREF(yyvsp[0].opval); } +#line 550 "perly.y" +{ yyval.opval = newHVREF(yyvsp[0].opval); } break; case 154: -#line 548 "perly.y" -{ yyval.opval = newGVREF(0,yyvsp[0].opval); } +#line 554 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } break; case 155: -#line 552 "perly.y" -{ yyval.opval = scalar(yyvsp[0].opval); } +#line 558 "perly.y" +{ yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 156: -#line 554 "perly.y" -{ yyval.opval = scalar(yyvsp[0].opval); } +#line 562 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } break; case 157: -#line 556 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } +#line 564 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } break; case 158: -#line 559 "perly.y" +#line 566 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } +break; +case 159: +#line 569 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2139 "y.tab.c" +#line 2237 "y_tab.c" } yyssp -= yym; yystate = *yyssp; diff --git a/vms/perly_h.vms b/vms/perly_h.vms index 17a3769ef4..c6ec3a41ad 100644 --- a/vms/perly_h.vms +++ b/vms/perly_h.vms @@ -1,50 +1,51 @@ +/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */ #define WORD 257 #define METHOD 258 #define FUNCMETH 259 #define THING 260 #define PMFUNC 261 #define PRIVATEREF 262 -#define LABEL 263 -#define FORMAT 264 -#define SUB 265 -#define ANONSUB 266 -#define PACKAGE 267 -#define USE 268 -#define WHILE 269 -#define UNTIL 270 -#define IF 271 -#define UNLESS 272 -#define ELSE 273 -#define ELSIF 274 -#define CONTINUE 275 -#define FOR 276 -#define LOOPEX 277 -#define DOTDOT 278 -#define FUNC0 279 -#define FUNC1 280 -#define FUNC 281 -#define FUNC0SUB 282 -#define RELOP 283 -#define EQOP 284 -#define MULOP 285 -#define ADDOP 286 -#define DOLSHARP 287 -#define DO 288 -#define LOCAL 289 -#define HASHBRACK 290 -#define NOAMP 291 -#define OROP 292 -#define ANDOP 293 -#define NOTOP 294 -#define LSTOP 295 -#define LSTOPSUB 296 -#define ASSIGNOP 297 -#define OROR 298 -#define ANDAND 299 -#define BITOROP 300 -#define BITANDOP 301 -#define UNIOP 302 -#define UNIOPSUB 303 +#define FUNC0SUB 263 +#define UNIOPSUB 264 +#define LSTOPSUB 265 +#define LABEL 266 +#define FORMAT 267 +#define SUB 268 +#define ANONSUB 269 +#define PACKAGE 270 +#define USE 271 +#define WHILE 272 +#define UNTIL 273 +#define IF 274 +#define UNLESS 275 +#define ELSE 276 +#define ELSIF 277 +#define CONTINUE 278 +#define FOR 279 +#define LOOPEX 280 +#define DOTDOT 281 +#define FUNC0 282 +#define FUNC1 283 +#define FUNC 284 +#define RELOP 285 +#define EQOP 286 +#define MULOP 287 +#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 diff --git a/vms/sockadapt.c b/vms/sockadapt.c index 69f5def785..08251d6bdf 100644 --- a/vms/sockadapt.c +++ b/vms/sockadapt.c @@ -1,7 +1,7 @@ /* sockadapt.c * * Author: Charles Bailey bailey@genetics.upenn.edu - * Last Revised: 17-Mar-1995 + * Last Revised: 29-Jan-1996 * * This file should contain stubs for any of the TCP/IP functions perl5 * requires which are not supported by your TCP/IP stack. These stubs @@ -13,22 +13,31 @@ #include "EXTERN.h" #include "perl.h" +#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) +# define __sockadapt_my_netent_t __struct_netent_ptr32 +# define __sockadapt_my_addr_t __in_addr_t +# define __sockadapt_my_name_t const char * +#else +# define __sockadapt_my_netent_t struct netent * +# define __sockadapt_my_addr_t long +# define __sockadapt_my_name_t char * +#endif -void endnetent() { - croak("Function \"endnetent\" not implemented in this version of perl"); -} -struct netent *getnetbyaddr( long net, int type) { +__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) { croak("Function \"getnetbyaddr\" not implemented in this version of perl"); return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ } -struct netent *getnetbyname( char *name) { +__sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) { croak("Function \"getnetbyname\" not implemented in this version of perl"); return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ } -struct netent *getnetent() { +__sockadapt_my_netent_t getnetent() { croak("Function \"getnetent\" not implemented in this version of perl"); return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ } void setnetent() { croak("Function \"setnetent\" not implemented in this version of perl"); } +void endnetent() { + croak("Function \"endnetent\" not implemented in this version of perl"); +} @@ -2,7 +2,7 @@ * * VMS-specific routines for perl5 * - * Last revised: 22-Nov-1995 by Charles Bailey bailey@genetics.upenn.edu + * Last revised: 18-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu * Version: 5.2.0 */ @@ -36,6 +36,19 @@ #include "perl.h" #include "XSUB.h" +/* gcc's header files don't #define direct access macros + * corresponding to VAXC's variant structs */ +#ifdef __GNUC__ +# define uic$v_format uic$r_uic_form.uiv$v_format +# define uic$v_group uic$r_uic_form.uiv$v_group +# define uic$v_member uic$r_uic_form.uiv$v_member +# define prv$v_bypass prv$r_prvdef_bits0.prv$v_bypass +# define prv$v_grpprv prv$r_prvdef_bits0.prv$v_grpprv +# define prv$v_readall prv$r_prvdef_bits0.prv$v_readall +# define prv$v_sysprv prv$r_prvdef_bits0.prv$v_sysprv +#endif + + struct itmlst_3 { unsigned short int buflen; unsigned short int itmcode; @@ -43,30 +56,34 @@ struct itmlst_3 { unsigned short int *retlen; }; -static char * -my_trnlnm(char *lnm, char *eqv) +int +my_trnlnm(char *lnm, char *eqv, unsigned long int idx) { static char __my_trnlnm_eqv[LNM$C_NAMLENGTH+1]; unsigned short int eqvlen; unsigned long int retsts, attr = LNM$M_CASE_BLIND; $DESCRIPTOR(tabdsc,"LNM$FILE_DEV"); struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; - struct itmlst_3 lnmlst[2] = {{LNM$C_NAMLENGTH, LNM$_STRING,0, &eqvlen}, + struct itmlst_3 lnmlst[3] = {{sizeof idx, LNM$_INDEX, &idx, 0}, + {LNM$C_NAMLENGTH, LNM$_STRING, 0, &eqvlen}, {0, 0, 0, 0}}; if (!eqv) eqv = __my_trnlnm_eqv; - lnmlst[0].bufadr = (void *)eqv; + lnmlst[1].bufadr = (void *)eqv; lnmdsc.dsc$a_pointer = lnm; lnmdsc.dsc$w_length = strlen(lnm); retsts = sys$trnlnm(&attr,&tabdsc,&lnmdsc,0,lnmlst); - if (retsts == SS$_NOLOGNAM || retsts == SS$_IVLOGNAM) return Nullch; + if (retsts == SS$_NOLOGNAM || retsts == SS$_IVLOGNAM) { + set_vaxc_errno(retsts); set_errno(EINVAL); return 0; + } else if (retsts & 1) { eqv[eqvlen] = '\0'; - return eqv; + return 1; } _ckvmssts(retsts); /* Must be an error */ - return Nullch; /* Not reached, assuming _ckvmssts() bails out */ -} + return 0; /* Not reached, assuming _ckvmssts() bails out */ + +} /* end of my_trnlnm */ /* my_getenv * Translate a logical name. Substitute for CRTL getenv() to avoid @@ -82,6 +99,7 @@ my_getenv(char *lnm) { static char __my_getenv_eqv[LNM$C_NAMLENGTH+1]; char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2; + unsigned long int idx = 0; for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1); *cp2 = '\0'; @@ -89,24 +107,31 @@ my_getenv(char *lnm) getcwd(__my_getenv_eqv,sizeof __my_getenv_eqv); return __my_getenv_eqv; } - else if (my_trnlnm(uplnm,__my_getenv_eqv) != NULL) { - return __my_getenv_eqv; - } else { - unsigned long int retsts; - struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, - valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T, - DSC$K_CLASS_S, __my_getenv_eqv}; - symdsc.dsc$w_length = cp1 - lnm; - symdsc.dsc$a_pointer = uplnm; - retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0); - if (retsts == LIB$_INVSYMNAM) return Nullch; - if (retsts != LIB$_NOSUCHSYM) { - /* We want to return only logical names or CRTL Unix emulations */ - if (retsts & 1) return Nullch; - _ckvmssts(retsts); + if ((cp2 = strchr(uplnm,';')) != NULL) { + *cp2 = '\0'; + idx = strtoul(cp2+1,NULL,0); + } + if (my_trnlnm(uplnm,__my_getenv_eqv,idx)) { + return __my_getenv_eqv; + } + else { + unsigned long int retsts; + struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, + valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T, + DSC$K_CLASS_S, __my_getenv_eqv}; + symdsc.dsc$w_length = cp1 - lnm; + symdsc.dsc$a_pointer = uplnm; + retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0); + if (retsts == LIB$_INVSYMNAM) return Nullch; + if (retsts != LIB$_NOSUCHSYM) { + /* We want to return only logical names or CRTL Unix emulations */ + if (retsts & 1) return Nullch; + _ckvmssts(retsts); + } + /* Try for CRTL emulation of a Unix/POSIX name */ + else return getenv(lnm); } - else return getenv(lnm); /* Try for CRTL emulation of a Unix/POSIX name */ } return Nullch; @@ -149,6 +174,69 @@ my_setenv(char *lnm,char *eqv) } /* end of my_setenv() */ /*}}}*/ + +/*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/ +/* my_crypt - VMS password hashing + * my_crypt() provides an interface compatible with the Unix crypt() + * C library function, and uses sys$hash_password() to perform VMS + * password hashing. The quadword hashed password value is returned + * as a NUL-terminated 8 character string. my_crypt() does not change + * the case of its string arguments; in order to match the behavior + * of LOGINOUT et al., alphabetic characters in both arguments must + * be upcased by the caller. + */ +char * +my_crypt(const char *textpasswd, const char *usrname) +{ +# ifndef UAI$C_PREFERRED_ALGORITHM +# define UAI$C_PREFERRED_ALGORITHM 127 +# endif + unsigned char alg = UAI$C_PREFERRED_ALGORITHM; + unsigned short int salt = 0; + unsigned long int sts; + struct const_dsc { + unsigned short int dsc$w_length; + unsigned char dsc$b_type; + unsigned char dsc$b_class; + const char * dsc$a_pointer; + } usrdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, + txtdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct itmlst_3 uailst[3] = { + { sizeof alg, UAI$_ENCRYPT, &alg, 0}, + { sizeof salt, UAI$_SALT, &salt, 0}, + { 0, 0, NULL, NULL}}; + static char hash[9]; + + usrdsc.dsc$w_length = strlen(usrname); + usrdsc.dsc$a_pointer = usrname; + if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) { + switch (sts) { + case SS$_NOGRPPRV: + case SS$_NOSYSPRV: + set_errno(EACCES); + break; + case RMS$_RNF: + set_errno(ESRCH); /* There isn't a Unix no-such-user error */ + break; + default: + set_errno(EVMSERR); + } + set_vaxc_errno(sts); + if (sts != RMS$_RNF) return NULL; + } + + txtdsc.dsc$w_length = strlen(textpasswd); + txtdsc.dsc$a_pointer = textpasswd; + if (!((sts = sys$hash_password(&txtdsc, alg, salt, &usrdsc, &hash)) & 1)) { + set_errno(EVMSERR); set_vaxc_errno(sts); return NULL; + } + + return (char *) hash; + +} /* end of my_crypt() */ +/*}}}*/ + + static char *do_fileify_dirspec(char *, char *, int); static char *do_tovmsspec(char *, char *, int); @@ -560,11 +648,11 @@ I32 my_pclose(FILE *fp) /* get here => no such pipe open */ croak("No such pipe open"); + fclose(info->fp); + if (info->done) retsts = info->completion; else waitpid(info->pid,(int *) &retsts,0); - fclose(info->fp); - /* remove from list of open pipes */ if (last) last->next = info->next; else open_pipes = info->next; @@ -691,15 +779,32 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) char *retspec, *cp1, *cp2, *lastdir; char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1]; - if (dir == NULL) return NULL; + if (!dir || !*dir) { + set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; + } dirlen = strlen(dir); if (dir[dirlen-1] == '/') dir[--dirlen] = '\0'; + if (!dirlen) { + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } if (!strpbrk(dir+1,"/]>:")) { strcpy(trndir,*dir == '/' ? dir + 1: dir); - while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir) != NULL) ; + while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) ; dir = trndir; dirlen = strlen(dir); } + /* If we were handed a rooted logical name or spec, treat it like a + * simple directory, so that + * $ Define myroot dev:[dir.] + * ... do_fileify_dirspec("myroot",buf,1) ... + * does something useful. + */ + if (!strcmp(dir+dirlen-2,".]")) { + dir[--dirlen] = '\0'; + dir[dirlen-1] = ']'; + } if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */ if (dir[0] == '.') { @@ -848,6 +953,11 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) strcpy(retspec,esa); return retspec; } + if ((cp1 = strstr(esa,".][000000]")) != NULL) { + for (cp2 = cp1 + 9; *cp2; cp1++,cp2++) *cp1 = *cp2; + *cp1 = '\0'; + dirnam.nam$b_esl -= 9; + } if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>'); if (cp1 == NULL) return NULL; /* should never happen */ term = *cp1; @@ -930,10 +1040,26 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) unsigned long int retlen; char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1]; - if (dir == NULL) return NULL; + if (!dir || !*dir) { + set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; + } + + if (*dir) strcpy(trndir,dir); + else getcwd(trndir,sizeof trndir - 1); + + while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir,0)) { + STRLEN trnlen = strlen(trndir); - strcpy(trndir,dir); - while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir) != NULL) ; + /* Trap simple rooted lnms, and return lnm:[000000] */ + if (!strcmp(trndir+trnlen-2,".]")) { + if (buf) retpath = buf; + else if (ts) New(7018,retpath,strlen(dir)+10,char); + else retpath = __pathify_retbuf; + strcpy(retpath,dir); + strcat(retpath,":[000000]"); + return retpath; + } + } dir = trndir; if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */ @@ -1201,7 +1327,7 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2; *cp1 = '\0'; - islnm = (my_trnlnm(rslt,trndev) != Nullch); + islnm = my_trnlnm(rslt,trndev,0); trnend = islnm ? strlen(trndev) - 1 : 0; islnm = trnend ? (trndev[trnend] == ']' || trndev[trnend] == '>') : 0; rooted = islnm ? (trndev[trnend-1] == '.') : 0; @@ -1658,7 +1784,6 @@ static void expand_wild_cards(char *item, int expcount = 0; unsigned long int context = 0; int isunix = 0; -int status_value; char *had_version; char *had_device; int had_directory; @@ -1667,7 +1792,7 @@ char vmsspec[NAM$C_MAXRSS+1]; $DESCRIPTOR(filespec, ""); $DESCRIPTOR(defaultspec, "SYS$DISK:[]"); $DESCRIPTOR(resultspec, ""); -unsigned long int zero = 0; +unsigned long int zero = 0, sts; if (strcspn(item, "*%") == strlen(item)) { @@ -1692,8 +1817,8 @@ unsigned long int zero = 0; had_device = strchr(item, ':'); had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<')); - while (1 == (1&lib$find_file(&filespec, &resultspec, &context, - &defaultspec, 0, &status_value, &zero))) + while (1 == (1 & (sts = lib$find_file(&filespec, &resultspec, &context, + &defaultspec, 0, 0, &zero)))) { char *string; char *c; @@ -1720,10 +1845,28 @@ unsigned long int zero = 0; add_item(head, tail, string, count); ++expcount; } + if (sts != RMS$_NMF) + { + set_vaxc_errno(sts); + switch (sts) + { + case RMS$_FNF: + case RMS$_DIR: + set_errno(ENOENT); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + _ckvmssts(sts); + } + } if (expcount == 0) add_item(head, tail, item, count); - lib$sfree1_dd(&resultspec); - lib$find_file_end(&context); + _ckvmssts(lib$sfree1_dd(&resultspec)); + _ckvmssts(lib$find_file_end(&context)); } static int child_st[2];/* Event Flag set when child process completes */ @@ -2035,17 +2178,12 @@ readdir(DIR *dd) set_vaxc_errno(tmpsts); switch (tmpsts) { case RMS$_PRV: - set_errno(EACCES); - break; + set_errno(EACCES); break; case RMS$_DEV: - set_errno(ENODEV); - break; + set_errno(ENODEV); break; case RMS$_DIR: - set_errno(ENOTDIR); - break; case RMS$_FNF: - set_errno(ENOENT); - break; + set_errno(ENOENT); break; default: set_errno(EVMSERR); } @@ -2479,7 +2617,7 @@ static int fillpasswd (const char *name, struct passwd *pwd) static unsigned short lowner, luic, ldefdev, ldefdir, ldefcli, lpwd; struct dsc$descriptor_s name_desc; - int status; + unsigned long int sts; static struct itmlst_3 itmlst[]= { {UAI$S_OWNER+1, UAI$_OWNER, &owner, &lowner}, @@ -2496,8 +2634,12 @@ static int fillpasswd (const char *name, struct passwd *pwd) name_desc.dsc$a_pointer= (char *) name; /* Note that sys$getuai returns many fields as counted strings. */ - status= sys$getuai(0, 0, &name_desc, &itmlst, 0, 0, 0); - if (!(status&1)) return status; + sts= sys$getuai(0, 0, &name_desc, &itmlst, 0, 0, 0); + if (sts == SS$_NOSYSPRV || sts == SS$_NOGRPPRV || sts == RMS$_RNF) { + set_vaxc_errno(sts); set_errno(sts == RMS$_RNF ? EINVAL : EACCES); + } + else { _ckvmssts(sts); } + if (!(sts & 1)) return 0; /* out here in case _ckvmssts() doesn't abort */ if ((int) owner.length < lowner) lowner= (int) owner.length; if ((int) defdev.length < ldefdev) ldefdev= (int) defdev.length; @@ -2526,7 +2668,7 @@ static int fillpasswd (const char *name, struct passwd *pwd) else strcpy(pwd->pw_unixdir, pwd->pw_dir); _mystrtolower(pwd->pw_unixdir); - return status; + return 1; } /* @@ -2540,8 +2682,7 @@ struct passwd *my_getpwnam(char *name) unsigned long int status, stat; __pwdcache = __passwd_empty; - if ((status = fillpasswd(name, &__pwdcache)) == SS$_NOSYSPRV - || status == SS$_NOGRPPRV || status == RMS$_RNF) { + if (!fillpasswd(name, &__pwdcache)) { /* We still may be able to determine pw_uid and pw_gid */ name_desc.dsc$w_length= strlen(name); name_desc.dsc$b_dtype= DSC$K_DTYPE_T; @@ -2551,10 +2692,15 @@ struct passwd *my_getpwnam(char *name) __pwdcache.pw_uid= uic.uic$l_uic; __pwdcache.pw_gid= uic.uic$v_group; } - else if (stat == SS$_NOSUCHID || stat == RMS$_PRV) return NULL; - else { _ckvmssts(stat); } + else { + if (stat == SS$_NOSUCHID || stat == SS$_IVIDENT || stat == RMS$_PRV) { + set_vaxc_errno(stat); + set_errno(stat == RMS$_PRV ? EACCES : EINVAL); + return NULL; + } + else { _ckvmssts(stat); } + } } - else { _ckvmssts(status); } strncpy(__pw_namecache, name, sizeof(__pw_namecache)); __pw_namecache[sizeof __pw_namecache - 1] = '\0'; __pwdcache.pw_name= __pw_namecache; @@ -2578,6 +2724,8 @@ struct passwd *my_getpwuid(Uid_t uid) do { status = sys$idtoasc(-1, &lname, &name_desc, &uic, 0, &contxt); if (status == SS$_NOSUCHID || status == RMS$_PRV) { + set_vaxc_errno(status); + set_errno(status == RMS$_PRV ? EACCES : EINVAL); my_endpwent(); return NULL; } @@ -2586,11 +2734,17 @@ struct passwd *my_getpwuid(Uid_t uid) } else { uic.uic$l_uic= uid; - if (!uic.uic$v_group) uic.uic$v_group= getgid(); + if (!uic.uic$v_group) + uic.uic$v_group= getgid(); if (valid_uic(uic)) status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0); else status = SS$_IVIDENT; - _ckvmssts(status); + if (status == SS$_IVIDENT || status == SS$_NOSUCHID || + status == RMS$_PRV) { + set_vaxc_errno(status); set_errno(status == RMS$_PRV ? EACCES : EINVAL); + return NULL; + } + else { _ckvmssts(status); } } __pw_namecache[lname]= '\0'; _mystrtolower(__pw_namecache); @@ -2604,9 +2758,7 @@ struct passwd *my_getpwuid(Uid_t uid) __pwdcache.pw_uid = uic.uic$l_uic; __pwdcache.pw_gid = uic.uic$v_group; - status = fillpasswd(__pw_namecache, &__pwdcache); - if (status != SS$_NOSYSPRV && status != SS$_NOGRPPRV && - status != RMS$_RNF) { _ckvmssts(status); } + fillpasswd(__pw_namecache, &__pwdcache); return &__pwdcache; } /* end of my_getpwuid() */ @@ -2810,7 +2962,7 @@ cando(I32 bit, I32 effective, struct stat *statbufp) namdsc.dsc$a_pointer = fname; namdsc.dsc$w_length = sizeof fname - 1; - retsts = lib$fid_to_name(&devdsc,statbufp->st_inode_u.fid,&namdsc, + retsts = lib$fid_to_name(&devdsc,&(statbufp->st_ino),&namdsc, &namdsc.dsc$w_length,0,0); if (retsts & 1) { fname[namdsc.dsc$w_length] = '\0'; @@ -2826,6 +2978,7 @@ cando(I32 bit, I32 effective, struct stat *statbufp) } /* end of cando() */ /*}}}*/ + /*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/ I32 cando_by_name(I32 bit, I32 effective, char *fname) @@ -2884,10 +3037,10 @@ cando_by_name(I32 bit, I32 effective, char *fname) necessary privs currently enabled? */ _ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0)); if ((privused & CHP$M_BYPASS) && !curprv.prv$v_bypass) return FALSE; - if ((privused & CHP$M_SYSPRV) && !curprv.prv$v_sysprv - && !curprv.prv$v_bypass) return FALSE; - if ((privused & CHP$M_GRPPRV) && !curprv.prv$v_grpprv - && !curprv.prv$v_sysprv && !curprv.prv$v_bypass) return FALSE; + if ((privused & CHP$M_SYSPRV) && !curprv.prv$v_sysprv && + !curprv.prv$v_bypass) return FALSE; + if ((privused & CHP$M_GRPPRV) && !curprv.prv$v_grpprv && + !curprv.prv$v_sysprv && !curprv.prv$v_bypass) return FALSE; if ((privused & CHP$M_READALL) && !curprv.prv$v_readall) return FALSE; return TRUE; } @@ -2962,6 +3115,17 @@ flex_stat(char *fspec, struct mystat *statbufp) #define stat mystat /*}}}*/ +/*{{{char *my_getlogin()*/ +/* VMS cuserid == Unix getlogin, except calling sequence */ +char * +my_getlogin() +{ + static char user[L_cuserid]; + return cuserid(user); +} +/*}}}*/ + + /*** The following glue provides 'hooks' to make some of the routines * from this file available from Perl. These routines are sufficiently * basic, and are required sufficiently early in the build process, diff --git a/vms/vms_yfix.pl b/vms/vms_yfix.pl index 323a40d792..33af914b25 100644 --- a/vms/vms_yfix.pl +++ b/vms/vms_yfix.pl @@ -6,20 +6,26 @@ # If it finds that the input files are already patches for VMS, # it just copies the input to the output. # -# Revised 26-May-1995 by Charles Bailey bailey@genetics.upenn.edu +# Revised 29-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu + +$VERSION = '1.1'; ($cinfile,$hinfile,$coutfile,$houtfile) = @ARGV; open C,$cinfile or die "Can't read $cinfile: $!\n"; open COUT, ">$coutfile" or die "Can't create $coutfile: $!\n"; +print COUT <<EOH; +/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */ +EOH while (<C>) { - if (/^dEXT/) { # we've already got a fixed copy - print COUT $_,<C>; - last; + # "y.tab.c" is illegal as a VMS filename; DECC 5.2/VAX preprocessor + # doesn't like this. + if ( s/^#line\s+(\d+)\s+"y.tab.c"/#line $1 "y_tab.c"/ ) { 1; } + else { + # add the dEXT tag to definitions of global vars, so we'll insert + # a globaldef when perly.c is compiled + s/^(short|int|YYSTYPE|char \*)\s*yy/dEXT $1 yy/; } - # add the dEXT tag to definitions of global vars, so we'll insert - # a globaldef when perly.c is compiled - s/^(short|int|YYSTYPE|char \*)\s*yy/dEXT $1 yy/; print COUT; } close C; @@ -27,6 +33,9 @@ close COUT; open H,$hinfile or die "Can't read $hinfile: $!\n"; open HOUT, ">$houtfile" or die "Can't create $houtfile: $!\n"; +print HOUT <<EOH; +/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */ +EOH $hfixed = 0; # keep -w happy while (<H>) { $hfixed = /globalref/ unless $hfixed; # we've already got a fixed copy diff --git a/vms/vmsish.h b/vms/vmsish.h index 65f182c2ff..6492773e88 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -3,7 +3,7 @@ * VMS-specific C header file for perl5. * * Last revised: 01-Oct-1995 by Charles Bailey bailey@genetics.upenn.edu - * Version: 5.2.b1 + * Version: 5.1.6 */ #ifndef __vmsish_h_included @@ -89,6 +89,8 @@ #include "sockadapt.h" #endif +#define BIT_BUCKET "_NLA0:" +#define PERL_SYS_INIT(c,v) getredirection((c),(v)) #define HAS_KILL #define HAS_WAIT @@ -177,6 +179,12 @@ struct tms { #define DYNAMIC_ENV_FETCH 1 #define ENV_HV_NAME "%EnV%VmS%" +/* Thin jacket around cuserid() tomatch Unix' calling sequence */ +#define getlogin my_getlogin + +/* Ditto for sys$hash_passwrod() . . . */ +#define crypt my_crypt + /* Use our own stat() clones, which handle Unix-style directory names */ #define Stat(name,bufptr) flex_stat(name,bufptr) #define Fstat(fd,bufptr) flex_fstat(fd,bufptr) @@ -228,7 +236,14 @@ struct passwd { /* Our own stat_t substitute, since we play with st_dev and st_ino - * we want atomic types so Unix-bound code which compares these fields - * for two files will work most of the time under VMS + * for two files will work most of the time under VMS. + * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) == + * sizeof(unsigned) + sizeof(unsigned short). We can't use a union type + * to map the unsigned int we want and the unsigned short[3] the CRTL + * returns into the same member, since gcc has different ideas than DECC + * and VAXC about sizing union types. + * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the + * address of a FID. */ /* First, grab the system types, so we don't clobber them later */ #include <stat.h> @@ -247,10 +262,8 @@ struct passwd { struct mystat { char *st_devnam; /* pointer to device name */ - union { - unsigned short fid[3]; - unsigned long st_ino_mostly; - } st_inode_u; + unsigned st_ino; /* hack - CRTL uses unsigned short[3] for */ + unsigned short rvn; /* FID (num,seq,rvn) */ unsigned short st_mode; /* file "mode" i.e. prot, dir, reg, etc. */ int st_nlink; /* for compatibility - not really used */ unsigned st_uid; /* from ACP - QIO uic field */ @@ -265,14 +278,10 @@ struct mystat char st_fab_fsz; /* fixed header size */ unsigned st_dev; /* encoded device name */ }; -#ifdef st_ino -# undef st_ino -#endif -#define st_ino st_inode_u.st_ino_mostly #define stat mystat typedef unsigned mydev_t; #define dev_t mydev_t -typedef unsigned long myino_t; +typedef unsigned myino_t; #define ino_t myino_t #if defined(__DECC) || defined(__DECCXX) # pragma __member_alignment __restore @@ -294,8 +303,11 @@ typedef unsigned long myino_t; * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form * <data type><TAB>name<WHITESPACE>_((<prototype args>)); */ -typedef char __VMS_PROTOTYPES__; /* prototype section start marker */ +/* prototype section start marker; `typedef' passes through cpp */ +typedef char __VMS_PROTOTYPES__; +int my_trnlnm _((char *, char *, unsigned long int)); char * my_getenv _((char *)); +char * my_crypt _((const char *, const char *)); unsigned long int waitpid _((unsigned long int, int *, int)); char * my_gconvert _((double, int, int, char *)); int do_rmdir _((char *)); @@ -335,8 +347,10 @@ struct passwd * my_getpwnam _((char *name)); struct passwd * my_getpwuid _((Uid_t uid)); struct passwd * my_getpwent _(()); void my_endpwent _(()); +char * my_getlogin _(()); void init_os_extras _(()); -typedef char __VMS_SEPYTOTORP__; /* prototype section end marker */ +typedef char __VMS_SEPYTOTORP__; +/* prototype section end marker; `typedef' passes through cpp */ #ifndef VMS_DO_SOCKETS /* This relies on tricks in perl.h to pick up that these manifest constants |