source: trunk/third/perl/vms/genconfig.pl @ 14545

Revision 14545, 14.5 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, which included commits to RCS files with non-trunk default branches.
Line 
1#!/usr/bin/perl
2# Habit . . .
3#
4# Extract info from Config.VMS, and add extra data here, to generate Config.sh
5# Edit the static information after __END__ to reflect your site and options
6# that went into your perl binary.  In addition, values which change from run
7# to run may be supplied on the command line as key=val pairs.
8#
9# Rev. 16-Feb-1998  Charles Bailey  bailey@newman.upenn.edu
10#
11
12#==== Locations of installed Perl components
13$prefix='perl_root';
14$builddir="$prefix:[000000]";
15$installbin="$prefix:[000000]";
16$installscript="$prefix:[000000]";
17$installman1dir="$prefix:[man.man1]";
18$installman3dir="$prefix:[man.man3]";
19$installprivlib="$prefix:[lib]";
20$installsitelib="$prefix:[lib.site_perl]";
21
22unshift(@INC,'lib');  # In case someone didn't define Perl_Root
23                      # before the build
24
25if ($ARGV[0] eq '-f') {
26  open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n";
27  @ARGV = ();
28  while (<ARGS>) {
29    chomp;
30    push(@ARGV,split(/\|/,$_));
31  }
32  close ARGS;
33}
34
35if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; }
36elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; }
37elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";}
38
39if ($infile) { print "Generating Config.sh from $infile . . .\n"; }
40else { die <<EndOfGasp;
41Can't find config.vms or config.h to read!
42        Please run this script from the perl source directory or
43        the VMS subdirectory in the distribution.
44EndOfGasp
45}
46$outdir = '';
47open(IN,"$infile") || die "Can't open $infile: $!\n";
48open(OUT,">${outdir}Config.sh") || die "Can't open ${outdir}Config.sh: $!\n";
49
50$time = localtime;
51$cf_by = (getpwuid($<))[0];
52$archsufx = `Write Sys\$Output F\$GetSyi("HW_MODEL")` > 1024 ? 'AXP' : 'VAX';
53($vers = $]) =~ tr/./_/;
54$installarchlib = VMS::Filespec::vmspath($installprivlib);
55$installarchlib =~ s#\]#.VMS_$archsufx.$vers\]#;
56$installsitearch = VMS::Filespec::vmspath($installsitelib);
57$installsitearch =~ s#\]#.VMS_$archsufx\]#;
58($osvers = `Write Sys\$Output F\$GetSyi("VERSION")`) =~ s/^V?(\S+)\s*\n?$/$1/;
59
60print OUT <<EndOfIntro;
61# This file generated by GenConfig.pl on a VMS system.
62# Input obtained from:
63#     $infile
64#     $0
65# Time: $time
66
67package='perl5'
68CONFIG='true'
69cf_time='$time'
70cf_by='$cf_by'
71ccdlflags='undef'
72cccdlflags='undef'
73mab='undef'
74libpth='/sys\$share /sys\$library'
75ld='Link'
76lddlflags='/Share'
77ranlib='undef'
78ar='undef'
79eunicefix=':'
80hint='none'
81hintfile='undef'
82useshrplib='define'
83usemymalloc='n'
84usevfork='true'
85spitshell='write sys\$output '
86dlsrc='dl_vms.c'
87binexp='$installbin'
88man1ext='rno'
89man3ext='rno'
90arch='VMS_$archsufx'
91archname='VMS_$archsufx'
92bincompat3='undef'
93d_bincompat3='undef'
94osvers='$osvers'
95prefix='$prefix'
96builddir='$builddir'
97installbin='$installbin'
98installscript='$installscript'
99installman1dir='$installman1dir'
100installman3dir='$installman3dir'
101installprivlib='$installprivlib'
102installarchlib='$installarchlib'
103installsitelib='$installsitelib'
104installsitearch='$installsitearch'
105path_sep='|'
106startperl='\$ perl 'f\$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
107\$ exit++ + ++\$status != 0 and \$exit = \$status = undef;'
108EndOfIntro
109
110foreach (@ARGV) {
111  ($key,$val) = split('=',$_,2);
112  if ($key eq 'cc') {  # Figure out which C compiler we're using
113    my($cc,$ccflags) = split('/',$val,2);
114    my($d_attr);
115    $ccflags = "/$ccflags";
116    if ($ccflags =~s!/DECC!!ig) {
117      $cc .= '/DECC';
118      $cctype = 'decc';
119      $d_attr = 'undef';
120    }
121    elsif ($ccflags =~s!/VAXC!!ig) {
122      $cc .= '/VAXC';
123      $cctype = 'vaxc';
124      $d_attr = 'undef';
125    }
126    elsif (`$val/NoObject/NoList _nla0:/Version` =~ /GNU C version (\S+)/) {
127      $cctype = 'gcc';
128      $d_attr = 'define';
129      print OUT "gccversion='$1'\n";
130    }
131    elsif ($archsufx eq 'VAX' &&
132           # Check exit status too, in case message is turned off
133           ( `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/ ||
134              $? == 0x38240 )) {
135      $cctype = 'vaxc';
136      $d_attr = 'undef';
137    }
138    else {
139      $cctype = 'decc';
140      $d_attr = 'undef';
141    }
142    print OUT "vms_cc_type='$cctype'\n";
143    print OUT "d_attribut='$d_attr'\n";
144    print OUT "cc='$cc'\n";
145    if ( ($cctype eq 'decc' and $archsufx eq 'VAX') || $cctype eq 'gcc') {
146      # gcc and DECC for VAX requires filename in /object qualifier, so we
147      # have to remove it here.  Alas, this means we lose the user's
148      # object file suffix if it's not .obj.
149      $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i;
150    }
151    $debug = $optimize = '';
152    while ( ($qual) = $ccflags =~ m|(/(No)?Deb[^/]*)|i ) {
153      $debug = $qual;
154      $ccflags =~ s/$qual//;
155    }
156    while ( ($qual) = $ccflags =~ m|(/(No)?Opt[^/]*)|i ) {
157      $optimize = $qual;
158      $ccflags =~ s/$qual//;
159    }
160    $usethreads = ($ccflags =~ m!/DEF[^/]+USE_THREADS!i and
161                   $ccflags !~ m!/UND[^/]+USE_THREADS!i);
162    print OUT "usethreads='",($usethreads ? 'define' : 'undef'),"'\n";;
163    $optimize = "$debug$optimize";
164    print OUT "ccflags='$ccflags'\n";
165    print OUT "optimize='$optimize'\n";
166    $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and
167               $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i);
168    print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n";
169    print OUT "d_socket=",$dosock ? "'define'\n" : "'undef'\n";
170    print OUT "d_sockpair=",$dosock ? "'define'\n" : "'undef'\n";
171    print OUT "d_gethent=",$dosock ? "'define'\n" : "'undef'\n";
172    print OUT "d_sethent=",$dosock ? "'define'\n" : "'undef'\n";
173    print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n";
174    print OUT "i_netdb=",$dosock ? "'define'\n" : "'undef'\n";
175    print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n";
176    print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n";
177    print OUT "d_gethbyname=",$dosock ? "'define'\n" : "'undef'\n";
178    print OUT "d_gethbyaddr=",$dosock ? "'define'\n" : "'undef'\n";
179    print OUT "d_getpbyname=",$dosock ? "'define'\n" : "'undef'\n";
180    print OUT "d_getpbynumber=",$dosock ? "'define'\n" : "'undef'\n";
181    print OUT "d_getsbyname=",$dosock ? "'define'\n" : "'undef'\n";
182    print OUT "d_getsbyport=",$dosock ? "'define'\n" : "'undef'\n";
183    print OUT "d_endhent=",$dosock ? "'define'\n" : "'undef'\n";
184    print OUT "d_getpent=",$dosock ? "'define'\n" : "'undef'\n";
185    print OUT "d_setpent=",$dosock ? "'define'\n" : "'undef'\n";
186    print OUT "d_endpent=",$dosock ? "'define'\n" : "'undef'\n";
187    print OUT "d_getsent=",$dosock ? "'define'\n" : "'undef'\n";
188    print OUT "d_setsent=",$dosock ? "'define'\n" : "'undef'\n";
189    print OUT "d_endsent=",$dosock ? "'define'\n" : "'undef'\n";
190    print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n";
191    print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n";
192    print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n";
193    print OUT "d_gethostprotos=",$dosock ? "'define'\n" : "'undef'\n";
194    print OUT "d_getnetprotos=",$dosock ? "'define'\n" : "'undef'\n";
195    print OUT "d_getservprotos=",$dosock ? "'define'\n" : "'undef'\n";
196    print OUT "d_getprotoprotos=",$dosock ? "'define'\n" : "'undef'\n";
197
198    if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) {
199      print OUT "selecttype='fd_set'\n";
200      print OUT "d_getnbyaddr='define'\n";
201      print OUT "d_getnbyname='define'\n";
202      print OUT "d_getnent='define'\n";
203      print OUT "d_setnent='define'\n";
204      print OUT "d_endnent='define'\n";
205      print OUT "netdb_net_type='long'\n";
206    }
207    else {
208      print OUT "selecttype='int'\n";
209      print OUT "d_getnybname='undef'\n";
210      print OUT "d_getnybaddr='undef'\n";
211      print OUT "d_getnent='undef'\n";
212      print OUT "d_setnent='undef'\n";
213      print OUT "d_endnent='undef'\n";
214      print OUT "netdb_net_type='undef'\n";
215    }
216
217    if ($cctype eq 'decc') {
218      $rtlhas  = 'define';
219      print OUT "useposix='true'\n";
220      ($ccver,$vmsver) = `$cc/VERSION` =~ /V(\S+) on .*V(\S+)$/;
221      # Best guess; the may be wrong on systems which have separately
222      # installed the new CRTL.
223      if ($ccver >= 5.2 and $vmsver >= 7) { $rtlnew = 'define'; }
224      else                                { $rtlnew = 'undef';  }
225    }
226    else { $rtlhas = $rtlnew = 'undef';  print OUT "useposix='false'\n"; }
227    foreach (qw[ d_stdstdio d_stdio_ptr_lval d_stdio_cnt_lval d_stdiobase
228                 d_locconv d_setlocale i_locale d_mbstowcs d_mbtowc
229                 d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) {
230      print OUT "$_='$rtlhas'\n";
231    }
232    foreach (qw[ d_gettimeod d_uname d_truncate d_wait4 d_index
233                 d_pathconf d_fpathconf d_sysconf d_sigsetjmp ]) {
234      print OUT "$_='$rtlnew'\n";
235    }
236    next;
237  }
238  elsif ($key eq 'exe_ext') {
239    my($nodot) = $val;
240    $nodot =~ s!\.!!;
241    print OUT "so='$nodot'\ndlext='$nodot'\n";
242  }
243  elsif ($key eq 'obj_ext') { print OUT "dlobj='dl_vms$val'\n";     }
244  print OUT "$key='$val'\n";
245}
246
247# Are there any other logicals which TCP/IP stacks use for the host name?
248$myname = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
249          $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
250          $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
251if (!$myname) {
252  ($myname) = `hostname` =~ /^(\S+)/;
253  if ($myname =~ /IVVERB/) {
254    warn "Can't determine TCP/IP hostname" if $dosock;
255    $myname = '';
256  }
257}
258$myname = $ENV{'SYS$NODE'} unless $myname;
259($myhostname,$mydomain) = split(/\./,$myname,2);
260print OUT "myhostname='$myhostname'\n" if $myhostname;
261if ($mydomain) {
262  print OUT "mydomain='.$mydomain'\n";
263  print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n";
264  print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n";
265}
266else {
267  print OUT "perladmin='$cf_by'\n";
268  print OUT "cf_email='$cf_by'\n";
269}
270chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`);
271$hwname = $archsufx if $hwname =~ /IVKEYW/;  # *really* old VMS version
272print OUT "myuname='VMS $myname $osvers $hwname'\n";
273
274# Before we read the C header file, find out what config.sh constants are
275# equivalent to the C preprocessor macros
276if (open(SH,"${outdir}config_h.SH")) {
277  while (<SH>) {
278    next unless m%^#(?!if).*\$%;
279    s/^#//; s!(.*?)\s*/\*.*!$1!;
280    my(@words) = split;
281    $words[1] =~ s/\(.*//;  # Clip off args from macro
282    # Did we use a shell variable for the preprocessor directive?
283    if ($words[0] =~ m!^\$(\w+)!) { $pp_vars{$words[1]} = $1; }
284    if (@words > 2) {  # We may also have a shell var in the value
285      shift @words;              #  Discard preprocessor directive
286      my($token) = shift @words; #  and keep constant name
287      my($word);
288      foreach $word (@words) {
289        next unless $word =~ m!\$(\w+)!;
290        $val_vars{$token} = $1;
291        last;
292      }
293    }
294  }
295  close SH;
296}
297else { warn "Couldn't read ${outdir}config_h.SH: $!\n"; }
298$pp_vars{UNLINK_ALL_VERSIONS} = 'd_unlink_all_versions';  # VMS_specific
299
300# OK, now read the C header file, and retcon statements into config.sh
301while (<IN>) {  # roll through the comment header in Config.VMS
302  last if /config-start/;
303}
304
305while (<IN>) {
306  chop;
307  while (/\\\s*$/) {  # pick up contination lines
308    my $line = $_;
309    $line =~ s/\\\s*$//;
310    $_ = <IN>;
311    s/^\s*//;
312    $_ = $line . $_;
313  }             
314  next unless my ($blocked,$un,$token,$val) =
315                 m%^(\/\*)?\s*\#\s*(un)?def\w*\s+([A-Za-z0-9]\w+)\S*\s*(.*)%;
316  if (/config-skip/) {
317    delete $pp_vars{$token} if exists $pp_vars{$token};
318    delete $val_vars{$token} if exists $val_vars{$token};
319    next;
320  }
321  $val =~ s!\s*/\*.*!!; # strip off trailing comment
322  my($had_val); # Maybe a macro with args that we just #undefd or commented
323  if (!length($val) and $val_vars{$token} and ($un || $blocked)) {
324    print OUT "$val_vars{$token}=''\n" unless exists $done{$val_vars{$token}};
325    $done{$val_vars{$token}}++;
326    delete $val_vars{$token};
327    $had_val = 1;
328  }
329  $state = ($blocked || $un) ? 'undef' : 'define';
330  if ($pp_vars{$token}) {
331    print OUT "$pp_vars{$token}='$state'\n" unless exists $done{$pp_vars{$token}};
332    $done{$pp_vars{$token}}++;
333    delete $pp_vars{$token};
334  }
335  elsif (not length $val and not $had_val) {
336    # Wups -- should have been shell var for C preprocessor directive
337    warn "Constant $token not found in config_h.SH\n";
338    $token = lc $token;
339    $token = "d_$token" unless $token =~ /^i_/;
340    print OUT "$token='$state'\n";
341  }
342  next unless length $val;
343  $val =~ s/^"//; $val =~ s/"$//;               # remove end quotes
344  $val =~ s/","/ /g;                            # make signal list look nice
345  # Library directory; convert to VMS syntax
346  $val = VMS::Filespec::vmspath($val) if ($token =~ /EXP$/);
347  if ($val_vars{$token}) {
348    print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}};
349    if ($val_vars{$token} =~ s/exp$//) {
350      print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}};;
351    }
352    $done{$val_vars{$token}}++;
353    delete $val_vars{$token};
354  }
355  elsif (!$pp_vars{$token}) {  # Haven't seen it previously, either
356    warn "Constant $token not found in config_h.SH (val=|$val|)\n";
357    $token = lc $token;
358    print OUT "$token='$val'\n";
359    if ($token =~ s/exp$//) {print OUT "$token='$val'\n";}
360  }
361}
362close IN;
363# Special case -- preprocessor manifest "VMS" is defined automatically
364# on VMS systems, but is also used erroneously by the Perl build process
365# as the manifest for the obsolete variable $d_eunice.
366print OUT "d_eunice='undef'\n";  delete $pp_vars{VMS};
367
368# XXX temporary -- USE_THREADS is currently on CC command line
369delete $pp_vars{'USE_THREADS'};
370
371foreach (sort keys %pp_vars) {
372  warn "Didn't see $_ in $infile\n";
373}
374foreach (sort keys %val_vars) {
375  warn "Didn't see $_ in $infile(val)\n";
376}
377
378if (open(OPT,"${outdir}crtl.opt")) {
379  while (<OPT>) {
380    next unless m#/(sha|lib)#i;
381    chomp;
382    if (/crtl/i || /gcclib/i) { push(@crtls,$_); }
383    else                      { push(@libs,$_);  }
384  }
385  close OPT;
386  print OUT "libs='",join(' ',@libs),"'\n";
387  push(@crtls,'(DECCRTL)') if $cctype eq 'decc';
388  print OUT "libc='",join(' ',@crtls),"'\n";
389}
390else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; }
391
392if (open(PL,"${outdir}patchlevel.h")) {
393  while (<PL>) {
394    if    (/^#define PERL_VERSION\s+(\S+)/) {
395      print OUT "PERL_VERSION='$1'\n";
396      print OUT "PATCHLEVEL='$1'\n";    # XXX compat
397    }
398    elsif (/^#define PERL_SUBVERSION\s+(\S+)/) {
399      print OUT "PERL_SUBVERSION='$1'\n";
400      print OUT "SUBVERSION='$1'\n";    # XXX compat
401    }
402  }
403  close PL;
404}
405else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; }
406
407# simple pager support for perldoc                                             
408if    (`most not..file` =~ /IVVERB/) {
409  $pager = 'more';
410  if (`more nl:` =~ /IVVERB/) { $pager = 'type/page'; }
411}
412else { $pager = 'most'; }
413print OUT "pager='$pager'\n";
414
415close OUT;
Note: See TracBrowser for help on using the repository browser.