genps.pl

nasm的全套源代码,有些我做了些修改,以方便您更方便更容易调试成功,方便学习做编译器

		 ++$curcolumn < $psconf{idxcolumns} ) {
		# We're actually breaking text into columns, not pages
		$curypos = $columnstart;
	    } else {
		undef $columnstart;
		$curpage++;
		$curypos = 0;
	    }
	    next;
	}

	# Add end of paragraph skip
	if ( $$linfo[1] & 2 ) {
	    $curypos += $skiparray{$$linfo[0]};
	}
    }
}

ps_break_pages(0,$nlines);	# Break the main text body into pages

#
# Find the page number of all the indices
#
%ps_xref_page   = ();		# Crossref anchor pages
%ps_index_pages = ();		# Index item pages
$nlines = scalar(@pslines);
for ( $i = 0 ; $i < $nlines ; $i++ ) {
    my $linfo = $pslines[$i]->[0];
    foreach my $c ( @{$pslines[$i]->[1]} ) {
	if ( $$c[0] == -4 ) {
	    if ( !defined($ps_index_pages{$$c[1]}) ) {
		$ps_index_pages{$$c[1]} = [];
	    } elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
		# Pages are emitted in order; if this is a duplicated
		# entry it will be the last one
		next;		# Duplicate
	    }
	    push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
	} elsif ( $$c[0] == -5 ) {
	    $ps_xref_page{$$c[1]} = $$linfo[4];
	}
    }
}

#
# Emit index paragraphs
#
$startofindex = scalar(@pslines);
@ixparas = ([[-5,'index'],[0,'Index']]);
@ixptypes = ('chap');

foreach $k ( @ixentries ) {
    my $n,$i;
    my $ixptype = 'idx0';
    my $prefix = $ixhasprefix{$k};
    my @ixpara = mkparaarray($ixptype,@{$ixterms{$k}});
    my $commapos = undef;

    if ( defined($prefix) && $ixprefixes{$prefix} > 1 ) {
	# This entry has a "hanging comma"
	for ( $i = 0 ; $i < scalar(@ixpara)-1 ; $i++ ) {
	    if ( substr($ixpara[$i]->[1],-1,1) eq ',' &&
		 $ixpara[$i+1]->[1] eq ' ' ) {
		$commapos = $i;
		last;
	    }
	}
    }
    if ( defined($commapos) ) {
	if ( $ixcommafirst{$k} ) {
	    # This is the first entry; generate the
	    # "hanging comma" entry
	    my @precomma = splice(@ixpara,0,$commapos);
	    if ( $ixpara[0]->[1] eq ',' ) {
		shift(@ixpara);	# Discard lone comma
	    } else {
		# Discard attached comma
		$ixpara[0]->[1] =~ s/\,$//;
		push(@precomma,shift(@ixpara));
	    }
	    push(@precomma, [-6,undef]);
	    push(@ixparas, [@precomma]);
	    push(@ixptypes, $ixptype);
	    shift(@ixpara);	# Remove space
	} else {
	    splice(@ixpara,0,$commapos+2);
	}
	$ixptype = 'idx1';
    }

    push(@ixpara, [-6,undef]);	# Left/right marker
    $i = 1;  $n = scalar(@{$ps_index_pages{$k}});
    foreach $p ( @{$ps_index_pages{$k}} ) {
	if ( $i++ == $n ) {
	    push(@ixpara,[-7,$p],[0,"$p"],[-1,undef]);
	} else {
	    push(@ixpara,[-7,$p],[0,"$p,"],[-1,undef],[0,' ']);
	}
    }

    push(@ixparas, [@ixpara]);
    push(@ixptypes, $ixptype);
}

#
# Flow index paragraphs into lines
#
ps_break_lines(\@ixparas, \@ixptypes);

#
# Format index into pages
#
$nlines = scalar(@pslines);
ps_break_pages($startofindex, $nlines);

#
# Push index onto bookmark list
#
push(@bookmarks, ['index', 0, 'Index']);

# Get the list of fonts used
%ps_all_fonts = ();
foreach $fset ( @AllFonts ) {
    foreach $font ( @{$fset->{fonts}} ) {
	$ps_all_fonts{$font->[1]->{name}}++;
    }
}

# Emit the PostScript DSC header
print "%!PS-Adobe-3.0\n";
print "%%Pages: $curpage\n";
print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
print "%%Creator: (NASM psflow.pl)\n";
print "%%DocumentData: Clean7Bit\n";
print "%%DocumentFonts: ", join(' ', keys(%ps_all_fonts)), "\n";
print "%%DocumentNeededFonts: ", join(' ', keys(%ps_all_fonts)), "\n";
print "%%Orientation: Portrait\n";
print "%%PageOrder: Ascend\n";
print "%%EndComments\n";
print "%%BeginProlog\n";

# Emit the configurables as PostScript tokens
foreach $c ( keys(%psconf) ) {
    print "/$c ", $psconf{$c}, " def\n";
}
foreach $c ( keys(%psbool) ) {
    print "/$c ", ($psbool{$c}?'true':'false'), " def\n";
}

# Emit custom encoding vector
$zstr = '/NASMEncoding [ ';
foreach $c ( @NASMEncoding ) {
    my $z = '/'.(defined($c)?$c:'.notdef ').' ';
    if ( length($zstr)+length($z) > 72 ) {
	print $zstr,"\n";
	$zstr = ' ';
    }
    $zstr .= $z;
}
print $zstr, "] def\n";

# Font recoding routine
# newname fontname --
print "/nasmenc {\n";
print "  findfont dup length dict begin\n";
print "    { 1 index /FID ne {def}{pop pop} ifelse } forall\n";
print "    /Encoding NASMEncoding def\n";
print "    currentdict\n";
print "  end\n";
print "  definefont pop\n";
print "} def\n";

# Emit fontset definitions
foreach $font ( keys(%ps_all_fonts) ) {
    print '/',$font,'-NASM /',$font," nasmenc\n";
}

foreach $fset ( @AllFonts ) {
    my $i = 0;
    my @zfonts = ();
    foreach $font ( @{$fset->{fonts}} ) {
	print '/', $fset->{name}, $i, ' ',
	'/', $font->[1]->{name}, '-NASM findfont ',
	$font->[0], " scalefont def\n";
	push(@zfonts, $fset->{name}.$i);
	$i++;
    }
    print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
}

# This is used by the bullet-paragraph PostScript methods
print "/bullet [",ps_string($charcode{'bullet'}),"] def\n";

# Emit the canned PostScript prologue
open(PSHEAD, "< head.ps");
while ( defined($line = <PSHEAD>) ) {
    print $line;
}
close(PSHEAD);
print "%%EndProlog\n";

# Generate a PostScript string
sub ps_string($) {
    my ($s) = @_;
    my ($i,$c);
    my ($o) = '(';
    my ($l) = length($s);
    for ( $i = 0 ; $i < $l ; $i++ ) {
	$c = substr($s,$i,1);
	if ( ord($c) < 32 || ord($c) > 126 ) {
	    $o .= sprintf("\\%03o", ord($c));
	} elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
	    $o .= "\\".$c;
	} else {
	    $o .= $c;
	}
    }
    return $o.')';
}

# Generate PDF bookmarks
print "%%BeginSetup\n";
foreach $b ( @bookmarks ) {
    print '[/Title ', ps_string($b->[2]), "\n";
    print '/Count ', $b->[1], ' ' if ( $b->[1] );
    print '/Dest /',$b->[0]," /OUT pdfmark\n";
}

# Ask the PostScript interpreter for the proper size media
print "setpagesize\n";
print "%%EndSetup\n";

# Start a PostScript page
sub ps_start_page() {
    $ps_page++;
    print "%%Page: $ps_page $ps_page\n";
    print "%%BeginPageSetup\n";
    print "save\n";
    print "%%EndPageSetup\n";
    print '/', $ps_page, " pa\n";
}

# End a PostScript page
sub ps_end_page($) {
    my($pn) = @_;
    if ( $pn ) {
	print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
    }
    print "restore showpage\n";
}

$ps_page = 0;

# Title page
ps_start_page();
$title = $metadata{'title'} || '';
$title =~ s/ \- / $charcode{'emdash'} /;

$subtitle = $metadata{'subtitle'} || '';
$subtitle =~ s/ \- / $charcode{'emdash'} /;

# Print title
print "/ti ", ps_string($title), " def\n";
print "/sti ", ps_string($subtitle), " def\n";
print "lmarg pageheight 2 mul 3 div moveto\n";
print "tfont0 setfont\n";
print "/title linkdest ti show\n";
print "lmarg pageheight 2 mul 3 div 10 sub moveto\n";
print "0 setlinecap 3 setlinewidth\n";
print "pagewidth lmarg sub rmarg sub 0 rlineto currentpoint stroke moveto\n";
print "hfont1 setfont sti stringwidth pop neg ",
    -$HeadFont{leading}, " rmoveto\n";
print "sti show\n";

# Print logo, if there is one
# FIX: To be 100% correct, this should look for DocumentNeeded*
# and DocumentFonts in the header of the EPSF and add those to the
# global header.
if ( defined($metadata{epslogo}) &&
     sysopen(EPS, $metadata{epslogo}, O_RDONLY) ) {
    my @eps = ();
    my ($bbllx,$bblly,$bburx,$bbury) = (undef,undef,undef,undef);
    my $line;
    my $scale = 1;
    my $maxwidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
    my $maxheight = $psconf{pageheight}/3-40;
    my $width, $height;
    my $x, $y;

    while ( defined($line = <EPS>) ) {
	last if ( $line =~ /^%%EOF/ );
	if ( !defined($bbllx) &&
	     $line =~ /^\%\%BoundingBox\:\s*([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)/i ) {
	    $bbllx = $1+0; $bblly = $2+0;
	    $bburx = $3+0; $bbury = $4+0;
	}
	push(@eps,$line);
    }
    close(EPS);

    if ( defined($bbllx) ) {
	$width = $bburx-$bbllx;
	$height = $bbury-$bblly;

	if ( $width > $maxwidth ) {
	    $scale = $maxwidth/$width;
	}
	if ( $height*$scale > $maxheight ) {
	    $scale = $maxheight/$height;
	}

	$x = ($psconf{pagewidth}-$width*$scale)/2;
	$y = ($psconf{pageheight}-$height*$scale)/2;

	print "BeginEPSF\n";
	print $x, ' ', $y, " translate\n";
	print $scale, " dup scale\n" unless ( $scale == 1 );
	print -$bbllx, ' ', -$bblly, " translate\n";
	print "$bbllx $bblly moveto\n";
	print "$bburx $bblly lineto\n";
	print "$bburx $bbury lineto\n";
	print "$bbllx $bbury lineto\n";
	print "$bbllx $bblly lineto clip newpath\n";
	print "%%BeginDocument: ",ps_string($metadata{epslogo}),"\n";
	print @eps;
	print "%%EndDocument\n";
	print "EndEPSF\n";
    }
}
ps_end_page(0);

# Emit the rest of the document (page 2 and on)
$curpage = 2;
ps_start_page();
foreach $line ( @pslines ) {
    my $linfo = $line->[0];
    
    if ( $$linfo[4] != $curpage ) {
        ps_end_page($curpage > 2);
        ps_start_page();
        $curpage = $$linfo[4];
    }

    print '[';
    my $curfont = 0;
    foreach my $c ( @{$line->[1]} ) {
        if ( $$c[0] >= 0 ) {
	    if ( $curfont != $$c[0] ) {
		print ($curfont = $$c[0]);
	    }
	    print ps_string($$c[1]);
	} elsif ( $$c[0] == -1 ) {
	    print '{el}';	# End link
	} elsif ( $$c[0] == -2 ) {
	    print '{/',$$c[1],' xl}'; # xref link
	} elsif ( $$c[0] == -3 ) {
	    print '{',ps_string($$c[1]),'wl}'; # web link
	} elsif ( $$c[0] == -4 ) {
	    # Index anchor -- ignore
	} elsif ( $$c[0] == -5 ) {
	    print '{/',$$c[1],' xa}'; #xref anchor
	} elsif ( $$c[0] == -6 ) {
	    print '][';		# Start a new array
	    $curfont = 0;
	} elsif ( $$c[0] == -7 ) {
	    print '{/',$$c[1],' pl}'; # page link
	} else {
	    die "Unknown annotation";
	}
    }
    print ']';
    if ( defined($$linfo[2]) ) {
	foreach my $x ( @{$$linfo[2]} ) {
	    if ( $$x[0] == $AuxStr ) {
		print ps_string($$x[1]);
	    } elsif ( $$x[0] == $AuxPage ) {
		print $ps_xref_page{$$x[1]},' ';
	    } elsif ( $$x[0] == $AuxPageStr ) {
		print ps_string($ps_xref_page{$$x[1]});
	    } elsif ( $$x[0] == $AuxXRef ) {
		print '/',ps_xref($$x[1]),' ';
	    } elsif ( $$x[0] == $AuxNum ) {
		print $$x[1],' ';
	    } else {
		die "Unknown auxilliary data type";
	    }
	}
    }
    print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
    print ' ', $$linfo[6] if ( defined($$linfo[6]) );
    print ' ', $$linfo[0].$$linfo[1], "\n";
}

ps_end_page(1);
print "%%EOF\n";