genps.pl

开源的nasm编译器源码,研究编译器原理很有帮且

    my(@ci) = @_;
    my($c, $lc);
    my(@co, $eco);
    
    undef $lc;
    @co = ();
    $eco = -1;			# Index of the last entry in @co
    foreach $c ( @ci ) {
	if ( defined($lc) && $$c[0] == $lc && $$c[0] >= 0 ) {
	    $co[$eco]->[1] .= $$c[1];
	} else {
	    push(@co, $c);  $eco++;
	    $lc = $$c[0];
	}
    }
    return @co;
}

#
# Convert paragraphs to rendering arrays.  Each
# element in the array contains (font, string),
# where font can be one of:
# -1 end link
# -2 begin crossref
# -3 begin weblink
# -4 index item anchor
# -5 crossref anchor
# -6 left/right marker (used in the index)
# -7 page link (used in the index)
#  0 normal
#  1 empatic (italic)
#  2 code (fixed spacing)
#

sub mkparaarray($@) {
    my($ptype, @chunks) = @_;

    my @para = ();
    my $in_e = 0;
    my $chunk;

    if ( $ptype =~ /^code/ ) {
	foreach $chunk ( @chunks ) {
	    push(@para, [2, $chunk]);
	}
    } else {
	foreach $chunk ( @chunks ) {
	    my $type = substr($chunk,0,2);
	    my $text = substr($chunk,2);
	    
	    if ( $type eq 'sp' ) {
		push(@para, [$in_e?1:0, ' ']);
	    } elsif ( $type eq 'da' ) {
		push(@para, [$in_e?1:0, $charcode{'endash'}]);
	    } elsif ( $type eq 'n ' ) {
		push(@para, [0, $text]);
		$in_e = 0;
	    } elsif ( $type =~ '^e' ) {
		push(@para, [1, $text]);
		$in_e = ($type eq 'es' || $type eq 'e ');
	    } elsif ( $type eq 'c ' ) {
		push(@para, [2, $text]);
		$in_e = 0;
	    } elsif ( $type eq 'x ' ) {
		push(@para, [-2, ps_xref($text)]);
	    } elsif ( $type eq 'xe' ) {
		push(@para, [-1, undef]);
	    } elsif ( $type eq 'wc' || $type eq 'w ' ) {
		$text =~ /\<(.*)\>(.*)$/;
		my $link = $1; $text = $2;
		push(@para, [-3, $link]);
		push(@para, [($type eq 'wc') ? 2:0, $text]);
		push(@para, [-1, undef]);
		$in_e = 0;
	    } elsif ( $type eq 'i ' ) {
		push(@para, [-4, $text]);
	    } else {
		die "Unexpected paragraph chunk: $chunk";
	    }
	}
    }
    return @para;
}

$npara = scalar(@paras);
for ( $i = 0 ; $i < $npara ; $i++ ) {
    $paras[$i] = [mkparaarray($ptypes[$i], @{$paras[$i]})];
}

#
# This converts a rendering array to a simple string
#
sub ps_arraytostr(@) {
    my $s = '';
    my $c;
    foreach $c ( @_ ) {
	$s .= $$c[1] if ( $$c[0] >= 0 );
    }
    return $s;
}

#
# This generates a duplicate of a paragraph
#
sub ps_dup_para(@) {
    my(@i) = @_;
    my(@o) = ();
    my($c);

    foreach $c ( @i ) {
	my @cc = @{$c};
	push(@o, [@cc]);
    }
    return @o;
}

#
# This generates a duplicate of a paragraph, stripping anchor
# tags (-4 and -5)
#
sub ps_dup_para_noanchor(@) {
    my(@i) = @_;
    my(@o) = ();
    my($c);

    foreach $c ( @i ) {
	my @cc = @{$c};
	push(@o, [@cc]) unless ( $cc[0] == -4 || $cc[0] == -5 );
    }
    return @o;
}

#
# Scan for header paragraphs and fix up their contents;
# also generate table of contents and PDF bookmarks.
#
@tocparas = ([[-5, 'contents'], [0,'Contents']]);
@tocptypes = ('chap');
@bookmarks = (['title', 0, 'Title'], ['contents', 0, 'Contents']);
%bookref = ();
for ( $i = 0 ; $i < $npara ; $i++ ) {
    my $xtype = $ptypes[$i];
    my $ptype = substr($xtype,0,4);
    my $str;
    my $book;

    if ( $ptype eq 'chap' || $ptype eq 'appn' ) {
	unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
	    die "Bad para";
	}
	my $secn = $1;
	my $sech = $2;
	my $xref = ps_xref($sech);
	my $chap = ($ptype eq 'chap')?'Chapter':'Appendix';

	$book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
	push(@bookmarks, $book);
	$bookref{$secn} = $book;

	push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
	push(@tocptypes, 'toc0'.' :'.$sech.':'.$chap.' '.$secn.':');

	unshift(@{$paras[$i]},
 		[-5, $xref], [0,$chap.' '.$secn.':'], [0, ' ']);
    } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
	unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
	    die "Bad para";
	}
	my $secn = $1;
	my $sech = $2;
	my $xref = ps_xref($sech);
	my $pref;
	$pref = $secn; $pref =~ s/\.[^\.]+$//; # Find parent node

	$book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
	push(@bookmarks, $book);
	$bookref{$secn} = $book;
	$bookref{$pref}->[1]--;	# Adjust count for parent node

	push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
	push(@tocptypes,
	     (($ptype eq 'subh') ? 'toc2':'toc1').' :'.$sech.':'.$secn);

	unshift(@{$paras[$i]}, [-5, $xref]);
    }
}

#
# Add TOC to beginning of paragraph list
#
unshift(@paras,  @tocparas);  undef @tocparas;
unshift(@ptypes, @tocptypes); undef @tocptypes;

#
# Add copyright notice to the beginning
#
unshift(@paras,
	[[0, $charcode{'copyright'}], [0, ' '], [0,$metadata{'year'}],
	 [0, ' '], string2array($metadata{'author'})],
	[string2array($metadata{'license'})]);
unshift(@ptypes, 'norm', 'norm');

$npara = scalar(@paras);

#
# No lines generated, yet.
#
@pslines    = ();

#
# Line Auxilliary Information Types
#
$AuxStr	    = 1;		# String
$AuxPage    = 2;		# Page number (from xref)
$AuxPageStr = 3;		# Page number as a PostScript string
$AuxXRef    = 4;		# Cross reference as a name
$AuxNum     = 5;		# Number

#
# Break or convert paragraphs into lines, and push them
# onto the @pslines array.
#
sub ps_break_lines($$) {
    my ($paras,$ptypes) = @_;

    my $linewidth  = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
    my $bullwidth  = $linewidth-$psconf{bulladj};
    my $indxwidth  = ($linewidth-$psconf{idxgutter})/$psconf{idxcolumns}
                     -$psconf{idxspace};

    my $npara = scalar(@{$paras});
    my $i;

    for ( $i = 0 ; $i < $npara ; $i++ ) {
	my $xtype = $ptypes->[$i];
	my $ptype = substr($xtype,0,4);
	my @data = @{$paras->[$i]};
	my @ls = ();
	if ( $ptype eq 'code' ) {
	    my $p;
	    # Code paragraph; each chunk is a line
	    foreach $p ( @data ) {
		push(@ls, [[$ptype,0,undef,\%BodyFont,0,0],[$p]]);
	    }
	    $ls[0]->[0]->[1] |= 1;	     # First in para
	    $ls[-1]->[0]->[1] |= 2;      # Last in para
	} elsif ( $ptype eq 'chap' || $ptype eq 'appn' ) {
	    # Chapters are flowed normally, but in an unusual font
	    @ls = ps_flow_lines($linewidth, \%ChapFont, $ptype, @data);
	} elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
	    unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
		die "Bad para";
	    }
	    my $secn = $1;
	    my $sech = $2;
	    my $font = ($ptype eq 'head') ? \%HeadFont : \%SubhFont;
	    @ls = ps_flow_lines($linewidth, $font, $ptype, @data);
	    # We need the heading number as auxillary data
	    $ls[0]->[0]->[2] = [[$AuxStr,$secn]];
	} elsif ( $ptype eq 'norm' ) {
	    @ls = ps_flow_lines($linewidth, \%BodyFont, $ptype, @data);
	} elsif ( $ptype eq 'bull' ) {
	    @ls = ps_flow_lines($bullwidth, \%BodyFont, $ptype, @data);
	} elsif ( $ptype =~ /^toc/ ) {
	    unless ( $xtype =~/^\S+ :([^:]*):(.*)$/ ) {
		die "Bad para";
	    }
	    my $xref = $1;
	    my $refname = $2.' ';
	    my $ntoc = substr($ptype,3,1)+0;
	    my $refwidth = ps_width($refname, $BodyFont{fonts}->[0][1],
				    \@NASMEncoding) *
		($BodyFont{fonts}->[0][0]/1000);
	    
	    @ls = ps_flow_lines($linewidth-$ntoc*$psconf{tocind}-
				$psconf{tocpnz}-$refwidth,
				\%BodyFont, $ptype, @data);
	    
	    # Auxilliary data: for the first line, the cross reference symbol
	    # and the reference name; for all lines but the first, the
	    # reference width; and for the last line, the page number
	    # as a string.
	    my $nl = scalar(@ls);
	    $ls[0]->[0]->[2] = [[$AuxStr,$refname], [$AuxXRef,$xref]];
	    for ( $j = 1 ; $j < $nl ; $j++ ) {
		$ls[$j]->[0]->[2] = [[$AuxNum,$refwidth]];
	    }
	    push(@{$ls[$nl-1]->[0]->[2]}, [$AuxPageStr,$xref]);
	} elsif ( $ptype =~ /^idx/ ) {
	    my $lvl = substr($ptype,3,1)+0;

	    @ls = ps_flow_lines($indxwidth-$lvl*$psconf{idxindent},
				\%BodyFont, $ptype, @data);
	} else {
	    die "Unknown para type: $ptype";
	}
	# Merge adjacent identical chunks
	foreach $l ( @ls ) {
	    @{$$l[1]} = ps_merge_chunks(@{$$l[1]});
	}
	push(@pslines,@ls);
    }
}

# Break the main body text into lines.
ps_break_lines(\@paras, \@ptypes);

#
# Break lines in to pages
#

# Where to start on page 2, the copyright page
$curpage = 2;			# Start on page 2
$curypos = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg}-
    $psconf{startcopyright};
undef $columnstart;		# Not outputting columnar text
undef $curcolumn;		# Current column
$nlines = scalar(@pslines);

#
# This formats lines inside the global @pslines array into pages,
# updating the page and y-coordinate entries.  Start at the
# $startline position in @pslines and go to but not including
# $endline.  The global variables $curpage, $curypos, $columnstart
# and $curcolumn are updated appropriately.
#
sub ps_break_pages($$) {
    my($startline, $endline) = @_;
    
    # Paragraph types which should never be broken
    my $nobreakregexp = "^(chap|appn|head|subh|toc.|idx.)\$";
    # Paragraph types which are heading (meaning they should not be broken
    # immediately after)
    my $nobreakafter = "^(chap|appn|head|subh)\$";
    # Paragraph types which should never be broken *before*
    my $nobreakbefore = "^idx[1-9]\$";
    # Paragraph types which are set in columnar format
    my $columnregexp = "^idx.\$";

    my $upageheight = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg};

    my $i;

    for ( $i = $startline ; $i < $endline ; $i++ ) {
	my $linfo = $pslines[$i]->[0];
	if ( ($$linfo[0] eq 'chap' || $$linfo[0] eq 'appn' )
	     && ($$linfo[1] & 1) ) {
	    # First line of a new chapter heading.  Start a new page.
	    undef $columnstart;
	    $curpage++ if ( $curypos > 0 || defined($columnstart) );
	    $curypos = $chapstart;
	} elsif ( defined($columnstart) && $$linfo[0] !~ /$columnregexp/o ) {
	    undef $columnstart;
	    $curpage++;
	    $curypos = 0;
	}

	if ( $$linfo[0] =~ /$columnregexp/o && !defined($columnstart) ) {
	    $columnstart = $curypos;
	    $curcolumn = 0;
	}
    
	# Adjust position by the appropriate leading
	$curypos += $$linfo[3]->{leading};
	
	# Record the page and y-position
	$$linfo[4] = $curpage;
	$$linfo[5] = $curypos; 
	$$linfo[6] = $curcolumn if ( defined($columnstart) );
	
	if ( $curypos > $upageheight ) {
	    # We need to break the page before this line.
	    my $broken = 0;		# No place found yet
	    while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
		my $linfo = $pslines[$i]->[0];
		my $pinfo = $pslines[$i-1]->[0];
		
		if ( $$linfo[1] == 2 ) {
		    # This would be an orphan, don't break.
		} elsif ( $$linfo[1] & 1 ) {
		    # Sole line or start of paragraph.  Break unless
		    # the previous line was part of a heading.
		    $broken = 1 if ( $$pinfo[0] !~ /$nobreakafter/o &&
				     $$linfo[0] !~ /$nobreakbefore/o );
		} else {
		    # Middle of paragraph.  Break unless we're in a
		    # no-break paragraph, or the previous line would
		    # end up being a widow.
		    $broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
				     $$pinfo[1] != 1 );
		}
		$i--;
	    }
	    die "Nowhere to break page $curpage\n" if ( !$broken );
	    # Now $i should point to line immediately before the break, i.e.
	    # the next paragraph should be the first on the new page
	    if ( defined($columnstart) &&