| 1 | # Create global symbol declarations, transfer vector, and
|
|---|
| 2 | # linker options files for PerlShr.
|
|---|
| 3 | #
|
|---|
| 4 | # Input:
|
|---|
| 5 | # $cflags - command line qualifiers passed to cc when preprocesing perl.h
|
|---|
| 6 | # Note: A rather simple-minded attempt is made to restore quotes to
|
|---|
| 7 | # a /Define clause - use with care.
|
|---|
| 8 | # $objsuffix - file type (including '.') used for object files.
|
|---|
| 9 | # $libperl - Perl object library.
|
|---|
| 10 | # $extnames - package names for static extensions (used to generate
|
|---|
| 11 | # linker options file entries for boot functions)
|
|---|
| 12 | # $rtlopt - name of options file specifying RTLs to which PerlShr.Exe
|
|---|
| 13 | # must be linked
|
|---|
| 14 | #
|
|---|
| 15 | # Output:
|
|---|
| 16 | # PerlShr_Attr.Opt - linker options file which speficies that global vars
|
|---|
| 17 | # be placed in NOSHR,WRT psects. Use when linking any object files
|
|---|
| 18 | # against PerlShr.Exe, since cc places global vars in SHR,WRT psects
|
|---|
| 19 | # by default.
|
|---|
| 20 | # PerlShr_Bld.Opt - declares universal symbols for PerlShr.Exe
|
|---|
| 21 | # Perlshr_Gbl*.Mar, Perlshr_Gbl*.Obj (VAX only) - declares global symbols
|
|---|
| 22 | # for global vars (done here because gcc can't globaldef) and creates
|
|---|
| 23 | # transfer vectors for routines on a VAX.
|
|---|
| 24 | # PerlShr_Gbl.Opt (VAX only) - list of PerlShr_Gbl*.Obj, used for input
|
|---|
| 25 | # to the linker when building PerlShr.Exe.
|
|---|
| 26 | #
|
|---|
| 27 | # To do:
|
|---|
| 28 | # - figure out a good way to collect global vars in one psect, given that
|
|---|
| 29 | # we can't use globaldef because of gcc.
|
|---|
| 30 | # - then, check for existing files and preserve symbol and transfer vector
|
|---|
| 31 | # order for upward compatibility
|
|---|
| 32 | # - then, add GSMATCH to options file - but how do we insure that new
|
|---|
| 33 | # library has everything old one did
|
|---|
| 34 | # (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)?
|
|---|
| 35 | #
|
|---|
| 36 | # Author: Charles Bailey bailey@newman.upenn.edu
|
|---|
| 37 |
|
|---|
| 38 | require 5.000;
|
|---|
| 39 |
|
|---|
| 40 | $debug = $ENV{'GEN_SHRFLS_DEBUG'};
|
|---|
| 41 |
|
|---|
| 42 | print "gen_shrfls.pl Rev. 18-Dec-2003\n" if $debug;
|
|---|
| 43 |
|
|---|
| 44 | if ($ARGV[0] eq '-f') {
|
|---|
| 45 | open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
|
|---|
| 46 | print "Input taken from file $ARGV[1]\n" if $debug;
|
|---|
| 47 | @ARGV = ();
|
|---|
| 48 | while (<INP>) {
|
|---|
| 49 | chomp;
|
|---|
| 50 | push(@ARGV,split(/\|/,$_));
|
|---|
| 51 | }
|
|---|
| 52 | close INP;
|
|---|
| 53 | print "Read input data | ",join(' | ',@ARGV)," |\n" if $debug > 1;
|
|---|
| 54 | }
|
|---|
| 55 |
|
|---|
| 56 | $cc_cmd = shift @ARGV;
|
|---|
| 57 |
|
|---|
| 58 | # Someday, we'll have $GetSyI built into perl . . .
|
|---|
| 59 | $isvax = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .LE. 1024 .AND. F\$GetSyI(\"HW_MODEL\") .GT. 0\)`;
|
|---|
| 60 | chomp $isvax;
|
|---|
| 61 | print "\$isvax: \\$isvax\\\n" if $debug;
|
|---|
| 62 |
|
|---|
| 63 | print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
|
|---|
| 64 | $docc = ($cc_cmd !~ /^~~/);
|
|---|
| 65 | print "\$docc = $docc\n" if $debug;
|
|---|
| 66 |
|
|---|
| 67 | if ($docc) {
|
|---|
| 68 | if (-f 'perl.h') { $dir = '[]'; }
|
|---|
| 69 | elsif (-f '[-]perl.h') { $dir = '[-]'; }
|
|---|
| 70 | else { die "$0: Can't find perl.h\n"; }
|
|---|
| 71 |
|
|---|
| 72 | $use_threads = $use_mymalloc = $case_about_case = $debugging_enabled = 0;
|
|---|
| 73 | $hide_mymalloc = $isgcc = $use_perlio = 0;
|
|---|
| 74 |
|
|---|
| 75 | # Go see what is enabled in config.sh
|
|---|
| 76 | $config = $dir . "config.sh";
|
|---|
| 77 | open CONFIG, "< $config";
|
|---|
| 78 | while(<CONFIG>) {
|
|---|
| 79 | $use_threads++ if /usethreads='(define|yes|true|t|y|1)'/i;
|
|---|
| 80 | $use_mymalloc++ if /usemymalloc='(define|yes|true|t|y|1)'/i;
|
|---|
| 81 | $care_about_case++ if /d_vms_case_sensitive_symbols='(define|yes|true|t|y|1)'/i;
|
|---|
| 82 | $debugging_enabled++ if /usedebugging_perl='(define|yes|true|t|y|1)'/i;
|
|---|
| 83 | $hide_mymalloc++ if /embedmymalloc='(define|yes|true|t|y|1)'/i;
|
|---|
| 84 | $isgcc++ if /gccversion='[^']/;
|
|---|
| 85 | $use_perlio++ if /useperlio='(define|yes|true|t|y|1)'/i;
|
|---|
| 86 | }
|
|---|
| 87 | close CONFIG;
|
|---|
| 88 |
|
|---|
| 89 | # put quotes back onto defines - they were removed by DCL on the way in
|
|---|
| 90 | if (($prefix,$defines,$suffix) =
|
|---|
| 91 | ($cc_cmd =~ m#(.*)/Define=(.*?)([/\s].*)#i)) {
|
|---|
| 92 | $defines =~ s/^\((.*)\)$/$1/;
|
|---|
| 93 | $debugging_enabled ||= $defines =~ /\bDEBUGGING\b/;
|
|---|
| 94 | @defines = split(/,/,$defines);
|
|---|
| 95 | $cc_cmd = "$prefix/Define=(" . join(',',grep($_ = "\"$_\"",@defines))
|
|---|
| 96 | . ')' . $suffix;
|
|---|
| 97 | }
|
|---|
| 98 | print "Filtered \$cc_cmd: \\$cc_cmd\\\n" if $debug;
|
|---|
| 99 |
|
|---|
| 100 | # check for gcc - if present, we'll need to use MACRO hack to
|
|---|
| 101 | # define global symbols for shared variables
|
|---|
| 102 |
|
|---|
| 103 | print "\$isgcc: $isgcc\n" if $debug;
|
|---|
| 104 | print "\$debugging_enabled: $debugging_enabled\n" if $debug;
|
|---|
| 105 |
|
|---|
| 106 | }
|
|---|
| 107 | else {
|
|---|
| 108 | ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
|
|---|
| 109 | $isgcc = $cc_cmd =~ /case_hack/i
|
|---|
| 110 | or 0; # for nice debug output
|
|---|
| 111 | $debugging_enabled = $cc_cmd =~ /\bdebugging\b/i;
|
|---|
| 112 | print "\$isgcc: \\$isgcc\\\n" if $debug;
|
|---|
| 113 | print "\$debugging_enabled: \\$debugging_enabled\\\n" if $debug;
|
|---|
| 114 | print "Not running cc, preprocesor output in \\$cpp_file\\\n" if $debug;
|
|---|
| 115 | }
|
|---|
| 116 |
|
|---|
| 117 | $objsuffix = shift @ARGV;
|
|---|
| 118 | print "\$objsuffix: \\$objsuffix\\\n" if $debug;
|
|---|
| 119 | $dbgprefix = shift @ARGV;
|
|---|
| 120 | print "\$dbgprefix: \\$dbgprefix\\\n" if $debug;
|
|---|
| 121 | $olbsuffix = shift @ARGV;
|
|---|
| 122 | print "\$olbsuffix: \\$olbsuffix\\\n" if $debug;
|
|---|
| 123 | $libperl = "${dbgprefix}libperl$olbsuffix";
|
|---|
| 124 | $extnames = shift @ARGV;
|
|---|
| 125 | print "\$extnames: \\$extnames\\\n" if $debug;
|
|---|
| 126 | $rtlopt = shift @ARGV;
|
|---|
| 127 | print "\$rtlopt: \\$rtlopt\\\n" if $debug;
|
|---|
| 128 |
|
|---|
| 129 | sub scan_var {
|
|---|
| 130 | my($line) = @_;
|
|---|
| 131 | my($const) = $line =~ /^EXTCONST/;
|
|---|
| 132 |
|
|---|
| 133 | print "\tchecking for global variable\n" if $debug > 1;
|
|---|
| 134 | $line =~ s/\s*EXT/EXT/;
|
|---|
| 135 | $line =~ s/INIT\s*\(.*\)//;
|
|---|
| 136 | $line =~ s/\[.*//;
|
|---|
| 137 | $line =~ s/=.*//;
|
|---|
| 138 | $line =~ s/\W*;?\s*$//;
|
|---|
| 139 | $line =~ s/\W*\)\s*\(.*$//; # closing paren for args stripped in previous stmt
|
|---|
| 140 | print "\tfiltered to \\$line\\\n" if $debug > 1;
|
|---|
| 141 | if ($line =~ /(\w+)$/) {
|
|---|
| 142 | print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1;
|
|---|
| 143 | if ($const) { $cvars{$1}++; }
|
|---|
| 144 | else { $vars{$1}++; }
|
|---|
| 145 | }
|
|---|
| 146 | }
|
|---|
| 147 |
|
|---|
| 148 | sub scan_func {
|
|---|
| 149 | my @lines = split /;/, @_[0];
|
|---|
| 150 |
|
|---|
| 151 | for my $line (@lines) {
|
|---|
| 152 | print "\tchecking for global routine\n" if $debug > 1;
|
|---|
| 153 | $line =~ s/\b(IV|Off_t|Size_t|SSize_t|void)\b//i;
|
|---|
| 154 | if ( $line =~ /(\w+)\s*\(/ ) {
|
|---|
| 155 | print "\troutine name is \\$1\\\n" if $debug > 1;
|
|---|
| 156 | if ($1 eq 'main' || $1 eq 'perl_init_ext' || $1 eq '__attribute__format__'
|
|---|
| 157 | || $1 eq 'sizeof' || (($1 eq 'Perl_stashpv_hvname_match') && ! $use_threads)) {
|
|---|
| 158 | print "\tskipped\n" if $debug > 1;
|
|---|
| 159 | }
|
|---|
| 160 | else { $fcns{$1}++ }
|
|---|
| 161 | }
|
|---|
| 162 | }
|
|---|
| 163 | }
|
|---|
| 164 |
|
|---|
| 165 | # Go add some right up front if we need 'em
|
|---|
| 166 | if ($use_mymalloc) {
|
|---|
| 167 | $fcns{'Perl_malloc'}++;
|
|---|
| 168 | $fcns{'Perl_calloc'}++;
|
|---|
| 169 | $fcns{'Perl_realloc'}++;
|
|---|
| 170 | $fcns{'Perl_mfree'}++;
|
|---|
| 171 | }
|
|---|
| 172 |
|
|---|
| 173 | if ($use_perlio) {
|
|---|
| 174 | $preprocess_list = "${dir}perl.h+${dir}perlapi.h,${dir}perliol.h";
|
|---|
| 175 | } else {
|
|---|
| 176 | $preprocess_list = "${dir}perl.h+${dir}perlapi.h";
|
|---|
| 177 | }
|
|---|
| 178 |
|
|---|
| 179 | $used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
|
|---|
| 180 | if ($docc) {
|
|---|
| 181 | open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output $preprocess_list|")
|
|---|
| 182 | or die "$0: Can't preprocess $preprocess_list: $!\n";
|
|---|
| 183 | }
|
|---|
| 184 | else {
|
|---|
| 185 | open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
|
|---|
| 186 | }
|
|---|
| 187 | %checkh = map { $_,1 } qw( thread bytecode byterun proto perlapi perlio perlvars intrpvar thrdvar );
|
|---|
| 188 | $ckfunc = 0;
|
|---|
| 189 | LINE: while (<CPP>) {
|
|---|
| 190 | while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
|
|---|
| 191 | while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) {
|
|---|
| 192 | print "vms_proto>> $_" if $debug > 2;
|
|---|
| 193 | if (/^\s*EXT/) { &scan_var($_); }
|
|---|
| 194 | else { &scan_func($_); }
|
|---|
| 195 | last LINE unless defined($_ = <CPP>);
|
|---|
| 196 | }
|
|---|
| 197 | print "vmsish.h>> $_" if $debug > 2;
|
|---|
| 198 | if (/^\s*EXT/) { &scan_var($_); }
|
|---|
| 199 | last LINE unless defined($_ = <CPP>);
|
|---|
| 200 | }
|
|---|
| 201 | while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
|
|---|
| 202 | print "opcode.h>> $_" if $debug > 2;
|
|---|
| 203 | if (/^OP \*\s/) { &scan_func($_); }
|
|---|
| 204 | if (/^\s*EXT/) { &scan_var($_); }
|
|---|
| 205 | last LINE unless defined($_ = <CPP>);
|
|---|
| 206 | }
|
|---|
| 207 | # Check for transition to new header file
|
|---|
| 208 | if (/^# \d+ "(\S+)"/) {
|
|---|
| 209 | my $spec = $1;
|
|---|
| 210 | # Pull name from library module or header filespec
|
|---|
| 211 | $spec =~ /^(\w+)$/ or $spec =~ /(\w+)\.h/i;
|
|---|
| 212 | my $name = lc $1;
|
|---|
| 213 | $name = 'perlio' if $name eq 'perliol';
|
|---|
| 214 | $ckfunc = exists $checkh{$name} ? 1 : 0;
|
|---|
| 215 | $scanname = $name if $ckfunc;
|
|---|
| 216 | print "Header file transition: ckfunc = $ckfunc for $name.h\n" if $debug > 1;
|
|---|
| 217 | }
|
|---|
| 218 | if ($ckfunc) {
|
|---|
| 219 | print "$scanname>> $_" if $debug > 2;
|
|---|
| 220 | if (/^\s*EXT/) { &scan_var($_); }
|
|---|
| 221 | else { &scan_func($_); }
|
|---|
| 222 | }
|
|---|
| 223 | else {
|
|---|
| 224 | print $_ if $debug > 3 && ($debug > 5 || length($_));
|
|---|
| 225 | if (/^\s*EXT/) { &scan_var($_); }
|
|---|
| 226 | }
|
|---|
| 227 | }
|
|---|
| 228 | close CPP;
|
|---|
| 229 |
|
|---|
| 230 | while (<DATA>) {
|
|---|
| 231 | next if /^#/;
|
|---|
| 232 | s/\s+#.*\n//;
|
|---|
| 233 | next if /^\s*$/;
|
|---|
| 234 | ($key,$array) = split('=',$_);
|
|---|
| 235 | if ($array eq 'vars') { $key = "PL_$key"; }
|
|---|
| 236 | else { $key = "Perl_$key"; }
|
|---|
| 237 | print "Adding $key to \%$array list\n" if $debug > 1;
|
|---|
| 238 | ${$array}{$key}++;
|
|---|
| 239 | }
|
|---|
| 240 | if ($debugging_enabled and $isgcc) { $vars{'colors'}++ }
|
|---|
| 241 | foreach (split /\s+/, $extnames) {
|
|---|
| 242 | my($pkgname) = $_;
|
|---|
| 243 | $pkgname =~ s/::/__/g;
|
|---|
| 244 | $fcns{"boot_$pkgname"}++;
|
|---|
| 245 | print "Adding boot_$pkgname to \%fcns (for extension $_)\n" if $debug;
|
|---|
| 246 | }
|
|---|
| 247 |
|
|---|
| 248 | # Eventually, we'll check against existing copies here, so we can add new
|
|---|
| 249 | # symbols to an existing options file in an upwardly-compatible manner.
|
|---|
| 250 |
|
|---|
| 251 | $marord++;
|
|---|
| 252 | open(OPTBLD,">${dir}${dbgprefix}perlshr_bld.opt")
|
|---|
| 253 | or die "$0: Can't write to ${dir}${dbgprefix}perlshr_bld.opt: $!\n";
|
|---|
| 254 | if ($isvax) {
|
|---|
| 255 | open(MAR,">${dir}perlshr_gbl${marord}.mar")
|
|---|
| 256 | or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
|
|---|
| 257 | print MAR "\t.title perlshr_gbl$marord\n";
|
|---|
| 258 | }
|
|---|
| 259 |
|
|---|
| 260 | unless ($isgcc) {
|
|---|
| 261 | print OPTBLD "PSECT_ATTR=\$GLOBAL_RO_VARS,PIC,NOEXE,RD,NOWRT,SHR\n";
|
|---|
| 262 | print OPTBLD "PSECT_ATTR=\$GLOBAL_RW_VARS,PIC,NOEXE,RD,WRT,NOSHR\n";
|
|---|
| 263 | }
|
|---|
| 264 | print OPTBLD "case_sensitive=yes\n" if $care_about_case;
|
|---|
| 265 | foreach $var (sort (keys %vars,keys %cvars)) {
|
|---|
| 266 | if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; }
|
|---|
| 267 | else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; }
|
|---|
| 268 | # This hack brought to you by the lack of a globaldef in gcc.
|
|---|
| 269 | if ($isgcc) {
|
|---|
| 270 | if ($count++ > 200) { # max 254 psects/file
|
|---|
| 271 | print MAR "\t.end\n";
|
|---|
| 272 | close MAR;
|
|---|
| 273 | $marord++;
|
|---|
| 274 | open(MAR,">${dir}perlshr_gbl${marord}.mar")
|
|---|
| 275 | or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
|
|---|
| 276 | print MAR "\t.title perlshr_gbl$marord\n";
|
|---|
| 277 | $count = 0;
|
|---|
| 278 | }
|
|---|
| 279 | print MAR "\t.psect ${var},long,pic,ovr,rd,wrt,noexe,noshr\n";
|
|---|
| 280 | print MAR "\t${var}:: .blkl 1\n";
|
|---|
| 281 | }
|
|---|
| 282 | }
|
|---|
| 283 |
|
|---|
| 284 | print MAR "\t.psect \$transfer_vec,pic,rd,nowrt,exe,shr\n" if ($isvax);
|
|---|
| 285 | foreach $func (sort keys %fcns) {
|
|---|
| 286 | if ($isvax) {
|
|---|
| 287 | print MAR "\t.transfer $func\n";
|
|---|
| 288 | print MAR "\t.mask $func\n";
|
|---|
| 289 | print MAR "\tjmp G\^${func}+2\n";
|
|---|
| 290 | }
|
|---|
| 291 | else { print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n"; }
|
|---|
| 292 | }
|
|---|
| 293 | if ($isvax) {
|
|---|
| 294 | print MAR "\t.end\n";
|
|---|
| 295 | close MAR;
|
|---|
| 296 | }
|
|---|
| 297 |
|
|---|
| 298 | open(OPTATTR,">${dir}perlshr_attr.opt")
|
|---|
| 299 | or die "$0: Can't write to ${dir}perlshr_attr.opt: $!\n";
|
|---|
| 300 | if ($isgcc) {
|
|---|
| 301 | foreach $var (sort keys %cvars) {
|
|---|
| 302 | print OPTATTR "PSECT_ATTR=${var},PIC,OVR,RD,NOEXE,NOWRT,SHR\n";
|
|---|
| 303 | }
|
|---|
| 304 | foreach $var (sort keys %vars) {
|
|---|
| 305 | print OPTATTR "PSECT_ATTR=${var},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
|
|---|
| 306 | }
|
|---|
| 307 | }
|
|---|
| 308 | else {
|
|---|
| 309 | print OPTATTR "! No additional linker directives are needed when using DECC\n";
|
|---|
| 310 | }
|
|---|
| 311 | close OPTATTR;
|
|---|
| 312 |
|
|---|
| 313 | $incstr = 'PERL,GLOBALS';
|
|---|
| 314 | if ($isvax) {
|
|---|
| 315 | $drvrname = "Compile_shrmars.tmp_".time;
|
|---|
| 316 | open (DRVR,">$drvrname") or die "$0: Can't write to $drvrname: $!\n";
|
|---|
| 317 | print DRVR "\$ Set NoOn\n";
|
|---|
| 318 | print DRVR "\$ Delete/NoLog/NoConfirm $drvrname;\n";
|
|---|
| 319 | print DRVR "\$ old_proc_vfy = F\$Environment(\"VERIFY_PROCEDURE\")\n";
|
|---|
| 320 | print DRVR "\$ old_img_vfy = F\$Environment(\"VERIFY_IMAGE\")\n";
|
|---|
| 321 | print DRVR "\$ MCR $^X -e \"\$ENV{'LIBPERL_RDT'} = (stat('$libperl'))[9]\"\n";
|
|---|
| 322 | print DRVR "\$ Set Verify\n";
|
|---|
| 323 | print DRVR "\$ If F\$Search(\"$libperl\").eqs.\"\" Then Library/Object/Create $libperl\n";
|
|---|
| 324 | do {
|
|---|
| 325 | push(@symfiles,"perlshr_gbl$marord");
|
|---|
| 326 | print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n";
|
|---|
| 327 | print DRVR "\$ Library/Object/Replace/Log $libperl PerlShr_Gbl${marord}$objsuffix\n";
|
|---|
| 328 | } while (--$marord);
|
|---|
| 329 | # We had to have a working miniperl to run this program; it's probably the
|
|---|
| 330 | # one we just built. It depended on LibPerl, which will be changed when
|
|---|
| 331 | # the PerlShr_Gbl* modules get inserted, so miniperl will be out of date,
|
|---|
| 332 | # and so, therefore, will all of its dependents . . .
|
|---|
| 333 | # We touch LibPerl here so it'll be back 'in date', and we won't rebuild
|
|---|
| 334 | # miniperl etc., and therefore LibPerl, the next time we invoke MM[KS].
|
|---|
| 335 | print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n";
|
|---|
| 336 | print DRVR "\$ MCR $^X -e \"utime 0, \$ENV{'LIBPERL_RDT'}, '$libperl'\"\n";
|
|---|
| 337 | close DRVR;
|
|---|
| 338 | }
|
|---|
| 339 |
|
|---|
| 340 | # Initial hack to permit building of compatible shareable images for a
|
|---|
| 341 | # given version of Perl.
|
|---|
| 342 | if ($ENV{PERLSHR_USE_GSMATCH}) {
|
|---|
| 343 | if ($ENV{PERLSHR_USE_GSMATCH} eq 'INCLUDE_COMPILE_OPTIONS') {
|
|---|
| 344 | # Build up a major ID. Since it can only be 8 bits, we encode the version
|
|---|
| 345 | # number in the top four bits and use the bottom four for build options
|
|---|
| 346 | # that'll cause incompatibilities
|
|---|
| 347 | ($ver, $sub) = $] =~ /\.(\d\d\d)(\d\d)/;
|
|---|
| 348 | $ver += 0; $sub += 0;
|
|---|
| 349 | $gsmatch = ($sub >= 50) ? "equal" : "lequal"; # Force an equal match for
|
|---|
| 350 | # dev, but be more forgiving
|
|---|
| 351 | # for releases
|
|---|
| 352 |
|
|---|
| 353 | $ver *=16;
|
|---|
| 354 | $ver += 8 if $debugging_enabled; # If DEBUGGING is set
|
|---|
| 355 | $ver += 4 if $use_threads; # if we're threaded
|
|---|
| 356 | $ver += 2 if $use_mymalloc; # if we're using perl's malloc
|
|---|
| 357 | print OPTBLD "GSMATCH=$gsmatch,$ver,$sub\n";
|
|---|
| 358 | }
|
|---|
| 359 | else {
|
|---|
| 360 | my $major = int($] * 1000) & 0xFF; # range 0..255
|
|---|
| 361 | my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF; # range 0..255
|
|---|
| 362 | print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
|
|---|
| 363 | }
|
|---|
| 364 | print OPTBLD 'CLUSTER=$$TRANSFER_VECTOR,,',
|
|---|
| 365 | map(",$_$objsuffix",@symfiles), "\n";
|
|---|
| 366 | }
|
|---|
| 367 | elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
|
|---|
| 368 | # Include object modules and RTLs in options file
|
|---|
| 369 | # Linker wants /Include and /Library on different lines
|
|---|
| 370 | print OPTBLD "$libperl/Include=($incstr)\n";
|
|---|
| 371 | print OPTBLD "$libperl/Library\n";
|
|---|
| 372 | open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n";
|
|---|
| 373 | while (<RTLOPT>) { print OPTBLD; }
|
|---|
| 374 | close RTLOPT;
|
|---|
| 375 | close OPTBLD;
|
|---|
| 376 |
|
|---|
| 377 | exec "\$ \@$drvrname" if $isvax;
|
|---|
| 378 |
|
|---|
| 379 |
|
|---|
| 380 | __END__
|
|---|
| 381 |
|
|---|
| 382 | # Oddball cases, so we can keep the perl.h scan above simple
|
|---|
| 383 | regkind=vars # declared in regcomp.h
|
|---|
| 384 | simple=vars # declared in regcomp.h
|
|---|
| 385 | varies=vars # declared in regcomp.h
|
|---|
