X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=vms%2Fgen_shrfls.pl;h=3cdd3ef84ae80a6767322d66cc06405c2c6e7c04;hb=96a925ab0077cdd24bd7d328f20be3d5373d4885;hp=35cab2f819d1474a1ae83ef35a061b5bcea922f4;hpb=b6837a3b27252f74ff8399514c00fa18a38dd3a6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index 35cab2f..3cdd3ef 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. 14-Dec-1997\n" if $debug; +print "gen_shrfls.pl Rev. 18-May-2001\n" if $debug; if ($ARGV[0] eq '-f') { open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; @@ -68,16 +68,22 @@ if ($docc) { elsif (-f '[-]perl.h') { $dir = '[-]'; } else { die "$0: Can't find perl.h\n"; } - # Go see if debugging is enabled in config.h - $config = $dir . "config.h"; + $use_threads = $use_mymalloc = $case_about_case = $debugging_enabled = 0; + $hide_mymalloc = $isgcc = $use_perlio = 0; + + # Go see what is enabled in config.sh + $config = $dir . "config.sh"; open CONFIG, "< $config"; while() { - $debugging_enabled++ if /define\s+DEBUGGING/; - $use_mymalloc++ if /define\s+MYMALLOC/; - $hide_mymalloc++ if /define\s+EMBEDMYMALLOC/; - $use_threads++ if /define\s+USE_THREADS/; - $care_about_case++ if /define\s+VMS_WE_ARE_CASE_SENSITIVE/; + $use_threads++ if /usethreads='(define|yes|true|t|y|1)'/i; + $use_mymalloc++ if /usemymalloc='(define|yes|true|t|y|1)'/i; + $care_about_case++ if /d_vms_case_sensitive_symbols='(define|yes|true|t|y|1)'/i; + $debugging_enabled++ if /usedebugging_perl='(define|yes|true|t|y|1)'/i; + $hide_mymalloc++ if /embedmymalloc='(define|yes|true|t|y|1)'/i; + $isgcc++ if /gccversion='[^']/; + $use_perlio++ if /useperlio='(define|yes|true|t|y|1)'/i; } + close CONFIG; # put quotes back onto defines - they were removed by DCL on the way in if (($prefix,$defines,$suffix) = @@ -92,15 +98,8 @@ if ($docc) { # check for gcc - if present, we'll need to use MACRO hack to # define global symbols for shared variables - $isvaxc = 0; - $isgcc = `$cc_cmd _nla0:/Version` =~ /GNU/ - or 0; # make debug output nice - $isvaxc = (!$isgcc && $isvax && - # Check exit status too, in case message is shut off - (`$cc_cmd /prefix=all _nla0:` =~ /IVQUAL/ || $? == 0x38240)) - 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; } @@ -108,11 +107,8 @@ else { ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4); $isgcc = $cc_cmd =~ /case_hack/i 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; } @@ -129,33 +125,6 @@ print "\$extnames: \\$extnames\\\n" if $debug; $rtlopt = shift @ARGV; print "\$rtlopt: \\$rtlopt\\\n" if $debug; -# This part gets tricky. VAXC creates global symbols for each of the -# constants in an enum if that enum is ever used as the data type of a -# global[dr]ef. We have to detect enums which are used in this way, so we -# can set up the constants as universal symbols, since anything which -# #includes perl.h will want to resolve these global symbols. -# We're using a weak test here - we basically know that the only enums -# we need to handle now are the big one in opcode.h, and the -# "typedef enum { ... } expectation" in perl.h, so we hard code -# appropriate tests below. Since we can't know in general whether a given -# enum will be used elsewhere in a globaldef, it's hard to decide a -# priori whether its constants need to be treated as global symbols. -sub scan_enum { - my($line) = @_; - - return unless $isvaxc; - - return unless /^\s+(OP|X)/; # we only want opcode and expectation enums - print "\tchecking for enum constant\n" if $debug > 1; - $line =~ s#/\*.+##; - $line =~ s/,?\s*\n?$//; - print "\tfiltered to \\$line\\\n" if $debug > 1; - if ($line =~ /(\w+)$/) { - print "\tconstant name is \\$1\\\n" if $debug > 1; - $enums{$1}++; - } -} - sub scan_var { my($line) = @_; my($const) = $line =~ /^EXTCONST/; @@ -173,24 +142,13 @@ sub scan_var { if ($const) { $cvars{$1}++; } else { $vars{$1}++; } } - if ($isvaxc) { - my($type) = $line =~ /^\s*EXT\w*\s+(\w+)/; - print "\tchecking for use of enum (type is \"$type\")\n" if $debug > 2; - if ($type eq 'expectation') { - $used_expectation_enum++; - print "\tsaw global use of enum \"expectation\"\n" if $debug > 1; - } - if ($type eq 'opcode') { - $used_opcode_enum++; - print "\tsaw global use of enum \"opcode\"\n" if $debug > 1; - } - } } sub scan_func { my($line) = @_; print "\tchecking for global routine\n" if $debug > 1; + $line =~ s/\b(IV|Off_t|Size_t|SSize_t|void)\b//i; if ( $line =~ /(\w+)\s*\(/ ) { print "\troutine name is \\$1\\\n" if $debug > 1; if ($1 eq 'main' || $1 eq 'perl_init_ext') { @@ -208,15 +166,21 @@ if ($use_mymalloc) { $fcns{'Perl_mfree'}++; } +if ($use_perlio) { + $preprocess_list = "${dir}perl.h+${dir}perlapi.h,${dir}perliol.h"; +} else { + $preprocess_list = "${dir}perl.h+${dir}perlapi.h"; +} + $used_expectation_enum = $used_opcode_enum = 0; # avoid warnings if ($docc) { - open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output ${dir}perl.h|") - or die "$0: Can't preprocess ${dir}perl.h: $!\n"; + open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output $preprocess_list|") + or die "$0: Can't preprocess $preprocess_list: $!\n"; } else { open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n"; } -%checkh = map { $_,1 } qw( thread bytecode byterun proto ); +%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio perlvars intrpvar thrdvar ); $ckfunc = 0; LINE: while () { while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) { @@ -234,12 +198,6 @@ LINE: while () { print "opcode.h>> $_" if $debug > 2; if (/^OP \*\s/) { &scan_func($_); } if (/^\s*EXT/) { &scan_var($_); } - if (/^\s+OP_/) { &scan_enum($_); } - last LINE unless defined($_ = ); - } - while (/^typedef enum/ .. /^\s*\}/) { - print "global enum>> $_" if $debug > 2; - &scan_enum($_); last LINE unless defined($_ = ); } # Check for transition to new header file @@ -248,13 +206,14 @@ LINE: while () { # Pull name from library module or header filespec $spec =~ /^(\w+)$/ or $spec =~ /(\w+)\.h/i; my $name = lc $1; + $name = 'perlio' if $name eq 'perliol'; $ckfunc = exists $checkh{$name} ? 1 : 0; $scanname = $name if $ckfunc; print "Header file transition: ckfunc = $ckfunc for $name.h\n" if $debug > 1; } if ($ckfunc) { print "$scanname>> $_" if $debug > 2; - if (/\s*^EXT/) { &scan_var($_); } + if (/^\s*EXT/) { &scan_var($_); } else { &scan_func($_); } } else { @@ -282,22 +241,6 @@ foreach (split /\s+/, $extnames) { print "Adding boot_$pkgname to \%fcns (for extension $_)\n" if $debug; } -# If we're using VAXC, fold in the names of the constants for enums -# we've seen as the type of global vars. -if ($isvaxc) { - foreach (keys %enums) { - if (/^OP/) { - $vars{$_}++ if $used_opcode_enum; - next; - } - if (/^X/) { - $vars{$_}++ if $used_expectation_enum; - next; - } - print STDERR "Unrecognized enum constant \"$_\" ignored\n"; - } -} - # Eventually, we'll check against existing copies here, so we can add new # symbols to an existing options file in an upwardly-compatible manner. @@ -350,10 +293,7 @@ if ($isvax) { open(OPTATTR,">${dir}perlshr_attr.opt") or die "$0: Can't write to ${dir}perlshr_attr.opt: $!\n"; -if ($isvaxc) { - print OPTATTR "PSECT_ATTR=\$CHAR_STRING_CONSTANTS,PIC,SHR,NOEXE,RD,NOWRT\n"; -} -elsif ($isgcc) { +if ($isgcc) { foreach $var (sort keys %cvars) { print OPTATTR "PSECT_ATTR=${var},PIC,OVR,RD,NOEXE,NOWRT,SHR\n"; } @@ -401,6 +341,7 @@ if ($ENV{PERLSHR_USE_GSMATCH}) { # number in the top four bits and use the bottom four for build options # that'll cause incompatibilities ($ver, $sub) = $] =~ /\.(\d\d\d)(\d\d)/; + $ver += 0; $sub += 0; $gsmatch = ($sub >= 50) ? "equal" : "lequal"; # Force an equal match for # dev, but be more forgiving # for releases