rdsrc.pl

一个汇编语言编译器源码

  $w =~ s/</&lt;/g;
  $w =~ s/>/&gt;/g;
  if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
    return $pfx . $w . $sfx;
  } elsif ($wtype eq "sp") {
    return ' ';
  } elsif ($wtype eq "da") {
    return '-'; # sadly, en-dashes are non-standard in HTML
  } elsif ($wmajt eq "c" || $wtype eq "wc") {
    return $pfx . "<code><nobr>${w}</nobr></code>" . $sfx;
  } elsif ($wtype eq "es") {
    return "<em>${w}";
  } elsif ($wtype eq "ee") {
    return "${w}</em>";
  } elsif ($wtype eq "eo") {
    return "<em>${w}</em>";
  } elsif ($wtype eq "x ") {
    # Magic: we must resolve the cross reference into file and marker
    # parts, then dispose of the file part if it's us, and dispose of
    # the marker part if the cross reference describes the top node of
    # another file.
    my $node = $nodexrefs{$w}; # find the node we're aiming at
    my $level = $tstruct_level{$node}; # and its level
    my $up = $node, $uplev = $level-1;
    $up = $tstruct_up{$up} while $uplev--; # get top node of containing file
    my $file = ($up ne $chapternode) ? $html_fnames{$up} : "";
    my $marker = ($level == 1 and $file) ? "" : "#$w";
    return "<a href=\"$file$marker\">";
  } elsif ($wtype eq "xe") {
    return "</a>";
  } elsif ($wmajt eq "i") {
    return "\001";
  } else {
    die "panic in word_html: $wtype$w\n";
  }
}

sub write_ps {
  # This is called from the top level, so I won't bother using
  # my or local.

  # First, set up the font metric arrays.
  &font_metrics;

  # First stage: reprocess the source arrays into a list of
  # lines, each of which is a list of word-strings, each of
  # which has a single-letter font code followed by text.
  # Each line also has an associated type, which will be
  # used for final alignment and font selection and things.
  #
  # Font codes are:
  #   n == Normal
  #   e == Emphasised
  #   c == Code
  #  ' ' == space (no following text required)
  #  '-' == dash (no following text required)
  #
  # Line types are:
  #   chap == Chapter or appendix heading.
  #   head == Major heading.
  #   subh == Sub-heading.
  #   Ccha == Contents entry for a chapter.
  #   Chea == Contents entry for a heading.
  #   Csub == Contents entry for a subheading.
  #   cone == Code paragraph with just this one line on it.
  #   cbeg == First line of multi-line code paragraph.
  #   cbdy == Interior line of multi-line code paragraph.
  #   cend == Final line of multi-line code paragraph.
  #   none == Normal paragraph with just this one line on it.
  #   nbeg == First line of multi-line normal paragraph.
  #   nbdy == Interior line of multi-line normal paragraph.
  #   nend == Final line of multi-line normal paragraph.
  #   bone == Bulleted paragraph with just this one line on it.
  #   bbeg == First line of multi-line bulleted paragraph.
  #   bbdy == Interior line of multi-line bulleted paragraph.
  #   bend == Final line of multi-line bulleted paragraph.
  print "line-breaks...";
  $lname = "psline000000";
  $lnamei = "idx" . $lname;
  @lnames = @ltypes = ();

  for ($para = 0; $para <= $#pnames; $para++) {
    $pname = $pnames[$para];
    $pflags = $pflags[$para];
    $ptype = substr($pflags,0,4);

    # New paragraph _ergo_ new line.
    @line = ();
    @lindex = (); # list of index tags referenced to this line

    if ($ptype eq "chap") {
      # Chapter heading. "Chapter N: Title" followed by a line of
      # minus signs.
      $pflags =~ /chap (.*) :(.*)/;
      push @line, "nChapter", " ", "n$1:", " ";
      foreach $i (@$pname) {
        $ww = &word_ps($i);
        push @line, $ww unless $ww eq "x";
      }
      @$lname = @line; @$lnamei = @lindex;
      push @lnames, $lname++;
      $lnamei = "idx" . $lname;
      push @ltypes, "chap";
    } elsif ($ptype eq "appn") {
      # Appendix heading. "Appendix N: Title" followed by a line of
      # minus signs.
      $pflags =~ /appn (.*) :(.*)/;
      push @line, "nAppendix", " ", "n$1:", " ";
      foreach $i (@$pname) {
        $ww = &word_ps($i);
        push @line, $ww unless $ww eq "x";
      }
      @$lname = @line; @$lnamei = @lindex;
      push @lnames, $lname++;
      $lnamei = "idx" . $lname;
      push @ltypes, "chap";
    } elsif ($ptype eq "head") {
      # Heading. Just a number and some text.
      $pflags =~ /.... (.*) :(.*)/;
      push @line, "n$1";
      foreach $i (@$pname) {
        $ww = &word_ps($i);
        push @line, $ww unless $ww eq "x";
      }
      @$lname = @line; @$lnamei = @lindex;
      push @lnames, $lname++;
      $lnamei = "idx" . $lname;
      push @ltypes, $ptype;
    } elsif ($ptype eq "subh") {
      # Subheading. Just a number and some text.
      $pflags =~ /subh (.*) :(.*)/;
      push @line, "n$1";
      foreach $i (@$pname) {
        push @line, &word_ps($i);
      }
      @$lname = @line; @$lnamei = @lindex;
      push @lnames, $lname++;
      $lnamei = "idx" . $lname;
      push @ltypes, "subh";
    } elsif ($ptype eq "code") {
      # Code paragraph. Emit lines one at a time.
      $type = "cbeg";
      foreach $i (@$pname) {
        @$lname = ("c$i");
	push @lnames, $lname++;
	$lnamei = "idx" . $lname;
	push @ltypes, $type;
	$type = "cbdy";
      }
      $ltypes[$#ltypes] = ($ltypes[$#ltypes] eq "cbeg" ? "cone" : "cend");
    } elsif ($ptype eq "bull" || $ptype eq "norm") {
      # Ordinary paragraph, optionally bulleted. We wrap, with ragged
      # 75-char right margin and either 7 or 11 char left margin
      # depending on bullets.
      if ($ptype eq "bull") {
        $width = 456; # leave 12-pt left indent for the bullet
	$type = $begtype = "bbeg";
	$bodytype = "bbdy";
	$onetype = "bone";
	$endtype = "bend";
      } else {
        $width = 468;
	$type = $begtype = "nbeg";
	$bodytype = "nbdy";
	$onetype = "none";
	$endtype = "nend";
      }
      @a = @$pname;
      @line = @wd = ();
      $linelen = 0;
      $wprev = undef;
      do {
        do { $w = &word_ps(shift @a) } while ($w eq "x");
	push @wd, $wprev if $wprev;
	if ($wprev =~ /^n.*-$/ || $w eq ' ' || $w eq '' || $w eq undef) {
	  $wdlen = &len_ps(@wd);
	  if ($linelen + $wdlen > $width) {
	    pop @line while $line[$#line] eq ' '; # trim trailing spaces
	    @$lname = @line; @$lnamei = @lindex;
	    push @lnames, $lname++;
	    $lnamei = "idx" . $lname;
	    push @ltypes, $type;
	    $type = $bodytype;
	    @line = @lindex = ();
	    $linelen = 0;
	    shift @wd while $wd[0] eq ' '; # trim leading spaces
	  }
	  push @line, @wd;
	  $linelen += $wdlen;
	  @wd = ();
	}
	$wprev = $w;
      } while ($w ne '' && $w ne undef);
      if (@line) {
        pop @line while $line[$#line] eq ' '; # trim trailing spaces
	@$lname = @line; @$lnamei = @lindex;
	push @lnames, $lname++;
	$lnamei = "idx" . $lname;
	push @ltypes, $type;
	$type = $bodytype;
      }
      $ltypes[$#ltypes] =
        ($ltypes[$#ltypes] eq $begtype ? $onetype : $endtype);
    }
  }

  # We've now processed the document source into lines. Before we
  # go on and do the page breaking, we'll fabricate a table of contents,
  # line by line, and then after doing page breaks we'll go back and
  # insert the page numbers into the contents entries.
  print "building contents...";
  @clnames = @cltypes = ();
  $clname = "pscont000000";
  @$clname = ("nContents"); # "chapter heading" for TOC
  push @clnames,$clname++;
  push @cltypes,"chap";
  for ($i=0; $i<=$#lnames; $i++) {
    $lname = $lnames[$i];
    if ($ltypes[$i] =~ /^(chap|head|subh)/) {
      @$clname = @$lname;
      splice @$clname,1,0," " if ($ltypes[$i] !~ /chap/);
      push @$clname,$i; # placeholder for page number
      push @clnames,$clname++;
      push @cltypes,"C" . substr($ltypes[$i],0,3);
    }
  }
  @$clname = ("nIndex"); # contents entry for Index
  push @$clname,$i;      # placeholder for page number
  $idx_clname = $clname;
  push @clnames,$clname++;
  push @cltypes,"Ccha";
  $contlen = $#clnames + 1;
  unshift @lnames,@clnames;
  unshift @ltypes,@cltypes;

  # Second stage: now we have a list of lines, break them into pages.
  # We do this by means of adding a third array in parallel with
  # @lnames and @ltypes, called @lpages, in which we store the page
  # number that each line resides on. We also add @ycoord which
  # stores the vertical position of each line on the page.
  #
  # Page breaks may not come after line-types:
  #   chap head subh cbeg nbeg bbeg
  # and may not come before line-types:
  #   cend nend bend
  # They are forced before line-types:
  #   chap
  print "page-breaks...";
  $pmax = 600; # ADJUSTABLE: maximum length of a page in points
  $textht = 11; # ADJUSTABLE: height of a normal line in points
  $spacing = 6; # ADJUSTABLE: space between paragraphs, in points
  $headht = 14; # ADJUSTABLE: height of a major heading in points
  $subht = 12; # ADJUSTABLE: height of a sub-heading in points
  $pstart = 0; # start line of current page
  $plen = 0; # current length of current page
  $pnum = 1; # number of current page
  $bpt = -1; # last feasible break point
  $i = 0; # line number
  while ($i <= $#lnames) {
    $lname = $lnames[$i];
    # Add the height of this line (computed the last time we went round
    # the loop, unless we're a chapter heading in which case we do it
    # now) to the length of the current page. Also, _put_ this line on
    # the current page, and allocate it a y-coordinate.
    if ($ltypes[$i] =~ /^chap$/) {
      $plen = 100; # ADJUSTABLE: space taken up by a chapter heading
      $ycoord[$i] = 0; # chapter heading: y-coord doesn't matter
    } else {
      $ycoord[$i] = $plen + $space;
      $plen += $space + $ht;
    }
    # See if we can break after this line.
    $bpt = $i if $ltypes[$i] !~ /^chap|head|subh|cbeg|nbeg|bbeg$/ &&
		 $ltypes[$i+1] !~ /^cend|nend|bend$/;
    # Assume, to start with, that we don't break after this line.
    $break = 0;
    # See if a break is forced.
    $break = 1, $bpt = $i if $ltypes[$i+1] eq "chap" || !$ltypes[$i+1];
    # Otherwise, compute the height of the next line, and break if
    # it would make this page too long.
    $ht = $textht, $space = 0 if $ltypes[$i+1] =~ /^[nbc](bdy|end)$/;
    $ht = $textht, $space = $spacing if $ltypes[$i+1] =~ /^[nbc](one|beg)$/;
    $ht = $textht, $space = $spacing if $ltypes[$i+1] =~ /^C/;
    $ht = $subht, $space = $spacing if $ltypes[$i+1] eq "subh";
    $ht = $headht, $space = $spacing if $ltypes[$i+1] eq "head";
    $break = 1 if $plen + $space + $ht > $pmax;
    # Now, if we're breaking, assign page number $pnum to all lines up
    # to $bpt, set $i == $bpt+1, and zero $space since we are at the
    # start of a new page and don't want leading space.
    if ($break) {
      die "no feasible break point at all on page $pnum\n" if $bpt == -1;
      for ($j = $pstart; $j <= $bpt; $j++) {
	$lnamei = "idx" . $lnames[$j];
	foreach $k (@$lnamei) {
	  ${$psidxpp{$k}}{$pnum} = 1;
	}
        $lpages[$j] = $pnum;
      }
      $pnum++;
      $i = $bpt;
      $bpt = -1;
      $pstart = $i+1;
      $plen = 0;
      $space = 0;
    }
    $i++;
  }

  # Now fix up the TOC with page numbers.
  print "\n   fixing up contents...";
  for ($i=0; $i<=$#lnames; $i++) {
    $lname = $lnames[$i];
    if ($ltypes[$i] =~ /^C/) {
      $j = pop @$lname;
      push @$lname, "n" . $lpages[$j+$contlen];
    }
  }

  # Having got page numbers for most stuff, generate an index.
  print "building index...";
  $iwid = 222;
  $sep = 12;
  $commaindent = 32;
  foreach $k (@itags) {
    @line = ();
    $cmd = "index";
    @idxentry = @{$idxmap{$k}};
    if ($commaafter{$k} and !$commanext{$k}) {
      # This line is a null line beginning a multiple entry. We must
      # output the prefix on a line by itself.

      @idxhead = splice @idxentry,0,$commapos{$k};
      @line = ();
      foreach $i (@idxhead) {
        $ww = &word_ps($i);
	push @line, $ww unless $ww eq "x";
      }
      &ps_idxout("index",\@line,[]);
      $cmd = "iindex";
      @line = ();
    }
    $cmd = "iindex", splice @idxentry,0,$commapos{$k} if $commanext{$k};
    foreach $i (@idxentry) {
      $ww = &word_ps($i);
      push @line, $ww unless $ww eq "x";
    }
    $len = $iwid - $sep - &len_ps(@line);
    warn "text for index tag `%s' is longer than one index line!\n"
      if $len < -$sep;
    @pp = ();
    $inums = join(',',sort { $a <=> $b } keys %{$psidxpp{$k}});
    while (length $inums) {
      $inums =~ /^([^,]+,?)(.*)$/;
      $inums = $2, $inum = $1;
      @pnum = (" ", "n$inum");
      $pnumlen = &len_ps(@pnum);
      if ($pnumlen > $len) {
        &ps_idxout($cmd,\@line,\@pp);
	@pp = ();
	@line = ();
	$cmd = "index";
	$len = $iwid - $sep;
      }
      push @pp, @pnum;
      $len -= $pnumlen;
    }
    &ps_idxout($cmd,\@line,\@pp) if (length @pp);
    $l1 = &len_ps(@line);
    $l2 = &len_ps($pp);
  }
  $$idx_clname[$#$idx_clname] = "n" . $pnum; # fix up TOC entry for index

  print "writing file...";
  open PS,">nasmdoc.ps";
  select PS;
  $page = $lpages[0];
  &ps_header;
  for ($i=0; $i<=$#lnames; $i++) {
    &ps_throw_pg($page,$lpages[$i]) if $page != $lpages[$i];
    $page = $lpages[$i];
    &ps_out_line($ycoord[$i],$ltypes[$i],$lnames[$i]);
  }
  $i = 0;
  while ($i <= $#psindex) {
    &ps_throw_pg($page, $pnum) if $page != $pnum;
    $page = $pnum++;
    $ypos = 0;
    $ypos = 100, &ps_out_line(0, "chap", ["nIndex"]) if !$i;
    $lines = ($pmax - $ypos) / $textht;
    my $col; # ps_out_line hits this variable
    PAGE:for ($col = 1; $col <= 2; $col++) {
      $y = $ypos; $l = $lines;
      COL: while ($l > 0) {
        $j = $i+1;
	$j++ while $psindex[$j] and ($psindex[$j][3] == 0); # find next break
	last COL if $j-$i > $l or $i > $#psindex;
	while ($i < $j) {
	  &ps_out_line($y, $psindex[$i][0] eq "index" ? "idl$col" : "ldl$col",
	               $psindex[$i][1]);
	  &ps_out_line($y,"idr$col",$psindex[$i][2]);
	  $i++;
	  $y += $textht;
	  $l--;
	}
      }
      last PAGE if $i > $#psindex;
    }
  }
  &ps_trailer;
  close PS;
  select STDOUT;
}

sub ps_idxout {