summaryrefslogtreecommitdiff
path: root/vms/gen_shrfls.pl
diff options
context:
space:
mode:
authorCharles Bailey <bailey@newman.upenn.edu>1998-03-12 11:02:29 -0500
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>1998-03-16 15:55:28 +0000
commit09b7f37c58c6da6f4965b846b64eab7d9a205663 (patch)
tree0175e00c54b302fe0ffcfa25f9c82103d3196460 /vms/gen_shrfls.pl
parenta887ff1142f02c0c19143d1511194864ae5eafab (diff)
downloadperl-09b7f37c58c6da6f4965b846b64eab7d9a205663.tar.gz
VMS updates (direct)
[Needed manual tweaks on vms/config.vms since it clashed with other patches. I may have got it wrong.] p4raw-id: //depot/perl@817
Diffstat (limited to 'vms/gen_shrfls.pl')
-rw-r--r--vms/gen_shrfls.pl49
1 files changed, 30 insertions, 19 deletions
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index 0a8d7e60dc..9d5748d499 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -68,6 +68,7 @@ if ($docc) {
if (($prefix,$defines,$suffix) =
($cc_cmd =~ m#(.*)/Define=(.*?)([/\s].*)#i)) {
$defines =~ s/^\((.*)\)$/$1/;
+ $debugging_enabled = $defines =~ /\bDEBUGGING\b/;
@defines = split(/,/,$defines);
$cc_cmd = "$prefix/Define=(" . join(',',grep($_ = "\"$_\"",@defines))
. ')' . $suffix;
@@ -85,6 +86,7 @@ if ($docc) {
or 0; # again, make debug output nice
print "\$isgcc: $isgcc\n" if $debug;
print "\$isvaxc: $isvaxc\n" if $debug;
+ print "\$debugging_enabled: $debugging_enabled\n" if $debug;
if (-f 'perl.h') { $dir = '[]'; }
elsif (-f '[-]perl.h') { $dir = '[-]'; }
@@ -96,8 +98,10 @@ else {
or 0; # for nice debug output
$isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i)
or 0; # again, for nice debug output
+ $debugging_enabled = $cc_cmd =~ /\bdebugging\b/i;
print "\$isgcc: \\$isgcc\\\n" if $debug;
print "\$isvaxc: \\$isvaxc\\\n" if $debug;
+ print "\$debugging_enabled: \\$debugging_enabled\\\n" if $debug;
print "Not running cc, preprocesor output in \\$cpp_file\\\n" if $debug;
}
@@ -192,44 +196,51 @@ if ($docc) {
else {
open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
}
+%checkh = map { $_,1 } qw( thread bytecode byterun proto );
+$ckfunc = 0;
LINE: while (<CPP>) {
while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) {
print "vms_proto>> $_" if $debug > 2;
if (/^\s*EXT/) { &scan_var($_); }
else { &scan_func($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
print "vmsish.h>> $_" if $debug > 2;
if (/^\s*EXT/) { &scan_var($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
print "opcode.h>> $_" if $debug > 2;
if (/^OP \*\s/) { &scan_func($_); }
if (/^\s*EXT/) { &scan_var($_); }
if (/^\s+OP_/) { &scan_enum($_); }
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
- while (/^typedef enum/ .. /^\}/) {
+ while (/^typedef enum/ .. /^\s*\}/) {
print "global enum>> $_" if $debug > 2;
&scan_enum($_);
- last LINE unless $_ = <CPP>;
+ last LINE unless defined($_ = <CPP>);
}
- while (/^#.*thread\.h/i .. /^#.*perl\.h/i) {
- print "thread.h>> $_" if $debug > 2;
- if (/\s*^EXT/) { &scan_var($_); }
- else { &scan_func($_); }
- last LINE unless $_ = <CPP>;
+ # Check for transition to new header file
+ if (/^# \d+ "(\S+)"/) {
+ my $spec = $1;
+ # Pull name from library module or header filespec
+ $spec =~ /^(\w+)$/ or $spec =~ /(\w+)\.h/i;
+ my $name = lc $1;
+ $ckfunc = exists $checkh{$name} ? 1 : 0;
+ $scanname = $name if $ckfunc;
+ print "Header file transition: ckfunc = $ckfunc for $name.h\n" if $debug > 1;
}
- while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
- print "proto.h>> $_" if $debug > 2;
+ if ($ckfunc) {
+ print "$scanname>> $_" if $debug > 2;
if (/\s*^EXT/) { &scan_var($_); }
- else { &scan_func($_); }
- last LINE unless $_ = <CPP>;
+ else { &scan_func($_); }
+ }
+ else {
+ print $_ if $debug > 3 && ($debug > 5 || length($_));
+ if (/^\s*EXT/) { &scan_var($_); }
}
- print $_ if $debug > 3 && ($debug > 5 || length($_));
- if (/^\s*EXT/) { &scan_var($_); }
}
close CPP;
@@ -248,6 +259,7 @@ while (<DATA>) {
print "Adding $key to \%$array list\n" if $debug > 1;
${$array}{$key}++;
}
+if ($debugging_enabled and ($isvaxc or $isgcc)) { $vars{'colors'}++ }
foreach (split /\s+/, $extnames) {
my($pkgname) = $_;
$pkgname =~ s/::/__/g;
@@ -378,9 +390,8 @@ if ($ENV{PERLSHR_USE_GSMATCH}) {
my $major = int($] * 1000) & 0xFF; # range 0..255
my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF; # range 0..255
print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
- foreach (@symfiles) {
- print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_$objsuffix\n";
- }
+ print OPTBLD 'CLUSTER=$$TRANSFER_VECTOR,,',
+ map(",$_$objsuffix",@symfiles), "\n";
}
elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
# Include object modules and RTLs in options file