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

Revision 17035, 14.6 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r17034, 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    print OUT "d_stdio_ptr_lval_sets_cnt='undef'\n";
233    print OUT "d_stdio_ptr_lval_nochange_cnt='undef'\n";
234    foreach (qw[ d_gettimeod d_uname d_truncate d_wait4 d_index
235                 d_pathconf d_fpathconf d_sysconf d_sigsetjmp ]) {
236      print OUT "$_='$rtlnew'\n";
237    }
238    next;
239  }
240  elsif ($key eq 'exe_ext') {
241    my($nodot) = $val;
242    $nodot =~ s!\.!!;
243    print OUT "so='$nodot'\ndlext='$nodot'\n";
244  }
245  elsif ($key eq 'obj_ext') { print OUT "dlobj='dl_vms$val'\n";     }
246  print OUT "$key='$val'\n";
247}
248
249# Are there any other logicals which TCP/IP stacks use for the host name?
250$myname = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
251          $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
252          $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
253if (!$myname) {
254  ($myname) = `hostname` =~ /^(\S+)/;
255  if ($myname =~ /IVVERB/) {
256    warn "Can't determine TCP/IP hostname" if $dosock;
257    $myname = '';
258  }
259}
260$myname = $ENV{'SYS$NODE'} unless $myname;
261($myhostname,$mydomain) = split(/\./,$myname,2);
262print OUT "myhostname='$myhostname'\n" if $myhostname;
263if ($mydomain) {
264  print OUT "mydomain='.$mydomain'\n";
265  print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n";
266  print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n";
267}
268else {
269  print OUT "perladmin='$cf_by'\n";
270  print OUT "cf_email='$cf_by'\n";
271}
272chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`);
273$hwname = $archsufx if $hwname =~ /IVKEYW/;  # *really* old VMS version
274print OUT "myuname='VMS $myname $osvers $hwname'\n";
275
276# Before we read the C header file, find out what config.sh constants are
277# equivalent to the C preprocessor macros
278if (open(SH,"${outdir}config_h.SH")) {
279  while (<SH>) {
280    next unless m%^#(?!if).*\$%;
281    s/^#//; s!(.*?)\s*/\*.*!$1!;
282    my(@words) = split;
283    $words[1] =~ s/\(.*//;  # Clip off args from macro
284    # Did we use a shell variable for the preprocessor directive?
285    if ($words[0] =~ m!^\$(\w+)!) { $pp_vars{$words[1]} = $1; }
286    if (@words > 2) {  # We may also have a shell var in the value
287      shift @words;              #  Discard preprocessor directive
288      my($token) = shift @words; #  and keep constant name
289      my($word);
290      foreach $word (@words) {
291        next unless $word =~ m!\$(\w+)!;
292        $val_vars{$token} = $1;
293        last;
294      }
295    }
296  }
297  close SH;
298}
299else { warn "Couldn't read ${outdir}config_h.SH: $!\n"; }
300$pp_vars{UNLINK_ALL_VERSIONS} = 'd_unlink_all_versions';  # VMS_specific
301
302# OK, now read the C header file, and retcon statements into config.sh
303while (<IN>) {  # roll through the comment header in Config.VMS
304  last if /config-start/;
305}
306
307while (<IN>) {
308  chop;
309  while (/\\\s*$/) {  # pick up contination lines
310    my $line = $_;
311    $line =~ s/\\\s*$//;
312    $_ = <IN>;
313    s/^\s*//;
314    $_ = $line . $_;
315  }             
316  next unless my ($blocked,$un,$token,$val) =
317                 m%^(\/\*)?\s*\#\s*(un)?def\w*\s+([A-Za-z0-9]\w+)\S*\s*(.*)%;
318  if (/config-skip/) {
319    delete $pp_vars{$token} if exists $pp_vars{$token};
320    delete $val_vars{$token} if exists $val_vars{$token};
321    next;
322  }
323  $val =~ s!\s*/\*.*!!; # strip off trailing comment
324  my($had_val); # Maybe a macro with args that we just #undefd or commented
325  if (!length($val) and $val_vars{$token} and ($un || $blocked)) {
326    print OUT "$val_vars{$token}=''\n" unless exists $done{$val_vars{$token}};
327    $done{$val_vars{$token}}++;
328    delete $val_vars{$token};
329    $had_val = 1;
330  }
331  $state = ($blocked || $un) ? 'undef' : 'define';
332  if ($pp_vars{$token}) {
333    print OUT "$pp_vars{$token}='$state'\n" unless exists $done{$pp_vars{$token}};
334    $done{$pp_vars{$token}}++;
335    delete $pp_vars{$token};
336  }
337  elsif (not length $val and not $had_val) {
338    # Wups -- should have been shell var for C preprocessor directive
339    warn "Constant $token not found in config_h.SH\n";
340    $token = lc $token;
341    $token = "d_$token" unless $token =~ /^i_/;
342    print OUT "$token='$state'\n";
343  }
344  next unless length $val;
345  $val =~ s/^"//; $val =~ s/"$//;               # remove end quotes
346  $val =~ s/","/ /g;                            # make signal list look nice
347  # Library directory; convert to VMS syntax
348  $val = VMS::Filespec::vmspath($val) if ($token =~ /EXP$/);
349  if ($val_vars{$token}) {
350    print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}};
351    if ($val_vars{$token} =~ s/exp$//) {
352      print OUT "$val_vars{$token}='$val'\n" unless exists $done{$val_vars{$token}};;
353    }
354    $done{$val_vars{$token}}++;
355    delete $val_vars{$token};
356  }
357  elsif (!$pp_vars{$token}) {  # Haven't seen it previously, either
358    warn "Constant $token not found in config_h.SH (val=|$val|)\n";
359    $token = lc $token;
360    print OUT "$token='$val'\n";
361    if ($token =~ s/exp$//) {print OUT "$token='$val'\n";}
362  }
363}
364close IN;
365# Special case -- preprocessor manifest "VMS" is defined automatically
366# on VMS systems, but is also used erroneously by the Perl build process
367# as the manifest for the obsolete variable $d_eunice.
368print OUT "d_eunice='undef'\n";  delete $pp_vars{VMS};
369
370# XXX temporary -- USE_THREADS is currently on CC command line
371delete $pp_vars{'USE_THREADS'};
372
373foreach (sort keys %pp_vars) {
374  warn "Didn't see $_ in $infile\n";
375}
376foreach (sort keys %val_vars) {
377  warn "Didn't see $_ in $infile(val)\n";
378}
379
380if (open(OPT,"${outdir}crtl.opt")) {
381  while (<OPT>) {
382    next unless m#/(sha|lib)#i;
383    chomp;
384    if (/crtl/i || /gcclib/i) { push(@crtls,$_); }
385    else                      { push(@libs,$_);  }
386  }
387  close OPT;
388  print OUT "libs='",join(' ',@libs),"'\n";
389  push(@crtls,'(DECCRTL)') if $cctype eq 'decc';
390  print OUT "libc='",join(' ',@crtls),"'\n";
391}
392else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; }
393
394if (open(PL,"${outdir}patchlevel.h")) {
395  while (<PL>) {
396    if    (/^#define PERL_VERSION\s+(\S+)/) {
397      print OUT "PERL_VERSION='$1'\n";
398      print OUT "PATCHLEVEL='$1'\n";    # XXX compat
399    }
400    elsif (/^#define PERL_SUBVERSION\s+(\S+)/) {
401      print OUT "PERL_SUBVERSION='$1'\n";
402      print OUT "SUBVERSION='$1'\n";    # XXX compat
403    }
404  }
405  close PL;
406}
407else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; }
408
409# simple pager support for perldoc                                             
410if    (`most not..file` =~ /IVVERB/) {
411  $pager = 'more';
412  if (`more nl:` =~ /IVVERB/) { $pager = 'type/page'; }
413}
414else { $pager = 'most'; }
415print OUT "pager='$pager'\n";
416
417close OUT;
Note: See TracBrowser for help on using the repository browser.