This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
SIGRTMAX, SIGRTMIN, LDBL_MAX, LDBL_MIN, LDBL_EPSILON and HUGE_VAL
[perl5.git] / vms / gen_shrfls.pl
index d393b0f..fcd72f4 100644 (file)
@@ -39,7 +39,7 @@ require 5.000;
 
 $debug = $ENV{'GEN_SHRFLS_DEBUG'};
 
-print "gen_shrfls.pl Rev. 18-May-2001\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;
@@ -75,13 +76,13 @@ if ($docc) {
   $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'/;
+    $use_perlio++ if /useperlio='(define|yes|true|t|y|1)'/i;
   }
   close CONFIG;
   
@@ -145,16 +146,19 @@ sub scan_var {
 }
 
 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') {
-      print "\tskipped\n" if $debug > 1;
+  my @lines = split /;/, @_[0];
+
+  for my $line (@lines) {
+    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' || $1 eq '__attribute__format__'
+          || $1 eq 'sizeof' || (($1 eq 'Perl_stashpv_hvname_match') && ! $use_threads)) {
+        print "\tskipped\n" if $debug > 1;
+      }
+      else { $fcns{$1}++ }
     }
-    else { $fcns{$1}++ }
   }
 }
 
@@ -167,9 +171,9 @@ if ($use_mymalloc) {
 }
 
 if ($use_perlio) {
-  $preprocess_list = "${dir}perl.h,${dir}perliol.h";
+  $preprocess_list = "${dir}perl.h+${dir}perlapi.h,${dir}perliol.h";
 } else {
-  $preprocess_list = "${dir}perl.h";
+  $preprocess_list = "${dir}perl.h+${dir}perlapi.h";
 }
 
 $used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
@@ -180,7 +184,7 @@ 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 perlio );
+%checkh = map { $_,1 } qw( thread bytecode byterun proto perlapi perlio perlvars intrpvar thrdvar );
 $ckfunc = 0;
 LINE: while (<CPP>) {
   while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
@@ -213,7 +217,7 @@ LINE: while (<CPP>) {
   }
   if ($ckfunc) {
     print "$scanname>> $_" if $debug > 2;
-    if (/\s*^EXT/) { &scan_var($_);  }
+    if (/^\s*EXT/) { &scan_var($_);  }
     else           { &scan_func($_); }
   }
   else {