rdsrc.pl

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

      &texi_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /appn (.*) :(.*)/;
      $node = "Appendix $1";
      $title = "Appendix $1: ";
      foreach $i (@$pname) {
        $ww = &word_texi($i);
        $title .= $ww unless $ww eq "\001";
      }
      print "\@node $node, $tstruct_next{$node}, $tstruct_prev{$node},";
      print " $tstruct_up{$node}\n\@unnumbered $title\n";
    } elsif ($ptype eq "head" || $ptype eq "subh") {
      # Heading or subheading. Begin a new node.
      &texi_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /.... (.*) :(.*)/;
      $node = "Section $1";
      $title = "$1. ";
      foreach $i (@$pname) {
        $ww = &word_texi($i);
        $title .= $ww unless $ww eq "\001";
      }
      print "\@node $node, $tstruct_next{$node}, $tstruct_prev{$node},";
      print " $tstruct_up{$node}\n";
      $hdr = ($ptype eq "subh" ? "\@unnumberedsubsec" : "\@unnumberedsec");
      print "$hdr $title\n";
    } elsif ($ptype eq "code") {
      # Code paragraph. Surround with @example / @end example.
      print "\@example\n";
      foreach $i (@$pname) {
        warn "code line longer than 68 chars: $i\n" if length $i > 68;
	$i =~ s/\@/\@\@/g;
	$i =~ s/\{/\@\{/g;
	$i =~ s/\}/\@\}/g;
        print "$i\n";
      }
      print "\@end example\n";
    } elsif ($ptype eq "bull" || $ptype eq "norm") {
      # Ordinary paragraph, optionally bulleted. We wrap, FWIW.
      if ($ptype eq "bull") {
        $bulleting = 1, print "\@itemize \@bullet\n" if !$bulleting;
	print "\@item\n";
      }
      $line = '';
      @a = @$pname;
      $wd = $wprev = '';
      do {
        do { $w = &word_texi(shift @a); } while $w eq "\001"; # hack
	$wd .= $wprev;
	if ($wprev =~ /-$/ || $w eq ' ' || $w eq '' || $w eq undef) {
	  if (length ($line . $wd) > 75) {
	    $line =~ s/\s*$//; # trim trailing spaces
	    print "$line\n";
	    $line = '';
	    $wd =~ s/^\s*//; # trim leading spaces
	  }
	  $line .= $wd;
	  $wd = '';
	}
	$wprev = $w;
      } while ($w ne '' && $w ne undef);
      if ($line =~ /\S/) {
	$line =~ s/\s*$//; # trim trailing spaces
	print "$line\n";
      }
    }
  }

  # Write index.
  &texi_index;

  # Close file.
  print "\n\@contents\n\@bye\n";
  select STDOUT;
  close TEXT;
}

# Side effect of this procedure: update global `texiwdlen' to be the length
# in chars of the formatted version of the word.
sub word_texi {
  my ($w) = @_;
  my $wtype, $wmajt;

  return undef if $w eq '' || $w eq undef;
  $wtype = substr($w,0,2);
  $wmajt = substr($wtype,0,1);
  $w = substr($w,2);
  $wlen = length $w;
  $w =~ s/\@/\@\@/g;
  $w =~ s/\{/\@\{/g;
  $w =~ s/\}/\@\}/g;
  $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
  substr($w,0,1) =~ tr/a-z/A-Z/, $capital = 0 if $capital;
  if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
    $texiwdlen = $wlen;
    return $w;
  } elsif ($wtype eq "sp") {
    $texiwdlen = 1;
    return ' ';
  } elsif ($wtype eq "da") {
    $texiwdlen = 2;
    return '--';
  } elsif ($wmajt eq "c" || $wtype eq "wc") {
    $texiwdlen = 2 + $wlen;
    return "\@code\{$w\}";
  } elsif ($wtype eq "es") {
    $texiwdlen = 1 + $wlen;
    return "\@emph\{${w}";
  } elsif ($wtype eq "ee") {
    $texiwdlen = 1 + $wlen;
    return "${w}\}";
  } elsif ($wtype eq "eo") {
    $texiwdlen = 2 + $wlen;
    return "\@emph\{${w}\}";
  } elsif ($wtype eq "x ") {
    $texiwdlen = 0; # we don't need it in this case
    $capital = 1; # hack
    return "\@ref\{";
  } elsif ($wtype eq "xe") {
    $texiwdlen = 0; # we don't need it in this case
    return "\}";
  } elsif ($wmajt eq "i") {
    $texiwdlen = 0; # we don't need it in this case
    return "\001";
  } else {
    die "panic in word_texi: $wtype$w\n";
  }
}

sub texi_menu {
  my ($topitem) = @_;
  my $item, $i, $mpname, $title, $wd;

  $item = $tstruct_next{$topitem};
  print "\@menu\n";
  while ($item) {
    $title = "";
    $mpname = $tstruct_pname{$item};
    foreach $i (@$mpname) {
      $wd = &word_texi($i);
      $title .= $wd unless $wd eq "\001";
    }
    print "* ${item}:: $title\n";
    $item = $tstruct_mnext{$item};
  }
  print "* Index::\n" if $topitem eq "Top";
  print "\@end menu\n";
}

sub texi_index {
  my $itag, $ientry, @a, $wd, $item, $len;
  my $subnums = "123456789ABCDEFGHIJKLMNOPQRSTU" .
                "VWXYZabcdefghijklmnopqrstuvwxyz";

  print "\@ifinfo\n\@node Index, , $FIXMElastnode, Top\n";
  print "\@unnumbered Index\n\n\@menu\n";

  foreach $itag (@itags) {
    $ientry = $idxmap{$itag};
    @a = @$ientry;
    $item = '';
    $len = 0;
    foreach $i (@a) {
      $wd = &word_texi($i);
      $item .= $wd, $len += $texiwdlen unless $wd eq "\001";
    }
    $i = 0;
    foreach $node (@nodes) {
      next if !$idxnodes{$node,$itag};
      printf "* %s%s (%s): %s.\n",
          $item, " " x (40-$len), substr($subnums,$i++,1), $node;
    }
  }
  print "\@end menu\n\@end ifinfo\n";
}

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

  # Build the index-tag text forms.
  print "building index entries...";
  @hlp_index = map {
                 my $i,$ww;
		 my $ientry = $idxmap{$_};
		 my $title = "";
                 foreach $i (@$ientry) {
		   $ww = &word_hlp($i,0);
		   $title .= $ww unless $ww eq "\001";
		 }
		 $title;
               } @itags;

  # Write the HPJ project-description file.
  print "writing .hpj file...";
  open HPJ,">nasmdoc.hpj";
  print HPJ "[OPTIONS]\ncompress=true\n";
  print HPJ "title=NASM: The Netwide Assembler\noldkeyphrase=no\n\n";
  print HPJ "[FILES]\nnasmdoc.rtf\n\n";
  print HPJ "[CONFIG]\n";
  print HPJ 'CreateButton("btn_up", "&Up",'.
            ' "JumpContents(`nasmdoc.hlp'."'".')")';
  print HPJ "\nBrowseButtons()\n";
  close HPJ;

  # Open file.
  print "\n   writing .rtf file...";
  open TEXT,">nasmdoc.rtf";
  select TEXT;

  # Preamble.
  print "{\\rtf1\\ansi{\\fonttbl\n";
  print "\\f0\\froman Times New Roman;\\f1\\fmodern Courier New;\n";
  print "\\f2\\fswiss Arial;\\f3\\ftech Wingdings}\\deff0\n";
  print "#{\\footnote Top}\n";
  print "\${\\footnote Contents}\n";
  print "+{\\footnote browse:00000}\n";
  print "!{\\footnote DisableButton(\"btn_up\")}\n";
  print "\\keepn\\f2\\b\\fs30\\sb0\n";
  print "NASM: The Netwide Assembler\n";
  print "\\par\\pard\\plain\\sb120\n";
  print "This file documents NASM, the Netwide Assembler: an assembler \n";
  print "targetting the Intel x86 series of processors, with portable source.\n";

  $node = "Top";
  $browse = 0;

  $newpar = "\\par\\sb120\n";
  for ($para = 0; $para <= $#pnames; $para++) {
    $pname = $pnames[$para];
    $pflags = $pflags[$para];
    $ptype = substr($pflags,0,4);

    print $newpar;
    $newpar = "\\par\\sb120\n";

    if ($ptype eq "chap") {
      # Chapter heading. Begin a new node.
      &hlp_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /chap (.*) :(.*)/;
      $node = "Chapter $1";
      $title = $footnotetitle = "Chapter $1: ";
      foreach $i (@$pname) {
        $ww = &word_hlp($i,1);
	$title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
      }
      print "\\page\n";
      printf "#{\\footnote %s}\n", &hlp_sectkw($node);
      print "\${\\footnote $footnotetitle}\n";
      printf "+{\\footnote browse:%05d}\n", ++$browse;
      printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
             "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
	     &hlp_sectkw($tstruct_up{$node});
      print "EnableButton(\"btn_up\")}\n";
      &hlp_keywords($node);
      print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
      print "$title\n";
      $newpar = "\\par\\pard\\plain\\sb120\n";
    } elsif ($ptype eq "appn") {
      # Appendix heading. Begin a new node.
      &hlp_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /appn (.*) :(.*)/;
      $node = "Appendix $1";
      $title = $footnotetitle = "Appendix $1: ";
      foreach $i (@$pname) {
        $ww = &word_hlp($i,1);
	$title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
      }
      print "\\page\n";
      printf "#{\\footnote %s}\n", &hlp_sectkw($node);
      print "\${\\footnote $footnotetitle}\n";
      printf "+{\\footnote browse:%05d}\n", ++$browse;
      printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
             "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
	     &hlp_sectkw($tstruct_up{$node});
      print "EnableButton(\"btn_up\")}\n";
      &hlp_keywords($node);
      print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
      print "$title\n";
      $newpar = "\\par\\pard\\plain\\sb120\n";
    } elsif ($ptype eq "head" || $ptype eq "subh") {
      # Heading or subheading. Begin a new node.
      &hlp_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /.... (.*) :(.*)/;
      $node = "Section $1";
      $title = $footnotetitle = "$1. ";
      foreach $i (@$pname) {
        $ww = &word_hlp($i,1);
	$title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
      }
      print "\\page\n";
      printf "#{\\footnote %s}\n", &hlp_sectkw($node);
      print "\${\\footnote $footnotetitle}\n";
      printf "+{\\footnote browse:%05d}\n", ++$browse;
      printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
             "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
	     &hlp_sectkw($tstruct_up{$node});
      print "EnableButton(\"btn_up\")}\n";
      &hlp_keywords($node);
      print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
      print "$title\n";
      $newpar = "\\par\\pard\\plain\\sb120\n";
    } elsif ($ptype eq "code") {
      # Code paragraph.
      print "\\keep\\f1\\sb120\n";
      foreach $i (@$pname) {
        warn "code line longer than 68 chars: $i\n" if length $i > 68;
	$i =~ s/\\/\\\\/g;
	$i =~ s/\{/\\\{/g;
	$i =~ s/\}/\\\}/g;
        print "$i\\par\\sb0\n";
      }
      $newpar = "\\pard\\f0\\sb120\n";
    } elsif ($ptype eq "bull" || $ptype eq "norm") {
      # Ordinary paragraph, optionally bulleted. We wrap, FWIW.
      if ($ptype eq "bull") {
        print "\\tx360\\li360\\fi-360{\\f3\\'9F}\\tab\n";
	$newpar = "\\par\\pard\\sb120\n";
      } else {
	$newpar = "\\par\\sb120\n";
      }
      $line = '';
      @a = @$pname;
      $wd = $wprev = '';
      do {
        do { $w = &word_hlp((shift @a),1); } while $w eq "\001"; # hack
	$wd .= $wprev;
	if ($w eq ' ' || $w eq '' || $w eq undef) {
	  if (length ($line . $wd) > 75) {
	    $line =~ s/\s*$//; # trim trailing spaces
	    print "$line \n"; # and put one back
	    $line = '';
	    $wd =~ s/^\s*//; # trim leading spaces
	  }
	  $line .= $wd;
	  $wd = '';
	}
	$wprev = $w;
      } while ($w ne '' && $w ne undef);
      if ($line =~ /\S/) {
	$line =~ s/\s*$//; # trim trailing spaces
	print "$line\n";
      }
    }
  }

  # Close file.
  print "\\page}\n";
  select STDOUT;
  close TEXT;
}

sub word_hlp {
  my ($w, $docode) = @_;
  my $wtype, $wmajt;

  return undef if $w eq '' || $w eq undef;
  $wtype = substr($w,0,2);
  $wmajt = substr($wtype,0,1);
  $w = substr($w,2);
  $w =~ s/\\/\\\\/g;
  $w =~ s/\{/\\\{/g;
  $w =~ s/\}/\\\}/g;
  $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
  substr($w,0,length($w)-1) =~ s/-/\\\'AD/g if $wmajt ne "x"; #nonbreakhyphens
  if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
    return $w;
  } elsif ($wtype eq "sp") {
    return ' ';
  } elsif ($wtype eq "da") {
    return "\\'96";
  } elsif ($wmajt eq "c" || $wtype eq "wc") {
    $w =~ s/ /\\\'A0/g; # make spaces non-breaking
    return $docode ? "{\\f1 ${w}}" : $w;
  } elsif ($wtype eq "es") {
    return "{\\i ${w}";
  } elsif ($wtype eq "ee") {
    return "${w}}";
  } elsif ($wtype eq "eo") {
    return "{\\i ${w}}";
  } elsif ($wtype eq "x ") {
    return "{\\uldb ";
  } elsif ($wtype eq "xe") {
    $w = &hlp_sectkw($w);
    return "}{\\v ${w}}";
  } elsif ($wmajt eq "i") {
    return "\001";
  } else {
    die "panic in word_hlp: $wtype$w\n";
  }
}

sub hlp_menu {
  my ($topitem) = @_;
  my $item, $kword, $i, $mpname, $title;

  $item = $tstruct_next{$topitem};
  print "\\li360\\fi-360\n";
  while ($item) {
    $title = "";
    $mpname = $tstruct_pname{$item};
    foreach $i (@$mpname) {
      $ww = &word_hlp($i, 0);
      $title .= $ww unless $ww eq "\001";
    }
    $kword = &hlp_sectkw($item);
    print "{\\uldb ${item}: $title}{\\v $kword}\\par\\sb0\n";
    $item = $tstruct_mnext{$item};
  }
  print "\\pard\\sb120\n";
}

sub hlp_sectkw {
  my ($node) = @_;
  $node =~ tr/A-Z/a-z/;
  $node =~ tr/- ./___/;
  $node;
}

sub hlp_keywords {
  my ($node) = @_;
  my $pfx = "K{\\footnote ";
  my $done = 0;
  foreach $i (0..$#itags) {
    (print $pfx,$hlp_index[$i]), $pfx = ";\n", $done++
        if $idxnodes{$node,$itags[$i]};
  }
  print "}\n" if $done;
}

# Make tree structures. $tstruct_* is top-level and global.
sub add_item {
  my ($item, $level) = @_;
  my $i;

  $tstruct_pname{$item} = $pname;
  $tstruct_next{$tstruct_previtem} = $item;
  $tstruct_prev{$item} = $tstruct_previtem;
  $tstruct_level{$item} = $level;
  $tstruct_up{$item} = $tstruct_last[$level-1];
  $tstruct_mnext{$tstruct_last[$level]} = $item;
  $tstruct_last[$level] = $item;
  for ($i=$level+1; $i<$MAXLEVEL; $i++) { $tstruct_last[$i] = undef; }
  $tstruct_previtem = $item;
  push @nodes, $item;
}

#
# This produces documentation intermediate paragraph format; this is
# basically the digested output of the front end.  Intended for use
# by future backends, instead of putting it all in the same script.
#
sub write_dip {
  open(PARAS, "> nasmdoc.dip");
  foreach $k (keys(%metadata)) {
      print PARAS 'meta :', $k, "\n";
      print PARAS $metadata{$k},"\n";
  }
  for ($para = 0; $para <= $#pnames; $para++) {
      print PARAS $pflags[$para], "\n";
      print PARAS join("\037", @{$pnames[$para]}, "\n");
  }
  foreach $k (@itags) {
      print PARAS 'indx :', $k, "\n";
      print PARAS join("\037", @{$idxmap{$k}}), "\n";
  }
  close(PARAS);
}