diff options
| -rw-r--r-- | configure.com | 74 | ||||
| -rw-r--r-- | lib/File/Spec/VMS.pm | 66 | ||||
| -rwxr-xr-x | t/lib/filespec.t | 64 | ||||
| -rw-r--r-- | vms/ext/filespec.t | 4 | ||||
| -rw-r--r-- | vms/subconfigure.com | 381 | ||||
| -rw-r--r-- | vms/vms.c | 30 |
6 files changed, 297 insertions, 322 deletions
diff --git a/configure.com b/configure.com index 84ac265024..8c65d774b9 100644 --- a/configure.com +++ b/configure.com @@ -134,12 +134,17 @@ $ use_5005_threads = "N" $ use_ithreads = "N" $! $!: option parsing +$ config_args = "" $ IF (P1 .NES. "") $ THEN !one or more switches was thrown $ i = 1 $ bang = 0 $Param_loop: -$ IF (P'i'.NES."") THEN bang = bang + 1 +$ IF (P'i'.NES."") +$ THEN +$ bang = bang + 1 +$ config_args = config_args + F$FAO(" !AS",P'i') +$ ENDIF $ i = i + 1 $ IF (i.LT.9) THEN GOTO Param_loop !DCL allows P1..P8 $! @@ -300,6 +305,7 @@ $ i = i + 1 $ IF (i .LT. (bang + 1)) THEN GOTO Opt_loop $! $ ENDIF ! (P1 .NES. "") +$ config_args = F$EDIT(config_args,"TRIM") $! $ IF (error) $ THEN @@ -766,7 +772,7 @@ $!: who configured the system $! see 'user' above. $ cf_by = F$EDIT(user,"LOWERCASE") $! cf_time = F$CVTIME() !superceded by procedure below -$ osvers = F$GETSYI("VERSION") +$ osvers = F$EDIT(F$GETSYI("VERSION"),"TRIM") $! $! Peter Prymmer has seen: $! "SYS$TIMEZONE_DIFFERENTIAL" = "-46800" (sic) @@ -899,9 +905,13 @@ $ IF (F$GETSYI("HW_MODEL") .LT. 1024) $ THEN $ archname = "VMS_VAX" $ otherarch = "an Alpha" +$ alignbytes="8" +$ arch_type = "ARCH-TYPE=__VAX__" $ ELSE $ archname = "VMS_AXP" $ otherarch = "a VAX" +$ alignbytes="8" +$ arch_type = "ARCH-TYPE=__AXP__" $ ENDIF $ rp = "What is your architecture name? [''archname'] " $ GOSUB myread @@ -970,7 +980,7 @@ $! $ vms_skip_install = "true" $ dflt = "y" $! echo "" -$ rp = "%Config-I-VMS, Do you wish to skip the remaining """"where install"""" questions? [''dflt'] " +$ rp = "%Config-I-VMS, Skip the remaining """"where install"""" questions? [''dflt'] " $ GOSUB myread $ IF (.NOT.ans).AND.(ans.NES."") THEN vms_skip_install = "false" $ IF (.NOT.vms_skip_install) @@ -1032,7 +1042,8 @@ $ ENDIF $ ENDIF ! (.NOT.perl_symbol) $! $!: set the base revision -$ baserev="5" +$ baserev="5.0" +$ revision = baserev - ".0" $!: get the patchlevel $ echo "" $ echo4 "Getting the current patchlevel..." !>&4 @@ -1041,6 +1052,9 @@ $ IF (patchlevel_h.NES."") $ THEN $ got_patch = "false" $ got_sub = "false" +$ got_api_revision = "false" +$ got_api_version = "false" +$ got_api_subversion = "false" $ OPEN/READONLY CONFIG 'patchlevel_h' $Patchlevel_h_loop: $ READ/END_Of_File=Close_patch CONFIG line @@ -1056,6 +1070,24 @@ $ line = F$EDIT(line,"COMPRESS, TRIM") $ subversion = F$ELEMENT(2," ",line) $ got_sub = "true" $ ENDIF +$ IF ((F$LOCATE("#define PERL_API_REVISION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_revision)) +$ THEN +$ line = F$EDIT(line,"COMPRESS, TRIM") +$ api_revision = F$ELEMENT(2," ",line) +$ got_api_revision = "true" +$ ENDIF +$ IF ((F$LOCATE("#define PERL_API_VERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_version)) +$ THEN +$ line = F$EDIT(line,"COMPRESS, TRIM") +$ api_version = F$ELEMENT(2," ",line) +$ got_api_version = "true" +$ ENDIF +$ IF ((F$LOCATE("#define PERL_API_SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_subversion)) +$ THEN +$ line = F$EDIT(line,"COMPRESS, TRIM") +$ api_subversion = F$ELEMENT(2," ",line) +$ got_api_subversion = "true" +$ ENDIF $ IF (.NOT.got_patch).OR.(.NOT.got_sub) THEN GOTO Patchlevel_h_loop $Close_patch: $ CLOSE CONFIG @@ -1063,24 +1095,14 @@ $ ELSE $ patchlevel="0" $ subversion="0" $ ENDIF -$ echo "(You have ''package' ''baserev' PL''patchlevel' sub''subversion'.)" -$! This whole thing needs replacing w/ F$FAO() calls: -$ patchlevel = F$INTEGER(patchlevel) -$ IF patchlevel.LT.10 -$ THEN patchlevel = "00" + F$STRING(patchlevel) -$ ELSE patchlevel = "0" + F$STRING(patchlevel) -$ ENDIF -$ subversion = F$INTEGER(subversion) -$ IF subversion.GT.0 +$ IF (F$STRING(subversion) .NES. "0") $ THEN -$ IF subversion.LT.10 -$ THEN subversion = "0" + F$STRING(subversion) -$ ELSE subversion = F$STRING(subversion) -$ ENDIF -$ ELSE subversion = "" +$ echo "(You have ''package' revision ''revision' patchlevel ''patchlevel' subversion ''subversion'.)" +$ ELSE +$ echo "(You have ''package' revision ''revision' patchlevel ''patchlevel'.)" $ ENDIF $! -$ version = baserev + "_" + patchlevel + "_" + subversion +$ version = revision + "_" + patchlevel + "_" + subversion $! $ IF (.NOT.vms_skip_install) $ THEN @@ -1902,7 +1924,7 @@ $ echo "default file types, however, you can configure Perl to try default" $ echo "file types of nothing, .pl, and .com, in that order (e.g. typing" $ echo """$ perl foo"" would cause Perl to look for foo., then foo.pl, and" $ echo "finally foo.com)." -$ dflt = "n" +$ dflt = "y" $ rp = "Always use default file types? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" @@ -2122,13 +2144,13 @@ $! echo4 "Updating makefile..." $! $ IF (make .EQS. "MMS").OR.(make .EQS. "MMK") $ THEN -$ makefile = "" !wrt MANIFEST dir -$ UUmakefile = "DESCRIP.MMS" !wrt CWD dir -$ DEFmakefile = "DESCRIP.MMS" !wrt DEF dir (?) +$ makefile = "" !wrt MANIFEST dir +$ UUmakefile = "[-]DESCRIP.MMS" !wrt CWD dir +$ DEFmakefile = "DESCRIP.MMS" !wrt DEF dir (?) $ ELSE -$ makefile = " -f [.VMS]Makefile." !wrt MANIFEST dir -$ UUmakefile = "[-.VMS]Makefile." !wrt CWD dir -$ DEFmakefile = "[-.VMS]Makefile." !wrt DEF dir (?) +$ makefile = " -f Makefile." !wrt MANIFEST dir +$ UUmakefile = "[-]Makefile." !wrt CWD dir +$ DEFmakefile = "Makefile." !wrt DEF dir (?) $ ENDIF $! $ IF macros.NES."" diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index d3f6018515..28c1050576 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -128,7 +128,7 @@ sub fixpath { =item canonpath (override) -Removes redundant portions of file specifications according to VMS syntax +Removes redundant portions of file specifications according to VMS syntax. =cut @@ -142,8 +142,13 @@ sub canonpath { else { return vmsify($path); } } else { - $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar - $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo + $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar + $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo + 1 while $path =~ s{-\.-}{--}; # -.- ==> -- + $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/; # bar.foo.-] ==> bar] + $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s + $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g; # bar.-.foo ==> foo + $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode return $path; } } @@ -168,15 +173,16 @@ sub catdir { $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s; $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); - # Special case for VMS absolute directory specs: these will have had device - # prepended during trip through Unix syntax in eliminate_macros(), since - # Unix syntax has no way to express "absolute from the top of this device's - # directory tree". - if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } + # Special case for VMS absolute directory specs: these will have had device + # prepended during trip through Unix syntax in eliminate_macros(), since + # Unix syntax has no way to express "absolute from the top of this device's + # directory tree". + if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } } else { - if ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; } - else { $rslt = vmspath($dir); } + if (not defined $dir or not length $dir) { $rslt = ''; } + elsif ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; } + else { $rslt = vmspath($dir); } } return $rslt; } @@ -205,7 +211,7 @@ sub catfile { $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); } } - else { $rslt = vmsify($file); } + else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; } return $rslt; } @@ -245,7 +251,7 @@ sub rootdir { Returns a string representation of the first writable directory from the following list or '' if none are writable: - /sys$scratch + sys$scratch $ENV{TMPDIR} =cut @@ -253,7 +259,7 @@ from the following list or '' if none are writable: my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - foreach ('/sys$scratch', $ENV{TMPDIR}) { + foreach ('sys$scratch', $ENV{TMPDIR}) { next unless defined && -d && -w _; $tmpdir = $_; last; @@ -333,6 +339,7 @@ Split dirspec using VMS syntax. sub splitdir { my($self,$dirspec) = @_; $dirspec =~ s/\]\[//g; $dirspec =~ s/\-\-/-.-/g; + $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal my(@dirs) = split('\.', vmspath($dirspec)); $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\z//s; @dirs; @@ -347,17 +354,25 @@ Construct a complete filespec using VMS syntax sub catpath { my($self,$dev,$dir,$file) = @_; - if ($dev =~ m|^/+([^/]+)|) { $dev =~ "$1:"; } + if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; } - $dir = vmspath($dir); + if (length($dev) or length($dir)) { + $dir = "[$dir]" unless $dir =~ /[\[<\/]/; + $dir = vmspath($dir); + } "$dev$dir$file"; } +=item abs2rel (override) + +Use VMS syntax when converting filespecs. + +=cut sub abs2rel { my $self = shift; - return File::Spec::Unix::abs2rel( $self, @_ ) + return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) if ( join( '', @_ ) =~ m{/} ) ; my($path,$base) = @_; @@ -413,13 +428,19 @@ sub abs2rel { # @pathchunks now has the directories to descend in to. $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; $path_directories =~ s{\.\z}{} ; - return $self->catpath( '', $path_directories, $path_file ) ; + return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; } +=item rel2abs (override) + +Use VMS syntax when converting filespecs. + +=cut + sub rel2abs($;$;) { my $self = shift ; - return File::Spec::Unix::rel2abs( $self, @_ ) + return vmspath(File::Spec::Unix::rel2abs( $self, @_ )) if ( join( '', @_ ) =~ m{/} ) ; my ($path,$base ) = @_; @@ -443,12 +464,15 @@ sub rel2abs($;$;) { my ( $base_volume, $base_directories, undef ) = $self->splitpath( $base ) ; + $path_directories = '' if $path_directories eq '[]' || + $path_directories eq '<>'; my $sep = '' ; $sep = '.' - if ( $base_directories =~ m{[^.]\z} && - $path_directories =~ m{^[^.]}s + if ( $base_directories =~ m{[^.\]>]\z} && + $path_directories =~ m{^[^.\[<]}s ) ; - $base_directories = "$base_directories$sep$path_directories" ; + $base_directories = "$base_directories$sep$path_directories"; + $base_directories =~ s{\.?[\]>][\[<]\.?}{.}; $path = $self->catpath( $base_volume, $base_directories, $path_file ); } diff --git a/t/lib/filespec.t b/t/lib/filespec.t index e44648ad74..da52ec5fb5 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -181,24 +181,24 @@ BEGIN { [ "Win32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work\\..' ], [ "VMS->splitpath('file')", ',,file' ], -[ "VMS->splitpath('[d1.d2.d3]')", ',d1.d2.d3,' ], -[ "VMS->splitpath('[.d1.d2.d3]')", ',.d1.d2.d3,' ], -[ "VMS->splitpath('[d1.d2.d3]file')", ',d1.d2.d3,file' ], -[ "VMS->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], -[ "VMS->splitpath('/d1/d2/d3/file')", '/d1,/d2/d3/,file' ], -[ "VMS->splitpath('[.d1.d2.d3]file')", ',.d1.d2.d3,file' ], -[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,d1.d2.d3,' ], -[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,d1.d2.d3,file' ], -[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,d1.d2.d3,' ], -[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,d1.d2.d3,file' ], +[ "VMS->splitpath('[d1.d2.d3]')", ',[d1.d2.d3],' ], +[ "VMS->splitpath('[.d1.d2.d3]')", ',[.d1.d2.d3],' ], +[ "VMS->splitpath('[d1.d2.d3]file')", ',[d1.d2.d3],file' ], +[ "VMS->splitpath('d1/d2/d3/file')", ',[.d1.d2.d3],file' ], +[ "VMS->splitpath('/d1/d2/d3/file')", 'd1:,[d2.d3],file' ], +[ "VMS->splitpath('[.d1.d2.d3]file')", ',[.d1.d2.d3],file' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,[d1.d2.d3],' ], +[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,[d1.d2.d3],file' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,[d1.d2.d3],' ], +[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ], [ "VMS->catpath('','','file')", 'file' ], [ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ], [ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ], [ "VMS->catpath('','[d1.d2.d3]','file')", '[d1.d2.d3]file' ], [ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ], -[ "VMS->catpath('','d1/d2/d3','file')", 'd1/d2/d3/file' ], -[ "VMS->catpath('v','d1/d2/d3','file')", 'd1/d2/d3/file' ], +[ "VMS->catpath('','d1/d2/d3','file')", '[.d1.d2.d3]file' ], +[ "VMS->catpath('v','d1/d2/d3','file')", 'v:[.d1.d2.d3]file' ], [ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ], [ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ], [ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ], @@ -206,7 +206,7 @@ BEGIN { [ "VMS->canonpath('')", '' ], [ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], -[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d1.-.d2.d3.d4.-]' ], +[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d2.d3]' ], [ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", 'volume:[d1]d2.dir;1' ], [ "VMS->splitdir('')", '' ], @@ -218,20 +218,15 @@ BEGIN { [ "VMS->splitdir('.-.d2.d3')", ',-,d2,d3' ], [ "VMS->splitdir('[.-.d2.d3]')", ',-,d2,d3' ], -# these appear to need VMS::Filespec, which won't work on other platforms -[ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c', 'VMS' ], -[ "VMS->catdir('d1','d2','d3')", '[.d1.d2.d3]', 'VMS' ], -[ "VMS->catdir('d1','d2/','d3')", '[.d1.d2.d3]', 'VMS' ], -[ "VMS->catdir('','d1','d2','d3')", '[.d1.d2.d3]', 'VMS' ], -[ "VMS->catdir('','-','d2','d3')", '[-.d2.d3]', 'VMS' ], -[ "VMS->catdir('','-','','d3')", '[-.d3]', 'VMS' ], -[ "VMS->catdir('[]','<->','[]','[d3]')", '[-.d3]', 'VMS' ], -[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[.dir.d2.d3]','VMS' ], -[ "VMS->catdir('[.name]')", '[.name]', 'VMS' ], -[ "VMS->catdir('[.name]','[.name]')", '[.name.name]','VMS' ], - -#[ "VMS->catdir('')", '[]' ], -#[ "VMS->catdir('a:[.name]','b:[.name]')", '[.name.name]' ], +[ "VMS->catdir('')", '' ], +[ "VMS->catdir('d1','d2','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('d1','d2/','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('','d1','d2','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[-.d2.d3]' ], +[ "VMS->catdir('','-','','d3')", '[-.d3]' ], +[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[.dir.d2.d3]' ], +[ "VMS->catdir('[.name]')", '[.name]' ], +[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], [ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", '' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], @@ -240,19 +235,16 @@ BEGIN { [ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], [ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", '[-]file' ], [ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[t4]' ], -[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[-.-.-.t4.t5.t6]' ], -#[ "VMS->abs2rel('[]','[t1.t2.t3]')", '[-.-.-]' ], -#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], -#[ "VMS->abs2rel('[.]','[t1.t2.t3]')", '[-.-.-]' ], -#[ "VMS->abs2rel('[..]','[t1.t2.t3]')", '[-.-.-]' ], -#[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], -#[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[-.-.-.b]' ], +[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[---.t4.t5.t6]' ], +[ "VMS->abs2rel('[000000]','[t1.t2.t3]')", '[---.000000]' ], +[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], +[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[---.b]' ], [ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", '[t1.t2.t3.t4]' ], [ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')", '[t1.t2.t3.t4.t5]' ], [ "VMS->rel2abs('[]','[t1.t2.t3]')", '[t1.t2.t3]' ], -[ "VMS->rel2abs('[-]','[t1.t2.t3]')", '[t1.t2.t3.-]' ], -[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", '[t1.t2.t3.-.t4]' ], +[ "VMS->rel2abs('[-]','[t1.t2.t3]')", '[t1.t2]' ], +[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", '[t1.t2.t4]' ], [ "VMS->rel2abs('[t1]','[t1.t2.t3]')", '[t1]' ], [ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ], diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 31c476a8e6..779396be73 100644 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t @@ -86,7 +86,7 @@ some:[where.over]the.rainbow unixify /some/where/over/the.rainbow /some/where/over/the.rainbow vmsify some:[where.over]the.rainbow some/where/over/the.rainbow vmsify [.some.where.over]the.rainbow ../some/where/over/the.rainbow vmsify [-.some.where.over]the.rainbow -some/../../where/over/the.rainbow vmsify [.some.--.where.over]the.rainbow +some/../../where/over/the.rainbow vmsify [-.where.over]the.rainbow .../some/where/over/the.rainbow vmsify [...some.where.over]the.rainbow some/.../where/over/the.rainbow vmsify [.some...where.over]the.rainbow /some/.../where/over/the.rainbow vmsify some:[...where.over]the.rainbow @@ -139,7 +139,7 @@ path vmspath [.path] / vmspath sys$disk:[000000] # Redundant characters in Unix paths -//some/where//over/../the.rainbow vmsify some:[where.over.-]the.rainbow +//some/where//over/../the.rainbow vmsify some:[where]the.rainbow /some/where//over/./the.rainbow vmsify some:[where.over]the.rainbow ..//../ vmspath [--] ./././ vmspath [] diff --git a/vms/subconfigure.com b/vms/subconfigure.com index d9231e7ffd..af900a0ce1 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -1,4 +1,7 @@ -$! SUBCONFIGURE.COM - build a config.sh for VMS Perl. +$! SUBCONFIGURE.COM +$! - build a config.sh for VMS Perl. +$! - use built config.sh to take config_h.SH -> config.h +$! - also take vms/descrip_mms.template -> descrip.mms (VMS Makefile) $! $! Note for folks from other platforms changing things in here: $! Fancy changes (based on compiler capabilities or VMS version or @@ -9,12 +12,12 @@ $! or something like that) are straightforward. Adding a new item for the $! ultimately created config.sh requires adding two lines to this file. $! $! First, a line in the format: -$! $ perl_foo = "bar" +$! $ foo = "bar" $! after the line tagged ##ADD NEW CONSTANTS HERE##. Replace foo with the $! variable name as it appears in config.sh. $! $! Second, add a line in the format: -$! $ WC "foo='" + perl_foo + "'" +$! $ WC "foo='" + foo + "'" $! after the line tagged ##WRITE NEW CONSTANTS HERE##. Careful of the $! quoting, as it can be tricky. $! @@ -38,33 +41,32 @@ $ Dec_C_Version := "''Dec_C_Version'" $ Dec_C_Version = Dec_C_Version + 0 $ Vms_Ver := "''f$extract(1,3, f$getsyi(""version""))'" $ perl_extensions := "''extensions'" -$ if f$length(Mcc) .eq. 0 then Mcc := "cc" +$ IF F$LENGTH(Mcc) .EQ. 0 THEN Mcc := "cc" $ MCC = f$edit(mcc, "UPCASE") $ C_Compiler_Replace := "CC=CC=''Mcc'''CC_flags'" -$ if "''Using_Dec_C'" .eqs. "Yes" +$ IF Using_Dec_C $ THEN $ Checkcc := "''Mcc'/prefix=all" $ ELSE $ Checkcc := "''Mcc'" $ ENDIF $ cc_flags = cc_flags + extra_flags -$ if be_case_sensitive -$ then -$ d_vms_be_case_sensitive = "define" -$ else -$ d_vms_be_case_sensitive = "undef" -$ endif -$ if use_multiplicity .eqs. "Y" +$ IF be_case_sensitive +$ THEN +$ d_vms_be_case_sensitive = "define" +$ ELSE +$ d_vms_be_case_sensitive = "undef" +$ ENDIF +$ IF use_multiplicity $ THEN $ perl_usemultiplicity = "define" $ ELSE $ perl_usemultiplicity = "undef" $ ENDIF $! Some constant defaults. -$ $ hwname = f$getsyi("HW_NAME") $ myname = myhostname -$ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE") +$ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## $ perl_shmattype = "" @@ -135,7 +137,6 @@ $ perl_d_writev="undef" $ perl_i_machcthr="undef" $ perl_i_netdb="undef" $ perl_d_gnulibc="undef" -$ perl_cf_by="unknown" $ perl_ccdlflags="" $ perl_cccdlflags="" $ perl_mab="" @@ -221,7 +222,7 @@ $ perl_d_mknod="undef" $ perl_d_union_semun="undef" $ perl_d_semctl_semun="undef" $ perl_d_semctl_semid_ds="undef" -$ IF (sharedperl.EQS."Y" .AND. F$GETSYI("HW_MODEL").GE.1024) +$ IF (sharedperl .AND. F$GETSYI("HW_MODEL") .GE. 1024) $ THEN $ perl_obj_ext=".abj" $ perl_so="axe" @@ -396,12 +397,12 @@ $ perl_lseektype="int" $ perl_i_values="undef" $ perl_malloctype="void *" $ perl_freetype="void" -$ if "''mymalloc'".eqs."Y" +$ IF mymalloc $ THEN $ perl_d_mymalloc="define" $ ELSE $ perl_d_mymalloc="undef" -$ENDIF +$ ENDIF $ perl_sh="MCR" $ perl_modetype="unsigned int" $ perl_ssizetype="int" @@ -448,25 +449,23 @@ $ perl_defvoidused="15" $ perl_voidflags="15" $ perl_d_eunice="undef" $ perl_d_pwgecos="define" -$ IF ("''Use_Threads'".eqs."T").and.("''VMS_VER'".LES."6.2") +$ IF ((Use_Threads) .AND. (VMS_VER .LES. "6.2")) $ THEN $ perl_libs="SYS$SHARE:CMA$LIB_SHR.EXE/SHARE SYS$SHARE:CMA$RTL.EXE/SHARE SYS$SHARE:CMA$OPEN_LIB_SHR.exe/SHARE SYS$SHARE:CMA$OPEN_RTL.exe/SHARE" $ ELSE $ perl_libs=" " $ ENDIF -$ IF ("''Using_Dec_C'".eqs."Yes") +$ IF Using_Dec_C $ THEN -$ perl_libc="(DECCRTL)" +$ perl_libc="(DECCRTL)" $ ELSE -$ perl_libc=" " +$ perl_libc=" " $ ENDIF -$ perl_PATCHLEVEL="''patchlevel'" -$ perl_SUBVERSION="''subversion'" $ perl_pager="most" $! $! Are we 64 bit? $! -$ if (use64bitint) +$ IF (use64bitint) $ THEN $ perl_d_PRIfldbl = "define" $ perl_d_PRIgldbl = "define" @@ -505,34 +504,19 @@ $ ENDIF $! $! Now some that we build up $! -$ LocalTime = f$time() -$ perl_cf_time= f$extract(0, 3, f$cvtime(LocalTime,, "WEEKDAY")) + " " + - - f$edit(f$cvtime(LocalTime, "ABSOLUTE", "MONTH"), "LOWERCASE") + - - " " + f$cvtime(LocalTime,, "DAY") + " " + f$cvtime(LocalTime,, "TIME") + - - " " + f$cvtime(LocalTime,, "YEAR") -$ if f$getsyi("HW_MODEL").ge.1024 -$ THEN -$ perl_arch="VMS_AXP" -$ perl_archname="VMS_AXP" -$ perl_alignbytes="8" -$ ELSE -$ perl_arch="VMS_VAX" -$ perl_archname="VMS_VAX" -$ perl_alignbytes="8" -$ ENDIF -$ if ("''Use_Threads'".eqs."T") +$ IF Use_Threads $ THEN $ if use_5005_threads $ THEN -$ perl_arch = "''perl_arch'-thread" -$ perl_archname = "''perl_archname'-thread" +$ arch = "''arch'-thread" +$ archname = "''archname'-thread" $ perl_d_old_pthread_create_joinable = "undef" $ perl_old_pthread_create_joinable = " " $ perl_use5005threads = "define" $ perl_useithreads = "undef" $ ELSE -$ perl_arch = "''perl_arch'-ithread" -$ perl_archname = "''perl_archname'-ithread" +$ arch = "''arch'-ithread" +$ archname = "''archname'-ithread" $ perl_d_old_pthread_create_joinable = "undef" $ perl_old_pthread_create_joinable = " " $ perl_use5005threads = "undef" @@ -544,27 +528,20 @@ $ perl_old_pthread_create_joinable = " " $ perl_use5005threads = "undef" $ perl_useithreads = "undef" $ ENDIF -$ perl_osvers=f$edit(osvers, "TRIM") -$ if (perl_subversion + 0).eq.0 -$ THEN -$ LocalPerlVer = "5_" + Perl_PATCHLEVEL -$ ELSE -$ LocalPerlVer = "5_" + Perl_PATCHLEVEL + perl_subversion -$ ENDIF $! $! Some that we need to invoke the compiler for $ OS := "open/write SOURCECHAN []temp.c" $ WS := "write SOURCECHAN" $ CS := "close SOURCECHAN" $ DS := "delete/nolog []temp.*;*" -$ Needs_Opt := "No" -$ if ("''using_gnu_c'".eqs."Yes") +$ Needs_Opt := N +$ IF using_gnu_c $ THEN $ open/write OPTCHAN []temp.opt $ write OPTCHAN "Gnu_CC:[000000]gcclib.olb/library" $ write OPTCHAN "Sys$Share:VAXCRTL/Share" $ Close OPTCHAN -$ Needs_Opt := "Yes" +$ Needs_Opt := Y $ ENDIF $! $! Check for __STDC__ @@ -589,7 +566,7 @@ $ DEFINE SYS$OUTPUT _NLA0: $ ON ERROR THEN CONTINUE $ ON WARNING THEN CONTINUE $ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") +$ If Needs_Opt $ THEN $ link temp.obj,temp.opt/opt $ else @@ -608,7 +585,6 @@ $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT $ DELETE/NOLOG [-.uu]tempout.lis; -$ $ perl_cpp_stuff=line $ WRITE_RESULT "cpp_stuff is ''perl_cpp_stuff'" $! @@ -632,7 +608,7 @@ $ DEFINE SYS$OUTPUT _NLA0: $ ON ERROR THEN CONTINUE $ ON WARNING THEN CONTINUE $ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") +$ If Needs_Opt $ THEN $ link temp.obj,temp.opt/opt $ else @@ -681,16 +657,16 @@ $ perl_d_longdbl="undef" $ ELSE $ ON ERROR THEN CONTINUE $ ON WARNING THEN CONTINUE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN -$ link temp.obj,temp.opt/opt -$ else +$ link temp.obj,temp.opt/opt +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ teststatus = f$extract(9,1,$status) $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR -$ if (teststatus.nes."1") +$ IF (teststatus.nes."1") $ THEN $ perl_longdblsize="0" $ perl_d_longdbl="undef" @@ -706,7 +682,6 @@ $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT $ DELETE/NOLOG [-.uu]tempout.lis; -$ $ perl_longdblsize=line $ perl_d_longdbl="define" $ ENDIF @@ -732,12 +707,12 @@ $ DEFINE SYS$OUTPUT _NLA0: $ on error then continue $ on warning then continue $ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ teststatus = f$extract(9,1,$status) $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR @@ -853,7 +828,6 @@ $! Okay, failed. Must not have it $ perl_i_unistd = "undef" $ ELSE $ perl_i_unistd = "define" - $ ENDIF $ WRITE_RESULT "i_unistd is ''perl_i_unistd'" $! @@ -883,7 +857,6 @@ $! Okay, failed. Must not have it $ perl_i_shadow = "undef" $ ELSE $ perl_i_shadow = "define" - $ ENDIF $ WRITE_RESULT "i_shadow is ''perl_i_shadow'" $! @@ -913,13 +886,12 @@ $! Okay, failed. Must not have it $ perl_i_socks = "undef" $ ELSE $ perl_i_socks = "define" - $ ENDIF $ WRITE_RESULT "i_socks is ''perl_i_socks'" $! $! Check the prototype for select $! -$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T") +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr $ THEN $ OS $ WS "#ifdef __DECC @@ -928,13 +900,13 @@ $ WS "#endif $ WS "#include <stdio.h> $ WS "#include <types.h> $ WS "#include <unistd.h> -$ if ("''Has_Socketshr'".eqs."T") +$ IF Has_Socketshr $ THEN -$ WS "#include <socketshr.h>" -$ else -$ WS "#include <time.h> -$ WS "#include <socket.h> -$ endif +$ WS "#include <socketshr.h>" +$ ELSE +$ WS "#include <time.h> +$ WS "#include <socket.h> +$ ENDIF $ WS "int main() $ WS "{" $ WS "fd_set *foo; @@ -974,15 +946,15 @@ $ WS "#endif $ WS "#include <stdio.h> $ WS "#include <types.h> $ WS "#include <unistd.h> -$ if ("''Has_Socketshr'".eqs."T") +$ IF Has_Socketshr $ THEN -$ WS "#include <socketshr.h>" +$ WS "#include <socketshr.h>" $ ENDIF -$ IF ("''Has_Dec_C_Sockets'".eqs."T") +$ IF Has_Dec_C_Sockets $ THEN -$ WS "#include <time.h> -$ WS "#include <socket.h> -$ endif +$ WS "#include <time.h> +$ WS "#include <socket.h> +$ ENDIF $ WS "int main() $ WS "{" $ WS "fd_set *foo; @@ -1034,12 +1006,12 @@ $ perl_i_inttypes="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1081,12 +1053,12 @@ $ perl_d_herrno="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt) +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1210,7 +1182,7 @@ $ WRITE_RESULT "d_fpos64_t is ''perl_d_fpos64_t'" $! $! Check to see if gethostname exists $! -$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T") +$ IF (Has_Dec_C_Sockets .OR. Has_Socketshr) $ THEN $ OS $ WS "#ifdef __DECC @@ -1219,13 +1191,13 @@ $ WS "#endif $ WS "#include <stdio.h> $ WS "#include <types.h> $ WS "#include <unistd.h> -$ if ("''Has_Socketshr'".eqs."T") +$ IF Has_Socketshr $ THEN -$ WS "#include <socketshr.h>" -$ else -$ WS "#include <time.h> -$ WS "#include <socket.h> -$ endif +$ WS "#include <socketshr.h>" +$ ELSE +$ WS "#include <time.h> +$ WS "#include <socket.h> +$ ENDIF $ WS "int main() $ WS "{" $ WS "char name[100]; @@ -1248,12 +1220,12 @@ $ THEN $! Okay, compile failed. Must not have it $ perl_d_gethname = "undef" $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ if (teststatus.nes."1") @@ -1296,12 +1268,12 @@ $ perl_i_sysfile="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1342,12 +1314,12 @@ $ perl_i_sysutsname="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1388,12 +1360,12 @@ $ perl_i_syslog="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1434,12 +1406,12 @@ $ perl_i_poll="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt -$ else +$ ELSE $ link temp.obj -$ endif +$ ENDIF $ savedstatus = $status $ teststatus = f$extract(9,1,savedstatus) $ DEASSIGN SYS$OUTPUT @@ -1480,7 +1452,7 @@ $ perl_i_sysuio="undef" $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR $ ELSE -$ If (Needs_Opt.eqs."Yes") +$ IF Needs_Opt $ THEN $ link temp.obj,temp.opt/opt $ else @@ -3323,7 +3295,7 @@ $ perl_d_attribut="undef" $ ENDIF $ $! Dec C >= 5.2 and VMS ver >= 7.0 -$ IF ("''Using_Dec_C'".EQS."Yes").AND.(F$INTEGER(Dec_C_Version).GE.50200000).AND.("''VMS_VER'".GES."7.0") +$ IF (Using_Dec_C).AND.(F$INTEGER(Dec_C_Version).GE.50200000).AND.(VMS_VER .GES. "7.0") $ THEN $ perl_d_bcmp="define" $ perl_d_gettimeod="define" @@ -3459,11 +3431,11 @@ $ perl_d_getservprotos="undef" $ perl_socksizetype="undef" $ ENDIF $! Threads -$ if ("''use_threads'".eqs."T") +$ IF use_threads $ THEN $ perl_usethreads="define" $ perl_d_pthreads_created_joinable="define" -$ if ("''VMS_VER'".ges."7.0") +$ if (VMS_VER .GES. "7.0") $ THEN $ perl_d_oldpthreads="undef" $ ELSE @@ -3627,20 +3599,19 @@ $ perl_uvoformat="""lo""" $ perl_uvxformat="""lx""" $! $! Finally the composite ones. All config -$ perl_installarchlib="''perl_prefix':[lib.''perl_arch'.''localperlver']" -$ perl_installsitearch="''perl_prefix':[lib.site_perl.''perl_arch']" +$ perl_installarchlib="''perl_prefix':[lib.''archname'.''version']" +$ perl_installsitearch="''perl_prefix':[lib.site_perl.''archname']" $ perl_myhostname="''myhostname'" $ perl_mydomain="''mydomain'" $ perl_perladmin="''perladmin'" -$ perl_cf_email="''cf_email'" -$ perl_myuname:="VMS ''myname' ''f$edit(perl_osvers, "TRIM")' ''f$edit(hwname, "TRIM")'" -$ perl_archlibexp="''perl_prefix':[lib.''perl_arch'.''localperlver']" -$ perl_archlib="''perl_prefix':[lib.''perl_arch'.''lovalperlver']" -$ perl_oldarchlibexp="''perl_prefix':[lib.''perl_arch']" -$ perl_oldarchlib="''perl_prefix':[lib.''perl_arch']" -$ perl_sitearchexp="''perl_prefix':[lib.site_perl.''perl_arch']" -$ perl_sitearch="''perl_prefix':[lib.site_perl.''perl_arch']" -$ if "''Using_Dec_C'" .eqs. "Yes" +$ perl_myuname:="''osname' ''myname' ''osvers' ''f$edit(hwname, "TRIM")'" +$ perl_archlibexp="''perl_prefix':[lib.''archname'.''version']" +$ perl_archlib="''perl_prefix':[lib.''archname'.''version']" +$ perl_oldarchlibexp="''perl_prefix':[lib.''archname']" +$ perl_oldarchlib="''perl_prefix':[lib.''archname']" +$ perl_sitearchexp="''perl_prefix':[lib.site_perl.''archname']" +$ perl_sitearch="''perl_prefix':[lib.site_perl.''archname']" +$ IF Using_Dec_C $ THEN $ perl_ccflags="/Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=''perl_obj_ext'/NoList''cc_flags'" $ ENDIF @@ -3653,25 +3624,23 @@ $ perl_optimize= "" $ perl_dbgprefix = "" $ endif $! -$! Finally clean off any leading zeros from the patchlevel or subversion -$ perl_patchlevel = perl_patchlevel + 0 -$ perl_subversion = perl_subversion + 0 -$! $! Okay, we've got everything configured. Now go write out a config.sh. -$ open/write CONFIGSH [-]config.sh -$ WC := "write CONFIGSH" +$ echo4 "Creating config.sh..." +$ open/write CONFIG [-]config.sh +$ WC := "write CONFIG" $! $ WC "# This file generated by Configure.COM on a VMS system." -$ WC "# Time: " + perl_cf_time +$ WC "# Time: " + cf_time $ WC "" $ WC "CONFIGDOTSH=true" $ WC "package='" + perl_package + "'" +$ WC "config_args='" + config_args + "'" $ WC "d_nv_preserves_uv='" + perl_d_nv_preserves_uv + "'" $ WC "use5005threads='" + perl_use5005threads + "'" $ WC "useithreads='" + perl_useithreads + "'" $ WC "CONFIG='" + perl_config + "'" -$ WC "cf_time='" + perl_cf_time + "'" -$ WC "cf_by='" + perl_cf_by+ "'" +$ WC "cf_time='" + cf_time + "'" +$ WC "cf_by='" + cf_by + "'" $ WC "cpp_stuff='" + perl_cpp_stuff + "'" $ WC "ccdlflags='" + perl_ccdlflags + "'" $ WC "cccdlflags='" + perl_cccdlflags + "'" @@ -3694,9 +3663,8 @@ $ WC "dlsrc='dl_vms.c'" $ WC "binexp='" + perl_binexp + "'" $ WC "man1ext='" + perl_man1ext + "'" $ WC "man3ext='" + perl_man3ext + "'" -$ WC "arch='" + perl_arch + "'" -$ WC "archname='" + perl_archname + "'" -$ WC "osvers='" + perl_osvers + "'" +$ WC "archname='" + archname + "'" +$ WC "osvers='" + osvers + "'" $ WC "prefix='" + perl_prefix + "'" $ WC "builddir='" + perl_builddir + "'" $ WC "installbin='" + perl_installbin + "'" @@ -3749,14 +3717,14 @@ $ WC "lib_ext='" + perl_lib_ext + "'" $ WC "myhostname='" + perl_myhostname + "'" $ WC "mydomain='" + perl_mydomain + "'" $ WC "perladmin='" + perl_perladmin + "'" -$ WC "cf_email='" + perl_cf_email + "'" +$ WC "cf_email='" + cf_email + "'" $ WC "myuname='" + perl_myuname + "'" -$ WC "alignbytes='" + perl_alignbytes + "'" +$ WC "alignbytes='" + alignbytes + "'" $ WC "osname='" + perl_osname + "'" $ WC "d_archlib='" + perl_d_archlib + "'" $ WC "archlibexp='" + perl_archlibexp + "'" $ WC "archlib='" + perl_archlib + "'" -$ WC "archname='" + perl_archname + "'" +$ WC "archname='" + archname + "'" $ WC "d_bincompat3='" + perl_d_bincompat3 + "'" $ WC "cppstdin='" + perl_cppstdin + "'" $ WC "cppminus='" + perl_cppminus + "'" @@ -3993,14 +3961,6 @@ $ WC "voidflags='" + perl_voidflags + "'" $ WC "d_eunice='" + perl_d_eunice + "'" $ WC "libs='" + perl_libs + "'" $ WC "libc='" + perl_libc + "'" -$ tempstring = "PERL_VERSION='" + "''perl_patchlevel'" + "'" -$ WC tempstring -$ tempstring = "PERL_SUBVERSION='" + "''perl_patchlevel'" + "'" -$ WC tempstring -$ tempstring = "PATCHLEVEL='" + "''perl_patchlevel'" + "'" -$ WC tempstring -$ tempstring = "SUBVERSION='" + "''perl_SUBVERSION'" + "'" -$ WC tempstring $ WC "xs_apiversion='" + localperlver + "'" $ WC "pm_apiversion='" + localperlver + "'" $ WC "pager='" + perl_pager + "'" @@ -4238,7 +4198,7 @@ $ WC "d_vms_case_sensitive_symbols='" + d_vms_be_case_sensitive + "'" $! $! ##WRITE NEW CONSTANTS HERE## $! -$ Close CONFIGSH +$ Close CONFIG $ $! Okay, we've gotten here. Build munchconfig and run it $ 'Perl_CC' munchconfig.c @@ -4257,7 +4217,8 @@ $ else $ link munchconfig.obj $ endif $ echo "" -$ echo "Writing config.h" +$ echo "Doing variable substitutions on .SH files..." +$ echo "Extracting config.h (with variable substitutions)" $ ! $ ! we need an fdl file $ CREATE [-]CONFIG.FDL @@ -4267,72 +4228,36 @@ $ CREATE /FDL=[-]CONFIG.FDL [-]CONFIG.LOCAL $ ! First spit out the header info with the local defines (to get $ ! around the 255 character command line limit) $ OPEN/APPEND CONFIG [-]config.local -$ if use_debugging_perl.eqs."Y" -$ THEN -$ WRITE CONFIG "#define DEBUGGING" -$ ENDIF -$ if use_two_pot_malloc.eqs."Y" -$ THEN -$ WRITE CONFIG "#define TWO_POT_OPTIMIZE" -$ endif -$ if mymalloc.eqs."Y" -$ THEN -$ WRITE CONFIG "#define EMBEDMYMALLOC" -$ ENDIF -$ if use_pack_malloc.eqs."Y" -$ THEN -$ WRITE CONFIG "#define PACK_MALLOC" -$ endif -$ if use_debugmalloc.eqs."Y" -$ THEN -$ write config "#define DEBUGGING_MSTATS" -$ ENDIF -$ if "''Using_Gnu_C'" .eqs."Yes" -$ THEN -$ WRITE CONFIG "#define GNUC_ATTRIBUTE_CHECK" -$ ENDIF -$ if "''Has_Dec_C_Sockets'".eqs."T" -$ THEN -$ WRITE CONFIG "#define VMS_DO_SOCKETS" -$ WRITE CONFIG "#define DECCRTL_SOCKETS" -$ ENDIF -$ if "''Has_Socketshr'".eqs."T" +$ IF use_debugging_perl THEN WC "#define DEBUGGING" +$ IF use_two_pot_malloc THEN WC "#define TWO_POT_OPTIMIZE" +$ IF mymalloc THEN WC "#define EMBEDMYMALLOC" +$ IF use_pack_malloc THEN WC "#define PACK_MALLOC" +$ IF use_debugmalloc THEN WC "#define DEBUGGING_MSTATS" +$ IF Using_Gnu_C THEN WC "#define GNUC_ATTRIBUTE_CHECK" +$ IF (Has_Dec_C_Sockets) $ THEN -$ WRITE CONFIG "#define VMS_DO_SOCKETS" -$ ENDIF -$! This is VMS-specific for now -$ WRITE CONFIG "#''perl_d_setenv' HAS_SETENV" -$ if d_alwdeftype.eqs."Y" -$ THEN -$ WRITE CONFIG "#define SECURE_INTERNAL_GETENV" -$ ELSE -$ WRITE CONFIG "#undef SECURE_INTERNAL_GETENV" -$ ENDIF -$ if d_secintgenv.eqs."Y" -$ THEN -$ WRITE CONFIG "#define ALWAYS_DEFTYPES" +$ WC "#define VMS_DO_SOCKETS" +$ WC "#define DECCRTL_SOCKETS" $ ELSE -$ WRITE CONFIG "#undef ALWAYS_DEFTYPES" +$ IF Has_Socketshr THEN WC "#define VMS_DO_SOCKETS" $ ENDIF +$! This is VMS-specific for now +$ WC "#''perl_d_setenv' HAS_SETENV" +$ IF d_secintgenv THEN WC "#define SECURE_INTERNAL_GETENV" +$ if d_alwdeftype THEN WC "#define ALWAYS_DEFTYPES" $ IF (use64bitint) $ THEN -$ WRITE CONFIG "#define USE_64_BIT_INT" -$ WRITE CONFIG "#define USE_LONG_DOUBLE" +$ WC "#define USE_64_BIT_INT" +$ WC "#define USE_LONG_DOUBLE" $ ENDIF -$ IF (use64bitall) -$ THEN -$ WRITE CONFIG "#define USE_64_BIT_ALL" -$ ENDIF -$ if be_case_sensitive -$ then -$ write config "#define VMS_WE_ARE_CASE_SENSITIVE" -$ endif +$ IF use64bitall THEN WC "#define USE_64_BIT_ALL" +$ IF be_case_sensitive THEN WC "#define VMS_WE_ARE_CASE_SENSITIVE" $ if perl_d_herrno .eqs. "undef" $ THEN -$ write config "#define NEED_AN_H_ERRNO" +$ WC "#define NEED_AN_H_ERRNO" $ ENDIF -$ WRITE CONFIG "#define HAS_ENVGETENV" -$ WRITE CONFIG "#define PERL_EXTERNAL_GLOB" +$ WC "#define HAS_ENVGETENV" +$ WC "#define PERL_EXTERNAL_GLOB" $ CLOSE CONFIG $! $! Now build the normal config.h @@ -4345,32 +4270,32 @@ $ DELETE/NOLOG [-]CONFIG.MAIN;* $ DELETE/NOLOG [-]CONFIG.LOCAL;* $ DELETE/NOLOG [-]CONFIG.FDL;* $! -$ if "''Using_Dec_C'" .eqs."Yes" +$ IF Using_Dec_C $ THEN -$ DECC_REPLACE = "DECC=decc=1" +$ DECC_REPLACE = "DECC=decc=1" $ ELSE -$ DECC_REPLACE = "DECC=" +$ DECC_REPLACE = "DECC=" $ ENDIF -$ if "''Using_Gnu_C'" .eqs."Yes" +$ IF Using_Gnu_C $ THEN -$ GNUC_REPLACE = "GNUC=gnuc=1" +$ GNUC_REPLACE = "GNUC=gnuc=1" $ ELSE -$ GNUC_REPLACE = "GNUC=" +$ GNUC_REPLACE = "GNUC=" $ ENDIF -$ if "''Has_Dec_C_Sockets'" .eqs."T" +$ IF Has_Dec_C_Sockets $ THEN $ SOCKET_REPLACE = "SOCKET=DECC_SOCKETS=1" $ ELSE -$ if "''Has_Socketshr'" .eqs."T" +$ IF Has_Socketshr $ THEN $ SOCKET_REPLACE = "SOCKET=SOCKETSHR_SOCKETS=1" $ ELSE $ SOCKET_REPLACE = "SOCKET=" $ ENDIF $ ENDIF -$ IF ("''Use_Threads'".eqs."T") +$ IF (Use_Threads) $ THEN -$ if ("''VMS_VER'".LES."6.2") +$ IF (VMS_VER .LES. "6.2") $ THEN $ THREAD_REPLACE = "THREAD=OLDTHREADED=1" $ ELSE @@ -4379,24 +4304,18 @@ $ ENDIF $ ELSE $ THREAD_REPLACE = "THREAD=" $ ENDIF -$ if mymalloc.eqs."Y" +$ IF mymalloc $ THEN $ MALLOC_REPLACE = "MALLOC=MALLOC=1" $ ELSE $ MALLOC_REPLACE = "MALLOC=" $ ENDIF -$ if f$getsyi("HW_MODEL").ge.1024 -$ THEN -$ ARCH_TYPE = "ARCH-TYPE=__AXP__" -$ ELSE -$ ARCH_TYPE = "ARCH-TYPE=__VAX__" -$ ENDIF -$ echo "Writing DESCRIP.MMS" +$ echo "Extracting ''defmakefile' (with variable substitutions)" $!set ver -$ define/user sys$output [-]descrip.mms +$ define/user sys$output 'UUmakefile $ mcr []munchconfig [-]config.sh descrip_mms.template "''DECC_REPLACE'" "''ARCH_TYPE'" "''GNUC_REPLACE'" "''SOCKET_REPLACE'" "''THREAD_REPLACE'" - -"''C_Compiler_Replace'" "''MALLOC_REPLACE'" "''Thread_Live_Dangerously'" "PV=''LocalPerlVer'" "FLAGS=FLAGS=''extra_flags'" -$ echo "Extracting Build_Ext.Com" +"''C_Compiler_Replace'" "''MALLOC_REPLACE'" "''Thread_Live_Dangerously'" "PV=''version'" "FLAGS=FLAGS=''extra_flags'" +$ echo "Extracting Build_Ext.Com (without variable substitutions)" $ Create Sys$Disk:[-]Build_Ext.Com $ Deck/Dollar="$EndOfTpl$" $!++ Build_Ext.Com @@ -4456,5 +4375,5 @@ $ $! set nover $! $! Clean up after ourselves -$ delete/nolog munchconfig.exe;* -$ delete/nolog munchconfig.obj;* +$ DELETE/NOLOG/NOCONFIRM munchconfig.exe; +$ DELETE/NOLOG/NOCONFIRM munchconfig.obj; @@ -106,7 +106,7 @@ int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) { - char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2; + char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2; unsigned short int eqvlen, curtab, ivlnm = 0, ivsym = 0, ivenv = 0, secure; unsigned long int retsts, attr = LNM$M_CASE_BLIND; unsigned char acmode; @@ -141,6 +141,7 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, } lnmdsc.dsc$w_length = cp1 - lnm; lnmdsc.dsc$a_pointer = uplnm; + uplnm[lnmdsc.dsc$w_length] = '\0'; secure = flags & PERL__TRNENV_SECURE; acmode = secure ? PSL$C_EXEC : PSL$C_USER; if (!tabvec || !*tabvec) tabvec = env_tables; @@ -210,6 +211,19 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst); if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; } if (retsts == SS$_NOLOGNAM) continue; + /* PPFs have a prefix */ + if ( +#if INTSIZE == 4 + *((int *)uplnm) == *((int *)"SYS$") && +#endif + eqvlen >= 4 && eqv[0] == 0x1b && eqv[1] == 0x00 && + ( (uplnm[4] == 'O' && !strcmp(uplnm,"SYS$OUTPUT")) || + (uplnm[4] == 'I' && !strcmp(uplnm,"SYS$INPUT")) || + (uplnm[4] == 'E' && !strcmp(uplnm,"SYS$ERROR")) || + (uplnm[4] == 'C' && !strcmp(uplnm,"SYS$COMMAND")) ) ) { + memcpy(eqv,eqv+4,eqvlen-4); + eqvlen -= 4; + } break; } } @@ -2163,12 +2177,16 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { else if (!infront && *cp2 == '.') { if (cp2+1 == dirend || *(cp2+1) == '\0') { cp2++; break; } else if (*(cp2+1) == '/') cp2++; /* skip over "./" - it's redundant */ - else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) { /* handle "../" */ - if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; + else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) { + if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; /* handle "../" */ else if (*(cp1-2) == '[') *(cp1-1) = '-'; - else { -/* if (*(cp1-1) != '.') *(cp1++) = '.'; */ - *(cp1++) = '-'; + else { /* back up over previous directory name */ + cp1--; + while (*(cp1-1) != '.' && *(cp1-1) != '[') cp1--; + if (*(cp1-1) == '[') { + memcpy(cp1,"000000.",7); + cp1 += 7; + } } cp2 += 2; if (cp2 == dirend) break; |