rdsrc.pl

一个汇编语言编译器源码

  my ($cmd, $left, $right) = @_;
  my $break = 1;
  $break = 0
      if ($#psindex >= 0) and ( ($#$left < 0) or ($cmd eq "iindex") );
  push @psindex,[$cmd,[@$left],[@$right],$break];
}

sub ps_header {
  @pshdr = (
    '/sp (n ) def', # here it's sure not to get wrapped inside ()
    '/nf /Times-Roman findfont 11 scalefont def',
    '/ef /Times-Italic findfont 11 scalefont def',
    '/cf /Courier findfont 11 scalefont def',
    '/nc /Helvetica-Bold findfont 18 scalefont def',
    '/ec /Helvetica-Oblique findfont 18 scalefont def',
    '/cc /Courier-Bold findfont 18 scalefont def',
    '/nh /Helvetica-Bold findfont 14 scalefont def',
    '/eh /Helvetica-Oblique findfont 14 scalefont def',
    '/ch /Courier-Bold findfont 14 scalefont def',
    '/ns /Helvetica-Bold findfont 12 scalefont def',
    '/es /Helvetica-Oblique findfont 12 scalefont def',
    '/cs /Courier-Bold findfont 12 scalefont def',
    '/n 16#6E def /e 16#65 def /c 16#63 def',
    '/chapter {',
    '  100 620 moveto',
    '  {',
    '    dup 0 get',
    '    dup n eq {pop nc setfont} {',
    '      e eq {ec setfont} {cc setfont} ifelse',
    '    } ifelse',
    '    dup length 1 sub 1 exch getinterval show',
    '  } forall',
    '  0 setlinecap 3 setlinewidth',
    '  newpath 100 610 moveto 468 0 rlineto stroke',
    '} def',
    '/heading {',
    '  686 exch sub /y exch def /a exch def',
    '  90 y moveto a 0 get dup length 1 sub 1 exch getinterval',
    '  nh setfont dup stringwidth pop neg 0 rmoveto show',
    '  100 y moveto',
    '  a dup length 1 sub 1 exch getinterval {',
    '    /s exch def',
    '    s 0 get',
    '    dup n eq {pop nh setfont} {',
    '      e eq {eh setfont} {ch setfont} ifelse',
    '    } ifelse',
    '    s s length 1 sub 1 exch getinterval show',
    '  } forall',
    '} def',
    '/subhead {',
    '  688 exch sub /y exch def /a exch def',
    '  90 y moveto a 0 get dup length 1 sub 1 exch getinterval',
    '  ns setfont dup stringwidth pop neg 0 rmoveto show',
    '  100 y moveto',
    '  a dup length 1 sub 1 exch getinterval {',
    '    /s exch def',
    '    s 0 get',
    '    dup n eq {pop ns setfont} {',
    '      e eq {es setfont} {cs setfont} ifelse',
    '    } ifelse',
    '    s s length 1 sub 1 exch getinterval show',
    '  } forall',
    '} def',
    '/disp { /j exch def',
    '  568 exch sub exch 689 exch sub moveto',
    '  {',
    '    /s exch def',
    '    s 0 get',
    '    dup n eq {pop nf setfont} {',
    '      e eq {ef setfont} {cf setfont} ifelse',
    '    } ifelse',
    '    s s length 1 sub 1 exch getinterval show',
    '    s sp eq {j 0 rmoveto} if',
    '  } forall',
    '} def',
    '/contents { /w exch def /y exch def /a exch def',
    '  /yy 689 y sub def',
    '  a a length 1 sub get dup length 1 sub 1 exch getinterval /s exch def',
    '  nf setfont 568 s stringwidth pop sub /ex exch def',
    '  ex yy moveto s show',
    '  a 0 a length 1 sub getinterval y w 0 disp',
    '  /sx currentpoint pop def nf setfont',
    '  100 10 568 { /i exch def',
    '    i 5 sub sx gt i 5 add ex lt and {',
    '      i yy moveto (.) show',
    '    } if',
    '  } for',
    '} def',
    '/just { /w exch def /y exch def /a exch def',
    '  /jj w def /spaces 0 def',
    '  a {',
    '    /s exch def',
    '    s 0 get',
    '    dup n eq {pop nf setfont} {',
    '      e eq {ef setfont} {cf setfont} ifelse',
    '    } ifelse',
    '    s s length 1 sub 1 exch getinterval stringwidth pop',
    '    jj exch sub /jj exch def',
    '    s sp eq {/spaces spaces 1 add def} if',
    '  } forall',
    '  a y w jj spaces spaces 0 eq {pop pop 0} {div} ifelse disp',
    '} def',
    '/idl { 468 exch sub 0 disp } def',
    '/ldl { 436 exch sub 0 disp } def',
    '/idr { 222 add 468 exch sub /x exch def /y exch def /a exch def',
    '  a {',
    '    /s exch def',
    '    s 0 get',
    '    dup n eq {pop nf setfont} {',
    '      e eq {ef setfont} {cf setfont} ifelse',
    '    } ifelse',
    '    s s length 1 sub 1 exch getinterval stringwidth pop',
    '    x add /x exch def',
    '  } forall',
    '  a y x 0 disp',
    '} def',
    '/left {0 disp} def',
    '/bullet {',
    '  nf setfont dup 100 exch 689 exch sub moveto (\267) show',
    '} def'
  );
  print "%!PS-Adobe-3.0\n";
  print "%%BoundingBox: 95 95 590 705\n";
  print "%%Creator: a nasty Perl script\n";
  print "%%DocumentData: Clean7Bit\n";
  print "%%Orientation: Portrait\n";
  print "%%Pages: $lpages[$#lpages]\n";
  print "%%DocumentNeededResources: font Times-Roman Times-Italic\n";
  print "%%+ font Helvetica-Bold Courier Courier-Bold\n";
  print "%%EndComments\n%%BeginProlog\n%%EndProlog\n%%BeginSetup\nsave\n";
  $pshdr = join(' ',@pshdr);
  $pshdr =~ s/\s+/ /g;
  while ($pshdr =~ /\S/) {
    last if length($pshdr) < 72 || $pshdr !~ /^(.{0,72}\S)\s(.*)$/;
    $pshdr = $2;
    print "$1\n";
  }
  print "$pshdr\n" if $pshdr =~ /\S/;
  print "%%EndSetup\n";
  &ps_initpg($lpages[0]);
}

sub ps_trailer {
  &ps_donepg;
  print "%%Trailer\nrestore\n%%EOF\n";
}

sub ps_throw_pg {
  my ($oldpg, $newpg) = @_;
  &ps_donepg;
  &ps_initpg($newpg);
}

sub ps_initpg {
  my ($pgnum) = @_;
  print "%%Page: $pgnum $pgnum\n";
  print "%%BeginPageSetup\nsave\n%%EndPageSetup\n";
}

sub ps_donepg {
  print "%%PageTrailer\nrestore showpage\n";
}

sub ps_out_line {
  my ($ypos,$ltype,$lname) = @_;
  my $c,$d,$wid;

  print "[";
  $col = 1;
  foreach $c (@$lname) {#
    $c= "n " if $c eq " ";
    $c = "n\261" if $c eq "-";
    $d = '';
    while (length $c) {
      $d .= $1, $c = $2 while $c =~ /^([ -'\*-\[\]-~]+)(.*)$/;
      while (1) {
        $d .= "\\$1", $c = $2, next if $c =~ /^([\\\(\)])(.*)$/;
	($d .= sprintf "\\%3o",unpack("C",$1)), $c = $2, next
	  if $c =~ /^([^ -~])(.*)$/;
	last;
      }
    }
    $d = "($d)";
    $col = 0, print "\n" if $col>0 && $col+length $d > 77;
    print $d;
    $col += length $d;
  }
  print "\n" if $col > 60;
  print "]";
  if ($ltype =~ /^[nb](beg|bdy)$/) {
    printf "%d %s%d just\n",
      $ypos, ($ltype eq "bbeg" ? "bullet " : ""),
      ($ltype =~ /^b/ ? 456 : 468);
  } elsif ($ltype =~ /^[nb](one|end)$/) {
    printf "%d %s%d left\n",
      $ypos, ($ltype eq "bone" ? "bullet " : ""),
      ($ltype =~ /^b/ ? 456 : 468);
  } elsif ($ltype =~ /^c(one|beg|bdy|end)$/) {
    printf "$ypos 468 left\n";
  } elsif ($ltype =~ /^C/) {
    $wid = 468;
    $wid = 456 if $ltype eq "Chea";
    $wid = 444 if $ltype eq "Csub";
    printf "$ypos $wid contents\n";
  } elsif ($ltype eq "chap") {
    printf "chapter\n";
  } elsif ($ltype eq "head") {
    printf "$ypos heading\n";
  } elsif ($ltype eq "subh") {
    printf "$ypos subhead\n";
  } elsif ($ltype =~ /([il]d[lr])([12])/) {
    $left = ($2 eq "2" ? 468-222 : 0);
    printf "$ypos $left $1\n";
  }
}

sub word_ps {
  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);
  $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
  if ($wmajt eq "n" || $wtype eq "w ") {
    return "n$w";
  } elsif ($wtype eq "sp") {
    return ' ';
  } elsif ($wtype eq "da") {
    return '-';
  } elsif ($wmajt eq "c" || $wtype eq "wc") {
    return "c$w";
  } elsif ($wmajt eq "e") {
    return "e$w";
  } elsif ($wmajt eq "x") {
    return "x";
  } elsif ($wtype eq "i ") {
    push @lindex, $w;
    return "x";
  } else {
    die "panic in word_ps: $wtype$w\n";
  }
}

sub len_ps {
  my (@line) = @_;
  my $l = 0;
  my $w, $size;

  $size = 11/1000; # used only for length calculations
  while ($w = shift @line) {
    $w = "n " if $w eq " ";
    $w = "n\261" if $w eq "-";
    $f = substr($w,0,1);
    $f = "timesr" if $f eq "n";
    $f = "timesi" if $f eq "e";
    $f = "courr" if $f eq "c";
    foreach $c (unpack 'C*',substr($w,1)) {
      $l += $size * $$f[$c];
    }
  }
  return $l;
}

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

  # Open file.
  print "writing file...";
  open TEXT,">nasmdoc.texi";
  select TEXT;

  # Preamble.
  print "\input texinfo   \@c -*-texinfo-*-\n";
  print "\@c \%**start of header\n";
  print "\@setfilename nasm.info\n";
  print "\@dircategory Programming\n";
  print "\@direntry\n";
  print "* NASM: (nasm).                The Netwide Assembler for x86.\n";
  print "\@end direntry\n";
  print "\@settitle NASM: The Netwide Assembler\n";
  print "\@setchapternewpage odd\n";
  print "\@c \%**end of header\n";
  print "\n";
  print "\@ifinfo\n";
  print "This file documents NASM, the Netwide Assembler: an assembler\n";
  print "targetting the Intel x86 series of processors, with portable source.\n";
  print "\n";
  print "Copyright 1997 Simon Tatham\n";
  print "\n";
  print "All rights reserved. This document is redistributable under the\n";
  print "licence given in the file \"Licence\" distributed in the NASM archive.\n";
  print "\@end ifinfo\n";
  print "\n";
  print "\@titlepage\n";
  print "\@title NASM: The Netwide Assembler\n";
  print "\@author Simon Tatham\n";
  print "\n";
  print "\@page\n";
  print "\@vskip 0pt plus 1filll\n";
  print "Copyright \@copyright{} 1997 Simon Tatham\n";
  print "\n";
  print "All rights reserved. This document is redistributable under the\n";
  print "licence given in the file \"Licence\" distributed in the NASM archive.\n";
  print "\@end titlepage\n";
  print "\n";
  print "\@node Top, $tstruct_next{'Top'}, (dir), (dir)\n";
  print "\@top\n";
  print "\n";
  print "\@ifinfo\n";
  print "This file documents NASM, the Netwide Assembler: an assembler\n";
  print "targetting the Intel x86 series of processors, with portable source.\n";
  print "\@end ifinfo\n";

  $node = "Top";

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

    $bulleting = 0, print "\@end itemize\n" if $bulleting && $ptype ne "bull";
    print "\n"; # always one of these before a new paragraph

    if ($ptype eq "chap") {
      # Chapter heading. Begin a new node.
      &texi_menu($node)
        if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
      $pflags =~ /chap (.*) :(.*)/;
      $node = "Chapter $1";
      $title = "Chapter $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 "appn") {
      # Appendix heading. Begin a new node.
      &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\@unnumbered $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";