X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=vms%2Fgen_shrfls.pl;h=f8bf6b190ba9b4362972e0bcce2a77e6ed3c2554;hb=8bbf3450a1ff0a3996dade29a4194cc0939d871f;hp=48499d4a4912d2a57a29acc096143815bd5bae05;hpb=0e06870bf080a38cda51c06c6612359afc2334e1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index 48499d4..f8bf6b1 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-Dec-2003\n" if $debug;
 
 if ($ARGV[0] eq '-f') {
   open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
@@ -56,7 +56,8 @@ if ($ARGV[0] eq '-f') {
 $cc_cmd = shift @ARGV;
 
 # Someday, we'll have $GetSyI built into perl . . .
-$isvax = `\$ Write Sys\$Output F\$GetSyI(\"HW_MODEL\")` <= 1024;
+$isvax = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .LE. 1024 .AND. F\$GetSyI(\"HW_MODEL\") .GT. 0\)`;
+chomp $isvax;
 print "\$isvax: \\$isvax\\\n" if $debug;
 
 print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
@@ -69,18 +70,19 @@ if ($docc) {
   else { die "$0: Can't find perl.h\n"; }
 
   $use_threads = $use_mymalloc = $case_about_case = $debugging_enabled = 0;
-  $hide_mymalloc = $isgcc = 0;
+  $hide_mymalloc = $isgcc = $use_perlio = 0;
 
   # Go see what is enabled in config.sh
   $config = $dir . "config.sh";
   open CONFIG, "< $config";
   while(<CONFIG>) {
-    $use_threads++ if /usethreads='define'/;
-    $use_mymalloc++ if /usemymalloc='Y'/;
-    $care_about_case++ if /d_vms_case_sensitive_symbols='define'/;
-    $debugging_enabled++ if /usedebugging_perl='Y'/;
-    $hide_mymalloc++ if /embedmymalloc='Y'/;
+    $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;
   
@@ -147,6 +149,7 @@ 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') {
@@ -164,15 +167,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 perlio );
+%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio perlvars intrpvar thrdvar );
 $ckfunc = 0;
 LINE: while (<CPP>) {
   while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
@@ -198,13 +207,14 @@ LINE: while (<CPP>) {
     # 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 {