# against PerlShr.Exe, since cc places global vars in SHR,WRT psects
# by default.
# PerlShr_Bld.Opt - declares universal symbols for PerlShr.Exe
-# Perlshr_Gbl*.Mar, Perlshr_Gbl*.Obj (VAX only) - declares global symbols
-# for global vars (done here because gcc can't globaldef) and creates
-# transfer vectors for routines on a VAX.
-# PerlShr_Gbl.Opt (VAX only) - list of PerlShr_Gbl*.Obj, used for input
-# to the linker when building PerlShr.Exe.
#
# To do:
# - figure out a good way to collect global vars in one psect, given that
my $cc_cmd = shift @ARGV; # no longer used to run the preprocessor
-# Someday, we'll have $GetSyI built into perl . . .
-my $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;
-
-my $isi64 = `\$ Write Sys\$Output \(F\$GetSyI(\"HW_MODEL\") .GE. 4096)`;
-chomp $isi64;
-print "\$isi64: \\$isi64\\\n" if $debug;
-
print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
my $docc = ($cc_cmd !~ /^~~/);
print "\$docc = $docc\n" if $debug;
# makedef.pl loses distinction between vars and funcs, so
# use the start of the name to guess and add specific
# exceptions when we know about them.
- if ($line =~ m/^PL_/
+ if ($line =~ m/^(PL_|MallocCfg)/
|| $line eq 'PerlIO_perlio'
|| $line eq 'PerlIO_pending') {
$vars{$line}++;
my $marord = 1;
open(OPTBLD,'>', "${dir}${dbgprefix}perlshr_bld.opt")
or die "$0: Can't write to ${dir}${dbgprefix}perlshr_bld.opt: $!\n";
-if ($isvax) {
- open(MAR, '>', "${dir}perlshr_gbl${marord}.mar")
- or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
- print MAR "\t.title perlshr_gbl$marord\n";
-}
unless ($isgcc) {
- if ($isi64) {
- print OPTBLD "PSECT_ATTR=\$GLOBAL_RO_VARS,NOEXE,RD,NOWRT,SHR\n";
- print OPTBLD "PSECT_ATTR=\$GLOBAL_RW_VARS,NOEXE,RD,WRT,NOSHR\n";
- }
- else {
- print OPTBLD "PSECT_ATTR=\$GLOBAL_RO_VARS,PIC,NOEXE,RD,NOWRT,SHR\n";
- print OPTBLD "PSECT_ATTR=\$GLOBAL_RW_VARS,PIC,NOEXE,RD,WRT,NOSHR\n";
- }
+ print OPTBLD "PSECT_ATTR=LIB\$INITIALIZE,GBL,NOEXE,NOWRT,NOSHR,LONG\n";
}
print OPTBLD "case_sensitive=yes\n" if $care_about_case;
my $count = 0;
foreach my $var (sort (keys %vars)) {
- if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; }
- else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; }
- # This hack brought to you by the lack of a globaldef in gcc.
- if ($isgcc) {
- if ($count++ > 200) { # max 254 psects/file
- print MAR "\t.end\n";
- close MAR;
- $marord++;
- open(MAR, '>', "${dir}perlshr_gbl${marord}.mar")
- or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
- print MAR "\t.title perlshr_gbl$marord\n";
- $count = 0;
- }
- print MAR "\t.psect ${var},long,pic,ovr,rd,wrt,noexe,noshr\n";
- print MAR "\t${var}:: .blkl 1\n";
- }
+ print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n";
}
-print MAR "\t.psect \$transfer_vec,pic,rd,nowrt,exe,shr\n" if ($isvax);
foreach my $func (sort keys %fcns) {
- if ($isvax) {
- print MAR "\t.transfer $func\n";
- print MAR "\t.mask $func\n";
- print MAR "\tjmp G\^${func}+2\n";
- }
- else { print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n"; }
-}
-if ($isvax) {
- print MAR "\t.end\n";
- close MAR;
+ print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n";
}
open(OPTATTR, '>', "${dir}perlshr_attr.opt")
my $incstr = 'PERL,GLOBALS';
my (@symfiles, $drvrname);
-if ($isvax) {
- $drvrname = "Compile_shrmars.tmp_".time;
- open (DRVR,'>', $drvrname) or die "$0: Can't write to $drvrname: $!\n";
- print DRVR "\$ Set NoOn\n";
- print DRVR "\$ Delete/NoLog/NoConfirm $drvrname;\n";
- print DRVR "\$ old_proc_vfy = F\$Environment(\"VERIFY_PROCEDURE\")\n";
- print DRVR "\$ old_img_vfy = F\$Environment(\"VERIFY_IMAGE\")\n";
- print DRVR "\$ MCR $^X -e \"\$ENV{'LIBPERL_RDT'} = (stat('$libperl'))[9]\"\n";
- print DRVR "\$ Set Verify\n";
- print DRVR "\$ If F\$Search(\"$libperl\").eqs.\"\" Then Library/Object/Create $libperl\n";
- do {
- push(@symfiles,"perlshr_gbl$marord");
- print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n";
- print DRVR "\$ Library/Object/Replace/Log $libperl PerlShr_Gbl${marord}$objsuffix\n";
- } while (--$marord);
- # We had to have a working miniperl to run this program; it's probably the
- # one we just built. It depended on LibPerl, which will be changed when
- # the PerlShr_Gbl* modules get inserted, so miniperl will be out of date,
- # and so, therefore, will all of its dependents . . .
- # We touch LibPerl here so it'll be back 'in date', and we won't rebuild
- # miniperl etc., and therefore LibPerl, the next time we invoke MM[KS].
- print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n";
- print DRVR "\$ MCR $^X -e \"utime 0, \$ENV{'LIBPERL_RDT'}, '$libperl'\"\n";
- close DRVR;
-}
# Initial hack to permit building of compatible shareable images for a
# given version of Perl.
if ($ENV{PERLSHR_USE_GSMATCH}) {
if ($ENV{PERLSHR_USE_GSMATCH} eq 'INCLUDE_COMPILE_OPTIONS') {
- # Build up a major ID. Since it can only be 8 bits, we encode the version
- # number in the top four bits and use the bottom four for build options
- # that'll cause incompatibilities
- my ($ver, $sub) = $] =~ /\.(\d\d\d)(\d\d)/;
+ # Build up a major ID. Since on Alpha it can only be 8 bits, we encode
+ # the version number in the top 5 bits and use the bottom 3 for build
+ # options most likely to cause incompatibilities. Breaks at Perl 5.32.
+ my ($ver, $sub) = $] =~ /\.(\d\d\d)(\d\d\d)/;
$ver += 0; $sub += 0;
- my $gsmatch = ($sub >= 50) ? "equal" : "lequal"; # Force an equal match for
+ my $gsmatch = ($ver % 2 == 1) ? "EQUAL" : "LEQUAL"; # Force an equal match for
# dev, but be more forgiving
# for releases
- $ver *=16;
- $ver += 8 if $debugging_enabled; # If DEBUGGING is set
- $ver += 4 if $use_threads; # if we're threaded
- $ver += 2 if $use_mymalloc; # if we're using perl's malloc
+ $ver <<= 3;
+ $ver += 1 if $debugging_enabled; # If DEBUGGING is set
+ $ver += 2 if $use_threads; # if we're threaded
+ $ver += 4 if $use_mymalloc; # if we're using perl's malloc
print OPTBLD "GSMATCH=$gsmatch,$ver,$sub\n";
}
else {
my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF; # range 0..255
print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
}
- print OPTBLD 'CLUSTER=$$TRANSFER_VECTOR,,',
- map(",$_$objsuffix",@symfiles), "\n";
}
elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
# Include object modules and RTLs in options file
close RTLOPT;
close OPTBLD;
-exec "\$ \@$drvrname" if $isvax;
-
# Symbol shortening Copyright (c) 2012 Craig A. Berry
#
https://perl5.git.perl.org / perl5.git / blobdiff