diff options
| -rwxr-xr-x | Configure | 21 | ||||
| -rw-r--r-- | hints/dec_osf.sh | 56 | ||||
| -rw-r--r-- | hv.c | 46 | ||||
| -rw-r--r-- | lib/Getopt/Long.pm | 1148 | ||||
| -rw-r--r-- | lib/blib.pm | 1 | ||||
| -rw-r--r-- | perl.h | 7 | ||||
| -rw-r--r-- | perl_exp.SH | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 712 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | pp_sys.c | 6 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | regcomp.h | 8 | ||||
| -rw-r--r-- | regexec.c | 4 | ||||
| -rw-r--r-- | t/op/re_tests | 3 | ||||
| -rwxr-xr-x | t/pragma/locale.t | 8 | ||||
| -rw-r--r-- | utils/perldoc.PL | 12 | ||||
| -rw-r--r-- | vms/config.vms | 67 | ||||
| -rw-r--r-- | vms/descrip.mms | 793 | ||||
| -rw-r--r-- | vms/gen_shrfls.pl | 4 | ||||
| -rw-r--r-- | vms/genconfig.pl | 27 | ||||
| -rw-r--r-- | vms/perly_c.vms | 1 | ||||
| -rw-r--r-- | vms/vms.c | 8 | ||||
| -rw-r--r-- | vms/vmsish.h | 2 | ||||
| -rw-r--r-- | x2p/s2p.PL | 44 |
24 files changed, 1603 insertions, 1388 deletions
@@ -1825,7 +1825,7 @@ EOM osf1|mls+) case "$5" in alpha) osname=dec_osf - osvers=`echo "$3" | sed 's/^[vt]//'` + osvers=`echo "$3" | sed 's/^[xvt]//'` ;; hp*) osname=hp_osf1 ;; mips) osname=mips_osf1 ;; @@ -9327,7 +9327,7 @@ EOM gethbadd_addr_type="$ans" # Remove the "const" if needed. - gethbadd_addr_type=`echo $gethbadd_addr_type | sed 's/^const //'` + gethbadd_addr_type=`echo "$gethbadd_addr_type" | sed 's/^const //'` rp='What is the type for the 2nd argument to gethostbyaddr ?' dflt="Size_t" @@ -9966,11 +9966,16 @@ int main() { exit(0); } EOCP - : Compile and link separately because the used cc might not be - : able to link the right CRT and libs for pthreading. - if $cc $ccflags -c try.c >/dev/null 2>&1 && - $ld $ldflags -o try try$obj_ext $libs >/dev/null 2>&1; then + if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1; then yyy=`./try` + case "$yyy" in + detached) + echo "Nope, they aren't." + ;; + *) + echo "Yup, they are." + ;; + esac else echo "(I can't execute the test program--assuming they are.)" yyy=joinable @@ -9978,11 +9983,9 @@ EOCP case "$yyy" in detached) val="$undef" - echo "Nope, they aren't." ;; *) val="$define" - echo "Yup, they are." ;; esac set d_pthreads_created_joinable @@ -9990,7 +9993,7 @@ EOCP $rm -f try try.* fi else - d_pthreads_created_joinable=$undef + d_pthreads_created_joinable="$undef" fi : see whether the various POSIXish _yields exist within given cccmd diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh index 2f93f1f7bc..a1efc11cd1 100644 --- a/hints/dec_osf.sh +++ b/hints/dec_osf.sh @@ -102,7 +102,9 @@ case "$optimize" in *gcc*) optimize='-O3' ;; *) case "$_DEC_cc_style" in - new) optimize='-O4' ;; + new) optimize='-O4' + ccflags="$ccflags -fprm d -ieee" + ;; old) optimize='-O2 -Olimit 3200' ;; esac ccflags="$ccflags -D_INTRINSICS" @@ -111,6 +113,17 @@ case "$optimize" in ;; esac +# Make glibpth agree with the compiler suite. Note that /shlib +# is not here. That's on purpose. Even though that's where libc +# really lives from V4.0 on, the linker (and /sbin/loader) won't +# look there by default. The sharable /sbin utilities were all +# built with "-Wl,-rpath,/shlib" to get around that. This makes +# no attempt to figure out the additional location(s) searched by +# gcc, since not all versions of gcc are easily coerced into +# revealing that information. +glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc" +glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib" + # dlopen() is in libc libswanted="`echo $libswanted | sed -e 's/ dl / /'`" @@ -165,16 +178,29 @@ case "$optimize" in esac if [ "X$usethreads" != "X" ]; then - ccflags="-DUSE_THREADS $ccflags" - optimize="-pthread $optimize" - ldflags="-pthread $ldflags" - set `echo X "$libswanted "| sed -e 's/ c / pthread c_r /'` - shift - libswanted="$*" + # Threads interfaces changed with V4.0. + case "$_DEC_uname_r" in + *[123].*) libswanted="$libswanted pthreads mach exc c_r" + ccflags="-DUSE_THREADS -threads $ccflags" + ;; + *) libswanted="$libswanted pthread exc" + ccflags="-DUSE_THREADS -pthread $ccflags" + ;; + esac usemymalloc='n' fi # +# Make embedding in things like INN and Apache more memory friendly. +# Keep it overridable on the Configure command line, though, so that +# "-Uuseshrplib" prevents this default. +# + +case "$_DEC_cc_style.$useshrplib" in + new.) useshrplib="$define" ;; +esac + +# # Unset temporary variables no more needed. # @@ -184,6 +210,22 @@ unset _DEC_uname_r # # History: # +# perl5.004_57: +# +# 19-Dec-1997 Spider Boardman <spider@Orb.Nashua.NH.US> +# +# * Newer Digial UNIX compilers enforce signaling for NaN without +# -ieee. Added -fprm d at the same time since it's friendlier for +# embedding. +# +# * Fixed the library search path to match cc, ld, and /sbin/loader. +# +# * Default to building -Duseshrplib on newer systems. -Uuseshrplib +# still overrides. +# +# * Fix -pthread additions for useshrplib. ld has no -pthread option. +# +# # perl5.004_04: # # 19-Sep-1997 Spider Boardman <spider@Orb.Nashua.NH.US> @@ -257,7 +257,6 @@ hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store) *needs_copy = TRUE; switch (mg->mg_type) { case 'P': - case 'I': case 'S': *needs_store = FALSE; } @@ -429,15 +428,21 @@ hv_delete(HV *hv, char *key, U32 klen, I32 flags) if (!hv) return Nullsv; if (SvRMAGICAL(hv)) { - sv = *hv_fetch(hv, key, klen, TRUE); - mg_clear(sv); - if (mg_find(sv, 's')) { - return Nullsv; /* %SIG elements cannot be deleted */ - } - else if (mg_find(sv, 'p')) { - sv_unmagic(sv, 'p'); /* No longer an element */ - return sv; - } + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + + if (needs_copy) { + sv = *hv_fetch(hv, key, klen, TRUE); + mg_clear(sv); + if (!needs_store) { + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + return Nullsv; /* element cannot be deleted */ + } + } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv,'E')) { sv = sv_2mortal(newSVpv(key,klen)); @@ -492,12 +497,21 @@ hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash) if (!hv) return Nullsv; if (SvRMAGICAL(hv)) { - entry = hv_fetch_ent(hv, keysv, TRUE, hash); - sv = HeVAL(entry); - mg_clear(sv); - if (mg_find(sv, 'p')) { - sv_unmagic(sv, 'p'); /* No longer an element */ - return sv; + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + + if (needs_copy) { + entry = hv_fetch_ent(hv, keysv, TRUE, hash); + sv = HeVAL(entry); + mg_clear(sv); + if (!needs_store) { + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + return Nullsv; /* element cannot be deleted */ + } } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv,'E')) { diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 2b05300404..38b396771b 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -2,505 +2,14 @@ package Getopt::Long; -# RCS Status : $Id: GetoptLong.pm,v 2.11 1997-09-17 12:23:51+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pm,v 2.13 1997-12-25 16:20:17+01 jv Exp $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Wed Sep 17 12:20:10 1997 -# Update Count : 608 +# Last Modified On: Thu Dec 25 16:18:08 1997 +# Update Count : 647 # Status : Released -=head1 NAME - -GetOptions - extended processing of command line options - -=head1 SYNOPSIS - - use Getopt::Long; - $result = GetOptions (...option-descriptions...); - -=head1 DESCRIPTION - -The Getopt::Long module implements an extended getopt function called -GetOptions(). This function adheres to the POSIX syntax for command -line options, with GNU extensions. In general, this means that options -have long names instead of single letters, and are introduced with a -double dash "--". Support for bundling of command line options, as was -the case with the more traditional single-letter approach, is provided -but not enabled by default. For example, the UNIX "ps" command can be -given the command line "option" - - -vax - -which means the combination of B<-v>, B<-a> and B<-x>. With the new -syntax B<--vax> would be a single option, probably indicating a -computer architecture. - -Command line options can be used to set values. These values can be -specified in one of two ways: - - --size 24 - --size=24 - -GetOptions is called with a list of option-descriptions, each of which -consists of two elements: the option specifier and the option linkage. -The option specifier defines the name of the option and, optionally, -the value it can take. The option linkage is usually a reference to a -variable that will be set when the option is used. For example, the -following call to GetOptions: - - GetOptions("size=i" => \$offset); - -will accept a command line option "size" that must have an integer -value. With a command line of "--size 24" this will cause the variable -$offset to get the value 24. - -Alternatively, the first argument to GetOptions may be a reference to -a HASH describing the linkage for the options, or an object whose -class is based on a HASH. The following call is equivalent to the -example above: - - %optctl = ("size" => \$offset); - GetOptions(\%optctl, "size=i"); - -Linkage may be specified using either of the above methods, or both. -Linkage specified in the argument list takes precedence over the -linkage specified in the HASH. - -The command line options are taken from array @ARGV. Upon completion -of GetOptions, @ARGV will contain the rest (i.e. the non-options) of -the command line. - -Each option specifier designates the name of the option, optionally -followed by an argument specifier. Values for argument specifiers are: - -=over 8 - -=item E<lt>noneE<gt> - -Option does not take an argument. -The option variable will be set to 1. - -=item ! - -Option does not take an argument and may be negated, i.e. prefixed by -"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo> -(with value 0). -The option variable will be set to 1, or 0 if negated. - -=item =s - -Option takes a mandatory string argument. -This string will be assigned to the option variable. -Note that even if the string argument starts with B<-> or B<-->, it -will not be considered an option on itself. - -=item :s - -Option takes an optional string argument. -This string will be assigned to the option variable. -If omitted, it will be assigned "" (an empty string). -If the string argument starts with B<-> or B<-->, it -will be considered an option on itself. - -=item =i - -Option takes a mandatory integer argument. -This value will be assigned to the option variable. -Note that the value may start with B<-> to indicate a negative -value. - -=item :i - -Option takes an optional integer argument. -This value will be assigned to the option variable. -If omitted, the value 0 will be assigned. -Note that the value may start with B<-> to indicate a negative -value. - -=item =f - -Option takes a mandatory real number argument. -This value will be assigned to the option variable. -Note that the value may start with B<-> to indicate a negative -value. - -=item :f - -Option takes an optional real number argument. -This value will be assigned to the option variable. -If omitted, the value 0 will be assigned. - -=back - -A lone dash B<-> is considered an option, the corresponding option -name is the empty string. - -A double dash on itself B<--> signals end of the options list. - -=head2 Linkage specification - -The linkage specifier is optional. If no linkage is explicitly -specified but a ref HASH is passed, GetOptions will place the value in -the HASH. For example: - - %optctl = (); - GetOptions (\%optctl, "size=i"); - -will perform the equivalent of the assignment - - $optctl{"size"} = 24; - -For array options, a reference to an array is used, e.g.: - - %optctl = (); - GetOptions (\%optctl, "sizes=i@"); - -with command line "-sizes 24 -sizes 48" will perform the equivalent of -the assignment - - $optctl{"sizes"} = [24, 48]; - -For hash options (an option whose argument looks like "name=value"), -a reference to a hash is used, e.g.: - - %optctl = (); - GetOptions (\%optctl, "define=s%"); - -with command line "--define foo=hello --define bar=world" will perform the -equivalent of the assignment - - $optctl{"define"} = {foo=>'hello', bar=>'world') - -If no linkage is explicitly specified and no ref HASH is passed, -GetOptions will put the value in a global variable named after the -option, prefixed by "opt_". To yield a usable Perl variable, -characters that are not part of the syntax for variables are -translated to underscores. For example, "--fpp-struct-return" will set -the variable $opt_fpp_struct_return. Note that this variable resides -in the namespace of the calling program, not necessarily B<main>. -For example: - - GetOptions ("size=i", "sizes=i@"); - -with command line "-size 10 -sizes 24 -sizes 48" will perform the -equivalent of the assignments - - $opt_size = 10; - @opt_sizes = (24, 48); - -A lone dash B<-> is considered an option, the corresponding Perl -identifier is $opt_ . - -The linkage specifier can be a reference to a scalar, a reference to -an array, a reference to a hash or a reference to a subroutine. - -If a REF SCALAR is supplied, the new value is stored in the referenced -variable. If the option occurs more than once, the previous value is -overwritten. - -If a REF ARRAY is supplied, the new value is appended (pushed) to the -referenced array. - -If a REF HASH is supplied, the option value should look like "key" or -"key=value" (if the "=value" is omitted then a value of 1 is implied). -In this case, the element of the referenced hash with the key "key" -is assigned "value". - -If a REF CODE is supplied, the referenced subroutine is called with -two arguments: the option name and the option value. -The option name is always the true name, not an abbreviation or alias. - -=head2 Aliases and abbreviations - -The option name may actually be a list of option names, separated by -"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name -of this option. If no linkage is specified, options "foo", "bar" and -"blech" all will set $opt_foo. - -Option names may be abbreviated to uniqueness, depending on -configuration option B<auto_abbrev>. - -=head2 Non-option call-back routine - -A special option specifier, E<lt>E<gt>, can be used to designate a subroutine -to handle non-option arguments. GetOptions will immediately call this -subroutine for every non-option it encounters in the options list. -This subroutine gets the name of the non-option passed. -This feature requires configuration option B<permute>, see section -CONFIGURATION OPTIONS. - -See also the examples. - -=head2 Option starters - -On the command line, options can start with B<-> (traditional), B<--> -(POSIX) and B<+> (GNU, now being phased out). The latter is not -allowed if the environment variable B<POSIXLY_CORRECT> has been -defined. - -Options that start with "--" may have an argument appended, separated -with an "=", e.g. "--foo=bar". - -=head2 Return value - -A return status of 0 (false) indicates that the function detected -one or more errors. - -=head1 COMPATIBILITY - -Getopt::Long::GetOptions() is the successor of -B<newgetopt.pl> that came with Perl 4. It is fully upward compatible. -In fact, the Perl 5 version of newgetopt.pl is just a wrapper around -the module. - -If an "@" sign is appended to the argument specifier, the option is -treated as an array. Value(s) are not set, but pushed into array -@opt_name. If explicit linkage is supplied, this must be a reference -to an ARRAY. - -If an "%" sign is appended to the argument specifier, the option is -treated as a hash. Value(s) of the form "name=value" are set by -setting the element of the hash %opt_name with key "name" to "value" -(if the "=value" portion is omitted it defaults to 1). If explicit -linkage is supplied, this must be a reference to a HASH. - -If configuration option B<getopt_compat> is set (see section -CONFIGURATION OPTIONS), options that start with "+" or "-" may also -include their arguments, e.g. "+foo=bar". This is for compatiblity -with older implementations of the GNU "getopt" routine. - -If the first argument to GetOptions is a string consisting of only -non-alphanumeric characters, it is taken to specify the option starter -characters. Everything starting with one of these characters from the -starter will be considered an option. B<Using a starter argument is -strongly deprecated.> - -For convenience, option specifiers may have a leading B<-> or B<-->, -so it is possible to write: - - GetOptions qw(-foo=s --bar=i --ar=s); - -=head1 EXAMPLES - -If the option specifier is "one:i" (i.e. takes an optional integer -argument), then the following situations are handled: - - -one -two -> $opt_one = '', -two is next option - -one -2 -> $opt_one = -2 - -Also, assume specifiers "foo=s" and "bar:s" : - - -bar -xxx -> $opt_bar = '', '-xxx' is next option - -foo -bar -> $opt_foo = '-bar' - -foo -- -> $opt_foo = '--' - -In GNU or POSIX format, option names and values can be combined: - - +foo=blech -> $opt_foo = 'blech' - --bar= -> $opt_bar = '' - --bar=-- -> $opt_bar = '--' - -Example of using variable references: - - $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar); - -With command line options "-foo blech -bar 24 -ar xx -ar yy" -this will result in: - - $foo = 'blech' - $opt_bar = 24 - @ar = ('xx','yy') - -Example of using the E<lt>E<gt> option specifier: - - @ARGV = qw(-foo 1 bar -foo 2 blech); - GetOptions("foo=i", \$myfoo, "<>", \&mysub); - -Results: - - mysub("bar") will be called (with $myfoo being 1) - mysub("blech") will be called (with $myfoo being 2) - -Compare this with: - - @ARGV = qw(-foo 1 bar -foo 2 blech); - GetOptions("foo=i", \$myfoo); - -This will leave the non-options in @ARGV: - - $myfoo -> 2 - @ARGV -> qw(bar blech) - -=head1 CONFIGURATION OPTIONS - -B<GetOptions> can be configured by calling subroutine -B<Getopt::Long::config>. This subroutine takes a list of quoted -strings, each specifying a configuration option to be set, e.g. -B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g. -B<no_ignore_case>. Case does not matter. Multiple calls to B<config> -are possible. - -Previous versions of Getopt::Long used variables for the purpose of -configuring. Although manipulating these variables still work, it -is strongly encouraged to use the new B<config> routine. Besides, it -is much easier. - -The following options are available: - -=over 12 - -=item default - -This option causes all configuration options to be reset to their -default values. - -=item auto_abbrev - -Allow option names to be abbreviated to uniqueness. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset. - -=item getopt_compat - -Allow '+' to start options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset. - -=item require_order - -Whether non-options are allowed to be mixed with -options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case b<require_order> is reset. - -See also B<permute>, which is the opposite of B<require_order>. - -=item permute - -Whether non-options are allowed to be mixed with -options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case B<permute> is reset. -Note that B<permute> is the opposite of B<require_order>. - -If B<permute> is set, this means that - - -foo arg1 -bar arg2 arg3 - -is equivalent to - - -foo -bar arg1 arg2 arg3 - -If a non-option call-back routine is specified, @ARGV will always be -empty upon succesful return of GetOptions since all options have been -processed, except when B<--> is used: - - -foo arg1 -bar arg2 -- arg3 - -will call the call-back routine for arg1 and arg2, and terminate -leaving arg2 in @ARGV. - -If B<require_order> is set, options processing -terminates when the first non-option is encountered. - - -foo arg1 -bar arg2 arg3 - -is equivalent to - - -foo -- arg1 -bar arg2 arg3 - -=item bundling (default: reset) - -Setting this variable to a non-zero value will allow single-character -options to be bundled. To distinguish bundles from long option names, -long options must be introduced with B<--> and single-character -options (and bundles) with B<->. For example, - - ps -vax --vax - -would be equivalent to - - ps -v -a -x --vax - -provided "vax", "v", "a" and "x" have been defined to be valid -options. - -Bundled options can also include a value in the bundle; this value has -to be the last part of the bundle, e.g. - - scale -h24 -w80 - -is equivalent to - - scale -h 24 -w 80 - -Note: resetting B<bundling> also resets B<bundling_override>. - -=item bundling_override (default: reset) - -If B<bundling_override> is set, bundling is enabled as with -B<bundling> but now long option names override option bundles. In the -above example, B<-vax> would be interpreted as the option "vax", not -the bundle "v", "a", "x". - -Note: resetting B<bundling_override> also resets B<bundling>. - -B<Note:> Using option bundling can easily lead to unexpected results, -especially when mixing long options and bundles. Caveat emptor. - -=item ignore_case (default: set) - -If set, case is ignored when matching options. - -Note: resetting B<ignore_case> also resets B<ignore_case_always>. - -=item ignore_case_always (default: reset) - -When bundling is in effect, case is ignored on single-character -options also. - -Note: resetting B<ignore_case_always> also resets B<ignore_case>. - -=item pass_through (default: reset) - -Unknown options are passed through in @ARGV instead of being flagged -as errors. This makes it possible to write wrapper scripts that -process only part of the user supplied options, and passes the -remaining options to some other program. - -This can be very confusing, especially when B<permute> is also set. - -=item debug (default: reset) - -Enable copious debugging output. - -=back - -=head1 OTHER USEFUL VARIABLES - -=over 12 - -=item $Getopt::Long::VERSION - -The version number of this Getopt::Long implementation in the format -C<major>.C<minor>. This can be used to have Exporter check the -version, e.g. - - use Getopt::Long 3.00; - -You can inspect $Getopt::Long::major_version and -$Getopt::Long::minor_version for the individual components. - -=item $Getopt::Long::error - -Internal error flag. May be incremented from a call-back routine to -cause options parsing to fail. - -=back - -=cut - ################ Copyright ################ # This program is Copyright 1990,1997 by Johan Vromans. @@ -526,7 +35,7 @@ BEGIN { require 5.003; use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - $VERSION = sprintf("%d.%02d", q$Revision: 2.11 $ =~ /(\d+)\.(\d+)/); + $VERSION = sprintf("%d.%02d", q$Revision: 2.13 $ =~ /(\d+)\.(\d+)/); @ISA = qw(Exporter); @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); @@ -559,6 +68,7 @@ my $key; # hash key for a hash option # than once in differing environments my $config_defaults; # set config defaults my $find_option; # helper routine +my $croak; # helper routine ################ Subroutines ################ @@ -575,9 +85,9 @@ sub GetOptions { my %linkage; # linkage my $userlinkage; # user supplied HASH $genprefix = $gen_prefix; # so we can call the same module many times - $error = 0; + $error = ''; - print STDERR ('GetOptions $Revision: 2.11 $ ', + print STDERR ('GetOptions $Revision: 2.13 $ ', "[GetOpt::Long $Getopt::Long::VERSION] -- ", "called from package \"$pkg\".\n", " (@ARGV)\n", @@ -605,9 +115,9 @@ sub GetOptions { # starter characters. if ( $optionlist[0] =~ /^\W+$/ ) { $genprefix = shift (@optionlist); - # Turn into regexp. + # Turn into regexp. Needs to be parenthesized! $genprefix =~ s/(\W)/\\$1/g; - $genprefix = "[" . $genprefix . "]"; + $genprefix = "([" . $genprefix . "])"; } # Verify correctness of optionlist. @@ -617,7 +127,7 @@ sub GetOptions { my $opt = shift (@optionlist); # Strip leading prefix so people can specify "--foo=i" if they like. - $opt = $' if $opt =~ /^($genprefix)+/; + $opt = $2 if $opt =~ /^$genprefix+(.*)$/; if ( $opt eq '<>' ) { if ( (defined $userlinkage) @@ -628,20 +138,19 @@ sub GetOptions { } unless ( @optionlist > 0 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { - warn ("Option spec <> requires a reference to a subroutine\n"); - $error++; + $error .= "Option spec <> requires a reference to a subroutine\n"; next; } $linkage{'<>'} = shift (@optionlist); next; } - if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) { - warn ("Error in option spec: \"", $opt, "\"\n"); - $error++; + # Match option spec. Allow '?' as an alias. + if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?(!|[=:][infse][@%]?)?$/ ) { + $error .= "Error in option spec: \"$opt\"\n"; next; } - my ($o, $c, $a) = ($1, $2); + my ($o, $c, $a) = ($1, $5); $c = '' unless defined $c; if ( ! defined $o ) { @@ -718,18 +227,19 @@ sub GetOptions { $opctl{$o} .= '@' if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/; $bopctl{$o} .= '@' - if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/; + if $bundling and defined $bopctl{$o} and + $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/; } elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) { $linkage{$o} = shift (@optionlist); $opctl{$o} .= '%' if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/; $bopctl{$o} .= '%' - if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/; + if $bundling and defined $bopctl{$o} and + $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/; } else { - warn ("Invalid option linkage for \"", $opt, "\"\n"); - $error++; + $error .= "Invalid option linkage for \"$opt\"\n"; } } else { @@ -756,7 +266,8 @@ sub GetOptions { } # Bail out if errors found. - return 0 if $error; + die ($error) if $error; + $error = 0; # Sort the possible long option names. @opctl = sort(keys (%opctl)) if $autoabbrev; @@ -833,7 +344,7 @@ sub GetOptions { else { print STDERR ("Invalid REF type \"", ref($linkage{$opt}), "\" in linkage\n"); - die ("Getopt::Long -- internal error!\n"); + &$croak ("Getopt::Long -- internal error!\n"); } } # No entry in linkage means entry in userlinkage. @@ -873,7 +384,7 @@ sub GetOptions { # Try non-options call-back. my $cb; if ( (defined ($cb = $linkage{'<>'})) ) { - &$cb($tryopt); + &$cb ($tryopt); } else { print STDERR ("=> saving \"$tryopt\" ", @@ -909,9 +420,9 @@ sub config (@) { foreach $opt ( @options ) { my $try = lc ($opt); my $action = 1; - if ( $try =~ /^no_?/ ) { + if ( $try =~ /^no_?(.*)$/ ) { $action = 0; - $try = $'; + $try = $1; } if ( $try eq 'default' or $try eq 'defaults' ) { &$config_defaults () if $action; @@ -947,48 +458,39 @@ sub config (@) { $debug = $action; } else { - $Carp::CarpLevel = 1; - Carp::croak("Getopt::Long: unknown config parameter \"$opt\"") + &$croak ("Getopt::Long: unknown config parameter \"$opt\"") } } } -# Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1. -sub require_version { - no strict; - my ($self, $wanted) = @_; - my $pkg = ref $self || $self; - my $version = $ {"${pkg}::VERSION"} || "(undef)"; - - $wanted .= '.0' unless $wanted =~ /\./; - $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/; - $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/; - if ( $version < $wanted ) { - $version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e; - $wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e; - $Carp::CarpLevel = 1; - Carp::croak("$pkg $wanted required--this is only version $version") - } - $version; -} +# To prevent Carp from being loaded unnecessarily. +$croak = sub { + require 'Carp.pm'; + $Carp::CarpLevel = 1; + Carp::croak(@_); +}; ################ Private Subroutines ################ $find_option = sub { - return 0 unless $opt =~ /^$genprefix/; + print STDERR ("=> find \"$opt\", genprefix=\"$genprefix\"\n") if $debug; - $opt = $'; - my ($starter) = $&; + return 0 unless $opt =~ /^$genprefix(.*)$/; + + $opt = $2; + my ($starter) = $1; + + print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug; my $optarg = undef; # value supplied with --opt=value my $rest = undef; # remainder from unbundling # If it is a long option, it may include the value. - if (($starter eq "--" || $getopt_compat) - && $opt =~ /^([^=]+)=/ ) { + if (($starter eq "--" || ($getopt_compat && !$bundling)) + && $opt =~ /^([^=]+)=(.*)$/ ) { $opt = $1; - $optarg = $'; + $optarg = $2; print STDERR ("=> option \"", $opt, "\", optarg = \"$optarg\"\n") if $debug; } @@ -1041,8 +543,8 @@ $find_option = sub { # Now see if it really is ambiguous. unless ( keys(%hit) == 1 ) { return 0 if $passthrough; - print STDERR ("Option ", $opt, " is ambiguous (", - join(", ", @hits), ")\n"); + warn ("Option ", $opt, " is ambiguous (", + join(", ", @hits), ")\n"); $error++; undef $opt; return 1; @@ -1082,7 +584,7 @@ $find_option = sub { if ( $type eq '' || $type eq '!' ) { if ( defined $optarg ) { return 0 if $passthrough; - print STDERR ("Option ", $opt, " does not take an argument\n"); + warn ("Option ", $opt, " does not take an argument\n"); $error++; undef $opt; } @@ -1107,7 +609,7 @@ $find_option = sub { # Complain if this option needs an argument. if ( $mand eq "=" ) { return 0 if $passthrough; - print STDERR ("Option ", $opt, " requires an argument\n"); + warn ("Option ", $opt, " requires an argument\n"); $error++; undef $opt; } @@ -1124,7 +626,7 @@ $find_option = sub { # Get key if this is a "name=value" pair for a hash option. $key = undef; if ($hash && defined $arg) { - ($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1); + ($key, $arg) = ($arg =~ /^(.*)=(.*)$/o) ? ($1, $2) : ($arg, 1); } #### Check if the argument is valid for this option #### @@ -1148,15 +650,20 @@ $find_option = sub { } elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer - if ( $arg !~ /^-?[0-9]+$/ ) { + if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/ ) { + $arg = $1; + $rest = $2; + unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; + } + elsif ( $arg !~ /^-?[0-9]+$/ ) { if ( defined $optarg || $mand eq "=" ) { if ( $passthrough ) { unshift (@ARGV, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return 0; } - print STDERR ("Value \"", $arg, "\" invalid for option ", - $opt, " (number expected)\n"); + warn ("Value \"", $arg, "\" invalid for option ", + $opt, " (number expected)\n"); $error++; undef $opt; # Push back. @@ -1172,15 +679,24 @@ $find_option = sub { } elsif ( $type eq "f" ) { # real number, int is also ok - if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) { + # We require at least one digit before a point or 'e', + # and at least one digit following the point and 'e'. + # [-]NN[.NN][eNN] + if ( $bundling && defined $rest && + $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/ ) { + $arg = $1; + $rest = $4; + unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; + } + elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) { if ( defined $optarg || $mand eq "=" ) { if ( $passthrough ) { unshift (@ARGV, defined $rest ? $starter.$rest : $arg) unless defined $optarg; return 0; } - print STDERR ("Value \"", $arg, "\" invalid for option ", - $opt, " (real number expected)\n"); + warn ("Value \"", $arg, "\" invalid for option ", + $opt, " (real number expected)\n"); $error++; undef $opt; # Push back. @@ -1195,7 +711,7 @@ $find_option = sub { } } else { - die ("GetOpt::Long internal error (Can't happen)\n"); + &$croak ("GetOpt::Long internal error (Can't happen)\n"); } return 1; }; @@ -1236,3 +752,529 @@ $config_defaults = sub { ################ Package return ################ 1; + +__END__ + +=head1 NAME + +GetOptions - extended processing of command line options + +=head1 SYNOPSIS + + use Getopt::Long; + $result = GetOptions (...option-descriptions...); + +=head1 DESCRIPTION + +The Getopt::Long module implements an extended getopt function called +GetOptions(). This function adheres to the POSIX syntax for command +line options, with GNU extensions. In general, this means that options +have long names instead of single letters, and are introduced with a +double dash "--". Support for bundling of command line options, as was +the case with the more traditional single-letter approach, is provided +but not enabled by default. For example, the UNIX "ps" command can be +given the command line "option" + + -vax + +which means the combination of B<-v>, B<-a> and B<-x>. With the new +syntax B<--vax> would be a single option, probably indicating a +computer architecture. + +Command line options can be used to set values. These values can be +specified in one of two ways: + + --size 24 + --size=24 + +GetOptions is called with a list of option-descriptions, each of which +consists of two elements: the option specifier and the option linkage. +The option specifier defines the name of the option and, optionally, +the value it can take. The option linkage is usually a reference to a +variable that will be set when the option is used. For example, the +following call to GetOptions: + + GetOptions("size=i" => \$offset); + +will accept a command line option "size" that must have an integer +value. With a command line of "--size 24" this will cause the variable +$offset to get the value 24. + +Alternatively, the first argument to GetOptions may be a reference to +a HASH describing the linkage for the options, or an object whose +class is based on a HASH. The following call is equivalent to the +example above: + + %optctl = ("size" => \$offset); + GetOptions(\%optctl, "size=i"); + +Linkage may be specified using either of the above methods, or both. +Linkage specified in the argument list takes precedence over the +linkage specified in the HASH. + +The command line options are taken from array @ARGV. Upon completion +of GetOptions, @ARGV will contain the rest (i.e. the non-options) of +the command line. + +Each option specifier designates the name of the option, optionally +followed by an argument specifier. + +Options that do not take arguments will have no argument specifier. +The option variable will be set to 1 if the option is used. + +For the other options, the values for argument specifiers are: + +=over 8 + +=item ! + +Option does not take an argument and may be negated, i.e. prefixed by +"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo> +(with value 0). +The option variable will be set to 1, or 0 if negated. + +=item =s + +Option takes a mandatory string argument. +This string will be assigned to the option variable. +Note that even if the string argument starts with B<-> or B<-->, it +will not be considered an option on itself. + +=item :s + +Option takes an optional string argument. +This string will be assigned to the option variable. +If omitted, it will be assigned "" (an empty string). +If the string argument starts with B<-> or B<-->, it +will be considered an option on itself. + +=item =i + +Option takes a mandatory integer argument. +This value will be assigned to the option variable. +Note that the value may start with B<-> to indicate a negative +value. + +=item :i + +Option takes an optional integer argument. +This value will be assigned to the option variable. +If omitted, the value 0 will be assigned. +Note that the value may start with B<-> to indicate a negative +value. + +=item =f + +Option takes a mandatory real number argument. +This value will be assigned to the option variable. +Note that the value may start with B<-> to indicate a negative +value. + +=item :f + +Option takes an optional real number argument. +This value will be assigned to the option variable. +If omitted, the value 0 will be assigned. + +=back + +A lone dash B<-> is considered an option, the corresponding option +name is the empty string. + +A double dash on itself B<--> signals end of the options list. + +=head2 Linkage specification + +The linkage specifier is optional. If no linkage is explicitly +specified but a ref HASH is passed, GetOptions will place the value in +the HASH. For example: + + %optctl = (); + GetOptions (\%optctl, "size=i"); + +will perform the equivalent of the assignment + + $optctl{"size"} = 24; + +For array options, a reference to an array is used, e.g.: + + %optctl = (); + GetOptions (\%optctl, "sizes=i@"); + +with command line "-sizes 24 -sizes 48" will perform the equivalent of +the assignment + + $optctl{"sizes"} = [24, 48]; + +For hash options (an option whose argument looks like "name=value"), +a reference to a hash is used, e.g.: + + %optctl = (); + GetOptions (\%optctl, "define=s%"); + +with command line "--define foo=hello --define bar=world" will perform the +equivalent of the assignment + + $optctl{"define"} = {foo=>'hello', bar=>'world') + +If no linkage is explicitly specified and no ref HASH is passed, +GetOptions will put the value in a global variable named after the +option, prefixed by "opt_". To yield a usable Perl variable, +characters that are not part of the syntax for variables are +translated to underscores. For example, "--fpp-struct-return" will set +the variable $opt_fpp_struct_return. Note that this variable resides +in the namespace of the calling program, not necessarily B<main>. +For example: + + GetOptions ("size=i", "sizes=i@"); + +with command line "-size 10 -sizes 24 -sizes 48" will perform the +equivalent of the assignments + + $opt_size = 10; + @opt_sizes = (24, 48); + +A lone dash B<-> is considered an option, the corresponding Perl +identifier is $opt_ . + +The linkage specifier can be a reference to a scalar, a reference to +an array, a reference to a hash or a reference to a subroutine. + +If a REF SCALAR is supplied, the new value is stored in the referenced +variable. If the option occurs more than once, the previous value is +overwritten. + +If a REF ARRAY is supplied, the new value is appended (pushed) to the +referenced array. + +If a REF HASH is supplied, the option value should look like "key" or +"key=value" (if the "=value" is omitted then a value of 1 is implied). +In this case, the element of the referenced hash with the key "key" +is assigned "value". + +If a REF CODE is supplied, the referenced subroutine is called with +two arguments: the option name and the option value. +The option name is always the true name, not an abbreviation or alias. + +=head2 Aliases and abbreviations + +The option name may actually be a list of option names, separated by +"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name +of this option. If no linkage is specified, options "foo", "bar" and +"blech" all will set $opt_foo. For convenience, the single character +"?" is allowed as an alias, e.g. "help|?". + +Option names may be abbreviated to uniqueness, depending on +configuration option B<auto_abbrev>. + +=head2 Non-option call-back routine + +A special option specifier, E<lt>E<gt>, can be used to designate a subroutine +to handle non-option arguments. GetOptions will immediately call this +subroutine for every non-option it encounters in the options list. +This subroutine gets the name of the non-option passed. +This feature requires configuration option B<permute>, see section +CONFIGURATION OPTIONS. + +See also the examples. + +=head2 Option starters + +On the command line, options can start with B<-> (traditional), B<--> +(POSIX) and B<+> (GNU, now being phased out). The latter is not +allowed if the environment variable B<POSIXLY_CORRECT> has been +defined. + +Options that start with "--" may have an argument appended, separated +with an "=", e.g. "--foo=bar". + +=head2 Return values and Errors + +Configuration errors and errors in the option definitions are +signalled using C<die()> and will terminate the calling +program unless the call to C<Getopt::Long::GetOptions()> was embedded +in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>. + +A return value of 1 (true) indicates success. + +A return status of 0 (false) indicates that the function detected one +or more errors during option parsing. These errors are signalled using +C<warn()> and can be trapped with C<$SIG{__WARN__}>. + +Errors that can't happen are signalled using C<Carp::croak()>. + +=head1 COMPATIBILITY + +Getopt::Long::GetOptions() is the successor of +B<newgetopt.pl> that came with Perl 4. It is fully upward compatible. +In fact, the Perl 5 version of newgetopt.pl is just a wrapper around +the module. + +If an "@" sign is appended to the argument specifier, the option is +treated as an array. Value(s) are not set, but pushed into array +@opt_name. If explicit linkage is supplied, this must be a reference +to an ARRAY. + +If an "%" sign is appended to the argument specifier, the option is +treated as a hash. Value(s) of the form "name=value" are set by +setting the element of the hash %opt_name with key "name" to "value" +(if the "=value" portion is omitted it defaults to 1). If explicit +linkage is supplied, this must be a reference to a HASH. + +If configuration option B<getopt_compat> is set (see section +CONFIGURATION OPTIONS), options that start with "+" or "-" may also +include their arguments, e.g. "+foo=bar". This is for compatiblity +with older implementations of the GNU "getopt" routine. + +If the first argument to GetOptions is a string consisting of only +non-alphanumeric characters, it is taken to specify the option starter +characters. Everything starting with one of these characters from the +starter will be considered an option. B<Using a starter argument is +strongly deprecated.> + +For convenience, option specifiers may have a leading B<-> or B<-->, +so it is possible to write: + + GetOptions qw(-foo=s --bar=i --ar=s); + +=head1 EXAMPLES + +If the option specifier is "one:i" (i.e. takes an optional integer +argument), then the following situations are handled: + + -one -two -> $opt_one = '', -two is next option + -one -2 -> $opt_one = -2 + +Also, assume specifiers "foo=s" and "bar:s" : + + -bar -xxx -> $opt_bar = '', '-xxx' is next option + -foo -bar -> $opt_foo = '-bar' + -foo -- -> $opt_foo = '--' + +In GNU or POSIX format, option names and values can be combined: + + +foo=blech -> $opt_foo = 'blech' + --bar= -> $opt_bar = '' + --bar=-- -> $opt_bar = '--' + +Example of using variable references: + + $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar); + +With command line options "-foo blech -bar 24 -ar xx -ar yy" +this will result in: + + $foo = 'blech' + $opt_bar = 24 + @ar = ('xx','yy') + +Example of using the E<lt>E<gt> option specifier: + + @ARGV = qw(-foo 1 bar -foo 2 blech); + GetOptions("foo=i", \$myfoo, "<>", \&mysub); + +Results: + + mysub("bar") will be called (with $myfoo being 1) + mysub("blech") will be called (with $myfoo being 2) + +Compare this with: + + @ARGV = qw(-foo 1 bar -foo 2 blech); + GetOptions("foo=i", \$myfoo); + +This will leave the non-options in @ARGV: + + $myfoo -> 2 + @ARGV -> qw(bar blech) + +=head1 CONFIGURATION OPTIONS + +B<GetOptions> can be configured by calling subroutine +B<Getopt::Long::config>. This subroutine takes a list of quoted +strings, each specifying a configuration option to be set, e.g. +B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g. +B<no_ignore_case>. Case does not matter. Multiple calls to B<config> +are possible. + +Previous versions of Getopt::Long used variables for the purpose of +configuring. Although manipulating these variables still work, it +is strongly encouraged to use the new B<config> routine. Besides, it +is much easier. + +The following options are available: + +=over 12 + +=item default + +This option causes all configuration options to be reset to their +default values. + +=item auto_abbrev + +Allow option names to be abbreviated to uniqueness. +Default is set unless environment variable +POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset. + +=item getopt_compat + +Allow '+' to start options. +Default is set unless environment variable +POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset. + +=item require_order + +Whether non-options are allowed to be mixed with +options. +Default is set unless environment variable +POSIXLY_CORRECT has been set, in which case b<require_order> is reset. + +See also B<permute>, which is the opposite of B<require_order>. + +=item permute + +Whether non-options are allowed to be mixed with +options. +Default is set unless environment variable +POSIXLY_CORRECT has been set, in which case B<permute> is reset. +Note that B<permute> is the opposite of B<require_order>. + +If B<permute> is set, this means that + + -foo arg1 -bar arg2 arg3 + +is equivalent to + + -foo -bar arg1 arg2 arg3 + +If a non-option call-back routine is specified, @ARGV will always be +empty upon succesful return of GetOptions since all options have been +processed, except when B<--> is used: + + -foo arg1 -bar arg2 -- arg3 + +will call the call-back routine for arg1 and arg2, and terminate +leaving arg2 in @ARGV. + +If B<require_order> is set, options processing +terminates when the first non-option is encountered. + + -foo arg1 -bar arg2 arg3 + +is equivalent to + + -foo -- arg1 -bar arg2 arg3 + +=item bundling (default: reset) + +Setting this variable to a non-zero value will allow single-character +options to be bundled. To distinguish bundles from long option names, +long options must be introduced with B<--> and single-character +options (and bundles) with B<->. For example, + + ps -vax --vax + +would be equivalent to + + ps -v -a -x --vax + +provided "vax", "v", "a" and "x" have been defined to be valid +options. + +Bundled options can also include a value in the bundle; for strings +this value is the rest of the bundle, but integer and floating values +may be combined in the bundle, e.g. + + scale -h24w80 + +is equivalent to + + scale -h 24 -w 80 + +Note: resetting B<bundling> also resets B<bundling_override>. + +=item bundling_override (default: reset) + +If B<bundling_override> is set, bundling is enabled as with +B<bundling> but now long option names override option bundles. In the +above example, B<-vax> would be interpreted as the option "vax", not +the bundle "v", "a", "x". + +Note: resetting B<bundling_override> also resets B<bundling>. + +B<Note:> Using option bundling can easily lead to unexpected results, +especially when mixing long options and bundles. Caveat emptor. + +=item ignore_case (default: set) + +If set, case is ignored when matching options. + +Note: resetting B<ignore_case> also resets B<ignore_case_always>. + +=item ignore_case_always (default: reset) + +When bundling is in effect, case is ignored on single-character +options also. + +Note: resetting B<ignore_case_always> also resets B<ignore_case>. + +=item pass_through (default: reset) + +Unknown options are passed through in @ARGV instead of being flagged +as errors. This makes it possible to write wrapper scripts that +process only part of the user supplied options, and passes the +remaining options to some other program. + +This can be very confusing, especially when B<permute> is also set. + +=item debug (default: reset) + +Enable copious debugging output. + +=back + +=head1 OTHER USEFUL VARIABLES + +=over 12 + +=item $Getopt::Long::VERSION + +The version number of this Getopt::Long implementation in the format +C<major>.C<minor>. This can be used to have Exporter check the +version, e.g. + + use Getopt::Long 3.00; + +You can inspect $Getopt::Long::major_version and +$Getopt::Long::minor_version for the individual components. + +=item $Getopt::Long::error + +Internal error flag. May be incremented from a call-back routine to +cause options parsing to fail. + +=back + +=head1 AUTHOR + +Johan Vromans E<lt>jvromans@squirrel.nlE<gt> + +=head1 COPYRIGHT AND DISCLAIMER + +This program is Copyright 1990,1997 by Johan Vromans. +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +If you do not have a copy of the GNU General Public License write to +the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +MA 02139, USA. + +=cut diff --git a/lib/blib.pm b/lib/blib.pm index 9e0f6c07c3..1d56a58174 100644 --- a/lib/blib.pm +++ b/lib/blib.pm @@ -45,6 +45,7 @@ sub import { my $package = shift; my $dir = getcwd; + if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/$--; } if (@_) { $dir = shift; @@ -113,7 +113,8 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # define STANDARD_C 1 #endif -#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) +#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) \ + || defined(__DGUX) # define DONT_DECLARE_STD 1 #endif @@ -1382,7 +1383,9 @@ int runops_debug _((void)); /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__)) -#if !defined(DONT_DECLARE_STD) || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || defined(__sgi) +#if !defined(DONT_DECLARE_STD) \ + || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \ + || defined(__sgi) || defined(__DGUX) extern char ** environ; /* environment variables supplied via exec */ #endif #else diff --git a/perl_exp.SH b/perl_exp.SH index 06b587f9ef..067ebec135 100644 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -54,6 +54,13 @@ y*) ;; *) sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym interp.sym >> perl.exp + expperlvars=/tmp/exp$$pv + expthrdvar=/tmp/exp$$tv + sed -n 's/^PERLVARI*(G\([^,]*\).*/Perl_\1/p' perlvars.h >> $expperlvars + sed -n 's/^PERLVARI*(T\([^,]*\).*/Perl_\1/p' thrdvar.h >> $expthrdvar + # The shebang line nicely sorts as the first one. + sort -o perl.exp -u perl.exp $expperlvars $expthrdvar + rm -f $expperlvars $expthrdvar ;; esac @@ -33,9 +33,8 @@ static I32 dopoptolabel _((char *label)); static I32 dopoptoloop _((I32 startingblock)); static I32 dopoptosub _((I32 startingblock)); static void save_lines _((AV *array, SV *sv)); -static int sortcv _((const void *, const void *)); -static int sortcmp _((const void *, const void *)); -static int sortcmp_locale _((const void *, const void *)); +static I32 sortcv _((SV *a, SV *b)); +static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b))); static OP *doeval _((int gimme, OP** startop)); static I32 sortcxix; @@ -740,7 +739,7 @@ PP(pp_sort) } sortcxix = cxstack_ix; - qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv); + qsortsv(myorigmark+1, max, sortcv); POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); @@ -751,8 +750,8 @@ PP(pp_sort) else { if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ - qsort((char*)(ORIGMARK+1), max, sizeof(SV*), - (op->op_private & OPpLOCALE) ? sortcmp_locale : sortcmp); + qsortsv(ORIGMARK+1, max, + (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp); } } stack_sp = ORIGMARK + max; @@ -1223,17 +1222,15 @@ PP(pp_caller) RETURN; } -static int -sortcv(const void *a, const void *b) +static I32 +sortcv(SV *a, SV *b) { dTHR; - SV * const *str1 = (SV * const *)a; - SV * const *str2 = (SV * const *)b; I32 oldsaveix = savestack_ix; I32 oldscopeix = scopestack_ix; I32 result; - GvSV(firstgv) = *str1; - GvSV(secondgv) = *str2; + GvSV(firstgv) = a; + GvSV(secondgv) = b; stack_sp = stack_base; op = sortcop; runops(); @@ -1249,18 +1246,6 @@ sortcv(const void *a, const void *b) return result; } -static int -sortcmp(const void *a, const void *b) -{ - return sv_cmp(*(SV * const *)a, *(SV * const *)b); -} - -static int -sortcmp_locale(const void *a, const void *b) -{ - return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b); -} - PP(pp_reset) { djSP; @@ -2885,4 +2870,683 @@ doparseform(SV *sv) SvCOMPILED_on(sv); } +/* + * The rest of this file was derived from source code contributed + * by Tom Horsley. + * + * NOTE: this code was derived from Tom Horsley's qsort replacement + * and should not be confused with the original code. + */ + +/* Copyright (C) Tom Horsley, 1997. All rights reserved. + + Permission granted to distribute under the same terms as perl which are + (briefly): + + This program is free software; you can redistribute it and/or modify + it under the terms of either: + + a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or + + b) the "Artistic License" which comes with this Kit. + + Details on the perl license can be found in the perl source code which + may be located via the www.perl.com web page. + + This is the most wonderfulest possible qsort I can come up with (and + still be mostly portable) My (limited) tests indicate it consistently + does about 20% fewer calls to compare than does the qsort in the Visual + C++ library, other vendors may vary. + + Some of the ideas in here can be found in "Algorithms" by Sedgewick, + others I invented myself (or more likely re-invented since they seemed + pretty obvious once I watched the algorithm operate for a while). + + Most of this code was written while watching the Marlins sweep the Giants + in the 1997 National League Playoffs - no Braves fans allowed to use this + code (just kidding :-). + + I realize that if I wanted to be true to the perl tradition, the only + comment in this file would be something like: + + ...they shuffled back towards the rear of the line. 'No, not at the + rear!' the slave-driver shouted. 'Three files up. And stay there... + + However, I really needed to violate that tradition just so I could keep + track of what happens myself, not to mention some poor fool trying to + understand this years from now :-). +*/ + +/* ********************************************************** Configuration */ + +#ifndef QSORT_ORDER_GUESS +#define QSORT_ORDER_GUESS 2 /* Select doubling version of the netBSD trick */ +#endif + +/* QSORT_MAX_STACK is the largest number of partitions that can be stacked up for + future processing - a good max upper bound is log base 2 of memory size + (32 on 32 bit machines, 64 on 64 bit machines, etc). In reality can + safely be smaller than that since the program is taking up some space and + most operating systems only let you grab some subset of contiguous + memory (not to mention that you are normally sorting data larger than + 1 byte element size :-). +*/ +#ifndef QSORT_MAX_STACK +#define QSORT_MAX_STACK 32 +#endif + +/* QSORT_BREAK_EVEN is the size of the largest partition we should insertion sort. + Anything bigger and we use qsort. If you make this too small, the qsort + will probably break (or become less efficient), because it doesn't expect + the middle element of a partition to be the same as the right or left - + you have been warned). +*/ +#ifndef QSORT_BREAK_EVEN +#define QSORT_BREAK_EVEN 6 +#endif + +/* ************************************************************* Data Types */ + +/* hold left and right index values of a partition waiting to be sorted (the + partition includes both left and right - right is NOT one past the end or + anything like that). +*/ +struct partition_stack_entry { + int left; + int right; +#ifdef QSORT_ORDER_GUESS + int qsort_break_even; +#endif +}; + +/* ******************************************************* Shorthand Macros */ + +/* Note that these macros will be used from inside the qsort function where + we happen to know that the variable 'elt_size' contains the size of an + array element and the variable 'temp' points to enough space to hold a + temp element and the variable 'array' points to the array being sorted + and 'compare' is the pointer to the compare routine. + + Also note that there are very many highly architecture specific ways + these might be sped up, but this is simply the most generally portable + code I could think of. +*/ + +/* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2 +*/ +#define qsort_cmp(elt1, elt2) \ + ((*compare)(array[elt1], array[elt2])) + +#ifdef QSORT_ORDER_GUESS +#define QSORT_NOTICE_SWAP swapped++; +#else +#define QSORT_NOTICE_SWAP +#endif + +/* swaps contents of array elements elt1, elt2. +*/ +#define qsort_swap(elt1, elt2) \ + STMT_START { \ + QSORT_NOTICE_SWAP \ + temp = array[elt1]; \ + array[elt1] = array[elt2]; \ + array[elt2] = temp; \ + } STMT_END + +/* rotate contents of elt1, elt2, elt3 such that elt1 gets elt2, elt2 gets + elt3 and elt3 gets elt1. +*/ +#define qsort_rotate(elt1, elt2, elt3) \ + STMT_START { \ + QSORT_NOTICE_SWAP \ + temp = array[elt1]; \ + array[elt1] = array[elt2]; \ + array[elt2] = array[elt3]; \ + array[elt3] = temp; \ + } STMT_END + +/* ************************************************************ Debug stuff */ + +#ifdef QSORT_DEBUG + +static void +break_here() +{ + return; /* good place to set a breakpoint */ +} + +#define qsort_assert(t) (void)( (t) || (break_here(), 0) ) + +static void +doqsort_all_asserts( + void * array, + size_t num_elts, + size_t elt_size, + int (*compare)(const void * elt1, const void * elt2), + int pc_left, int pc_right, int u_left, int u_right) +{ + int i; + + qsort_assert(pc_left <= pc_right); + qsort_assert(u_right < pc_left); + qsort_assert(pc_right < u_left); + for (i = u_right + 1; i < pc_left; ++i) { + qsort_assert(qsort_cmp(i, pc_left) < 0); + } + for (i = pc_left; i < pc_right; ++i) { + qsort_assert(qsort_cmp(i, pc_right) == 0); + } + for (i = pc_right + 1; i < u_left; ++i) { + qsort_assert(qsort_cmp(pc_right, i) < 0); + } +} + +#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) \ + doqsort_all_asserts(array, num_elts, elt_size, compare, \ + PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) + +#else + +#define qsort_assert(t) ((void)0) + +#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) ((void)0) + +#endif + +/* ****************************************************************** qsort */ + +void +qsortsv( + SV ** array, + size_t num_elts, + I32 (*compare)(SV *a, SV *b)) +{ + register SV * temp; + + struct partition_stack_entry partition_stack[QSORT_MAX_STACK]; + int next_stack_entry = 0; + + int part_left; + int part_right; +#ifdef QSORT_ORDER_GUESS + int qsort_break_even; + int swapped; +#endif + /* Make sure we actually have work to do. + */ + if (num_elts <= 1) { + return; + } + + /* Setup the initial partition definition and fall into the sorting loop + */ + part_left = 0; + part_right = (int)(num_elts - 1); +#ifdef QSORT_ORDER_GUESS + qsort_break_even = QSORT_BREAK_EVEN; +#else +#define qsort_break_even QSORT_BREAK_EVEN +#endif + for ( ; ; ) { + if ((part_right - part_left) >= qsort_break_even) { + /* OK, this is gonna get hairy, so lets try to document all the + concepts and abbreviations and variables and what they keep + track of: + + pc: pivot chunk - the set of array elements we accumulate in the + middle of the partition, all equal in value to the original + pivot element selected. The pc is defined by: + + pc_left - the leftmost array index of the pc + pc_right - the rightmost array index of the pc + + we start with pc_left == pc_right and only one element + in the pivot chunk (but it can grow during the scan). + + u: uncompared elements - the set of elements in the partition + we have not yet compared to the pivot value. There are two + uncompared sets during the scan - one to the left of the pc + and one to the right. + + u_right - the rightmost index of the left side's uncompared set + u_left - the leftmost index of the right side's uncompared set + + The leftmost index of the left sides's uncompared set + doesn't need its own variable because it is always defined + by the leftmost edge of the whole partition (part_left). The + same goes for the rightmost edge of the right partition + (part_right). + + We know there are no uncompared elements on the left once we + get u_right < part_left and no uncompared elements on the + right once u_left > part_right. When both these conditions + are met, we have completed the scan of the partition. + + Any elements which are between the pivot chunk and the + uncompared elements should be less than the pivot value on + the left side and greater than the pivot value on the right + side (in fact, the goal of the whole algorithm is to arrange + for that to be true and make the groups of less-than and + greater-then elements into new partitions to sort again). + + As you marvel at the complexity of the code and wonder why it + has to be so confusing. Consider some of the things this level + of confusion brings: + + Once I do a compare, I squeeze every ounce of juice out of it. I + never do compare calls I don't have to do, and I certainly never + do redundant calls. + + I also never swap any elements unless I can prove there is a + good reason. Many sort algorithms will swap a known value with + an uncompared value just to get things in the right place (or + avoid complexity :-), but that uncompared value, once it gets + compared, may then have to be swapped again. A lot of the + complexity of this code is due to the fact that it never swaps + anything except compared values, and it only swaps them when the + compare shows they are out of position. + */ + int pc_left, pc_right; + int u_right, u_left; + + int s; + + pc_left = ((part_left + part_right) / 2); + pc_right = pc_left; + u_right = pc_left - 1; + u_left = pc_right + 1; + + /* Qsort works best when the pivot value is also the median value + in the partition (unfortunately you can't find the median value + without first sorting :-), so to give the algorithm a helping + hand, we pick 3 elements and sort them and use the median value + of that tiny set as the pivot value. + + Some versions of qsort like to use the left middle and right as + the 3 elements to sort so they can insure the ends of the + partition will contain values which will stop the scan in the + compare loop, but when you have to call an arbitrarily complex + routine to do a compare, its really better to just keep track of + array index values to know when you hit the edge of the + partition and avoid the extra compare. An even better reason to + avoid using a compare call is the fact that you can drop off the + edge of the array if someone foolishly provides you with an + unstable compare function that doesn't always provide consistent + results. + + So, since it is simpler for us to compare the three adjacent + elements in the middle of the partition, those are the ones we + pick here (conveniently pointed at by u_right, pc_left, and + u_left). The values of the left, center, and right elements + are refered to as l c and r in the following comments. + */ + +#ifdef QSORT_ORDER_GUESS + swapped = 0; +#endif + s = qsort_cmp(u_right, pc_left); + if (s < 0) { + /* l < c */ + s = qsort_cmp(pc_left, u_left); + /* if l < c, c < r - already in order - nothing to do */ + if (s == 0) { + /* l < c, c == r - already in order, pc grows */ + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s > 0) { + /* l < c, c > r - need to know more */ + s = qsort_cmp(u_right, u_left); + if (s < 0) { + /* l < c, c > r, l < r - swap c & r to get ordered */ + qsort_swap(pc_left, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l < c, c > r, l == r - swap c&r, grow pc */ + qsort_swap(pc_left, u_left); + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l < c, c > r, l > r - make lcr into rlc to get ordered */ + qsort_rotate(pc_left, u_right, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } + } else if (s == 0) { + /* l == c */ + s = qsort_cmp(pc_left, u_left); + if (s < 0) { + /* l == c, c < r - already in order, grow pc */ + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l == c, c == r - already in order, grow pc both ways */ + --pc_left; + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l == c, c > r - swap l & r, grow pc */ + qsort_swap(u_right, u_left); + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } else { + /* l > c */ + s = qsort_cmp(pc_left, u_left); + if (s < 0) { + /* l > c, c < r - need to know more */ + s = qsort_cmp(u_right, u_left); + if (s < 0) { + /* l > c, c < r, l < r - swap l & c to get ordered */ + qsort_swap(u_right, pc_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l > c, c < r, l == r - swap l & c, grow pc */ + qsort_swap(u_right, pc_left); + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l > c, c < r, l > r - rotate lcr into crl to order */ + qsort_rotate(u_right, pc_left, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } else if (s == 0) { + /* l > c, c == r - swap ends, grow pc */ + qsort_swap(u_right, u_left); + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l > c, c > r - swap ends to get in order */ + qsort_swap(u_right, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } + /* We now know the 3 middle elements have been compared and + arranged in the desired order, so we can shrink the uncompared + sets on both sides + */ + --u_right; + ++u_left; + qsort_all_asserts(pc_left, pc_right, u_left, u_right); + + /* The above massive nested if was the simple part :-). We now have + the middle 3 elements ordered and we need to scan through the + uncompared sets on either side, swapping elements that are on + the wrong side or simply shuffling equal elements around to get + all equal elements into the pivot chunk. + */ + + for ( ; ; ) { + int still_work_on_left; + int still_work_on_right; + + /* Scan the uncompared values on the left. If I find a value + equal to the pivot value, move it over so it is adjacent to + the pivot chunk and expand the pivot chunk. If I find a value + less than the pivot value, then just leave it - its already + on the correct side of the partition. If I find a greater + value, then stop the scan. + */ + while (still_work_on_left = (u_right >= part_left)) { + s = qsort_cmp(u_right, pc_left); + if (s < 0) { + --u_right; + } else if (s == 0) { + --pc_left; + if (pc_left != u_right) { + qsort_swap(u_right, pc_left); + } + --u_right; + } else { + break; + } + qsort_assert(u_right < pc_left); + qsort_assert(pc_left <= pc_right); + qsort_assert(qsort_cmp(u_right + 1, pc_left) <= 0); + qsort_assert(qsort_cmp(pc_left, pc_right) == 0); + } + + /* Do a mirror image scan of uncompared values on the right + */ + while (still_work_on_right = (u_left <= part_right)) { + s = qsort_cmp(pc_right, u_left); + if (s < 0) { + ++u_left; + } else if (s == 0) { + ++pc_right; + if (pc_right != u_left) { + qsort_swap(pc_right, u_left); + } + ++u_left; + } else { + break; + } + qsort_assert(u_left > pc_right); + qsort_assert(pc_left <= pc_right); + qsort_assert(qsort_cmp(pc_right, u_left - 1) <= 0); + qsort_assert(qsort_cmp(pc_left, pc_right) == 0); + } + + if (still_work_on_left) { + /* I know I have a value on the left side which needs to be + on the right side, but I need to know more to decide + exactly the best thing to do with it. + */ + if (still_work_on_right) { + /* I know I have values on both side which are out of + position. This is a big win because I kill two birds + with one swap (so to speak). I can advance the + uncompared pointers on both sides after swapping both + of them into the right place. + */ + qsort_swap(u_right, u_left); + --u_right; + ++u_left; + qsort_all_asserts(pc_left, pc_right, u_left, u_right); + } else { + /* I have an out of position value on the left, but the + right is fully scanned, so I "slide" the pivot chunk + and any less-than values left one to make room for the + greater value over on the right. If the out of position + value is immediately adjacent to the pivot chunk (there + are no less-than values), I can do that with a swap, + otherwise, I have to rotate one of the less than values + into the former position of the out of position value + and the right end of the pivot chunk into the left end + (got all that?). + */ + --pc_left; + if (pc_left == u_right) { + qsort_swap(u_right, pc_right); + qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1); + } else { + qsort_rotate(u_right, pc_left, pc_right); + qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1); + } + --pc_right; + --u_right; + } + } else if (still_work_on_right) { + /* Mirror image of complex case above: I have an out of + position value on the right, but the left is fully + scanned, so I need to shuffle things around to make room + for the right value on the left. + */ + ++pc_right; + if (pc_right == u_left) { + qsort_swap(u_left, pc_left); + qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right); + } else { + qsort_rotate(pc_right, pc_left, u_left); + qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right); + } + ++pc_left; + ++u_left; + } else { + /* No more scanning required on either side of partition, + break out of loop and figure out next set of partitions + */ + break; + } + } + + /* The elements in the pivot chunk are now in the right place. They + will never move or be compared again. All I have to do is decide + what to do with the stuff to the left and right of the pivot + chunk. + + Notes on the QSORT_ORDER_GUESS ifdef code: + + 1. If I just built these partitions without swapping any (or + very many) elements, there is a chance that the elements are + already ordered properly (being properly ordered will + certainly result in no swapping, but the converse can't be + proved :-). + + 2. A (properly written) insertion sort will run faster on + already ordered data than qsort will. + + 3. Perhaps there is some way to make a good guess about + switching to an insertion sort earlier than partition size 6 + (for instance - we could save the partition size on the stack + and increase the size each time we find we didn't swap, thus + switching to insertion sort earlier for partitions with a + history of not swapping). + + 4. Naturally, if I just switch right away, it will make + artificial benchmarks with pure ascending (or descending) + data look really good, but is that a good reason in general? + Hard to say... + */ + +#ifdef QSORT_ORDER_GUESS + if (swapped < 3) { +#if QSORT_ORDER_GUESS == 1 + qsort_break_even = (part_right - part_left) + 1; +#endif +#if QSORT_ORDER_GUESS == 2 + qsort_break_even *= 2; +#endif +#if QSORT_ORDER_GUESS == 3 + int prev_break = qsort_break_even; + qsort_break_even *= qsort_break_even; + if (qsort_break_even < prev_break) { + qsort_break_even = (part_right - part_left) + 1; + } +#endif + } else { + qsort_break_even = QSORT_BREAK_EVEN; + } +#endif + + if (part_left < pc_left) { + /* There are elements on the left which need more processing. + Check the right as well before deciding what to do. + */ + if (pc_right < part_right) { + /* We have two partitions to be sorted. Stack the biggest one + and process the smallest one on the next iteration. This + minimizes the stack height by insuring that any additional + stack entries must come from the smallest partition which + (because it is smallest) will have the fewest + opportunities to generate additional stack entries. + */ + if ((part_right - pc_right) > (pc_left - part_left)) { + /* stack the right partition, process the left */ + partition_stack[next_stack_entry].left = pc_right + 1; + partition_stack[next_stack_entry].right = part_right; +#ifdef QSORT_ORDER_GUESS + partition_stack[next_stack_entry].qsort_break_even = qsort_break_even; +#endif + part_right = pc_left - 1; + } else { + /* stack the left partition, process the right */ + partition_stack[next_stack_entry].left = part_left; + partition_stack[next_stack_entry].right = pc_left - 1; +#ifdef QSORT_ORDER_GUESS + partition_stack[next_stack_entry].qsort_break_even = qsort_break_even; +#endif + part_left = pc_right + 1; + } + qsort_assert(next_stack_entry < QSORT_MAX_STACK); + ++next_stack_entry; + } else { + /* The elements on the left are the only remaining elements + that need sorting, arrange for them to be processed as the + next partition. + */ + part_right = pc_left - 1; + } + } else if (pc_right < part_right) { + /* There is only one chunk on the right to be sorted, make it + the new partition and loop back around. + */ + part_left = pc_right + 1; + } else { + /* This whole partition wound up in the pivot chunk, so + we need to get a new partition off the stack. + */ + if (next_stack_entry == 0) { + /* the stack is empty - we are done */ + break; + } + --next_stack_entry; + part_left = partition_stack[next_stack_entry].left; + part_right = partition_stack[next_stack_entry].right; +#ifdef QSORT_ORDER_GUESS + qsort_break_even = partition_stack[next_stack_entry].qsort_break_even; +#endif + } + } else { + /* This partition is too small to fool with qsort complexity, just + do an ordinary insertion sort to minimize overhead. + */ + int i; + /* Assume 1st element is in right place already, and start checking + at 2nd element to see where it should be inserted. + */ + for (i = part_left + 1; i <= part_right; ++i) { + int j; + /* Scan (backwards - just in case 'i' is already in right place) + through the elements already sorted to see if the ith element + belongs ahead of one of them. + */ + for (j = i - 1; j >= part_left; --j) { + if (qsort_cmp(i, j) >= 0) { + /* i belongs right after j + */ + break; + } + } + ++j; + if (j != i) { + /* Looks like we really need to move some things + */ + temp = array[i]; + for (--i; i >= j; --i) + array[i + 1] = array[i]; + array[j] = temp; + } + } + + /* That partition is now sorted, grab the next one, or get out + of the loop if there aren't any more. + */ + + if (next_stack_entry == 0) { + /* the stack is empty - we are done */ + break; + } + --next_stack_entry; + part_left = partition_stack[next_stack_entry].left; + part_right = partition_stack[next_stack_entry].right; +#ifdef QSORT_ORDER_GUESS + qsort_break_even = partition_stack[next_stack_entry].qsort_break_even; +#endif + } + } + + /* Believe it or not, the array is sorted at this point! */ +} @@ -295,7 +295,7 @@ PP(pp_print) gv = (GV*)*++MARK; else gv = defoutgv; - if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { if (MARK == ORIGMARK) { MEXTEND(SP, 1); ++MARK; @@ -983,7 +983,7 @@ do_readline(void) I32 gimme = GIMME_V; MAGIC *mg; - if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) { + if (SvRMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) { PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; @@ -927,7 +927,7 @@ PP(pp_getc) if (!gv) gv = argvgv; - if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { I32 gimme = GIMME_V; PUSHMARK(SP); XPUSHs(mg->mg_obj); @@ -1145,7 +1145,7 @@ PP(pp_prtf) else gv = defoutgv; - if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { if (MARK == ORIGMARK) { MEXTEND(SP, 1); ++MARK; @@ -1255,7 +1255,7 @@ PP(pp_sysread) gv = (GV*)*++MARK; if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) && - SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) + SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { SV *sv; @@ -327,7 +327,9 @@ OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last)); OP* newPMOP _((I32 type, I32 flags)); OP* newPVOP _((I32 type, I32 flags, char* pv)); SV* newRV _((SV* ref)); +#if !defined(__GNUC__) && (defined(CRIPPLED_CC) || defined(USE_THREADS)) SV* newRV_noinc _((SV *)); +#endif #ifdef LEAKTEST SV* newSV _((I32 x, STRLEN len)); #else @@ -209,9 +209,9 @@ EXTCONST U8 regkind[] = { /* The following have no fixed length. char* since we do strchr on it. */ #ifndef DOINIT -EXT const char varies[]; +EXTCONST char varies[]; #else -EXT const char varies[] = { +EXTCONST char varies[] = { BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL, WHILEM, CURLYM, CURLYN, BRANCHJ, IFTHEN, SUSPEND, 0 }; @@ -219,9 +219,9 @@ EXT const char varies[] = { /* The following always have a length of 1. char* since we do strchr on it. */ #ifndef DOINIT -EXT const char simple[]; +EXTCONST char simple[]; #else -EXT const char simple[] = { +EXTCONST char simple[] = { ANY, SANY, ANYOF, ALNUM, ALNUML, NALNUM, NALNUML, SPACE, SPACEL, NSPACE, NSPACEL, @@ -1576,8 +1576,10 @@ regmatch(regnode *prog) logical = 0; sw = 1; } - if (OP(scan) == SUSPEND) + if (OP(scan) == SUSPEND) { locinput = reginput; + nextchar = UCHARAT(locinput); + } /* FALL THROUGH. */ case LONGJMP: do_longjump: diff --git a/t/op/re_tests b/t/op/re_tests index 29a6518cd9..b688a167f2 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -430,4 +430,7 @@ $(?<=^(a)) a y $1 a (?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a}) yaaxxaaaacd y $b 3 (?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a}) yaaxxaaaacd y $b 4 (>a+)ab aaab n - - +(?>a+)b aaab y - - +((?>a+)b) aaab y $1 aaab +(?>(a+))b aaab y $1 aaa ((?>[^()]+)|\([^()]*\))+ ((abc(ade)ufh()()x y $& abc(ade)ufh()()x diff --git a/t/pragma/locale.t b/t/pragma/locale.t index 8e296db8a7..d068465fb3 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -283,13 +283,13 @@ locatelocale(\$Spanish, \@Spanish, # Select the largest of the alpha(num)bets. ($Locale, @Locale) = ($English, @English) - if (length(@English) > length(@Locale)); + if (@English > @Locale); ($Locale, @Locale) = ($German, @German) - if (length(@German) > length(@Locale)); + if (@German > @Locale); ($Locale, @Locale) = ($French, @French) - if (length(@French) > length(@Locale)); + if (@French > @Locale); ($Locale, @Locale) = ($Spanish, @Spanish) - if (length(@Spanish) > length(@Locale)); + if (@Spanish > @Locale); print "# Locale = $Locale\n"; print "# Alnum_ = @Locale\n"; diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 3acb461f98..76385e2c18 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -64,6 +64,7 @@ $global_target = ""; $Is_VMS = $^O eq 'VMS'; $Is_MSWin32 = $^O eq 'MSWin32'; +$Is_Dos = $^O eq 'dos'; sub usage{ warn "@_\n" if @_; @@ -111,7 +112,7 @@ usage if $opt_h || $opt_h; # avoid -w warning if ($opt_t + $opt_u + $opt_m + $opt_l > 1) { usage("only one of -t, -u, -m or -l") -} elsif ($Is_MSWin32) { +} elsif ($Is_MSWin32 || $Is_Dos) { $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l; } @@ -151,7 +152,7 @@ sub containspod { sub minus_f_nocase { my($file) = @_; # on a case-forgiving file system we can simply use -f $file - if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') { + if ($Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') { return $file if -f $file and -r _; warn "Ignored $file: unreadable\n" if -f _; return ''; @@ -224,7 +225,7 @@ sub searchfor { $ret = check_file "$dir/$s.com") or ( $^O eq 'os2' and $ret = check_file "$dir/$s.cmd") - or ( ($Is_MSWin32 or $^O eq 'os2') and + or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and $ret = check_file "$dir/$s.bat") or ( $ret = check_file "$dir/pod/$s.pod") or ( $ret = check_file "$dir/pod/$s") @@ -320,6 +321,11 @@ if ($Is_MSWin32) { } elsif ($Is_VMS) { $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$; push @pagers, qw( most more less type/page ); +} elsif ($Is_Dos) { + $tmp = "$ENV{TEMP}/perldoc1.$$"; + $tmp =~ tr!\\/!//!s; + push @pagers, qw( less.exe more.com< ); + unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } else { if ($^O eq 'os2') { require POSIX; diff --git a/vms/config.vms b/vms/config.vms index 9aad64e493..9c31ace90c 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,8 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00454" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00456" /**/ + #define ARCHLIB ARCHLIB_EXP /*config-skip*/ @@ -373,6 +374,20 @@ */ #undef HAS_POLL /**/ +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield routine is + * available to yield the execution of the current thread. + * VMS: pthread_yield_np is there, but we won't worry for now since it's + * set up already as sched_yield. + */ +#undef HAS_PTHREAD_YIELD /**/ + +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield routine is + * available to yield the execution of the current thread. + */ +#define HAS_SCHED_YIELD /**/ + /* HAS_READDIR: * This symbol, if defined, indicates that the readdir routine is * available to read directory entries. You may have to include @@ -1757,6 +1772,12 @@ */ #undef USE_SFIO /**/ +/* PTHREADS_CREATED_JOINABLE: + * This symbol, if defined, indicates that pthreads are created + * in the joinable (aka undetached) state. + */ +#define PTHREADS_CREATED_JOINABLE /**/ + /* Sigjmp_buf: * This is the buffer type to be used with Sigsetjmp and Siglongjmp. */ @@ -1871,6 +1892,41 @@ */ #define HAS_GETHOSTENT /**/ /* config-skip */ +/* HAS_GETHBADD: + * This symbol, if defined, indicates that the gethostbyaddr routine is + * available to lookup host names by their IP addresses. + */ +#define HAS_GETHBADD /**/ /* config-skip */ + +/* Gethbadd_addr_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). + */ +#define Gethbadd_addr_t char * /**/ /* config-skip */ + +/* Gethbadd_alen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +#define Gethbadd_alen_t int /**/ /* config-skip */ + +#ifdef DECCRTL_SOCKETS +/* HAS_GETNBADD: + * This symbol, if defined, indicates that the getnetbyaddr routine is + * available to lookup networks by their IP addresses. + */ +#define HAS_GETNBADD /**/ /* config-skip */ + +/* Gethbadd_net_t: + * This symbol holds the type used for the 1st argument + * to getnetbyaddr(). + */ +#define Getnbadd_net_t long /**/ /* config-skip */ +#else +#undef HAS_GETNBADD /**/ /* config-skip */ +#undef Getnbadd_net_t long /**/ /* config-skip */ +#endif + /* VMS: In general, TCP/IP header files should be included from * sockadapt.h, instead of here, in order to keep the TCP/IP code * together as much as possible. @@ -1881,6 +1937,12 @@ */ #undef I_NETINET_IN /**/ /* config-skip */ +/* I_NETDB: + * This symbol, if defined, indicates that <netdb.h> exists and + * should be included. + */ +#undef I_NETDB /**/ /* config-skip */ + /* I_NET_ERRNO: * This symbol, if defined, indicates that <net/errno.h> exists and * should be included. @@ -1900,8 +1962,11 @@ #undef HAS_SOCKETPAIR /**/ /* config-skip */ #undef HAS_GETHOSTENT /**/ /* config-skip */ #undef I_NETINET_IN /**/ /* config-skip */ +#undef I_NETDB /**/ /* config-skip */ #undef I_NET_ERRNO /**/ /* config-skip */ #undef HAS_SELECT /**/ /* config-skip */ +#undef HAS_GETHBADD /**/ /* config-skip */ +#undef HAS_GETNBADD /**/ /* config-skip */ #endif /* !VMS_DO_SOCKETS */ diff --git a/vms/descrip.mms b/vms/descrip.mms index f26e0b6bb0..adbcb1cc75 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -1,5 +1,5 @@ # Descrip.MMS for perl5 on VMS -# Last revised 20-Mar-1997 by Charles Bailey bailey@genetics.upenn.edu +# Last revised 23-Dec-1997 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 @@ -74,7 +74,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00454# +PERL_VERSION = 5_00456# .ifdef DECC_SOCKETS SOCKET=1 @@ -208,18 +208,15 @@ SOCKOBJ = SOCKPM = .endif -THREADH = THREAD = .ifdef THREADED THREADDEF = ,USE_THREADS,MULTIPLICITY -THREADH = thread.h THREAD = THREAD .endif .ifdef OLDTHREADED THREADDEF = ,USE_THREADS,MULTIPLICITY,OLD_PTHREADS_API -THREADH = thread.h THREAD = THREAD LIBS2 = sys$share:cma$lib_shr/share,cma$rtl/share .ifdef __AXP__ @@ -229,8 +226,12 @@ LIBS2 = $(LIBS2),sys$share:cma$open_lib_shr/share,cma$open_rtl/share .ifdef FAKETHREADED THREADDEF = ,USE_THREADS,MULTIPLICITY,FAKE_THREADS -THREADH = thread.h fakethr.h +THREADH = fakethr.h +acth = $(ARCHCORE)fakethr.h THREAD = THREAD +.else +THREADH = +acth = .endif # C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger @@ -274,10 +275,11 @@ extobj = $(myextobj) h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h -h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h +h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h, thread.h h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h, perlio.h, perlsdio.h -h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) $(THREADH) +h5 = embedvar.h, intrpvar.h, perlvars.h, thrdvar.h +h = $(h1), $(h2), $(h3), $(h4), $(h5) $(SOCKHLIS) $(THREADH) c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c, perlio.c c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c @@ -295,11 +297,12 @@ ac1 = $(ARCHCORE)EXTERN.h $(ARCHCORE)INTERN.h $(ARCHCORE)XSUB.h $(ARCHCORE)av.h ac2 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h -ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h +ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h $(ARCHCORE)thread.h ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h -ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt -ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt +ac8 = $(ARCHCORE)embedvar.h $(ARCHCORE)intrpvar.h $(ARCHCORE)perlvars.h $(ARCHCORE)thrdvar.h +ac9 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt +ac10 = $(ARCHCORE)$(DBG)perlshr_bld.opt .ifdef SOCKET acs = $(ARCHCORE)$(SOCKH) .else @@ -365,7 +368,7 @@ pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.p 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 +archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(ac10) $(acs) $(acth) $(ARCHAUTO)time.stamp @ $(NOOP) miniperl : $(DBG)miniperl$(E) @@ -853,8 +856,6 @@ printconfig : .ifdef LINK_ONLY .else -$(SOCKOBJ) : $(SOCKC) $(SOCKH) - [.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE) @@ -864,6 +865,8 @@ $(SOCKOBJ) : $(SOCKC) $(SOCKH) vmsish.h : $(SOCKH) +$(SOCKOBJ) : $(SOCKC) EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h + $(SOCKC) : [.vms]$(SOCKC) Copy/Log/NoConfirm [.vms]$(SOCKC) []$(SOCKC) @@ -958,6 +961,14 @@ $(ARCHCORE)cv.h : cv.h $(ARCHCORE)embed.h : embed.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)embedvar.h : embedvar.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +.ifdef FAKETHREADED +$(ARCHCORE)fakethr.h : fakethr.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +.endif $(ARCHCORE)form.h : form.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) @@ -970,6 +981,9 @@ $(ARCHCORE)handy.h : handy.h $(ARCHCORE)hv.h : hv.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)intrpvar.h : intrpvar.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)keywords.h : keywords.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) @@ -994,6 +1008,9 @@ $(ARCHCORE)perlio.h : perlio.h $(ARCHCORE)perlsdio.h : perlsdio.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)perlvars.h : perlvars.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)perly.h : perly.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) @@ -1015,6 +1032,12 @@ $(ARCHCORE)scope.h : scope.h $(ARCHCORE)sv.h : sv.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)thrdvar.h : thrdvar.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)thread.h : thread.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)util.h : util.h @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) @@ -1046,713 +1069,41 @@ $(ARCHAUTO)time.stamp : util$(O) : util.c $(CC) $(CFLAGS) util.c # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE -av$(O) : EXTERN.h -av$(O) : av.c -av$(O) : av.h -av$(O) : config.h -av$(O) : cop.h -av$(O) : cv.h -av$(O) : embed.h -av$(O) : form.h -av$(O) : gv.h -av$(O) : handy.h -av$(O) : hv.h -av$(O) : mg.h -av$(O) : op.h -av$(O) : opcode.h -av$(O) : perl.h -av$(O) : perly.h -av$(O) : pp.h -av$(O) : proto.h -av$(O) : regexp.h -av$(O) : scope.h -av$(O) : sv.h -av$(O) : vmsish.h -av$(O) : util.h -scope$(O) : EXTERN.h -scope$(O) : av.h -scope$(O) : config.h -scope$(O) : cop.h -scope$(O) : cv.h -scope$(O) : embed.h -scope$(O) : form.h -scope$(O) : gv.h -scope$(O) : handy.h -scope$(O) : hv.h -scope$(O) : mg.h -scope$(O) : op.h -scope$(O) : opcode.h -scope$(O) : perl.h -scope$(O) : perly.h -scope$(O) : pp.h -scope$(O) : proto.h -scope$(O) : regexp.h -scope$(O) : scope.c -scope$(O) : scope.h -scope$(O) : sv.h -scope$(O) : vmsish.h -scope$(O) : util.h -op$(O) : EXTERN.h -op$(O) : av.h -op$(O) : config.h -op$(O) : cop.h -op$(O) : cv.h -op$(O) : embed.h -op$(O) : form.h -op$(O) : gv.h -op$(O) : handy.h -op$(O) : hv.h -op$(O) : mg.h -op$(O) : op.c -op$(O) : op.h -op$(O) : opcode.h -op$(O) : perl.h -op$(O) : perly.h -op$(O) : pp.h -op$(O) : proto.h -op$(O) : regexp.h -op$(O) : scope.h -op$(O) : sv.h -op$(O) : vmsish.h -op$(O) : util.h -doop$(O) : EXTERN.h -doop$(O) : av.h -doop$(O) : config.h -doop$(O) : cop.h -doop$(O) : cv.h -doop$(O) : doop.c -doop$(O) : embed.h -doop$(O) : form.h -doop$(O) : gv.h -doop$(O) : handy.h -doop$(O) : hv.h -doop$(O) : mg.h -doop$(O) : op.h -doop$(O) : opcode.h -doop$(O) : perl.h -doop$(O) : perly.h -doop$(O) : pp.h -doop$(O) : proto.h -doop$(O) : regexp.h -doop$(O) : scope.h -doop$(O) : sv.h -doop$(O) : vmsish.h -doop$(O) : util.h -doio$(O) : EXTERN.h -doio$(O) : av.h -doio$(O) : config.h -doio$(O) : cop.h -doio$(O) : cv.h -doio$(O) : doio.c -doio$(O) : embed.h -doio$(O) : form.h -doio$(O) : gv.h -doio$(O) : handy.h -doio$(O) : hv.h -doio$(O) : mg.h -doio$(O) : op.h -doio$(O) : opcode.h -doio$(O) : perl.h -doio$(O) : perly.h -doio$(O) : pp.h -doio$(O) : proto.h -doio$(O) : regexp.h -doio$(O) : scope.h -doio$(O) : sv.h -doio$(O) : vmsish.h -doio$(O) : util.h -dump$(O) : EXTERN.h -dump$(O) : av.h -dump$(O) : config.h -dump$(O) : cop.h -dump$(O) : cv.h -dump$(O) : dump.c -dump$(O) : embed.h -dump$(O) : form.h -dump$(O) : gv.h -dump$(O) : handy.h -dump$(O) : hv.h -dump$(O) : mg.h -dump$(O) : op.h -dump$(O) : opcode.h -dump$(O) : perl.h -dump$(O) : perly.h -dump$(O) : pp.h -dump$(O) : proto.h -dump$(O) : regexp.h -dump$(O) : scope.h -dump$(O) : sv.h -dump$(O) : vmsish.h -dump$(O) : util.h -hv$(O) : EXTERN.h -hv$(O) : av.h -hv$(O) : config.h -hv$(O) : cop.h -hv$(O) : cv.h -hv$(O) : embed.h -hv$(O) : form.h -hv$(O) : gv.h -hv$(O) : handy.h -hv$(O) : hv.c -hv$(O) : hv.h -hv$(O) : mg.h -hv$(O) : op.h -hv$(O) : opcode.h -hv$(O) : perl.h -hv$(O) : perly.h -hv$(O) : pp.h -hv$(O) : proto.h -hv$(O) : regexp.h -hv$(O) : scope.h -hv$(O) : sv.h -hv$(O) : vmsish.h -hv$(O) : util.h -mg$(O) : EXTERN.h -mg$(O) : av.h -mg$(O) : config.h -mg$(O) : cop.h -mg$(O) : cv.h -mg$(O) : embed.h -mg$(O) : form.h -mg$(O) : gv.h -mg$(O) : handy.h -mg$(O) : hv.h -mg$(O) : mg.c -mg$(O) : mg.h -mg$(O) : op.h -mg$(O) : opcode.h -mg$(O) : perl.h -mg$(O) : perly.h -mg$(O) : pp.h -mg$(O) : proto.h -mg$(O) : regexp.h -mg$(O) : scope.h -mg$(O) : sv.h -mg$(O) : vmsish.h -mg$(O) : util.h -universal$(O) : EXTERN.h -universal$(O) : av.h -universal$(O) : config.h -universal$(O) : cop.h -universal$(O) : cv.h -universal$(O) : embed.h -universal$(O) : form.h -universal$(O) : gv.h -universal$(O) : handy.h -universal$(O) : hv.h -universal$(O) : mg.h -universal$(O) : op.h -universal$(O) : opcode.h -universal$(O) : perl.h -universal$(O) : perly.h -universal$(O) : pp.h -universal$(O) : proto.h -universal$(O) : regexp.h -universal$(O) : scope.h -universal$(O) : sv.h -universal$(O) : vmsish.h -universal$(O) : util.h -universal$(O) : universal.c -perl$(O) : EXTERN.h -perl$(O) : av.h -perl$(O) : config.h -perl$(O) : cop.h -perl$(O) : cv.h -perl$(O) : embed.h -perl$(O) : form.h -perl$(O) : gv.h -perl$(O) : handy.h -perl$(O) : hv.h -perl$(O) : mg.h -perl$(O) : op.h -perl$(O) : opcode.h -perl$(O) : perl.c -perl$(O) : perl.h -perl$(O) : perly.h -perl$(O) : pp.h -perl$(O) : proto.h -perl$(O) : regexp.h -perl$(O) : scope.h -perl$(O) : sv.h -perl$(O) : vmsish.h -perl$(O) : util.h -perly$(O) : EXTERN.h -perly$(O) : av.h -perly$(O) : config.h -perly$(O) : cop.h -perly$(O) : cv.h -perly$(O) : embed.h -perly$(O) : form.h -perly$(O) : gv.h -perly$(O) : handy.h -perly$(O) : hv.h -perly$(O) : mg.h -perly$(O) : op.h -perly$(O) : opcode.h -perly$(O) : perl.h -perly$(O) : perly.h -perly$(O) : perly.c -perly$(O) : pp.h -perly$(O) : proto.h -perly$(O) : regexp.h -perly$(O) : scope.h -perly$(O) : sv.h -perly$(O) : vmsish.h -perly$(O) : util.h -pp$(O) : EXTERN.h -pp$(O) : av.h -pp$(O) : config.h -pp$(O) : cop.h -pp$(O) : cv.h -pp$(O) : embed.h -pp$(O) : form.h -pp$(O) : gv.h -pp$(O) : handy.h -pp$(O) : hv.h -pp$(O) : mg.h -pp$(O) : op.h -pp$(O) : opcode.h -pp$(O) : perl.h -pp$(O) : perly.h -pp$(O) : pp.c -pp$(O) : pp.h -pp$(O) : proto.h -pp$(O) : regexp.h -pp$(O) : scope.h -pp$(O) : sv.h -pp$(O) : vmsish.h -pp$(O) : util.h -pp_ctl$(O) : EXTERN.h -pp_ctl$(O) : av.h -pp_ctl$(O) : config.h -pp_ctl$(O) : cop.h -pp_ctl$(O) : cv.h -pp_ctl$(O) : embed.h -pp_ctl$(O) : form.h -pp_ctl$(O) : gv.h -pp_ctl$(O) : handy.h -pp_ctl$(O) : hv.h -pp_ctl$(O) : mg.h -pp_ctl$(O) : op.h -pp_ctl$(O) : opcode.h -pp_ctl$(O) : perl.h -pp_ctl$(O) : perly.h -pp_ctl$(O) : pp_ctl.c -pp_ctl$(O) : pp.h -pp_ctl$(O) : proto.h -pp_ctl$(O) : regexp.h -pp_ctl$(O) : scope.h -pp_ctl$(O) : sv.h -pp_ctl$(O) : vmsish.h -pp_ctl$(O) : util.h -pp_hot$(O) : EXTERN.h -pp_hot$(O) : av.h -pp_hot$(O) : config.h -pp_hot$(O) : cop.h -pp_hot$(O) : cv.h -pp_hot$(O) : embed.h -pp_hot$(O) : form.h -pp_hot$(O) : gv.h -pp_hot$(O) : handy.h -pp_hot$(O) : hv.h -pp_hot$(O) : mg.h -pp_hot$(O) : op.h -pp_hot$(O) : opcode.h -pp_hot$(O) : perl.h -pp_hot$(O) : perly.h -pp_hot$(O) : pp_hot.c -pp_hot$(O) : pp.h -pp_hot$(O) : proto.h -pp_hot$(O) : regexp.h -pp_hot$(O) : scope.h -pp_hot$(O) : sv.h -pp_hot$(O) : vmsish.h -pp_hot$(O) : util.h -pp_sys$(O) : EXTERN.h -pp_sys$(O) : av.h -pp_sys$(O) : config.h -pp_sys$(O) : cop.h -pp_sys$(O) : cv.h -pp_sys$(O) : embed.h -pp_sys$(O) : form.h -pp_sys$(O) : gv.h -pp_sys$(O) : handy.h -pp_sys$(O) : hv.h -pp_sys$(O) : mg.h -pp_sys$(O) : op.h -pp_sys$(O) : opcode.h -pp_sys$(O) : perl.h -pp_sys$(O) : perly.h -pp_sys$(O) : pp_sys.c -pp_sys$(O) : pp.h -pp_sys$(O) : proto.h -pp_sys$(O) : regexp.h -pp_sys$(O) : scope.h -pp_sys$(O) : sv.h -pp_sys$(O) : vmsish.h -pp_sys$(O) : util.h -regcomp$(O) : EXTERN.h -regcomp$(O) : INTERN.h -regcomp$(O) : av.h -regcomp$(O) : config.h -regcomp$(O) : cop.h -regcomp$(O) : cv.h -regcomp$(O) : embed.h -regcomp$(O) : form.h -regcomp$(O) : gv.h -regcomp$(O) : handy.h -regcomp$(O) : hv.h -regcomp$(O) : mg.h -regcomp$(O) : op.h -regcomp$(O) : opcode.h -regcomp$(O) : perl.h -regcomp$(O) : perly.h -regcomp$(O) : pp.h -regcomp$(O) : proto.h -regcomp$(O) : regcomp.c -regcomp$(O) : regcomp.h -regcomp$(O) : regexp.h -regcomp$(O) : scope.h -regcomp$(O) : sv.h -regcomp$(O) : vmsish.h -regcomp$(O) : util.h -regexec$(O) : EXTERN.h -regexec$(O) : av.h -regexec$(O) : config.h -regexec$(O) : cop.h -regexec$(O) : cv.h -regexec$(O) : embed.h -regexec$(O) : form.h -regexec$(O) : gv.h -regexec$(O) : handy.h -regexec$(O) : hv.h -regexec$(O) : mg.h -regexec$(O) : op.h -regexec$(O) : opcode.h -regexec$(O) : perl.h -regexec$(O) : perly.h -regexec$(O) : pp.h -regexec$(O) : proto.h -regexec$(O) : regcomp.h -regexec$(O) : regexec.c -regexec$(O) : regexp.h -regexec$(O) : scope.h -regexec$(O) : sv.h -regexec$(O) : vmsish.h -regexec$(O) : util.h -gv$(O) : EXTERN.h -gv$(O) : av.h -gv$(O) : config.h -gv$(O) : cop.h -gv$(O) : cv.h -gv$(O) : embed.h -gv$(O) : form.h -gv$(O) : gv.c -gv$(O) : gv.h -gv$(O) : handy.h -gv$(O) : hv.h -gv$(O) : mg.h -gv$(O) : op.h -gv$(O) : opcode.h -gv$(O) : perl.h -gv$(O) : perly.h -gv$(O) : pp.h -gv$(O) : proto.h -gv$(O) : regexp.h -gv$(O) : scope.h -gv$(O) : sv.h -gv$(O) : vmsish.h -gv$(O) : util.h -sv$(O) : EXTERN.h -sv$(O) : av.h -sv$(O) : config.h -sv$(O) : cop.h -sv$(O) : cv.h -sv$(O) : embed.h -sv$(O) : form.h -sv$(O) : gv.h -sv$(O) : handy.h -sv$(O) : hv.h -sv$(O) : mg.h -sv$(O) : op.h -sv$(O) : opcode.h -sv$(O) : perl.h -sv$(O) : perly.h -sv$(O) : pp.h -sv$(O) : proto.h -sv$(O) : regexp.h -sv$(O) : scope.h -sv$(O) : sv.c -sv$(O) : sv.h -sv$(O) : vmsish.h -sv$(O) : util.h -taint$(O) : EXTERN.h -taint$(O) : av.h -taint$(O) : config.h -taint$(O) : cop.h -taint$(O) : cv.h -taint$(O) : embed.h -taint$(O) : form.h -taint$(O) : gv.h -taint$(O) : handy.h -taint$(O) : hv.h -taint$(O) : mg.h -taint$(O) : op.h -taint$(O) : opcode.h -taint$(O) : perl.h -taint$(O) : perly.h -taint$(O) : pp.h -taint$(O) : proto.h -taint$(O) : regexp.h -taint$(O) : scope.h -taint$(O) : sv.h -taint$(O) : taint.c -taint$(O) : vmsish.h -taint$(O) : util.h -toke$(O) : EXTERN.h -toke$(O) : av.h -toke$(O) : config.h -toke$(O) : cop.h -toke$(O) : cv.h -toke$(O) : embed.h -toke$(O) : form.h -toke$(O) : gv.h -toke$(O) : handy.h -toke$(O) : hv.h -toke$(O) : keywords.h -toke$(O) : mg.h -toke$(O) : op.h -toke$(O) : opcode.h -toke$(O) : perl.h -toke$(O) : perly.h -toke$(O) : pp.h -toke$(O) : proto.h -toke$(O) : regexp.h -toke$(O) : scope.h -toke$(O) : sv.h -toke$(O) : toke.c -toke$(O) : vmsish.h -toke$(O) : util.h -util$(O) : EXTERN.h -util$(O) : av.h -util$(O) : config.h -util$(O) : cop.h -util$(O) : cv.h -util$(O) : embed.h -util$(O) : form.h -util$(O) : gv.h -util$(O) : handy.h -util$(O) : hv.h -util$(O) : mg.h -util$(O) : op.h -util$(O) : opcode.h -util$(O) : perl.h -util$(O) : perly.h -util$(O) : pp.h -util$(O) : proto.h -util$(O) : regexp.h -util$(O) : scope.h -util$(O) : sv.h -util$(O) : vmsish.h -util$(O) : util.c -util$(O) : util.h -deb$(O) : EXTERN.h -deb$(O) : av.h -deb$(O) : config.h -deb$(O) : cop.h -deb$(O) : cv.h -deb$(O) : deb.c -deb$(O) : embed.h -deb$(O) : form.h -deb$(O) : gv.h -deb$(O) : handy.h -deb$(O) : hv.h -deb$(O) : mg.h -deb$(O) : op.h -deb$(O) : opcode.h -deb$(O) : perl.h -deb$(O) : perly.h -deb$(O) : pp.h -deb$(O) : proto.h -deb$(O) : regexp.h -deb$(O) : scope.h -deb$(O) : sv.h -deb$(O) : vmsish.h -deb$(O) : util.h -run$(O) : EXTERN.h -run$(O) : av.h -run$(O) : config.h -run$(O) : cop.h -run$(O) : cv.h -run$(O) : embed.h -run$(O) : form.h -run$(O) : gv.h -run$(O) : handy.h -run$(O) : hv.h -run$(O) : mg.h -run$(O) : op.h -run$(O) : opcode.h -run$(O) : perl.h -run$(O) : perly.h -run$(O) : pp.h -run$(O) : proto.h -run$(O) : regexp.h -run$(O) : run.c -run$(O) : scope.h -run$(O) : sv.h -run$(O) : vmsish.h -run$(O) : util.h -vms$(O) : EXTERN.h -vms$(O) : av.h -vms$(O) : config.h -vms$(O) : cop.h -vms$(O) : cv.h -vms$(O) : embed.h -vms$(O) : form.h -vms$(O) : gv.h -vms$(O) : handy.h -vms$(O) : hv.h -vms$(O) : mg.h -vms$(O) : op.h -vms$(O) : opcode.h -vms$(O) : perl.h -vms$(O) : perly.h -vms$(O) : pp.h -vms$(O) : proto.h -vms$(O) : regexp.h -vms$(O) : vms.c -vms$(O) : scope.h -vms$(O) : sv.h -vms$(O) : vmsish.h -vms$(O) : util.h -perlio$(O) : EXTERN.h -perlio$(O) : av.h -perlio$(O) : config.h -perlio$(O) : cop.h -perlio$(O) : cv.h -perlio$(O) : embed.h -perlio$(O) : form.h -perlio$(O) : gv.h -perlio$(O) : handy.h -perlio$(O) : hv.h -perlio$(O) : mg.h -perlio$(O) : op.h -perlio$(O) : opcode.h -perlio$(O) : perl.h -perlio$(O) : perly.h -perlio$(O) : pp.h -perlio$(O) : proto.h -perlio$(O) : regexp.h -perlio$(O) : perlio.c -perlio$(O) : scope.h -perlio$(O) : sv.h -perlio$(O) : vmsish.h -perlio$(O) : util.h -miniperlmain$(O) : EXTERN.h -miniperlmain$(O) : av.h -miniperlmain$(O) : config.h -miniperlmain$(O) : cop.h -miniperlmain$(O) : cv.h -miniperlmain$(O) : embed.h -miniperlmain$(O) : form.h -miniperlmain$(O) : gv.h -miniperlmain$(O) : handy.h -miniperlmain$(O) : hv.h -miniperlmain$(O) : mg.h -miniperlmain$(O) : miniperlmain.c -miniperlmain$(O) : op.h -miniperlmain$(O) : opcode.h -miniperlmain$(O) : perl.h -miniperlmain$(O) : perly.h -miniperlmain$(O) : pp.h -miniperlmain$(O) : proto.h -miniperlmain$(O) : regexp.h -miniperlmain$(O) : scope.h -miniperlmain$(O) : sv.h -miniperlmain$(O) : vmsish.h -miniperlmain$(O) : util.h -perlmain$(O) : EXTERN.h -perlmain$(O) : av.h -perlmain$(O) : config.h -perlmain$(O) : cop.h -perlmain$(O) : cv.h -perlmain$(O) : embed.h -perlmain$(O) : form.h -perlmain$(O) : gv.h -perlmain$(O) : handy.h -perlmain$(O) : hv.h -perlmain$(O) : mg.h -perlmain$(O) : op.h -perlmain$(O) : opcode.h -perlmain$(O) : perl.h -perlmain$(O) : perly.h -perlmain$(O) : perlmain.c -perlmain$(O) : pp.h -perlmain$(O) : proto.h -perlmain$(O) : regexp.h -perlmain$(O) : scope.h -perlmain$(O) : sv.h -perlmain$(O) : vmsish.h -perlmain$(O) : util.h -globals$(O) : INTERN.h -globals$(O) : av.h -globals$(O) : config.h -globals$(O) : cop.h -globals$(O) : cv.h -globals$(O) : embed.h -globals$(O) : form.h -globals$(O) : gv.h -globals$(O) : handy.h -globals$(O) : hv.h -globals$(O) : mg.h -globals$(O) : op.h -globals$(O) : opcode.h -globals$(O) : perl.h -globals$(O) : perly.h -globals$(O) : globals.c -globals$(O) : pp.h -globals$(O) : proto.h -globals$(O) : regexp.h -globals$(O) : scope.h -globals$(O) : sv.h -globals$(O) : vmsish.h -globals$(O) : util.h -[.x2p]a2p$(O) : [.x2p]a2p.c -[.x2p]a2p$(O) : [.x2p]a2py.c -[.x2p]a2p$(O) : [.x2p]INTERN.h -[.x2p]a2p$(O) : [.x2p]a2p.h -[.x2p]a2p$(O) : [.x2p]hash.h -[.x2p]a2p$(O) : [.x2p]str.h -[.x2p]a2p$(O) : handy.h -[.x2p]hash$(O) : [.x2p]hash.c -[.x2p]hash$(O) : [.x2p]EXTERN.h -[.x2p]hash$(O) : [.x2p]a2p.h -[.x2p]hash$(O) : [.x2p]hash.h -[.x2p]hash$(O) : [.x2p]str.h -[.x2p]hash$(O) : handy.h -[.x2p]hash$(O) : [.x2p]util.h -[.x2p]str$(O) : [.x2p]str.c -[.x2p]str$(O) : [.x2p]EXTERN.h -[.x2p]str$(O) : [.x2p]a2p.h -[.x2p]str$(O) : [.x2p]hash.h -[.x2p]str$(O) : [.x2p]str.h -[.x2p]str$(O) : handy.h -[.x2p]str$(O) : [.x2p]util.h -[.x2p]util$(O) : [.x2p]util.c -[.x2p]util$(O) : [.x2p]EXTERN.h -[.x2p]util$(O) : [.x2p]a2p.h -[.x2p]util$(O) : [.x2p]hash.h -[.x2p]util$(O) : [.x2p]str.h -[.x2p]util$(O) : handy.h -[.x2p]util$(O) : [.x2p]INTERN.h -[.x2p]util$(O) : [.x2p]util.h -[.x2p]walk$(O) : [.x2p]walk.c -[.x2p]walk$(O) : [.x2p]EXTERN.h -[.x2p]walk$(O) : [.x2p]a2p.h -[.x2p]walk$(O) : [.x2p]hash.h -[.x2p]walk$(O) : [.x2p]str.h -[.x2p]walk$(O) : handy.h -[.x2p]walk$(O) : [.x2p]util.h +av$(O) : av.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +deb$(O) : deb.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +doio$(O) : doio.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +doop$(O) : doop.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +dump$(O) : dump.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +globals$(O) : globals.c INTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +gv$(O) : gv.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +hv$(O) : hv.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +malloc$(O) : malloc.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +mg$(O) : mg.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +miniperlmain$(O) : miniperlmain.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +op$(O) : op.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +perl$(O) : perl.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h patchlevel.h +perlio$(O) : perlio.c config.h EXTERN.h perl.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +perlmain$(O) : perlmain.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +perly$(O) : perly.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +pp$(O) : pp.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +pp_ctl$(O) : pp_ctl.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +pp_hot$(O) : pp_hot.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +pp_sys$(O) : pp_sys.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +regcomp$(O) : regcomp.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h INTERN.h regcomp.h +regexec$(O) : regexec.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h regcomp.h +run$(O) : run.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +scope$(O) : scope.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +sv$(O) : sv.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +taint$(O) : taint.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +toke$(O) : toke.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h keywords.h +universal$(O) : universal.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h XSUB.h +util$(O) : util.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h +vms$(O) : vms.c EXTERN.h perl.h config.h embed.h perlio.h perlsdio.h handy.h vmsish.h regexp.h sv.h util.h form.h gv.h cv.h opcode.h op.h cop.h av.h hv.h mg.h scope.h perly.h thread.h pp.h proto.h embedvar.h perlvars.h thrdvar.h intrpvar.h XSUB.h +[.x2p]a2p$(O) : [.x2p]a2p.c [.x2p]a2py.c [.x2p]INTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h config.h handy.h +[.x2p]hash$(O) : [.x2p]hash.c [.x2p]EXTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h +[.x2p]str$(O) : [.x2p]str.c [.x2p]EXTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h +[.x2p]util$(O) : [.x2p]util.c [.x2p]EXTERN.h [.x2p]INTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h +[.x2p]walk$(O) : [.x2p]walk.c [.x2p]EXTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h .endif # !LINK_ONLY config.h : [.vms]config.vms diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index 807ce59a90..0a8d7e60dc 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -39,7 +39,7 @@ require 5.000; $debug = $ENV{'GEN_SHRFLS_DEBUG'}; -print "gen_shrfls.pl Rev. 03-Nov-1997\n" if $debug; +print "gen_shrfls.pl Rev. 14-Dec-1997\n" if $debug; if ($ARGV[0] eq '-f') { open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; @@ -399,8 +399,6 @@ __END__ # Oddball cases, so we can keep the perl.h scan above simple rcsid=vars # declared in perl.c -regarglen=vars # declared in regcomp.h -regdummy=vars # declared in regcomp.h regkind=vars # declared in regcomp.h simple=vars # declared in regcomp.h varies=vars # declared in regcomp.h diff --git a/vms/genconfig.pl b/vms/genconfig.pl index 3b88be529b..d2da57262c 100644 --- a/vms/genconfig.pl +++ b/vms/genconfig.pl @@ -67,17 +67,17 @@ package='perl5' CONFIG='true' cf_time='$time' cf_by='$cf_by' -ccdlflags='' -cccdlflags='' -mab='' +ccdlflags='undef' +cccdlflags='undef' +mab='undef' libpth='/sys\$share /sys\$library' ld='Link' lddlflags='/Share' -ranlib='' -ar='' +ranlib='undef' +ar='undef' eunicefix=':' hint='none' -hintfile='' +hintfile='undef' useshrplib='define' usemymalloc='n' usevfork='true' @@ -167,12 +167,23 @@ foreach (@ARGV) { print OUT "d_sockpair=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "d_gethent=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "i_netdb=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "d_gethbadd=",$dosock ? "'define'\n" : "'undef'\n"; + print OUT "gethbadd_addr_type=",$dosock ? "'char *'\n" : "'undef'\n"; + print OUT "gethbadd_alen_type=",$dosock ? "'int'\n" : "'undef'\n"; + if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) { - print OUT "selecttype=fd_set\n"; + print OUT "selecttype='fd_set'\n"; + print OUT "d_getnbadd='define'\n"; + print OUT "getnbadd_net_type='long'\n"; + } + else { + print OUT "selecttype='int'\n"; + print OUT "d_getnbadd='undef'\n"; + print OUT "getnbadd_net_type='undef'\n"; } - else { print OUT "selecttype=int\n"; } if ($cctype eq 'decc') { $rtlhas = 'define'; print OUT "useposix='true'\n"; } else { $rtlhas = 'undef'; print OUT "useposix='false'\n"; } diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 7514f16803..8495c4d955 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1353,6 +1353,7 @@ yyparse(void) if (yyn >= '0' && yyn <= '9') yydebug = yyn - '0'; } + else SETERRNO(0,SS$_NORMAL); #endif yynerrs = 0; @@ -1019,6 +1019,14 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) if (*(cp1+2) == '.') cp1++; if (*(cp1+2) == '/' || *(cp1+2) == '\0') { if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL; + if (strchr(vmsdir,'/') != NULL) { + /* If do_tovmsspec() returned it, it must have VMS syntax + * delimiters in it, so it's a mixed VMS/Unix spec. We take + * the time to check this here only so we avoid a recursion + * loop; otherwise, gigo. + */ + set_errno(EINVAL); set_vaxc_errno(RMS$_SYN); return NULL; + } if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL; return do_tounixspec(trndir,buf,ts); } diff --git a/vms/vmsish.h b/vms/vmsish.h index c994140dab..cc08f39574 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -237,7 +237,7 @@ #endif #define BIT_BUCKET "_NLA0:" -#define PERL_SYS_INIT(c,v) vms_image_init((c),(v)), MALLOC_INIT +#define PERL_SYS_INIT(c,v) vms_image_init((c),(v)); MALLOC_INIT #define PERL_SYS_TERM() MALLOC_TERM #define dXSUB_SYS #define HAS_KILL diff --git a/x2p/s2p.PL b/x2p/s2p.PL index 73f67872de..fa0d567b6c 100644 --- a/x2p/s2p.PL +++ b/x2p/s2p.PL @@ -135,7 +135,7 @@ while ($ARGV[0] =~ /^-/) { } unless ($debug) { - open(BODY,">/tmp/sperl$$") || + open(BODY,"+>/tmp/sperl$$") || &Die("Can't open temp file: $!\n"); } @@ -343,26 +343,7 @@ print BODY &q(<<'EOT'); EOT } -close BODY; - unless ($debug) { - open(HEAD,">/tmp/sperl2$$.c") - || &Die("Can't open temp file 2: $!\n"); - print HEAD "#define PRINTIT\n" if $printit; - print HEAD "#define APPENDSEEN\n" if $appendseen; - print HEAD "#define TSEEN\n" if $tseen; - print HEAD "#define DSEEN\n" if $dseen; - print HEAD "#define ASSUMEN\n" if $assumen; - print HEAD "#define ASSUMEP\n" if $assumep; - print HEAD "#define TOPLABEL\n" if $toplabel; - print HEAD "#define SAWNEXT\n" if $sawnext; - if ($opens) {print HEAD "$opens\n";} - open(BODY,"/tmp/sperl$$") - || &Die("Can't reopen temp file: $!\n"); - while (<BODY>) { - print HEAD $_; - } - close HEAD; print &q(<<"EOT"); : $startperl @@ -370,11 +351,13 @@ unless ($debug) { : if \$running_under_some_shell; : EOT - open(BODY,"cc -E /tmp/sperl2$$.c |") || - &Die("Can't reopen temp file: $!\n"); + print"$opens\n" if $opens; + seek(BODY, 0, 0) || die "Can't rewind temp file: $!\n"; while (<BODY>) { - /^# [0-9]/ && next; /^[ \t]*$/ && next; + /^#ifdef (\w+)/ && ((${lc $1} || &skip), next); + /^#else/ && (&skip, next); + /^#endif/ && next; s/^<><>//; print; } @@ -384,8 +367,7 @@ EOT exit; sub Cleanup { - chdir "/tmp"; - unlink "sperl$$", "sperl2$$", "sperl2$$.c"; + unlink "/tmp/sperl$$"; } sub Die { &Cleanup; @@ -603,7 +585,6 @@ EOT $repl = substr($_, $repl+1, $end-$repl-1); $end = substr($_, $end + 1, 1000); &simplify($pat); - $dol = '$'; $subst = "$pat$repl$delim"; $cmd = ''; while ($end) { @@ -846,6 +827,17 @@ sub simplify { $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g; } +sub skip { + local($level) = 0; + + while(<BODY>) { + /^#ifdef/ && $level++; + /^#else/ && !$level && return; + /^#endif/ && !$level-- && return; + } + + die "Unterminated `#ifdef' conditional\n"; +} !NO!SUBS! close OUT or die "Can't close $file: $!"; |