summaryrefslogtreecommitdiff
path: root/systems/knuth/dist/texware
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/knuth/dist/texware
Initial commit
Diffstat (limited to 'systems/knuth/dist/texware')
-rw-r--r--systems/knuth/dist/texware/dvitype.web2506
-rw-r--r--systems/knuth/dist/texware/pltotf.web2518
-rw-r--r--systems/knuth/dist/texware/pooltype.web430
-rw-r--r--systems/knuth/dist/texware/tftopl.web1596
4 files changed, 7050 insertions, 0 deletions
diff --git a/systems/knuth/dist/texware/dvitype.web b/systems/knuth/dist/texware/dvitype.web
new file mode 100644
index 0000000000..a0c5dba2c7
--- /dev/null
+++ b/systems/knuth/dist/texware/dvitype.web
@@ -0,0 +1,2506 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was completed in September, 1982.
+% Slight changes were made in October, 1982, for version 0.7 of TeX.
+% Version 1.1 corrected minor bugs (May, 1983).
+% Version 2 was released with version 0.999 of TeX (July, 1983).
+% Version 2.1 corrected a bug when no fonts are present (September, 1983).
+% Version 2.2 corrected bugs in max_*_so_far and put1 (October, 1983).
+% Version 2.3 corrected spacing of accents (March, 1984).
+% Version 2.4 fixed rounding, changed oriental font conventions (April, 1984).
+% Version 2.5 improved the case of zero pages (May, 1984).
+% Version 2.6 introduced max_drift (June, 1984).
+% Version 2.7 had minor editorial changes (August, 1984).
+% Version 2.8 made default resolution 300/1 (April, 1985).
+% Version 2.9 changed negative scaling as in TeX version 2.7 (November, 1987).
+% Version 3 introduced an intermediate level of verbosity (October,1989).
+% Version 3.1 gave magnification info in final font list (November, 1989).
+% Version 3.2 doublechecked design size of each font (January, 1990).
+% Version 3.3 had more robust for loops in print_font, define_font (May, 1990).
+% Version 3.4 more robustness in presence of bad fonts (September, 1990).
+% Version 3.5 checked skipped material more strictly (March, 1995).
+% Version 3.6 gives a better help message (December, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVI$\,$\lowercase{type}}
+\def\contentspagenumber{401}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVItype} processor}
+ \vskip 15pt
+ \centerline{(Version 3.6, December 1995)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVItype} utility program reads binary device-independent (``\.{DVI}'')
+files that are produced by document compilers such as \TeX, and converts them
+into symbolic form. This program has two chief purposes: (1)~It can be used to
+determine whether a \.{DVI} file is valid or invalid, when diagnosing
+compiler errors; and (2)~it serves as an example of a program that reads
+\.{DVI} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on. But if rounding is done everywhere, even in the
+midst of words, there will be uneven spacing between the letters, and that
+looks bad. Human eyes notice differences of a thousandth of an inch in the
+positioning of lines that are close together; on low resolution devices,
+where rounding produces effects four times as great as this, the problem
+is especially critical. Experience has shown that unusual care is needed
+even on high-resolution equipment; for example, a mistake in the sixth
+significant hexadecimal place of a constant once led to a difficult-to-find
+bug in some software for the Alphatype CRS, which has a resolution of 5333
+pixels per inch (make that 5333.33333333 pixels per inch). The document
+compilers that generate \.{DVI} files make certain assumptions about the
+arithmetic that will be used by \.{DVI}-reading software, and if these
+assumptions are violated the results will be of inferior quality.
+Therefore the present program is intended as a guide to proper procedure
+in the critical places where a bit of subtlety is involved.
+
+The first \.{DVItype} program was designed by David Fuchs in 1979, and it
+@^Fuchs, David Raymond@>
+went through several versions on different computers as the format of
+\.{DVI} files was evolving to its present form. Peter Breitenlohner
+helped with the latest revisions.
+@^Breitenlohner, Peter@>
+
+The |banner| string defined here should be changed whenever \.{DVItype}
+gets modified.
+
+@d banner=='This is DVItype, Version 3.6' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVItype} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files, and they are not important for efficiency
+reasons either---an infrequently used program like \.{DVItype} does not
+have to be efficient. But they are included there because of \.{DVItype}'s
+r\^^Dole as a model of a \.{DVI} reading routine, since other \.{DVI}
+processors ought to be highly efficient. If \.{DVItype} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVItype} will not include the optional feature that reads the
+postamble first.
+
+Another extension is to use a default |case| as in \.{TANGLE}, \.{WEAVE},
+etc.
+
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program DVI_type(@!dvi_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. Another label, |done|, is used when stopping normally.
+
+@d final_end=9999 {label for the end of it all}
+@d done=30 {go here when finished with a subtask}
+
+@<Labels...@>=final_end,done;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVItype}'s capacity.
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_widths=10000; {maximum number of different characters among all fonts}
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
+\.{DVItype} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{DVItype}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{DVItype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} files use ASCII code for file names
+and certain other strings.
+
+The next few sections of \.{DVItype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{DVItype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{DVItype}.
+So we shall assume that the \PASCAL\ system being used for \.{DVItype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{DVItype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Device-independent file format.
+Before we get into the details of \.{DVItype}, we need to know exactly
+what \.{DVI} files are. The form of such files was designed by David R.
+@^Fuchs, David Raymond@>
+Fuchs in 1979. Almost any reasonable typesetting device can be driven by
+a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of document compilers like \TeX\ on many different kinds
+of equipment.
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$.
+@.DVI {\rm files}@>
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that they were generated, not in any particular
+numerical order. If we ignore |nop| commands and \\{fnt\_def} commands
+(which are allowed between any two commands in the file), each |eop|
+command is immediately followed by a |bop| command, or by a |post|
+command; in the latter case, there are no more pages in the file, and the
+remaining bytes form the postamble. Further details about the postamble
+will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one that starts in byte 100, has a pointer of $-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|set_char_1| through |set_char_127| (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, which is intended for processors that deal with oriental languages;
+but \.{DVItype} will allow character codes greater than 255, assuming that
+they all have the same width as the character whose code is $c \bmod 256$.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long, possibly even negative. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height |a| and width |b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+Programs that typeset from \.{DVI} files should be careful to make the rules
+line up carefully with digitized characters, as explained in connection with
+the |rule_pixels| subroutine below.
+
+\yskip\hang|put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters can
+be used to identify pages, if a user wants to print only part of a \.{DVI}
+file; \TeX82 gives them the values of \.{\\count0} $\ldots$ \.{\\count9}
+at the time \.{\\shipout} was invoked for this page. The parameter |p|
+points to the previous |bop| command in the file, where the first |bop|
+has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question. \.{DVItype} does not do such sorting.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them to |(h,v,w,x,y,z)|. The number of pops should never exceed the number
+of pushes, since it would be highly embarrassing if the stack were empty
+at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point actually moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|w2| 149 |b[2]|. Same as |w1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|w3| 150 |b[3]|. Same as |w1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|w4| 151 |b[4]|. Same as |w1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|x2| 154 |b[2]|. Same as |x1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|x3| 155 |b[3]|. Same as |x1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|x4| 156 |b[4]|. Same as |x1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point actually moves up.
+
+\yskip\hang|down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|y2| 163 |a[2]|. Same as |y1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|y3| 164 |a[3]|. Same as |y1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|y4| 165 |a[4]|. Same as |y1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|z2| 168 |a[2]|. Same as |z1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|z3| 169 |a[3]|. Same as |z1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|z4| 170 |a[4]|. Same as |z1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang|fnt_num_1| through |fnt_num_63| (opcodes 172 to 234). Set
+|f:=1|, \dots, |f:=63|, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when |xxx1| would be incorrect.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. (For example, there are
+exactly 7227 \TeX\ points in 254 centimeters, and \TeX82 works with scaled
+points where there are $2^{16}$ sp in a point, so \TeX82 sets |num=25400000|
+and $|den|=7227\cdot2^{16}=473628672$.)
+@^sp@>
+
+The |mag| parameter is what \TeX82 calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $mn/1000d$. Note that if a \TeX\ source document
+does not call for any `\.{true}' dimensions, and if you change it only by
+specifying a different \.{\\mag} setting, the \.{DVI} file that \TeX\
+creates will be completely unchanged except for the value of |mag| in the
+preamble and postamble. (Fancy \.{DVI}-reading programs allow users to
+override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ (or whatever program
+generated the \.{DVI} file) found in the \.{TFM} file for this font;
+|c| should match the check sum of the font found by programs that read
+this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to the
+character widths in font |k|; font dimensions in \.{TFM} files and other
+font files are relative to this quantity, which is always positive and
+less than $2^{27}$. It is given in the same units as the other dimensions
+of the \.{DVI} file. Parameter |d| is similar to |s|; it is the ``design
+size,'' and (like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be
+used at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader discovers all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+As noted above, \.{DVItype} will limit itself to the restrictions of standard
+\PASCAL\ if |random_reading| is defined to be |false|.
+
+@* Input from binary files.
+We have seen that a \.{DVI} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{DVItype} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |dvi_file| is the main
+input file that we are translating into symbolic form, and |tfm_file| is
+the current font metric file from which character-width information is
+being read.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
+@!tfm_file:byte_file; {a font metric file}
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |tfm_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What are |cur_loc| and |cur_name|?'' Good question. They're global
+variables: |cur_loc| is the number of the byte about to be read next from
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+
+@ It turns out to be convenient to read four bytes at a time, when we are
+inputting from \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ We shall use another set of simple functions to read the next byte or
+bytes from |dvi_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(dvi_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Finally we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |move_to_byte(n)|
+should position |dvi_file| so that the next |get_byte| will read byte |n|,
+starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+
+@* Reading the font information.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{DVItype} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{GF} files
+that specify bit patterns for digitized characters);
+thus, it is usually possible for \.{DVI} reading programs to get by with
+accessing only one file per font. \.{DVItype} has a comparatively easy
+task in this regard, since it needs only a few words of information from
+each font; other \.{DVI}-to-printer programs may have to go to some pains to
+deal with complications that arise when a large number of large font files
+all need to be accessed simultaneously.
+
+@ For purposes of this program, we need to know only two things about a
+given character |c| in a given font |f|: (1)~Is |c| a legal character
+in~|f|? (2)~If so, what is the width of |c|? We also need to know the
+symbolic name of each font, so it can be printed out, and we need to know
+the approximate size of inter-word spaces in each font.
+
+The answers to these questions appear implicitly in the following data
+structures. The current number of known fonts is |nf|. Each known font has
+an internal number |f|, where |0<=f<nf|; the external number of this font,
+i.e., its font identification number in the \.{DVI} file, is
+|font_num[f]|, and the external name of this font is the string that
+occupies positions |font_name[f]| through |font_name[f+1]-1| of the array
+|names|. The latter array consists of |ASCII_code| characters, and
+|font_name[nf]| is its first unoccupied position. A horizontal motion
+in the range |-4*font_space[f]<h<font_space[f]|
+will be treated as a `kern' that is not
+indicated in the printouts that \.{DVItype} produces between brackets. The
+legal characters run from |font_bc[f]| to |font_ec[f]|, inclusive; more
+precisely, a given character |c| is valid in font |f| if and only if
+|font_bc[f]<=c<=font_ec[f]| and |char_width(f)(c)<>invalid_width|.
+Finally, |char_width(f)(c)=width[width_base[f]+c]|, and |width_ptr| is the
+first unused position of the |width| array.
+
+@d char_width_end(#)==#]
+@d char_width(#)==width[width_base[#]+char_width_end
+@d invalid_width==@'17777777777
+@d invalid_font==max_fonts
+
+@<Glob...@>=
+@!font_num:array [0..max_fonts] of integer; {external font numbers}
+@!font_name:array [0..max_fonts] of 1..name_size; {starting positions
+ of external font names}
+@!names:array [1..name_size] of ASCII_code; {characters of names}
+@!font_check_sum:array [0..max_fonts] of integer; {check sums}
+@!font_scaled_size:array [0..max_fonts] of integer; {scale factors}
+@!font_design_size:array [0..max_fonts] of integer; {design sizes}
+@!font_space:array [0..max_fonts] of integer; {boundary between ``small''
+ and ``large'' spaces}
+@!font_bc:array [0..max_fonts] of integer; {beginning characters in fonts}
+@!font_ec:array [0..max_fonts] of integer; {ending characters in fonts}
+@!width_base:array [0..max_fonts] of integer; {index into |width| table}
+@!width:array [0..max_widths] of integer; {character widths, in \.{DVI} units}
+@!nf:0..max_fonts; {the number of known fonts}
+@!width_ptr:0..max_widths; {the number of known character widths}
+
+@ @<Set init...@>=
+nf:=0; width_ptr:=0; font_name[0]:=1;@/
+font_space[invalid_font]:=0; {for |out_space| and |out_vmove|}
+font_bc[invalid_font]:=1; font_ec[invalid_font]:=0;
+
+@ It is, of course, a simple matter to print the name of a given font.
+
+@p procedure print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin if f=invalid_font then print('UNDEFINED!')
+@.UNDEFINED@>
+else begin for k:=font_name[f] to font_name[f+1]-1 do
+ print(xchr[names[k]]);
+ end;
+end;
+
+@ An auxiliary array |in_width| is used to hold the widths as they are
+input. The global variables |tfm_check_sum| and |tfm_design_size| are
+set to the check sum and design size that
+appear in the current \.{TFM} file.
+
+@<Glob...@>=
+@!in_width:array[0..255] of integer; {\.{TFM} width data in \.{DVI} units}
+@!tfm_check_sum:integer; {check sum found in |tfm_file|}
+@!tfm_design_size:integer; {design size found in |tfm_file|, in \.{DVI} units}
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ Here is a procedure that absorbs the necessary information from a
+\.{TFM} file, assuming that the file has just been successfully reset
+so that we are ready to read its first byte. (A complete description of
+\.{TFM} file format appears in the documentation of \.{TFtoPL} and will
+not be repeated here.) The procedure does not check the \.{TFM} file
+for validity, nor does it give explicit information about what is
+wrong with a \.{TFM} file that proves to be invalid; \.{DVI}-reading
+programs need not do this, since \.{TFM} files are almost always valid,
+and since the \.{TFtoPL} utility program has been specifically designed
+to diagnose \.{TFM} errors. The procedure simply returns |false| if it
+detects anything amiss in the \.{TFM} data.
+
+There is a parameter, |z|, which represents the scaling factor being
+used to compute the font dimensions; it must be in the range $0<z<2^{27}$.
+
+@p function in_TFM(@!z:integer):boolean; {input \.{TFM} data or return |false|}
+label 9997, {go here when the format is bad}
+ 9998, {go here when the information cannot be loaded}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!lh:integer; {length of the header data, in four-byte words}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_widths; {new value of |width_ptr| after successful input}
+@!alpha,@!beta:integer; {quantities used in the scaling computation}
+begin @<Read past the header data; |goto 9997| if there is a problem@>;
+@<Store character-width indices at the end of the |width| table@>;
+@<Read and convert the width values, setting up the |in_width| table@>;
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>;
+width_ptr:=wp; in_TFM:=true; goto 9999;
+9997: print_ln('---not loaded, TFM file is bad');
+@.TFM file is bad@>
+9998: in_TFM:=false;
+9999: end;
+
+@ @<Read past the header...@>=
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3;
+if font_ec[nf]<font_bc[nf] then font_bc[nf]:=font_ec[nf]+1;
+if width_ptr+font_ec[nf]-font_bc[nf]+1>max_widths then
+ begin print_ln('---not loaded, DVItype needs larger width table');
+@.DVItype needs larger...@>
+ goto 9998;
+ end;
+wp:=width_ptr+font_ec[nf]-font_bc[nf]+1;
+read_tfm_word; nw:=b0*256+b1;
+if (nw=0)or(nw>256) then goto 9997;
+for k:=1 to 3+lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=4 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3
+ else if k=5 then
+ if b0<128 then
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+
+@ @<Store character-width indices...@>=
+if wp>0 then for k:=width_ptr to wp-1 do
+ begin read_tfm_word;
+ if b0>nw then goto 9997;
+ width[k]:=b0;
+ end;
+
+@ The most important part of |in_TFM| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. This fixed-point multiplication
+must be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be
+done exactly, for the reasons stated above; the following program does the
+job in a system-independent way, assuming that arithmetic is exact on
+numbers less than $2^{31}$ in magnitude.
+
+@<Read and convert the width values...@>=
+@<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=0 to nw-1 do
+ begin read_tfm_word;
+ in_width[k]:=(((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0>0 then if b0<255 then goto 9997
+ else in_width[k]:=in_width[k]-alpha;
+ end
+
+@ @<Replace |z|...@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+@ A \.{DVI}-reading program usually works with font files instead of
+\.{TFM} files, so \.{DVItype} is atypical in that respect. Font files
+should, however, contain exactly the same character width data that is
+found in the corresponding \.{TFM}s; check sums are used to help
+ensure this. In addition, font files usually also contain the widths of
+characters in pixels, since the device-independent character widths of
+\.{TFM} files are generally not perfect multiples of pixels.
+
+The |pixel_width| array contains this information; when |width[k]| is the
+device-independent width of some character in \.{DVI} units, |pixel_width[k]|
+is the corresponding width of that character in an actual font.
+The macro |char_pixel_width| is set up to be analogous to |char_width|.
+
+@d char_pixel_width(#)==pixel_width[width_base[#]+char_width_end
+
+@<Glob...@>=
+@!pixel_width:array[0..max_widths] of integer; {actual character widths,
+ in pixels}
+@!conv:real; {converts \.{DVI} units to pixels}
+@!true_conv:real; {converts unmagnified \.{DVI} units to pixels}
+@!numerator,@!denominator:integer; {stated conversion ratio}
+@!mag:integer; {magnification factor times 1000}
+
+@ The following code computes pixel widths by simply rounding the \.{TFM}
+widths to the nearest integer number of pixels, based on the conversion factor
+|conv| that converts \.{DVI} units to pixels. However, such a simple
+formula will not be valid for all fonts, and it will often give results that
+are off by $\pm1$ when a low-resolution font has been carefully
+hand-fitted. For example, a font designer often wants to make the letter `m'
+a pixel wider or narrower in order to make the font appear more consistent.
+\.{DVI}-to-printer programs should therefore input the correct pixel width
+information from font files whenever there is a chance that it may differ.
+A warning message may also be desirable in the case that at least one character
+is found whose pixel width differs from |conv*width| by more than a full pixel.
+@^system dependencies@>
+
+@d pixel_round(#)==round(conv*(#))
+
+@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>=
+if in_width[0]<>0 then goto 9997; {the first width should be zero}
+width_base[nf]:=width_ptr-font_bc[nf];
+if wp>0 then for k:=width_ptr to wp-1 do
+ if width[k]=0 then
+ begin width[k]:=invalid_width; pixel_width[k]:=0;
+ end
+ else begin width[k]:=in_width[width[k]];
+ pixel_width[k]:=pixel_round(width[k]);
+ end
+
+@* Optional modes of output.
+\.{DVItype} will print different quantities of information based on some
+options that the user must specify: The |out_mode| level is set to one of
+five values (|errors_only|, |terse|, |mnemonics_only|,
+|verbose|, |the_works|), giving
+different degrees of output; and the typeout can be confined to a
+restricted subset of the pages by specifying the desired starting page and
+the maximum number of pages. Furthermore there is an option to specify the
+resolution of an assumed discrete output device, so that pixel-oriented
+calculations will be shown; and there is an option to override the
+magnification factor that is stated in the \.{DVI} file.
+
+The starting page is specified by giving a sequence of 1 to 10 numbers or
+asterisks separated by dots. For example, the specification `\.{1.*.-5}'
+can be used to refer to a page output by \TeX\ when $\.{\\count0}=1$
+and $\.{\\count2}=-5$. (Recall that |bop| commands in a \.{DVI} file
+are followed by ten `count' values.) An asterisk matches any number,
+so the `\.*' in `\.{1.*.-5}' means that \.{\\count1} is ignored when
+specifying the first page. If several pages match the given specification,
+\.{DVItype} will begin with the earliest such page in the file. The
+default specification `\.*' (which matches all pages) therefore denotes
+the page at the beginning of the file.
+
+When \.{DVItype} begins, it engages the user in a brief dialog so that the
+options will be specified. This part of \.{DVItype} requires nonstandard
+\PASCAL\ constructions to handle the online interaction; so it may be
+preferable in some cases to omit the dialog and simply to stick to the
+default options (|out_mode=the_works|, starting page `\.*',
+|max_pages=1000000|, |resolution=300.0|, |new_mag=0|). On other hand, the
+system-dependent routines that are needed are not complicated, so it will
+not be terribly difficult to introduce them.
+@^system dependencies@>
+
+@d errors_only=0 {value of |out_mode| when minimal printing occurs}
+@d terse=1 {value of |out_mode| for abbreviated output}
+@d mnemonics_only=2 {value of |out_mode| for medium-quantity output}
+@d verbose=3 {value of |out_mode| for detailed tracing}
+@d the_works=4 {|verbose|, plus check of postamble if |random_reading|}
+
+@<Glob...@>=
+@!out_mode:errors_only..the_works; {controls the amount of output}
+@!max_pages:integer; {at most this many |bop..eop| pages will be printed}
+@!resolution:real; {pixels per inch}
+@!new_mag:integer; {if positive, overrides the postamble's magnification}
+
+@ The starting page specification is recorded in two global arrays called
+|start_count| and |start_there|. For example, `\.{1.*.-5}' is represented
+by |start_there[0]=true|, |start_count[0]=1|, |start_there[1]=false|,
+|start_there[2]=true|, |start_count[2]=-5|.
+We also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example.
+
+@<Glob...@>=
+@!start_count:array[0..9] of integer; {count values to select starting page}
+@!start_there:array[0..9] of boolean; {is the |start_count| value relevant?}
+@!start_vals:0..9; {the last count considered significant}
+@!count:array[0..9] of integer; {the count values on the current page}
+
+@ @<Set init...@>=
+out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ During the dialog, \.{DVItype} will treat the first blank space in a
+line as the end of that line. Therefore |input_ln| makes sure that there
+is always at least one blank space in |buffer|.
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVItype} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 1,2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |out_mode|@>;
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |out_mode|@>=
+1: write(term_out,'Output level (default=4, ? for help): ');
+out_mode:=the_works; input_ln;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0"
+ else begin write(term_out,'Type 4 for complete listing,');
+ write(term_out,' 0 for errors and fonts only,');
+ write_ln(term_out,' 1 or 2 or 3 for something in between.');
+ goto 1;
+ end
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{DVItype} thought was specified.
+
+@<Print all the selected options@>=
+print_ln('Options selected:');
+@.Options selected@>
+print(' Starting page = ');
+for k:=0 to start_vals do
+ begin if start_there[k] then print(start_count[k]:1)
+ else print('*');
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+print_ln(' Maximum number of pages = ',max_pages:1);
+print(' Output level = ',out_mode:1);
+case out_mode of
+errors_only: print_ln(' (showing bops, fonts, and error messages only)');
+terse: print_ln(' (terse)');
+mnemonics_only: print_ln(' (mnemonics)');
+verbose: print_ln(' (verbose)');
+the_works: if random_reading then print_ln(' (the works)')
+ else begin out_mode:=verbose;
+ print_ln(' (the works: same as level 3 in this DVItype)');
+ end;
+end;@/
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+
+@* Defining fonts.
+When |out_mode=the_works|, \.{DVItype} reads the postamble first and loads
+all of the fonts defined there; then it processes the pages. In this
+case, a \\{fnt\_def} command should match a previous definition if and only
+if the \\{fnt\_def} being processed is not in the postamble. But if
+|out_mode<the_works|, \.{DVItype} reads the pages first and the postamble
+last, so the conventions are reversed: a \\{fnt\_def} should match a previous
+\\{fnt\_def} if and only if the current one is a part of the postamble.
+
+A global variable |in_postamble| is provided to tell whether we are
+processing the postamble or not.
+
+@<Glob...@>=
+@!in_postamble:boolean; {are we reading the postamble?}
+
+@ @<Set init...@>=
+in_postamble:=false;
+
+@ The following subroutine does the necessary things when a \\{fnt\_def}
+command is being processed.
+
+@p procedure define_font(@!e:integer); {|e| is an external font number}
+var f:0..max_fonts;
+@!p:integer; {length of the area/directory spec}
+@!n:integer; {length of the font name proper}
+@!c,@!q,@!d,@!m:integer; {check sum, scaled size, design size, magnification}
+@!r:0..name_length; {index into |cur_name|}
+@!j,@!k:0..name_size; {indices into |names|}
+@!mismatch:boolean; {do names disagree?}
+begin if nf=max_fonts then abort('DVItype capacity exceeded (max fonts=',
+ max_fonts:1,')!');
+@.DVItype capacity exceeded...@>
+font_num[nf]:=e; f:=0;
+while font_num[f]<>e do incr(f);
+@<Read the font parameters into position for font |nf|, and
+ print the font name@>;
+if ((out_mode=the_works)and in_postamble)or@|
+ ((out_mode<the_works)and not in_postamble) then
+ begin if f<nf then print_ln('---this font was already defined!');
+@.this font was already defined@>
+ end
+else begin if f=nf then print_ln('---this font wasn''t loaded before!');
+@.this font wasn't loaded before@>
+ end;
+if f=nf then @<Load the new font, unless there are problems@>
+else @<Check that the current font definition matches the old one@>;
+end;
+
+@ @<Check that the current...@>=
+begin if font_check_sum[f]<>c then
+ print_ln('---check sum doesn''t match previous definition!');
+@.check sum doesn't match@>
+if font_scaled_size[f]<>q then
+ print_ln('---scaled size doesn''t match previous definition!');
+@.scaled size doesn't match@>
+if font_design_size[f]<>d then
+ print_ln('---design size doesn''t match previous definition!');
+@.design size doesn't match@>
+j:=font_name[f]; k:=font_name[nf];
+if font_name[f+1]-j<>font_name[nf+1]-k then mismatch:=true
+else begin mismatch:=false;
+ while j<font_name[f+1] do
+ begin if names[j]<>names[k] then mismatch:=true;
+ incr(j); incr(k);
+ end;
+ end;
+if mismatch then print_ln('---font name doesn''t match previous definition!');
+@.font name doesn't match@>
+end
+
+@ @<Read the font parameters into position for font |nf|...@>=
+c:=signed_quad; font_check_sum[nf]:=c;@/
+q:=signed_quad; font_scaled_size[nf]:=q;@/
+d:=signed_quad; font_design_size[nf]:=d;@/
+if (q<=0) or (d<=0) then m:=1000
+else m:=round((1000.0*conv*q)/(true_conv*d));
+p:=get_byte; n:=get_byte;
+if font_name[nf]+n+p>name_size then
+ abort('DVItype capacity exceeded (name size=',name_size:1,')!');
+@.DVItype capacity exceeded...@>
+font_name[nf+1]:=font_name[nf]+n+p;
+if showing then print(': ')
+ {when |showing| is true, the font number has already been printed}
+else print('Font ',e:1,': ');
+if n+p=0 then print('null font name!')
+@.null font name@>
+else for k:=font_name[nf] to font_name[nf+1]-1 do names[k]:=get_byte;
+print_font(nf);
+if not showing then if m<>1000 then print(' scaled ',m:1)
+@.scaled@>
+
+@ @<Load the new font, unless there are problems@>=
+begin @<Move font name into the |cur_name| string@>;
+open_tfm_file;
+if eof(tfm_file) then
+ print('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin if (q<=0)or(q>=@'1000000000) then
+ print('---not loaded, bad scale (',q:1,')!')
+@.bad scale@>
+ else if (d<=0)or(d>=@'1000000000) then
+ print('---not loaded, bad design size (',d:1,')!')
+@.bad design size@>
+ else if in_TFM(q) then @<Finish loading the new font info@>;
+ end;
+if out_mode=errors_only then print_ln(' ');
+end
+
+@ @<Finish loading...@>=
+begin font_space[nf]:=q div 6; {this is a 3-unit ``thin space''}
+if (c<>0)and(tfm_check_sum<>0)and(c<>tfm_check_sum) then
+ begin print_ln('---beware: check sums do not agree!');
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ print_ln(' (',c:1,' vs. ',tfm_check_sum:1,')');
+ print(' ');
+ end;
+if abs(tfm_design_size-d)>2 then
+ begin print_ln('---beware: design sizes do not agree!');
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ print_ln(' (',d:1,' vs. ',tfm_design_size:1,')');
+ print(' ');
+ end;
+print('---loaded at size ',q:1,' DVI units');
+d:=round((100.0*conv*q)/(true_conv*d));
+if d<>100 then
+ begin print_ln(' '); print(' (this font is magnified ',d:1,'%)');
+ end;
+@.this font is magnified@>
+incr(nf); {now the new font is officially present}
+end
+
+@ If |p=0|, i.e., if no font directory has been specified, \.{DVItype}
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+@* Low level output routines.
+Simple text in the \.{DVI} file is saved in a buffer until |line_length-2|
+characters have accumulated, or until some non-simple \.{DVI} operation
+occurs. Then the accumulated text is printed on a line, surrounded by
+brackets. The global variable |text_ptr| keeps track of the number of
+characters currently in the buffer.
+
+@<Glob...@>=
+@!text_ptr:0..line_length; {the number of characters in |text_buf|}
+@!text_buf:array[1..line_length] of ASCII_code; {saved characters}
+
+@ @<Set init...@>=
+text_ptr:=0;
+
+@ The |flush_text| procedure will empty the buffer if there is something in it.
+
+@p procedure flush_text;
+var k:0..line_length; {index into |text_buf|}
+begin if text_ptr>0 then
+ begin if out_mode>errors_only then
+ begin print('[');
+ for k:=1 to text_ptr do print(xchr[text_buf[k]]);
+ print_ln(']');
+ end;
+ text_ptr:=0;
+ end;
+end;
+
+@ And the |out_text| procedure puts something in it.
+
+@p procedure out_text(c:ASCII_code);
+begin if text_ptr=line_length-2 then flush_text;
+incr(text_ptr); text_buf[text_ptr]:=c;
+end;
+
+@* Translation to symbolic form.
+The main work of \.{DVItype} is accomplished by the |do_page| procedure,
+which produces the output for an entire page, assuming that the |bop|
+command for that page has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{DVI}
+commands.
+
+@ The definition of \.{DVI} files refers to six registers,
+$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units. In practice,
+we also need registers |hh| and |vv|, the pixel analogs of $h$ and $v$,
+since it is not always true that |hh=pixel_round(h)| or
+|vv=pixel_round(v)|.
+
+The stack of $(h,v,w,x,y,z)$ values is represented by eight arrays
+called |hstack|, \dots, |zstack|, |hhstack|, and |vvstack|.
+
+@<Glob...@>=
+@!h,@!v,@!w,@!x,@!y,@!z,@!hh,@!vv:integer; {current state values}
+@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
+ array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
+@!hhstack,@!vvstack:
+ array [0..stack_size] of integer; {pushed down values in pixels}
+
+@ Three characteristics of the pages (their |max_v|, |max_h|, and
+|max_s|) are specified in the postamble, and a warning message
+is printed if these limits are exceeded. Actually |max_v| is set to
+the maximum height plus depth of a page, and |max_h| to the maximum width,
+for purposes of page layout. Since characters can legally be set outside
+of the page boundaries, it is not an error when |max_v| or |max_h| is
+exceeded. But |max_s| should not be exceeded.
+
+The postamble also specifies the total number of pages; \.{DVItype}
+checks to see if this total is accurate.
+
+@<Glob...@>=
+@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
+@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
+@!max_s:integer; {the stack depth should not exceed this}
+@!max_v_so_far,@!max_h_so_far,@!max_s_so_far:integer; {the record high levels}
+@!total_pages:integer; {the stated total number of pages}
+@!page_count:integer; {the total number of pages seen so far}
+
+@ @<Set init...@>=
+max_v:=@'17777777777-99; max_h:=@'17777777777-99; max_s:=stack_size+1;@/
+max_v_so_far:=0; max_h_so_far:=0; max_s_so_far:=0; page_count:=0;
+
+@ Before we get into the details of |do_page|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
+ first_par:=o-set_char_0;
+set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
+set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
+set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
+right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
+right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
+right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
+set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
+ fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
+nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
+w0: first_par:=w;
+x0: first_par:=x;
+y0: first_par:=y;
+z0: first_par:=z;
+sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
+end;
+end;
+
+@ Here is another subroutine that we need: It computes the number of
+pixels in the height or width of a rule. Characters and rules will line up
+properly if the sizes are computed precisely as specified here. (Since
+|conv| is computed with some floating-point roundoff error, in a
+machine-dependent way, format designers who are tailoring something for a
+particular resolution should not plan their measurements to come out to an
+exact integer number of pixels; they should compute things so that the
+rule dimensions are a little less than an integer number of pixels, e.g.,
+4.99 instead of 5.00.)
+
+@p function rule_pixels(x:integer):integer;
+ {computes $\lceil|conv|\cdot x\rceil$}
+var n:integer;
+begin n:=trunc(conv*x);
+if n<conv*x then rule_pixels:=n+1 @+ else rule_pixels:=n;
+end;
+
+@ Strictly speaking, the |do_page| procedure is really a function with
+side effects, not a `\&{procedure}'\thinspace; it returns the value |false|
+if \.{DVItype} should be aborted because of some unusual happening. The
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code followed by |goto| statements leading to routines that
+finish up the activities common to different commands. We will use the
+following labels:
+
+@d fin_set=41 {label for commands that set or put a character}
+@d fin_rule=42 {label for commands that set or put a rule}
+@d move_right=43 {label for commands that change |h|}
+@d move_down=44 {label for commands that change |v|}
+@d show_state=45 {label for commands that change |s|}
+@d change_font=46 {label for commands that change |cur_font|}
+
+@ Some \PASCAL\ compilers severely restrict the length of procedure bodies,
+so we shall split |do_page| into two parts, one of which is
+called |special_cases|. The different parts communicate with each other
+via the global variables mentioned above, together with the following ones:
+
+@<Glob...@>=
+@!s:integer; {current stack size}
+@!ss:integer; {stack size to print}
+@!cur_font:integer; {current internal font number}
+@!showing:boolean; {is the current command being translated in full?}
+
+@ Here is the overall setup.
+
+@p @t\4@>@<Declare the function called |special_cases|@>@;
+function do_page:boolean;
+label fin_set,fin_rule,move_right,show_state,done,9998,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!a:integer; {byte number of the current command}
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+begin cur_font:=invalid_font; {set current font undefined}
+s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0;
+ {initialize the state variables}
+while true do @<Translate the next command in the \.{DVI} file;
+ |goto 9999| with |do_page=true| if it was |eop|;
+ |goto 9998| if premature termination is needed@>;
+9998: print_ln('!'); do_page:=false;
+9999: end;
+
+@ Commands are broken down into ``major'' and ``minor'' categories:
+A major command is always shown in full, while a minor one is
+put into the buffer in abbreviated form. Minor commands, which
+account for the bulk of most \.{DVI} files, involve horizontal spacing
+and the typesetting of characters in a line; these are shown in full
+only if |out_mode>=verbose|.
+
+@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#);
+ end
+@d major(#)==if out_mode>errors_only then show(#)
+@d minor(#)==if out_mode>terse then
+ begin showing:=true; print(a:1,': ',#);
+ end
+@d error(#)==if not showing then show(#) else print(' ',#)
+
+@<Translate the next command...@>=
+begin a:=cur_loc; showing:=false;
+o:=get_byte; p:=first_par(o);
+if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+@<Start translation of command |o| and |goto| the appropriate label to
+ finish the job@>;
+fin_set: @<Finish a command that either sets or puts a character, then
+ |goto move_right| or |done|@>;
+fin_rule: @<Finish a command that either sets or puts a rule, then
+ |goto move_right| or |done|@>;
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+show_state: @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|,
+ |hh|, and |vv|; then |goto done|@>;
+done: if showing then print_ln(' ');
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_page| is organized by the semantics.
+
+@<Start translation...@>=
+if o<set_char_0+128 then @<Translate a |set_char| command@>
+else case o of
+ four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set;
+ end;
+ four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set;
+ end;
+ set_rule: begin major('setrule'); goto fin_rule;
+ end;
+ put_rule: begin major('putrule'); goto fin_rule;
+ end;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+ @t\4@>@<Cases for horizontal motion@>@;
+ othercases if special_cases(o,p,a) then goto done@+else goto 9998
+ endcases
+
+@ @<Declare the function called |special_cases|@>=
+function special_cases(@!o:eight_bits;@!p,@!a:integer):boolean;
+label change_font,move_down,done,9998;
+var q:integer; {parameter of the current command}
+@!k:integer; {loop index}
+@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
+@!pure:boolean; {is the command error-free?}
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+begin pure:=true;
+case o of
+@t\4@>@<Cases for vertical motion@>@;
+@t\4@>@<Cases for fonts@>@;
+four_cases(xxx1): @<Translate an |xxx| command and |goto done|@>;
+pre: begin error('preamble command within a page!'); goto 9998;
+ end;
+@.preamble command within a page@>
+post,post_post: begin error('postamble command within a page!'); goto 9998;
+@.postamble command within a page@>
+ end;
+othercases begin error('undefined command ',o:1,'!');
+ goto done;
+@.undefined command@>
+ end
+endcases;
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+change_font: @<Finish a command that changes the current font,
+ then |goto done|@>;
+9998: pure:=false;
+done: special_cases:=pure;
+end;
+
+@ @<Cases for commands |nop|, |bop|, \dots, |pop|@>=
+nop: begin minor('nop'); goto done;
+ end;
+bop: begin error('bop occurred before eop!'); goto 9998;
+@.bop occurred before eop@>
+ end;
+eop: begin major('eop');
+ if s<>0 then error('stack not empty at end of page (level ',
+ s:1,')!');
+@.stack not empty...@>
+ do_page:=true; print_ln(' '); goto 9999;
+ end;
+push: begin major('push');
+ if s=max_s_so_far then
+ begin max_s_so_far:=s+1;
+ if s=max_s then error('deeper than claimed in postamble!');
+@.deeper than claimed...@>
+@.push deeper than claimed...@>
+ if s=stack_size then
+ begin error('DVItype capacity exceeded (stack size=',
+ stack_size:1,')'); goto 9998;
+ end;
+ end;
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+ xstack[s]:=x; ystack[s]:=y; zstack[s]:=z;
+ hhstack[s]:=hh; vvstack[s]:=vv; incr(s); ss:=s-1; goto show_state;
+ end;
+pop: begin major('pop');
+ if s=0 then error('(illegal at level zero)!')
+ else begin decr(s); hh:=hhstack[s]; vv:=vvstack[s];
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+ x:=xstack[s]; y:=ystack[s]; z:=zstack[s];
+ end;
+ ss:=s; goto show_state;
+ end;
+
+@ Rounding to the nearest pixel is best done in the manner shown here, so as
+to be inoffensive to the eye: When the horizontal motion is small, like a
+kern, |hh| changes by rounding the kern; but when the motion is large, |hh|
+changes by rounding the true position |h| so that accumulated rounding errors
+disappear. We allow a larger space in the negative direction than in
+the positive one, because \TeX\ makes comparatively
+large backspaces when it positions accents.
+
+@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ begin out_text(" "); hh:=pixel_round(h+p);
+ end
+ else hh:=hh+pixel_round(p);
+ minor(#,' ',p:1); q:=p; goto move_right
+
+@<Cases for horizontal motion@>=
+four_cases(right1):begin out_space('right',o-right1+1:1);
+ end;
+w0,four_cases(w1):begin w:=p; out_space('w',o-w0:1);
+ end;
+x0,four_cases(x1):begin x:=p; out_space('x',o-x0:1);
+ end;
+
+@ Vertical motion is done similarly, but with the threshold between
+``small'' and ``large'' increased by a factor of five. The idea is to make
+fractions like ``$1\over2$'' round consistently, but to absorb accumulated
+rounding errors in the baseline-skip moves.
+
+@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p)
+ else vv:=vv+pixel_round(p);
+ major(#,' ',p:1); goto move_down
+
+@<Cases for vertical motion@>=
+four_cases(down1):begin out_vmove('down',o-down1+1:1);
+ end;
+y0,four_cases(y1):begin y:=p; out_vmove('y',o-y0:1);
+ end;
+z0,four_cases(z1):begin z:=p; out_vmove('z',o-z0:1);
+ end;
+
+@ @<Cases for fonts@>=
+sixty_four_cases(fnt_num_0): begin major('fntnum',p:1);
+ goto change_font;
+ end;
+four_cases(fnt1): begin major('fnt',o-fnt1+1:1,' ',p:1);
+ goto change_font;
+ end;
+four_cases(fnt_def1): begin major('fntdef',o-fnt_def1+1:1,' ',p:1);
+ define_font(p); goto done;
+ end;
+
+@ @<Translate an |xxx| command and |goto done|@>=
+begin major('xxx '''); bad_char:=false;
+if p<0 then error('string of negative length!');
+@.string of negative length@>
+for k:=1 to p do
+ begin q:=get_byte;
+ if (q<" ")or(q>"~") then bad_char:=true;
+ if showing then print(xchr[q]);
+ end;
+if showing then print('''');
+if bad_char then error('non-ASCII character in xxx command!');
+@.non-ASCII character...@>
+goto done;
+end
+
+@ @<Translate a |set_char|...@>=
+begin if (o>" ")and(o<="~") then
+ begin out_text(p); minor('setchar',p:1);
+ end
+else major('setchar',p:1);
+goto fin_set;
+end
+
+@ @<Finish a command that either sets or puts a character...@>=
+if p<0 then p:=255-((-1-p) mod 256)
+else if p>=256 then p:=p mod 256; {width computation for oriental fonts}
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+if (p<font_bc[cur_font])or(p>font_ec[cur_font]) then q:=invalid_width
+else q:=char_width(cur_font)(p);
+if q=invalid_width then
+ begin error('character ',p:1,' invalid in font ');
+@.character $c$ invalid...@>
+ print_font(cur_font);
+ if cur_font<>invalid_font then
+ print('!'); {the invalid font has `\.!' in its name}
+ end;
+if o>=put1 then goto done;
+if q=invalid_width then q:=0
+else hh:=hh+char_pixel_width(cur_font)(p);
+goto move_right
+
+@ @<Finish a command that either sets or puts a rule...@>=
+q:=signed_quad;
+if showing then
+ begin print(' height ',p:1,', width ',q:1);
+ if out_mode>mnemonics_only then
+ if (p<=0)or(q<=0) then print(' (invisible)')
+ else print(' (',rule_pixels(p):1,'x',rule_pixels(q):1,' pixels)');
+ end;
+if o=put_rule then goto done;
+if showing then if out_mode>mnemonics_only then print_ln(' ');
+hh:=hh+rule_pixels(q); goto move_right
+
+@ A sequence of consecutive rules, or consecutive characters in a fixed-width
+font whose width is not an integer number of pixels, can cause |hh| to drift
+far away from a correctly rounded value. \.{DVItype} ensures that the
+amount of drift will never exceed |max_drift| pixels.
+
+Since \.{DVItype} is intended to diagnose strange errors, it checks
+carefully to make sure that |h| and |v| do not get out of range.
+Normal \.{DVI}-reading programs need not do this.
+
+@d infinity==@'17777777777 {$\infty$ (approximately)}
+@d max_drift=2 {we insist that abs|(hh-pixel_round(h))<=max_drift|}
+
+@<Finish a command that sets |h:=h+q|, then |goto done|@>=
+if (h>0)and(q>0) then if h>infinity-q then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ q:1,' to ',infinity-h:1);
+ q:=infinity-h;
+ end;
+if (h<0)and(q<0) then if -h>q+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ q:1, ' to ',(-h)-infinity:1);
+ q:=(-h)-infinity;
+ end;
+hhh:=pixel_round(h+q);
+if abs(hhh-hh)>max_drift then
+ if hhh>hh then hh:=hhh-max_drift
+ else hh:=hhh+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' h:=',h:1);
+ if q>=0 then print('+');
+ print(q:1,'=',h+q:1,', hh:=',hh:1);
+ end;
+h:=h+q;
+if abs(h)>max_h_so_far then
+ begin if abs(h)>max_h+99 then
+ begin error('warning: |h|>',max_h:1,'!');
+@.warning: |h|...@>
+ max_h:=abs(h);
+ end;
+ max_h_so_far:=abs(h);
+ end;
+goto done
+
+@ @<Finish a command that sets |v:=v+p|, then |goto done|@>=
+if (v>0)and(p>0) then if v>infinity-p then
+ begin error('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ p:1,' to ',infinity-v:1);
+ p:=infinity-v;
+ end;
+if (v<0)and(p<0) then if -v>p+infinity then
+ begin error('arithmetic overflow! parameter changed from ',
+ p:1, ' to ',(-v)-infinity:1);
+ p:=(-v)-infinity;
+ end;
+vvv:=pixel_round(v+p);
+if abs(vvv-vv)>max_drift then
+ if vvv>vv then vv:=vvv-max_drift
+ else vv:=vvv+max_drift;
+if showing then if out_mode>mnemonics_only then
+ begin print(' v:=',v:1);
+ if p>=0 then print('+');
+ print(p:1,'=',v+p:1,', vv:=',vv:1);
+ end;
+v:=v+p;
+if abs(v)>max_v_so_far then
+ begin if abs(v)>max_v+99 then
+ begin error('warning: |v|>',max_v:1,'!');
+@.warning: |v|...@>
+ max_v:=abs(v);
+ end;
+ max_v_so_far:=abs(v);
+ end;
+goto done
+
+@ @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|...@>=
+if showing then if out_mode>mnemonics_only then
+ begin print_ln(' ');
+ print('level ',ss:1,':(h=',h:1,',v=',v:1,
+ ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1,
+ ',hh=',hh:1,',vv=',vv:1,')');
+ end;
+goto done
+
+@ @<Finish a command that changes the current font...@>=
+font_num[nf]:=p; cur_font:=0;
+while font_num[cur_font]<>p do incr(cur_font);
+if cur_font=nf then
+ begin cur_font:=invalid_font;
+ error('invalid font selection: font ',p:1,' was never defined!');
+ end;
+if showing then if out_mode>mnemonics_only then
+ begin print(' current font is '); print_font(cur_font);
+ end;
+goto done
+
+@* Skipping pages.
+A routine that's much simpler than |do_page| is used to pass over
+pages that are not being translated. The |skip_pages| subroutine
+is assumed to begin just after the preamble has been read, or just
+after a |bop| has been processed. It continues until either finding a
+|bop| that matches the desired starting page specifications, or until
+running into the postamble.
+
+@p @t\4@>@<Declare the procedure called |scan_bop|@>@;
+procedure skip_pages(@!bop_seen:boolean);
+label 9999; {end of this subroutine}
+var p:integer; {a parameter}
+@!k:0..255; {command code}
+@!down_the_drain:integer; {garbage}
+begin showing:=false;
+while true do
+ begin if not bop_seen then
+ begin scan_bop;
+ if in_postamble then goto 9999;
+ if not started then if start_match then
+ begin started:=true; goto 9999;
+ end;
+ end;
+ @<Skip until finding |eop|@>;
+ bop_seen:=false;
+ end;
+9999:end;
+
+@ @<Skip until finding |eop|@>=
+repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ p:=first_par(k);
+ case k of
+ set_rule,put_rule: down_the_drain:=signed_quad;
+ four_cases(fnt_def1): begin define_font(p);
+ print_ln(' ');
+ end;
+ four_cases(xxx1): while p>0 do
+ begin down_the_drain:=get_byte; decr(p);
+ end;
+ bop,pre,post,post_post,undefined_commands:
+ bad_dvi('illegal command at byte ',cur_loc-1:1);
+@.illegal command at byte n@>
+ othercases do_nothing
+ endcases;
+until k=eop;
+
+@ Global variables called |old_backpointer| and |new_backpointer|
+are used to check whether the back pointers are properly set up.
+Another one tells whether we have already found the starting page.
+
+@<Glob...@>=
+@!old_backpointer:integer; {the previous |bop| command location}
+@!new_backpointer:integer; {the current |bop| command location}
+@!started:boolean; {has the starting page been found?}
+
+@ @<Set init...@>=
+old_backpointer:=-1; started:=false;
+
+@ The |scan_bop| procedure reads \.{DVI} commands following the preamble
+or following |eop|, until finding either |bop| or the postamble.
+
+@<Declare the procedure called |scan_bop|@>=
+procedure scan_bop;
+var k:0..255; {command code}
+begin repeat if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+ k:=get_byte;
+ if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin define_font(first_par(k)); k:=nop;
+ end;
+until k<>nop;
+if k=post then in_postamble:=true
+else begin if k<>bop then bad_dvi('byte ',cur_loc-1:1,' is not bop');
+@.byte n is not bop@>
+ new_backpointer:=cur_loc-1; incr(page_count);
+ for k:=0 to 9 do count[k]:=signed_quad;
+ if signed_quad<>old_backpointer
+ then print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ old_backpointer:=new_backpointer;
+ end;
+end;
+
+@* Using the backpointers.
+The routines in this section of the program are brought into play only
+if |random_reading| is |true| (and only if |out_mode=the_works|).
+First comes a routine that illustrates how to find the postamble quickly.
+
+@<Find the postamble, working back from the end@>=
+n:=dvi_length;
+if n<53 then bad_dvi('only ',n:1,' bytes long');
+@.only n bytes long@>
+m:=n-4;
+repeat if m=0 then bad_dvi('all 223s');
+@.all 223s@>
+move_to_byte(m); k:=get_byte; decr(m);
+until k<>223;
+if k<>id_byte then bad_dvi('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(m-3); q:=signed_quad;
+if (q<0)or(q>m-33) then bad_dvi('post pointer ',q:1,' at byte ',m-3:1);
+@.post pointer is wrong@>
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_dvi('byte ',q:1,' is not post');
+@.byte n is not post@>
+post_loc:=q; first_backpointer:=signed_quad
+
+@ Note that the last steps of the above code save the locations of the
+the |post| byte and the final |bop|. We had better declare these global
+variables, together with two more that we will need shortly.
+
+@<Glob...@>=
+@!post_loc:integer; {byte location where the postamble begins}
+@!first_backpointer:integer; {the pointer following |post|}
+@!start_loc:integer; {byte location of the first page to process}
+@!after_pre:integer; {byte location immediately following the preamble}
+
+@ The next little routine shows how the backpointers can be followed
+to move through a \.{DVI} file in reverse order. Ordinarily a \.{DVI}-reading
+program would do this only if it wants to print the pages backwards or
+if it wants to find a specified starting page that is not necessarily the
+first page in the file; otherwise it would of course be simpler and faster
+just to read the whole file from the beginning.
+
+@<Count the pages and move to the starting page@>=
+q:=post_loc; p:=first_backpointer; start_loc:=-1;
+if p<0 then in_postamble:=true
+else begin repeat
+ {now |q| points to a |post| or |bop| command; |p>=0| is prev pointer}
+ if p>q-46 then
+ bad_dvi('page link ',p:1,' after byte ',q:1);
+@.page link wrong...@>
+ q:=p; move_to_byte(q); k:=get_byte;
+ if k=bop then incr(page_count)
+ else bad_dvi('byte ',q:1,' is not bop');
+@.byte n is not bop@>
+ for k:=0 to 9 do count[k]:=signed_quad;
+ p:=signed_quad;
+ if start_match then
+ begin start_loc:=q; old_backpointer:=p;
+ end;
+ until p<0;
+ if start_loc<0 then abort('starting page number could not be found!');
+@.starting page number...@>
+ if old_backpointer<0 then start_loc:=after_pre; {we want to check everything}
+ move_to_byte(start_loc);
+ end;
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!')
+@.there are really n pages@>
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{DVI} file and positioned just
+four bytes after the |post| command. That, in fact, is the situation,
+when the following part of \.{DVItype} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p,@!q,@!m:integer; {general purpose registers}
+begin showing:=false; post_loc:=cur_loc-5;
+print_ln('Postamble starts at byte ',post_loc:1,'.');
+@.Postamble starts at byte n@>
+if signed_quad<>numerator then
+ print_ln('numerator doesn''t match the preamble!');
+@.numerator doesn't match@>
+if signed_quad<>denominator then
+ print_ln('denominator doesn''t match the preamble!');
+@.denominator doesn't match@>
+if signed_quad<>mag then if new_mag=0 then
+ print_ln('magnification doesn''t match the preamble!');
+@.magnification doesn't match@>
+max_v:=signed_quad; max_h:=signed_quad;@/
+print('maxv=',max_v:1,', maxh=',max_h:1);@/
+max_s:=get_two_bytes; total_pages:=get_two_bytes;@/
+print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1);
+if out_mode<the_works then
+ @<Compare the \\{lust} parameters with the accumulated facts@>;
+@<Process the font definitions of the postamble@>;
+@<Make sure that the end of the file is well-formed@>;
+end;
+
+@ No warning is given when |max_h_so_far| exceeds |max_h| by less than~100,
+since 100 units is invisibly small; it's approximately the wavelength of
+visible light, in the case of \TeX\ output. Rounding errors can be expected
+to make |h| and |v| slightly more than |max_h| and |max_v|, every once in
+a~while; hence small discrepancies are not cause for alarm.
+
+@<Compare the \\{lust}...@>=
+begin if max_v+99<max_v_so_far then
+ print_ln('warning: observed maxv was ',max_v_so_far:1);
+@.warning: observed maxv...@>
+@.observed maxv was x@>
+if max_h+99<max_h_so_far then
+ print_ln('warning: observed maxh was ',max_h_so_far:1);
+@.warning: observed maxh...@>
+@.observed maxh was x@>
+if max_s<max_s_so_far then
+ print_ln('warning: observed maxstackdepth was ',max_s_so_far:1);
+@.warning: observed maxstack...@>
+@.observed maxstackdepth was x@>
+if page_count<>total_pages then
+ print_ln('there are really ',page_count:1,' pages, not ',total_pages:1,'!');
+end
+@.there are really n pages@>
+
+@ When we get to the present code, the |post_post| command has
+just been read.
+
+@<Make sure that the end of the file is well-formed@>=
+q:=signed_quad;
+if q<>post_loc then
+ print_ln('bad postamble pointer in byte ',cur_loc-4:1,'!');
+@.bad postamble pointer@>
+m:=get_byte;
+if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1,
+@.identification...should be n@>
+ ' should be ',id_byte:1,'!');
+k:=cur_loc; m:=223;
+while (m=223)and not eof(dvi_file) do m:=get_byte;
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ print_ln('not enough signature bytes at end of file (',
+@.not enough signature bytes...@>
+ cur_loc-k:1,')');
+
+@ @<Process the font definitions...@>=
+repeat k:=get_byte;
+if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin p:=first_par(k); define_font(p); print_ln(' '); k:=nop;
+ end;
+until k<>nop;
+if k<>post_post then
+ print_ln('byte ',cur_loc-1:1,' is not postpost!')
+@.byte n is not postpost@>
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{DVItype} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+dialog; {set up all the options}
+@<Process the preamble@>;
+if out_mode=the_works then {|random_reading=true|}
+ begin @<Find the postamble, working back from the end@>;
+ in_postamble:=true; read_postamble; in_postamble:=false;
+ @<Count the pages and move to the starting page@>;
+ end;
+skip_pages(false);
+if not in_postamble then @<Translate up to |max_pages| pages@>;
+if out_mode<the_works then
+ begin if not in_postamble then skip_pages(true);
+ if signed_quad<>old_backpointer then
+ print_ln('backpointer in byte ',cur_loc-4:1,
+ ' should be ',old_backpointer:1,'!');
+@.backpointer...should be p@>
+ read_postamble;
+ end;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!m,@!n,@!p,@!q:integer; {general purpose registers}
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{DVItype} looks at the preamble in order to do error
+checking, and to display the introductory comment.
+
+@<Process the preamble@>=
+open_dvi_file;
+p:=get_byte; {fetch the first byte}
+if p<>pre then bad_dvi('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+p:=get_byte; {fetch the identification byte}
+if p<>id_byte then
+ print_ln('identification in byte 1 should be ',id_byte:1,'!');
+@.identification...should be n@>
+@<Compute the conversion factors@>;
+p:=get_byte; {fetch the length of the introductory comment}
+print('''');
+while p>0 do
+ begin decr(p); print(xchr[get_byte]);
+ end;
+print_ln('''');
+after_pre:=cur_loc
+
+@ The conversion factor |conv| is figured as follows: There are exactly
+|n/d| decimicrons per \.{DVI} unit, and 254000 decimicrons per inch,
+and |resolution| pixels per inch. Then we have to adjust this
+by the stated amount of magnification.
+
+@<Compute the conversion factors@>=
+numerator:=signed_quad; denominator:=signed_quad;
+if numerator<=0 then bad_dvi('numerator is ',numerator:1);
+@.numerator is wrong@>
+if denominator<=0 then bad_dvi('denominator is ',denominator:1);
+@.denominator is wrong@>
+print_ln('numerator/denominator=',numerator:1,'/',denominator:1);
+tfm_conv:=(25400000.0/numerator)*(denominator/473628672)/16.0;
+conv:=(numerator/254000.0)*(resolution/denominator);
+mag:=signed_quad;
+if new_mag>0 then mag:=new_mag
+else if mag<=0 then bad_dvi('magnification is ',mag:1);
+@.magnification is wrong@>
+true_conv:=conv; conv:=true_conv*(mag/1000.0);
+print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit')
+
+@ The code shown here uses a convention that has proved to be useful:
+If the starting page was specified as, e.g., `\.{1.*.-5}', then
+all page numbers in the file are displayed by showing the values of
+counts 0, 1, and~2, separated by dots. Such numbers can, for example,
+be displayed on the console of a printer when it is working on that
+page.
+
+@<Translate up to...@>=
+begin while max_pages>0 do
+ begin decr(max_pages);
+ print_ln(' '); print(cur_loc-45:1,': beginning of page ');
+ for k:=0 to start_vals do
+ begin print(count[k]:1);
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+ if not do_page then bad_dvi('page ended unexpectedly');
+@.page ended unexpectedly@>
+ scan_bop;
+ if in_postamble then goto done;
+ end;
+done:end
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/systems/knuth/dist/texware/pltotf.web b/systems/knuth/dist/texware/pltotf.web
new file mode 100644
index 0000000000..d68e1e1b23
--- /dev/null
+++ b/systems/knuth/dist/texware/pltotf.web
@@ -0,0 +1,2518 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people.
+% Hex was added in September 1982, and the result became "Version 1".
+% Version 1.1 fixed a bug in section 28 (since eoln is undefined after eof).
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 fixed a bug in section 115 (TOP, MID, and BOT can be zero)
+% Version 1.3 (April 1983) blanked out unused BCPL header bytes
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (May 1985) added checksum computation to match METAFONT.
+% Version 2.3 (August 1985) introduced `backup' to fix a minor bug.
+% Version 3 (October 1989) introduced extended ligature features.
+% Version 3.1 (November 1989) fixed two bugs (notably min_nl:=0).
+% Version 3.2 (December 1989) improved `shorten', increased max_letters.
+% Version 3.3 (September 1990) fixed `nonexistent char 0' (John Gourlay).
+% Version 3.4 (March 1991) has more robust `out_scaled' (Wayne Sullivan).
+% Version 3.5 (March 1995) initialized lk_step_ended (Armin K\"ollner).
+% Version 3.6 (January 2014) corrected possible end-of-line glitch (Ken Nakano),
+% and get_fix now treats -- as + (Peter Breitenlohner).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=logo10 % for the METAFONT logo
+\def\MF{{\logo METAFONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{PL\lowercase{to}TF}
+\def\contentspagenumber{301}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PLtoTF} processor}
+ \vskip 15pt
+ \centerline{(Version 3.6, January 2014)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{PLtoTF} utility program converts property-list (``\.{PL}'')
+files into equivalent \TeX\ font metric (``\.{TFM}'') files. It also
+makes a thorough check of the given \.{PL} file, so that the \.{TFM}
+file should be acceptable to \TeX.
+
+The first \.{PLtoTF} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by the author in 1989.
+
+The |banner| string defined here should be changed whenever \.{PLtoTF}
+gets modified.
+
+@d banner=='This is PLtoTF, Version 3.6' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it has to do some slightly system-dependent character code conversion
+on input. Furthermore, lower case letters are used in error messages;
+they could be converted to upper case if necessary. The input is read
+from |pl_file|, and the output is written on |tfm_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{PLtoTF}'s capacity.
+
+@<Constants...@>=
+@!buf_size=60; {length of lines displayed in error messages}
+@!max_header_bytes=100; {four times the maximum number of words allowed in
+ the \.{TFM} file header block, must be 1024 or less}
+@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
+@!max_lig_steps=5000;
+ {maximum length of ligature program, must be at most $32767-257=32510$}
+@!max_kerns=500; {the maximum number of distinct kern values}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Property list description of font metric data.
+The idea behind \.{PL} files is that precise details about fonts, i.e., the
+facts that are needed by typesetting routines like \TeX, sometimes have to
+be supplied by hand. The nested property-list format provides a reasonably
+convenient way to do this.
+
+A good deal of computation is necessary to parse and process a
+\.{PL} file, so it would be inappropriate for \TeX\ itself to do this
+every time it loads a font. \TeX\ deals only with the compact descriptions
+of font metric data that appear in \.{TFM} files. Such data is so compact,
+however, it is almost impossible for anybody but a computer to read it.
+The purpose of \.{PLtoTF} is to convert from a human-oriented file of text
+to a computer-oriented file of binary numbers.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+reset(pl_file);
+
+@ A \.{PL} file is a list of entries of the form
+$$\.{(PROPERTYNAME VALUE)}$$
+where the property name is one of a finite set of names understood by
+this program, and the value may itself in turn be a property list.
+The idea is best understood by looking at an example, so let's consider
+a fragment of the \.{PL} file for a hypothetical font.
+$$\vbox{\halign{\.{#}\hfil\cr
+(FAMILY NOVA)\cr
+(FACE F MIE)\cr
+(CODINGSCHEME ASCII)\cr
+(DESIGNSIZE D 10)\cr
+(DESIGNUNITS D 18)\cr
+(COMMENT A COMMENT IS IGNORED)\cr
+(COMMENT (EXCEPT THIS ONE ISN'T))\cr
+(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
+\qquad\qquad IT SAYS IT ISN'T))\cr
+(FONTDIMEN\cr
+\qquad (SLANT R -.25)\cr
+\qquad (SPACE D 6)\cr
+\qquad (SHRINK D 2)\cr
+\qquad (STRETCH D 3)\cr
+\qquad (XHEIGHT R 10.55)\cr
+\qquad (QUAD D 18)\cr
+\qquad )\cr
+(LIGTABLE\cr
+\qquad (LABEL C f)\cr
+\qquad (LIG C f O 200)\cr
+\qquad (SKIP D 1)\cr
+\qquad (LABEL O 200)\cr
+\qquad (LIG C i O 201)\cr
+\qquad (KRN O 51 R 1.5)\cr
+\qquad (/LIG C ? C f)\cr
+\qquad (STOP)\cr
+\qquad )\cr
+(CHARACTER C f\cr
+\qquad (CHARWD D 6)\cr
+\qquad (CHARHT R 13.5)\cr
+\qquad (CHARIC R 1.5)\cr
+\qquad )\cr}}$$
+This example says that the font whose metric information is being described
+belongs to the hypothetical
+\.{NOVA} family; its face code is medium italic extended;
+and the characters appear in ASCII code positions. The design size is 10 points,
+and all other sizes in this \.{PL} file are given in units such that 18 units
+equals the design size. The font is slanted with a slope of $-.25$ (hence the
+letters actually slant backward---perhaps that is why the family name is
+\.{NOVA}). The normal space between words is 6 units (i.e., one third of
+the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
+The letters for which accents don't need to be raised or lowered are 10.55
+units high, and one em equals 18 units.
+
+The example ligature table is a bit trickier. It specifies that the
+letter \.f followed by another \.f is changed to code @'200, while
+code @'200 followed by \.i is changed to @'201; presumably codes @'200
+and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
+\.f and @'200, if the following character is the code @'51 (which is a
+right parenthesis), an additional 1.5 units of space should be inserted
+before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
+\.{KRN} command, which in this case is the second \.{LIG}; in this way
+two different ligature/kern programs can come together.)
+Finally, if either \.f or @'200 is followed by a question mark,
+the question mark is replaced by \.f and the ligature program is
+started over. (Thus, the character pair `\.{f?}' would actually become
+the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
+avoid this restart procedure, the \.{/LIG} command could be replaced
+by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
+would become `f\kern0ptff'.)
+
+Character \.f itself is 6 units wide and 13.5 units tall, in this example.
+Its depth is zero (since \.{CHARDP} is not given), and its italic correction
+is 1.5 units.
+
+@ The example above illustrates most of the features found in \.{PL} files.
+Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
+string as their value; this string continues until the first unmatched
+right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
+and \.{LABEL}, take a number as their value. This number can be expressed in
+a variety of ways, indicated by a prefixed code; \.D stands for decimal,
+\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
+\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
+their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
+\.{CHARACTER}, have more complicated values that involve property lists.
+
+A property name is supposed to be used only in an appropriate property
+list. For example, \.{CHARWD} shouldn't occur on the outer level or
+within \.{FONTDIMEN}.
+
+The individual property-and-value pairs in a property list can appear in
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
+example, although the \.{TFM} file always puts the stretch parameter first.
+One could even give the information about characters like `\.f' before
+specifying the number of units in the design size, or before specifying the
+ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
+to this rule; the individual elements of the \.{LIGTABLE} property list
+can be reordered only to a certain extent without changing the meaning
+of that table.
+
+If property-and-value pairs are omitted, a default value is used. For example,
+we have already noted that the default for \.{CHARDP} is zero. The default
+for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
+below.
+
+If the same property name is used more than once, \.{PLtoTF} will not notice
+the discrepancy; it simply uses the final value given. Once again, however, the
+\.{LIGTABLE} is an exception to this rule; \.{PLtoTF} will complain if there
+is more than one label for some character. And of course many of the
+entries in the \.{LIGTABLE} property list have the same property name.
+
+From these rules, you can guess (correctly) that \.{PLtoTF} operates in four
+main steps. First it assigns the default values to all properties; then it scans
+through the \.{PL} file, changing property values as new ones are seen; then
+it checks the information and corrects any problems; and finally it outputs
+the \.{TFM} file.
+
+@ Instead of relying on a hypothetical example, let's consider a complete
+grammar for \.{PL} files. At the outer level, the following property names
+are valid:
+
+\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
+nonnegative integer less than $2^{32}$, is used to identify a particular
+version of a font; it should match the check sum value stored with the font
+itself. An explicit check sum of zero is used to bypass
+check sum testing. If no checksum is specified in the \.{PL} file,
+\.{PLtoTF} will compute the checksum that \MF\ would compute from the
+same data.
+
+\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
+should be a real number in the range |1.0<=x<2048|, represents the default
+amount by which all quantities will be scaled if the font is not loaded
+with an `\.{at}' specification. For example, if one says
+`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
+file is ignored and effectively replaced by 15 points; but if one simply
+says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
+always in units of printer's points.
+
+\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
+should be a positive real number; it says how many units equals the design
+size (or the eventual `\.{at}' size, if the font is being scaled). For
+example, suppose you have a font that has been digitized with 600 pixels per
+em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
+if you wanted to give all of your measurements in units of pixels.
+
+\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 40.
+It identifies the correspondence between the numeric codes and font characters.
+(\TeX\ ignores this information, but other software programs make use of it.)
+
+\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
+The string should not contain parentheses, and its length must be less than 20.
+It identifies the name of the family to which this font belongs, e.g.,
+`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
+example, when converting \.{DVI} files to \.{PRESS} files for Xerox
+equipment.)
+
+\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
+0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
+family. For example, bold italic condensed fonts might have the same family name
+as light roman extended fonts, differing only in their face byte. (\TeX\
+ignores this information; but it is needed, for example, when converting
+\.{DVI} files to \.{PRESS} files for Xerox equipment.)
+
+\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
+value should start with either `\.T' (true) or `\.F' (false). If true, character
+codes less than 128 cannot lead to codes of 128 or more via ligatures or
+charlists or extensible characters. (\TeX82 ignores this flag, but older
+versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
+\.{PLtoTF} computes the correct value of this flag and gives an error message
+only if a claimed ``true'' value is incorrect.
+
+\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
+The one-byte value should be between 18 and a maximum limit that can be
+raised or lowered depending on the compile-time setting of |max_header_bytes|.
+The four-byte value goes into the header word whose index is the one-byte
+value; for example, to set |header[18]:=1|, one may write
+`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
+is presently unnamed. (\TeX\ ignores it.)
+
+\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
+allowed in this property list.
+
+\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
+about this special kind of property list.
+
+\yskip\hang\.{BOUNDARYCHAR} (one-byte value). If this character appears in
+a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
+If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
+within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
+
+\yskip\hang\.{CHARACTER}. The value is a one-byte integer followed by
+a property list. The integer represents the number of a character that is
+present in the font; the property list of a character is defined below.
+The default is an empty property list.
+
+@ Numeric property list values can be given in various forms identified by
+a prefixed letter.
+
+\yskip\hang\.C denotes an ASCII character, which should be a standard visible
+character that is not a parenthesis. The numeric value will therefore be
+between @'41 and @'176 but not @'50 or @'51.
+
+\yskip\hang\.D denotes a decimal integer, which must be nonnegative and
+less than 256. (Use \.R for larger values or for negative values.)
+
+\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
+are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
+\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
+\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
+
+\yskip\hang\.O denotes an unsigned octal integer, which must be less than
+$2^{32}$, i.e., at most `\.{O 37777777777}'.
+
+\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
+$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
+
+\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
+by a `\.+' or `\.-' sign, and optionally including a decimal point. The
+absolute value must be less than 2048.
+
+@ The property names allowed in a \.{FONTDIMEN} property list correspond to
+various \TeX\ parameters, each of which has a (real) numeric value. All
+of the parameters except \.{SLANT} are in design units. The admissible
+names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
+\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
+\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
+\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
+1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
+\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
+\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
+8 to 13.
+
+The notation `\.{PARAMETER} $n$' provides another way to specify the
+$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
+to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
+and less than |max_param_words|.
+
+@ The elements of a \.{CHARACTER} property list can be of six different types.
+
+\yskip\hang\.{CHARWD} (real value) denotes the character's width in
+design units.
+
+\yskip\hang\.{CHARHT} (real value) denotes the character's height in
+design units.
+
+\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
+design units.
+
+\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
+design units.
+
+\yskip\hang\.{NEXTLARGER} (one-byte value), specifies the character that
+follows the present one in a ``charlist.'' The value must be the number of a
+character in the font, and there must be no infinite cycles of supposedly
+larger and larger characters.
+
+\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
+This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
+both be used within the same \.{CHARACTER} list.
+
+\yskip\noindent
+The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
+\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
+of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
+that the corresponding piece of the extensible character is absent. A nonzero
+value, or a \.{REP} value of zero, denotes the character code used to make
+up the top, middle, bottom, or replicated piece of an extensible character.
+
+@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
+program in a simple command language that \TeX\ uses for ligatures and kerns.
+If several \.{LIGTABLE} lists appear, they are effectively concatenated into
+a single list.
+
+\yskip\hang\.{LABEL} (one-byte value) means that the program for the
+stated character value starts here. The integer must be the number of a
+character in the font; its \.{CHARACTER} property list must not have a
+\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
+must follow.
+
+\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
+beginning-of-word ligatures starts here.
+
+\yskip\hang\.{LIG} (two one-byte values). The instruction `\.{(LIG} $c$ $r$\.)'
+means, ``If the next character is $c$, then insert character~$r$ and
+possibly delete the current character and/or~$c$;
+otherwise go on to the next instruction.''
+Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
+preceded or followed by a slash, and then immediately followed by \.>
+characters not exceeding the number of slashes. Thus there are eight
+possible forms:
+$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
+\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
+The slashes specify retention of the left or right original character; the
+\.> signs specify passing over the result without further ligature processing.
+
+\yskip\hang\.{KRN} (a one-byte value and a real value). The instruction
+`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
+a blank space of width $r$ between the current character character and $c$;
+otherwise go on to the next intruction.'' The value of $r$, which is in
+design units, is often negative. Character code $c$ must exist
+in the font.
+
+\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
+It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
+or \.{STOP} or \.{SKIP}.
+
+\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
+continuation of a ligature/kern program after the specified number of \.{LIG}
+or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and
+\.{KRN} instructions must therefore exceed this specified amount.
+
+@ In addition to all these possibilities, the property name \.{COMMENT} is
+allowed in any property list. Such comments are ignored.
+
+@ So that is what \.{PL} files hold. The next question is, ``What about
+\.{TFM} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{TFtoPL}, so it will not
+be repeated here. Suffice it to say that a \.{TFM} file stores all of the
+relevant font information in a sequence of 8-bit bytes. The number of
+bytes is always a multiple of 4, so we could regard the \.{TFM} file
+as a sequence of 32-bit words; but \TeX\ uses the byte interpretation,
+and so does \.{PLtoTF}. Note that the bytes are considered to be unsigned
+numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+
+@* Basic input routines.
+For the purposes of this program, a |byte| is an unsigned eight-bit quantity,
+and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
+correspond to one-character constants like \.{"A"} in \.{WEB} language.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
+
+@ One of the things \.{PLtoTF} has to do is convert characters of strings
+to ASCII form, since that is the code used for the family name and the
+coding scheme in a \.{TFM} file. An array |xord| is used to do the
+conversion from |char|; the method below should work with little or no change
+on most \PASCAL\ systems.
+@^system dependencies@>
+
+@d first_ord=0 {ordinal number of the smallest element of |char|}
+@d last_ord=127 {ordinal number of the largest element of |char|}
+
+@<Global...@>=
+@!xord:array[char] of ASCII_code; {conversion table}
+
+@ @<Local variables for init...@>=
+@!k:integer; {all-purpose initialization index}
+
+@ Characters that should not appear in \.{PL} files (except in comments)
+are mapped into @'177.
+
+@d invalid_code=@'177 {code deserving an error message}
+
+@<Set init...@>=
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
+xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
+xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
+xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
+xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
+xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
+xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
+xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
+xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
+xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
+xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
+xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
+xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
+xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
+xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
+xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
+xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
+xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
+xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
+xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
+
+@ In order to help catch errors of badly nested parentheses, \.{PLtoTF}
+assumes that the user will begin each line with a number of blank spaces equal
+to some constant times the number of open parentheses at the beginning of
+that line. However, the program doesn't know in advance what the constant
+is, nor does it want to print an error message on every line for a user
+who has followed no consistent pattern of indentation.
+
+Therefore the following strategy is adopted: If the user has been consistent
+with indentation for ten or more lines, an indentation error will be
+reported. The constant of indentation is reset on every line that should
+have nonzero indentation.
+
+@<Glob...@>=
+@!line:integer; {the number of the current line}
+@!good_indent:integer; {the number of lines since the last bad indentation}
+@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
+@!level: integer; {the current number of open parentheses}
+
+@ @<Set init...@>=
+line:=0; good_indent:=0; indent:=0; level:=0;
+
+@ The input need not really be broken into lines of any maximum length, and
+we could read it character by character without any buffering. But we shall
+place it into a small buffer so that offending lines can be displayed in error
+messages.
+
+@<Glob...@>=
+@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
+ at end-of-line marks?}
+@!limit:0..buf_size; {position of the last character present in the buffer}
+@!loc:0..buf_size; {position of the last character read in the buffer}
+@!buffer:array[1..buf_size] of char;
+@!input_has_ended:boolean; {there is no more input to read}
+
+@ @<Set init...@>=
+limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
+
+@ Just before each \.{CHARACTER} property list is evaluated, the character
+code is printed in octal notation. Up to eight such codes appear on a line;
+so we have a variable to keep track of how many are currently there.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+
+@ @<Set init...@>=
+chars_on_line:=0;
+
+@ The following routine prints an error message and an indication of
+where the error was detected. The error message should not include any
+final punctuation, since this procedure supplies its own.
+
+@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
+ print(#); show_error_context;
+ end
+
+@p procedure show_error_context; {prints the current scanner location}
+var k:0..buf_size; {an index into |buffer|}
+begin print_ln(' (line ',line:1,').');
+if not left_ln then print('...');
+for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
+print_ln(' ');
+if not left_ln then print(' ');
+for k:=1 to loc do print(' '); {space out the second line}
+for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
+if right_ln then print_ln(' ')@+else print_ln('...');
+chars_on_line:=0;
+end;
+
+@ Here is a procedure that does the right thing when we are done
+reading the present contents of the buffer. It keeps |buffer[buf_size]|
+empty, in order to avoid range errors on certain \PASCAL\ compilers.
+
+An infinite sequence of right parentheses is placed at the end of the
+file, so that the program is sure to get out of whatever level of nesting
+it is in.
+
+On some systems it is desirable to modify this code so that tab marks
+in the buffer are replaced by blank spaces. (Simply setting
+|xord[chr(@'11)]:=" "| would not work; for example, two-line
+error messages would not come out properly aligned.)
+@^system dependencies@>
+
+@p procedure fill_buffer;
+begin left_ln:=right_ln; limit:=0; loc:=0;
+if left_ln then
+ begin if line>0 then read_ln(pl_file);
+ incr(line);
+ end;
+if eof(pl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+ end
+else begin while (limit<buf_size-2)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
+ end;
+ buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
+ if right_ln then begin incr(limit); buffer[limit+1]:=' ';
+ end;
+ if left_ln then @<Set |loc| to the number of leading blanks in
+ the buffer, and check the indentation@>;
+ end;
+end;
+
+@ The interesting part about |fill_buffer| is the part that learns what
+indentation conventions the user is following, if any.
+
+@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
+ good_indent:=0; indent:=0;
+ end
+
+@<Set |loc|...@>=
+begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
+if loc<limit then
+ begin if level=0 then
+ if loc=0 then incr(good_indent)
+ else bad_indent('Warning: Indented line occurred at level zero')
+@.Warning: Indented line...@>
+ else if indent=0 then
+ if loc mod level=0 then
+ begin indent:=loc div level; good_indent:=1;
+ end
+ else good_indent:=0
+ else if indent*level=loc then incr(good_indent)
+ else bad_indent('Warning: Inconsistent indentation; ',
+@.Warning: Inconsistent indentation...@>
+ 'you are at parenthesis level ',level:1);
+ end;
+end
+
+@* Basic scanning routines.
+The global variable |cur_char| holds the ASCII code corresponding to the
+character most recently read from the input buffer, or to a character that
+has been substituted for the real one.
+
+@<Global...@>=
+@!cur_char:ASCII_code; {we have just read this}
+
+@ Here is a procedure that sets |cur_char| to an ASCII code for the
+next character of input, if that character is a letter or digit or slash
+or \.>. Otherwise
+it sets |cur_char:=" "|, and the input system will be poised to reread the
+character that was rejected, whether or not it was a space.
+Lower case letters are converted to upper case.
+
+@p procedure get_keyword_char;
+begin while (loc=limit)and(not right_ln) do fill_buffer;
+if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
+else begin cur_char:=xord[buffer[loc+1]];
+ if cur_char>="a" then cur_char:=cur_char-@'40;
+ if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
+ else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
+ else if cur_char="/" then incr(loc)
+ else if cur_char=">" then incr(loc)
+ else cur_char:=" ";
+ end;
+end;
+
+@ The following procedure sets |cur_char| to the next character code,
+and converts lower case to upper case. If the character is a left or
+right parenthesis, it will not be ``digested''; the character will
+be read again and again, until the calling routine does something
+like `|incr(loc)|' to get past it. Such special treatment of parentheses
+insures that the structural information they contain won't be lost in
+the midst of other error recovery operations.
+
+@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
+ end {undoes the effect of |get_next|}
+
+@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
+begin while loc=limit do fill_buffer;
+incr(loc); cur_char:=xord[buffer[loc]];
+if cur_char>="a" then
+ if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
+ else begin if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
+@.Illegal character...@>
+ cur_char:="?";
+ end;
+ end
+else if (cur_char<=")")and(cur_char>="(") then decr(loc);
+end;
+
+@ The next procedure is used to ignore the text of a comment, or to pass over
+erroneous material. As such, it has the privilege of passing parentheses.
+It stops after the first right parenthesis that drops the level below
+the level in force when the procedure was called.
+
+@p procedure skip_to_end_of_item;
+var l:integer; {initial value of |level|}
+begin l:=level;
+while level>=l do
+ begin while loc=limit do fill_buffer;
+ incr(loc);
+ if buffer[loc]=')' then decr(level)
+ else if buffer[loc]='(' then incr(level);
+ end;
+if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
+@.File ended unexpectedly...@>
+cur_char:=" "; {now the right parenthesis has been read and digested}
+end;
+
+@ Sometimes we merely want to skip past characters in the input until we
+reach a left or a right parenthesis. For example, we do this whenever we
+have finished scanning a property value and we hope that a right parenthesis
+is next (except for possible blank spaces).
+
+@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
+@d skip_error(#)==begin err_print(#); skip_to_paren;
+ end {this gets to the right parenthesis if something goes wrong}
+@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
+ end {this gets past the right parenthesis if something goes wrong}
+
+@ After a property value has been scanned, we want to move just past the
+right parenthesis that should come next in the input (except for possible
+blank spaces).
+
+@p procedure finish_the_property; {do this when the value has been scanned}
+begin while cur_char=" " do get_next;
+if cur_char<>")" then err_print('Junk after property value will be ignored');
+@.Junk after property value...@>
+skip_to_end_of_item;
+end;
+
+@* Scanning property names.
+We have to figure out the meaning of names that appear in the \.{PL} file,
+by looking them up in a dictionary of known keywords. Keyword number $n$
+appears in locations |start[n]| through |start[n+1]-1| of an array called
+|dictionary|.
+
+@d max_name_index=88 {upper bound on the number of keywords}
+@d max_letters=600 {upper bound on the total length of all keywords}
+
+@<Global...@>=
+@!start:array[1..max_name_index] of 0..max_letters;
+@!dictionary:array[0..max_letters] of ASCII_code;
+@!start_ptr:0..max_name_index; {the first available place in |start|}
+@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
+
+@ @<Set init...@>=
+start_ptr:=1; start[1]:=0; dict_ptr:=0;
+
+@ When we are looking for a name, we put it into the |cur_name| array.
+When we have found it, the corresponding |start| index will go into
+the global variable |name_ptr|.
+
+@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
+
+@<Glob...@>=
+@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
+@!name_length:0..longest_name; {its length}
+@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
+
+@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
+in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
+operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
+points into the |start| array.
+
+@d hash_prime=101 {size of the hash table}
+
+@<Glob...@>=
+@!nhash:array[0..hash_prime-1] of 0..max_name_index;
+@!cur_hash:0..hash_prime-1; {current position in the hash table}
+
+@ @<Local...@>=
+@!h:0..hash_prime-1; {runs through the hash table}
+
+@ @<Set init...@>=
+for h:=0 to hash_prime-1 do nhash[h]:=0;
+
+@ Since there is no chance of the hash table overflowing, the procedure
+is very simple. After |lookup| has done its work, |cur_hash| will point
+to the place where the given name was found, or where it should be inserted.
+
+@p procedure lookup; {finds |cur_name| in the dictionary}
+var k:0..longest_name; {index into |cur_name|}
+@!j:0..max_letters; {index into |dictionary|}
+@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
+begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
+not_found:=true;
+while not_found do
+ begin if cur_hash=0 then cur_hash:=hash_prime-1@+else decr(cur_hash);
+ if nhash[cur_hash]=0 then not_found:=false
+ else begin j:=start[nhash[cur_hash]];
+ if start[nhash[cur_hash]+1]=j+name_length then
+ begin not_found:=false;
+ for k:=1 to name_length do
+ if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
+ end;
+ end;
+ end;
+name_ptr:=nhash[cur_hash];
+end;
+
+@ @<Compute the hash...@>=
+cur_hash:=cur_name[1];
+for k:=2 to name_length do
+ cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
+
+@ The ``meaning'' of the keyword that begins at |start[k]| in the
+dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
+symbolic meanings by the following definitions.
+
+@d comment_code=0
+@d check_sum_code=1
+@d design_size_code=2
+@d design_units_code=3
+@d coding_scheme_code=4
+@d family_code=5
+@d face_code=6
+@d seven_bit_safe_flag_code=7
+@d header_code= 8
+@d font_dimen_code=9
+@d lig_table_code=10
+@d boundary_char_code=11
+@d character_code=12
+@d parameter_code=20
+@d char_info_code=50
+@d width=1
+@d height=2
+@d depth=3
+@d italic=4
+@d char_wd_code=char_info_code+width
+@d char_ht_code=char_info_code+height
+@d char_dp_code=char_info_code+depth
+@d char_ic_code=char_info_code+italic
+@d next_larger_code=55
+@d var_char_code=56
+@d label_code=70
+@d stop_code=71
+@d skip_code=72
+@d krn_code=73
+@d lig_code=74
+
+@<Glo...@>=
+@!equiv:array[0..max_name_index] of byte;
+@!cur_code:byte; {equivalent most recently found in |equiv|}
+
+@ We have to get the keywords into the hash table and into the dictionary in
+the first place (sigh). The procedure that does this has the desired
+|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
+for the initialization, the keyword being initialized is placed into the
+last positions of |cur_name|, instead of the first positions.
+
+@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
+var k:0..longest_name;
+begin for k:=1 to name_length do
+ cur_name[k]:=cur_name[k+longest_name-name_length];
+{now the name has been shifted into the correct position}
+lookup; {this sets |cur_hash| to the proper insertion place}
+nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
+for k:=1 to name_length do
+ begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+ end;
+incr(start_ptr); start[start_ptr]:=dict_ptr;
+end;
+
+@ Here are the macros to load a name of up to 20 letters into the
+dictionary. For example, the macro |load5| is used for five-letter keywords.
+
+@d tail(#)==enter_name(#)
+@d t20(#)==cur_name[20]:=#;tail
+@d t19(#)==cur_name[19]:=#;t20
+@d t18(#)==cur_name[18]:=#;t19
+@d t17(#)==cur_name[17]:=#;t18
+@d t16(#)==cur_name[16]:=#;t17
+@d t15(#)==cur_name[15]:=#;t16
+@d t14(#)==cur_name[14]:=#;t15
+@d t13(#)==cur_name[13]:=#;t14
+@d t12(#)==cur_name[12]:=#;t13
+@d t11(#)==cur_name[11]:=#;t12
+@d t10(#)==cur_name[10]:=#;t11
+@d t9(#)==cur_name[9]:=#;t10
+@d t8(#)==cur_name[8]:=#;t9
+@d t7(#)==cur_name[7]:=#;t8
+@d t6(#)==cur_name[6]:=#;t7
+@d t5(#)==cur_name[5]:=#;t6
+@d t4(#)==cur_name[4]:=#;t5
+@d t3(#)==cur_name[3]:=#;t4
+@d t2(#)==cur_name[2]:=#;t3
+@d t1(#)==cur_name[1]:=#;t2
+@d load3==name_length:=3;t18
+@d load4==name_length:=4;t17
+@d load5==name_length:=5;t16
+@d load6==name_length:=6;t15
+@d load7==name_length:=7;t14
+@d load8==name_length:=8;t13
+@d load9==name_length:=9;t12
+@d load10==name_length:=10;t11
+@d load11==name_length:=11;t10
+@d load12==name_length:=12;t9
+@d load13==name_length:=13;t8
+@d load14==name_length:=14;t7
+@d load15==name_length:=15;t6
+@d load16==name_length:=16;t5
+@d load17==name_length:=17;t4
+@d load18==name_length:=18;t3
+@d load19==name_length:=19;t2
+@d load20==name_length:=20;t1
+
+@ (Thank goodness for keyboard macros in the text editor used to create this
+\.{WEB} file.)
+
+@<Enter all of the names and their equivalents, except the parameter names@>=
+equiv[0]:=comment_code; {this is used after unknown keywords}
+load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
+load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
+load11("D")("E")("S")("I")("G")("N")
+ ("U")("N")("I")("T")("S")(design_units_code);@/
+load12("C")("O")("D")("I")("N")("G")
+ ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
+load6("F")("A")("M")("I")("L")("Y")(family_code);@/
+load4("F")("A")("C")("E")(face_code);@/
+load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
+ ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
+load6("H")("E")("A")("D")("E")("R")(header_code);@/
+load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
+load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
+load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
+ (boundary_char_code);@/
+load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
+load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
+load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
+load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
+load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
+load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
+load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
+load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
+load3("T")("O")("P")(var_char_code+1);@/
+load3("M")("I")("D")(var_char_code+2);@/
+load3("B")("O")("T")(var_char_code+3);@/
+load3("R")("E")("P")(var_char_code+4);@/
+load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
+load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
+load5("L")("A")("B")("E")("L")(label_code);@/
+load4("S")("T")("O")("P")(stop_code);@/
+load4("S")("K")("I")("P")(skip_code);@/
+load3("K")("R")("N")(krn_code);@/
+load3("L")("I")("G")(lig_code);@/
+load4("/")("L")("I")("G")(lig_code+2);@/
+load5("/")("L")("I")("G")(">")(lig_code+6);@/
+load4("L")("I")("G")("/")(lig_code+1);@/
+load5("L")("I")("G")("/")(">")(lig_code+5);@/
+load5("/")("L")("I")("G")("/")(lig_code+3);@/
+load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
+load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
+
+@ @<Enter the parameter names@>=
+load5("S")("L")("A")("N")("T")(parameter_code+1);@/
+load5("S")("P")("A")("C")("E")(parameter_code+2);@/
+load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
+load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
+load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
+load4("Q")("U")("A")("D")(parameter_code+6);@/
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load4("N")("U")("M")("1")(parameter_code+8);@/
+load4("N")("U")("M")("2")(parameter_code+9);@/
+load4("N")("U")("M")("3")(parameter_code+10);@/
+load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
+load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
+load4("S")("U")("P")("1")(parameter_code+13);@/
+load4("S")("U")("P")("2")(parameter_code+14);@/
+load4("S")("U")("P")("3")(parameter_code+15);@/
+load4("S")("U")("B")("1")(parameter_code+16);@/
+load4("S")("U")("B")("2")(parameter_code+17);@/
+load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
+load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
+load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
+load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
+load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
+load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
+ ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
+load13("B")("I")("G")("O")("P")
+ ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
+
+@ When a left parenthesis has been scanned, the following routine
+is used to interpret the keyword that follows, and to store the
+equivalent value in |cur_code|.
+
+@p procedure get_name;
+begin incr(loc); incr(level); {pass the left parenthesis}
+cur_char:=" ";
+while cur_char=" " do get_next;
+if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
+name_length:=0; get_keyword_char; {prepare to scan the name}
+while cur_char<>" " do
+ begin if name_length=longest_name then cur_name[1]:="X" {force error}
+ else incr(name_length);
+ cur_name[name_length]:=cur_char;
+ get_keyword_char;
+ end;
+lookup;
+if name_ptr=0 then err_print('Sorry, I don''t know that property name');
+@.Sorry, I don't know...@>
+cur_code:=equiv[name_ptr];
+end;
+
+@* Scanning numeric data.
+The next thing we need is a trio of subroutines to read the one-byte,
+four-byte, and real numbers that may appear as property values.
+These subroutines are careful to stick to numbers between $-2^{31}$
+and $2^{31}-1$, inclusive, so that a computer with two's complement
+32-bit arithmetic will not be interrupted by overflow.
+
+@ The first number scanner, which returns a one-byte value, surely has
+no problems of arithmetic overflow.
+
+@p function get_byte:byte; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+@!t:ASCII_code; {the type of value to be scanned}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+t:=cur_char; acc:=0;
+repeat get_next;
+until cur_char<>" "; {skip the blanks after the type code}
+if t="C" then @<Scan an ASCII character code@>
+else if t="D" then @<Scan a small decimal number@>
+else if t="O" then @<Scan a small octal number@>
+else if t="H" then @<Scan a small hexadecimal number@>
+else if t="F" then @<Scan a face code@>
+else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
+@.You need "C" or "D" ...here@>
+cur_char:=" "; get_byte:=acc;
+end;
+
+@ The |get_next| routine converts lower case to upper case, but it leaves
+the character in the buffer, so we can unconvert it.
+
+@<Scan an ASCII...@>=
+if (cur_char>=@'41)and(cur_char<=@'176)and
+ ((cur_char<"(")or(cur_char>")")) then
+ acc:=xord[buffer[loc]]
+else skip_error('"C" value must be standard ASCII and not a paren')
+@:C value}\.{"C" value must be...@>
+
+@ @<Scan a small dec...@>=
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed 255');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small oct...@>=
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed ''377');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a small hex...@>=
+begin while ((cur_char>="0")and(cur_char<="9"))or
+ ((cur_char>="A")and(cur_char<="F")) do
+ begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ acc:=acc*16+cur_char-"0";
+ if acc>255 then
+ begin skip_error('This value shouldn''t exceed "FF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end
+ else get_next;
+ end;
+backup;
+end
+
+@ @<Scan a face...@>=
+begin if cur_char="B" then acc:=2
+else if cur_char="L" then acc:=4
+else if cur_char<>"M" then acc:=18;
+get_next;
+if cur_char="I" then incr(acc)
+else if cur_char<>"R" then acc:=18;
+get_next;
+if cur_char="C" then acc:=acc+6
+else if cur_char="E" then acc:=acc+12
+else if cur_char<>"R" then acc:=18;
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
+@.Illegal face code...@>
+ acc:=0;
+ end;
+end
+
+@ The routine that scans a four-byte value puts its output into |cur_bytes|,
+which is a record containing (yes, you guessed it) four bytes.
+
+@<Types...@>=
+@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
+
+@ @d c0==cur_bytes.b0
+@d c1==cur_bytes.b1
+@d c2==cur_bytes.b2
+@d c3==cur_bytes.b3
+
+@<Glob...@>=
+@!cur_bytes:four_bytes; {a four-byte accumulator}
+
+@ Since the |get_four_bytes| routine is used very infrequently, no attempt
+has been made to make it fast; we only want it to work.
+
+@p procedure get_four_bytes; {scans an octal constant and sets |four_bytes|}
+var c:integer; {leading byte}
+@!r:integer; {radix}
+@!q:integer; {|256/r|}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+r:=0; c0:=0; c1:=0; c2:=0; c3:=0; {start with the accumulator zero}
+if cur_char="H" then r:=16
+else if cur_char="O" then r:=8
+else skip_error('An octal ("O") or hex ("H") value is needed here');
+@.An octal ("O") or hex ("H")...@>
+if r>0 then
+ begin q:=256 div r;
+ repeat get_next;
+ until cur_char<>" "; {skip the blanks after the type code}
+ while ((cur_char>="0")and(cur_char<="9"))or@|
+ ((cur_char>="A")and(cur_char<="F")) do
+ @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
+ end;
+end;
+
+@ @<Multiply by |r|...@>=
+begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+c:=(r*c0)+(c1 div q);
+if c>255 then
+ begin c0:=0; c1:=0; c2:=0; c3:=0;
+ if r=8 then
+ skip_error('Sorry, the maximum octal value is O 37777777777')
+@.Sorry, the maximum octal...@>
+ else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
+@.Sorry, the maximum hex...@>
+ end
+else if cur_char>="0"+r then skip_error('Illegal digit')
+@.Illegal digit@>
+else begin c0:=c;
+ c1:=(r*(c1 mod q))+(c2 div q);
+ c2:=(r*(c2 mod q))+(c3 div q);
+ c3:=(r*(c3 mod q))+cur_char-"0";
+ get_next;
+ end;
+end
+
+@ The remaining scanning routine is the most interesting. It scans a real
+constant and returns the nearest |fix_word| approximation to that constant.
+A |fix_word| is a 32-bit integer that represents a real value that
+has been multiplied by $2^{20}$. Since \.{PLtoTF} restricts the magnitude
+of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
+
+@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
+
+@<Types...@>=
+@!fix_word=integer; {a scaled real value with 20 bits of fraction}
+
+@ When a real value is desired, we might as well treat `\.D' and `\.R'
+formats as if they were identical.
+
+@p function get_fix:fix_word; {scans a real property value}
+var negative:boolean; {was there a minus sign?}
+@!acc:integer; {an accumulator}
+@!int_part:integer; {the integer part}
+@!j:0..7; {the number of decimal places stored}
+begin repeat get_next;
+until cur_char<>" "; {skip the blanks before the type code}
+negative:=false; acc:=0; {start with the accumulators zero}
+if (cur_char<>"R")and(cur_char<>"D") then
+ skip_error('An "R" or "D" value is needed here')
+@.An "R" or "D" ... needed here@>
+else begin @<Scan the blanks and/or signs after the type code@>;
+ while (cur_char>="0") and (cur_char<="9") do
+ @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
+ int_part:=acc; acc:=0;
+ if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
+ if (acc>=unity)and(int_part=2047) then
+ skip_error('Real constants must be less than 2048')
+@.Real constants must be...@>
+ else acc:=int_part*unity+acc;
+ end;
+if negative then get_fix:=-acc@+else get_fix:=acc;
+end;
+
+@ @<Scan the blanks...@>=
+repeat get_next;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=not negative;
+ end
+else if cur_char="+" then cur_char:=" ";
+until cur_char<>" "
+
+@ @<Multiply by 10...@>=
+begin acc:=acc*10+cur_char-"0";
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
+@.Real constants must be...@>
+ acc:=0; cur_char:=" ";
+ end
+else get_next;
+end
+
+@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
+of the digits $d_j$. A correct result is obtained if we first compute
+$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
+$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
+
+@<Glob...@>=
+@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
+
+@ @<Scan the frac...@>=
+begin j:=0; get_next;
+while (cur_char>="0")and(cur_char<="9") do
+ begin if j<7 then
+ begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+ end;
+ get_next;
+ end;
+acc:=0;
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
+ end;
+acc:=(acc+10) div 20;
+end
+
+@* Storing the property values.
+When property values have been found, they are squirreled away in a bunch
+of arrays. The header information is unpacked into bytes in an array
+called |header_bytes|. The ligature/kerning program is stored in an array
+of type |four_bytes|.
+Another |four_bytes| array holds the specifications of extensible characters.
+The kerns and parameters are stored in separate arrays of |fix_word| values.
+
+Instead of storing the design size in the header array, we will keep it
+in a |fix_word| variable until the last minute. The number of units in the
+design size is also kept in a |fix_word|.
+
+@<Glob...@>=
+@!header_bytes:array[header_index] of byte; {the header block}
+@!header_ptr:header_index; {the number of header bytes in use}
+@!design_size:fix_word; {the design size}
+@!design_units:fix_word; {reciprocal of the scaling factor}
+@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
+@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
+@!nl:0..32767; {the number of ligature/kern instructions so far}
+@!min_nl:0..32767; {the final value of |nl| must be at least this}
+@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
+@!nk:0..max_kerns; {the number of entries of |kern|}
+@!exten:array[0..255] of four_bytes; {extensible character specs}
+@!ne:0..256; {the number of extensible characters}
+@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
+@!np:0..max_param_words; {the largest parameter set nonzero}
+@!check_sum_specified:boolean; {did the user name the check sum?}
+@!bchar:0..256; {the right boundary character, or 256 if unspecified}
+
+@ @<Types...@>=
+@!header_index=0..max_header_bytes;
+@!indx=0..@'77777;
+
+@ @<Local...@>=
+@!d:header_index; {an index into |header_bytes|}
+
+@ We start by setting up the default values.
+
+@d check_sum_loc=0
+@d design_size_loc=4
+@d coding_scheme_loc=8
+@d family_loc=coding_scheme_loc+40
+@d seven_flag_loc=family_loc+20
+@d face_loc=seven_flag_loc+3
+
+@<Set init...@>=
+for d:=0 to 18*4-1 do header_bytes[d]:=0;
+header_bytes[8]:=11; header_bytes[9]:="U";
+header_bytes[10]:="N";
+header_bytes[11]:="S";
+header_bytes[12]:="P";
+header_bytes[13]:="E";
+header_bytes[14]:="C";
+header_bytes[15]:="I";
+header_bytes[16]:="F";
+header_bytes[17]:="I";
+header_bytes[18]:="E";
+header_bytes[19]:="D";
+@.UNSPECIFIED@>
+for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
+design_size:=10*unity; design_units:=unity; seven_bit_safe_flag:=false;@/
+header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
+check_sum_specified:=false; bchar:=256;
+
+@ Most of the dimensions, however, go into the |memory| array. There are
+at most 257 widths, 257 heights, 257 depths, and 257 italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for 1028 entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
+
+We also add four ``list head'' words to the |memory| and |link| arrays;
+these are in locations |width| through |italic|, i.e., 1 through 4.
+For example, |link[height]| points to the smallest element in
+the sorted list of distinct heights that have appeared so far, and
+|memory[height]| is the number of distinct heights.
+
+@d mem_size=1028+4 {number of nonzero memory addresses}
+
+@<Types...@>=
+@!pointer=0..mem_size; {an index into memory}
+
+@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
+pointers to the |memory| array entries where the corresponding dimensions
+appear. Two other arrays, |char_tag| and |char_remainder|, hold
+the other information that \.{TFM} files pack into a |char_info_word|.
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+@d bchar_label==char_remainder[256]
+ {beginning of ligature program for left boundary}
+
+@<Glob...@>=
+@!memory:array[pointer] of fix_word; {character dimensions and kerns}
+@!mem_ptr:pointer; {largest |memory| word in use}
+@!link:array[pointer] of pointer; {to make lists of |memory| items}
+@!char_wd:array[byte] of pointer; {pointers to the widths}
+@!char_ht:array[byte] of pointer; {pointers to the heights}
+@!char_dp:array[byte] of pointer; {pointers to the depths}
+@!char_ic:array[byte] of pointer; {pointers to italic corrections}
+@!char_tag:array[byte] of no_tag..ext_tag; {character tags}
+@!char_remainder:array[0..256] of 0..65535; {pointers to ligature labels,
+ next larger characters, or extensible characters}
+
+@ @<Local...@>=
+@!c:byte; {runs through all character codes}
+
+@ @<Set init...@>=
+bchar_label:=@'77777;
+for c:=0 to 255 do
+ begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+ char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
+memory[width]:=0; link[width]:=0; {width list is empty}
+memory[height]:=0; link[height]:=0; {height list is empty}
+memory[depth]:=0; link[depth]:=0; {depth list is empty}
+memory[italic]:=0; link[italic]:=0; {italic list is empty}
+mem_ptr:=italic;
+
+@ As an example of these data structures, let us consider the simple
+routine that inserts a potentially new element into one of the dimension
+lists. The first parameter indicates the list head (i.e., |h=width| for
+the width list, etc.); the second parameter is the value that is to be
+inserted into the list if it is not already present. The procedure
+returns the value of the location where the dimension appears in |memory|.
+The fact that |memory[0]| is larger than any legal dimension makes the
+algorithm particularly short.
+
+We do have to handle two somewhat subtle situations. A width of zero must be
+put into the list, so that a zero-width character in the font will not appear
+to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
+this does not need to be done for heights, depths, or italic corrections.
+Furthermore, it is necessary to test for memory overflow even though we
+have provided room for the maximum number of different dimensions in any
+legal font, since the \.{PL} file might foolishly give any number of
+different sizes to the same character.
+
+@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
+var p:pointer; {the current node of interest}
+begin if (d=0)and(h<>width) then sort_in:=0
+else begin p:=h;
+ while d>=memory[link[p]] do p:=link[p];
+ if (d=memory[p])and(p<>h) then sort_in:=p
+ else if mem_ptr=mem_size then
+ begin err_print('Memory overflow: more than 1028 widths, etc');
+@.Memory overflow...@>
+ print_ln('Congratulations! It''s hard to make this error.');
+ sort_in:=p;
+ end
+ else begin incr(mem_ptr); memory[mem_ptr]:=d;
+ link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
+ sort_in:=mem_ptr;
+ end;
+ end;
+end;
+
+@ When these lists of dimensions are eventually written to the \.{TFM}
+file, we may have to do some rounding of values, because the \.{TFM} file
+allows at most 256 widths, 16 heights, 16 depths, and 64 italic
+corrections. The following procedure takes a given list head |h| and a
+given dimension |d|, and returns the minimum $m$ such that the elements of
+the list can be covered by $m$ intervals of width $d$. It also sets
+|next_d| to the smallest value $d^\prime>d$ such that the covering found
+by this procedure would be different. In particular, if $d=0$ it computes
+the number of elements of the list, and sets |next_d| to the smallest
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
+
+@<Glob...@>=
+@!next_d:fix_word; {the next larger interval that is worth trying}
+
+@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
+
+@p function min_cover(@!h:pointer;@!d:fix_word):integer;
+var p:pointer; {the current node of interest}
+@!l:fix_word; {the least element covered by the current interval}
+@!m:integer; {the current size of the cover being generated}
+begin m:=0; p:=link[h]; next_d:=memory[0];
+while p<>0 do
+ begin incr(m); l:=memory[p];
+ while memory[link[p]]<=l+d do p:=link[p];
+ p:=link[p];
+ if memory[p]-l<next_d then next_d:=memory[p]-l;
+ end;
+min_cover:=m;
+end;
+
+@ The following procedure uses |min_cover| to determine the smallest $d$
+such that a given list can be covered with at most a given number of
+intervals.
+
+@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
+var d:fix_word; {the current trial interval length}
+@!k:integer; {the size of a minimum cover}
+begin if memory[h]>m then
+ begin excess:=memory[h]-m;
+ k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
+ repeat d:=d+d; k:=min_cover(h,d);
+ until k<=m; {first we ascend rapidly until finding the range}
+ d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
+ end;
+ shorten:=d;
+ end
+else shorten:=0;
+end;
+
+@ When we are nearly ready to output the \.{TFM} file, we will set
+|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
+|k|th element of its list.
+
+@<Glob...@>=
+@!index:array[pointer] of byte;
+@!excess:byte; {number of words to remove, if list is being shortened}
+
+@ Here is the procedure that sets the |index| values. It also shortens
+the list so that there is only one element per covering interval;
+the remaining elements are the midpoints of their clusters.
+
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
+var p:pointer; {the current node of interest}
+@!q:pointer; {trails one step behind |p|}
+@!m:byte; {index number of nodes in the current interval}
+@!l:fix_word; {least value in the current interval}
+begin q:=h; p:=link[q]; m:=0;
+while p<>0 do
+ begin incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do
+ begin p:=link[p]; index[p]:=m; decr(excess);
+ if excess=0 then d:=0;
+ end;
+ link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
+ end;
+memory[h]:=m;
+end;
+
+@* The input phase.
+We're ready now to read and parse the \.{PL} file, storing property
+values as we go.
+
+@<Glob...@>=
+@!c:byte; {the current character or byte being processed}
+
+@ @<Read all the input@>=
+cur_char:=" ";
+repeat while cur_char=" " do get_next;
+if cur_char="(" then @<Read a font property value@>
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
+ incr(loc); cur_char:=" ";
+ end
+@.Extra right parenthesis@>
+else if not input_has_ended then junk_error;
+until input_has_ended
+
+@ The |junk_error| routine just referred to is called when something
+appears in the forbidden area between properties of a property list.
+
+@p procedure junk_error; {gets past no man's land}
+begin err_print('There''s junk here that is not in parentheses');
+@.There's junk here...@>
+skip_to_paren;
+end;
+
+@ For each font property, we are supposed to read the data from the
+left parenthesis that is the current value of |cur_char| to the right
+parenthesis that matches it in the input. The main complication is
+to recover with reasonable grace from various error conditions that might arise.
+
+@<Read a font property value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code>character_code then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+else begin @<Read the font property value specified by |cur_code|@>;
+ finish_the_property;
+ end;
+end
+
+@ @<Read the font property value spec...@>=
+case cur_code of
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code:header_bytes[face_loc]:=get_byte;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+character_code: read_char_info;
+end
+
+@ The |case| statement just given makes use of two subroutines that we
+haven't defined yet. The first of these puts a 32-bit octal quantity
+into four specified bytes of the header block.
+
+@p procedure read_four_bytes(l:header_index);
+begin get_four_bytes;
+header_bytes[l]:=c0;
+header_bytes[l+1]:=c1;
+header_bytes[l+2]:=c2;
+header_bytes[l+3]:=c3;
+end;
+
+@ The second little procedure is used to scan a string and to store it in
+the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
+to contain at most |n| bytes, including the first byte (which holds the
+length of the rest of the string).
+
+@p procedure read_BCPL(l:header_index;n:byte);
+var k:header_index;
+begin k:=l;
+while cur_char=" " do get_next;
+while (cur_char<>"(")and(cur_char<>")") do
+ begin if k<l+n then incr(k);
+ if k<l+n then header_bytes[k]:=cur_char;
+ get_next;
+ end;
+if k=l+n then
+ begin err_print('String is too long; its first ',n-1:1,
+@.String is too long...@>
+ ' characters will be kept'); decr(k);
+ end;
+header_bytes[l]:=k-l;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
+ end;
+end;
+
+@ @<Read the design size@>=
+begin next_d:=get_fix;
+if next_d<unity then
+ err_print('The design size must be at least 1')
+@.The design size must...@>
+else design_size:=next_d;
+end
+
+@ @<Read the design units@>=
+begin next_d:=get_fix;
+if next_d<=0 then
+ err_print('The number of units per design size must be positive')
+@.The number of units...@>
+else design_units:=next_d;
+end
+
+@ @<Read the seven-bit-safe...@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then seven_bit_safe_flag:=true
+else if cur_char="F" then seven_bit_safe_flag:=false
+else err_print('The flag value should be "TRUE" or "FALSE"');
+@.The flag value should be...@>
+skip_to_paren;
+end
+
+@ @<Read an indexed header word@>=
+begin c:=get_byte;
+if c<18 then skip_error('HEADER indices should be 18 or more')
+@.HEADER indices...@>
+else if 4*c+4>max_header_bytes then
+ skip_error('This HEADER index is too big for my present table size')
+@.This HEADER index is too big...@>
+else begin while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
+ end;
+ read_four_bytes(4*c);
+ end;
+end
+
+@ The remaining kinds of font property values that need to be read are
+those that involve property lists on higher levels. Each of these has a
+loop similar to the one that was used at level zero. Then we put the
+right parenthesis back so that `|finish_the_property|' will be happy;
+there is probably a more elegant way to do this.
+
+@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
+ end
+
+@<Read font parameter list@>=
+begin while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a parameter value@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a parameter value@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
+ flush_error('This property name doesn''t belong in a FONTDIMEN list')
+@.This property name doesn't belong...@>
+else begin if cur_code=parameter_code then c:=get_byte
+ else c:=cur_code-parameter_code;
+ if c=0 then flush_error('PARAMETER index must not be zero')
+@.PARAMETER index must not...@>
+ else if c>max_param_words then
+ flush_error('This PARAMETER index is too big for my present table size')
+@.This PARAMETER index is too big...@>
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
+ end;
+ param[c]:=get_fix;
+ finish_the_property;
+ end;
+ end;
+end
+
+@ @<Read ligature/kern list@>=
+begin lk_step_ended:=false;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a ligature/kern command@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end
+
+@ @<Read a ligature/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<label_code then
+ flush_error('This property name doesn''t belong in a LIGTABLE list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7,
+ lig_code+11:@<Read a ligature step@>;
+ end; {there are no other cases |>=label_code|}
+ finish_the_property;
+ end;
+end
+
+@ When a character is about to be tagged, we call the following
+procedure so that an error message is given in case of multiple tags.
+
+@p procedure check_tag(c:byte); {print error if |c| already tagged}
+begin case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+@.This character already...@>
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
+end;
+
+@ @<Read a label step@>=
+begin while cur_char=" " do get_next;
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+ end
+else begin backup; c:=get_byte;
+ check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ end;
+if min_nl<=nl then min_nl:=nl+1;
+lk_step_ended:=false;
+end
+
+@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@<Globals...@>=
+@!lk_step_ended:boolean;
+ {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
+@!krn_ptr:0..max_kerns; {an index into |kern|}
+
+@ @<Read a stop step@>=
+if not lk_step_ended then
+ err_print('STOP must follow LIG or KRN')
+@.STOP must follow LIG or KRN@>
+else begin lig_kern[nl-1].b0:=stop_flag; lk_step_ended:=false;
+ end
+
+@ @<Read a skip step@>=
+if not lk_step_ended then
+ err_print('SKIP must follow LIG or KRN')
+@.SKIP must follow LIG or KRN@>
+else begin c:=get_byte;
+ if c>=128 then err_print('Maximum SKIP amount is 127')
+@.Maximum SKIP amount...@>
+ else if nl+c>=max_lig_steps then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+ else begin lig_kern[nl-1].b0:=c;
+ if min_nl<=nl+c then min_nl:=nl+c+1;
+ end;
+ lk_step_ended:=false;
+ end
+
+@ @<Read a ligature step@>=
+begin lig_kern[nl].b0:=0;
+lig_kern[nl].b2:=cur_code-lig_code;
+lig_kern[nl].b1:=get_byte;
+lig_kern[nl].b3:=get_byte;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
+kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
+@.Sorry, too many different kerns...@>
+ decr(krn_ptr);
+ end;
+ end;
+lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
+lig_kern[nl].b3:=krn_ptr mod 256;
+if nl>=max_lig_steps-1 then
+ err_print('Sorry, LIGTABLE too long for me to handle')
+@.Sorry, LIGTABLE too long...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ Finally we come to the part of \.{PLtoTF}'s input mechanism
+that is used most, the processing of individual character data.
+
+@<Read character info list@>=
+begin c:=get_byte; {read the character code that is being specified}
+@<Print |c| in octal notation@>;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a character property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
+finish_inner_property_list;
+end
+
+@ @<Read a character prop...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code)or(cur_code>var_char_code) then
+ flush_error('This property name doesn''t belong in a CHARACTER list')
+@.This property name doesn't belong...@>
+else begin case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ @<Read an extensible r...@>=
+begin if ne=256 then
+ err_print('At most 256 VARCHAR specs are allowed')
+@.At most 256 VARCHAR specs...@>
+else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+ exten[ne].b0:=0; exten[ne].b1:=0; exten[ne].b2:=0; exten[ne].b3:=0;
+ while level=2 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read an extensible piece@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+ incr(ne);
+ finish_inner_property_list;
+ end;
+end
+
+@ @<Read an extensible p...@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
+ flush_error('This property name doesn''t belong in a VARCHAR list')
+@.This property name doesn't belong...@>
+else begin case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ The input routine is now complete except for the following code,
+which prints a progress report as the file is being read.
+
+@p procedure print_octal(c:byte); {prints three octal digits}
+begin print('''',(c div 64):1,((c div 8) mod 8):1,(c mod 8):1);
+end;
+
+@ @<Print |c| in octal...@>=
+begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+print_octal(c); {progress report}
+end
+
+@* The checking and massaging phase.
+Once the whole \.{PL} file has been read in, we must check it for consistency
+and correct any errors. This process consists mainly of running through
+the characters that exist and seeing if they refer to characters that
+don't exist. We also compute the true value of |seven_unsafe|; we make sure
+that the charlists and ligature programs contain no loops; and we
+shorten the lists of widths, heights, depths, and italic corrections,
+if necessary, to keep from exceeding the required maximum sizes.
+
+@<Glob...@>=
+@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
+
+@ @<Correct and check the information@>=
+if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
+seven_unsafe:=false;
+for c:=0 to 255 do if char_wd[c]<>0 then
+ @<For all characters |g| generated by |c|,
+ make sure that |char_wd[g]| is nonzero, and
+ set |seven_unsafe| if |c<128<=g|@>;
+if bchar_label<@'77777 then
+ begin c:=256; @<Check ligature program of |c|@>;
+ end;
+if seven_bit_safe_flag and seven_unsafe then
+ print_ln('The font is not really seven-bit-safe!');
+@.The font is not...safe@>
+@<Check for infinite ligature loops@>;
+@<Doublecheck the lig/kern commands and the extensible recipes@>;
+for c:=0 to 255 do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@<Put the width, height, depth, and italic lists into final form@>
+
+@ The checking that we need in several places is accomplished by three
+macros that are only slightly tricky.
+
+@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
+ print(#,' '); print_octal(c);
+ print_ln(' had no CHARACTER spec.');
+ end;
+ end
+@d check_existence_and_safety(#)==begin g:=#;
+ if (g>=128)and(c<128) then seven_unsafe:=true;
+ if char_wd[g]=0 then existence_tail
+@d check_existence(#)==begin g:=#;
+ if char_wd[g]=0 then existence_tail
+
+@<For all characters |g| generated by |c|...@>=
+case char_tag[c] of
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
+@.The character NEXTLARGER...@>
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
+
+@ @<Check the pieces...@>=
+begin if exten[char_remainder[c]].b0>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b0)
+ ('TOP piece of character');
+@.TOP piece of character...@>
+if exten[char_remainder[c]].b1>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b1)
+ ('MID piece of character');
+@.MID piece of character...@>
+if exten[char_remainder[c]].b2>0 then
+ check_existence_and_safety(exten[char_remainder[c]].b2)
+ ('BOT piece of character');
+@.BOT piece of character...@>
+check_existence_and_safety(exten[char_remainder[c]].b3)
+ ('REP piece of character');
+@.REP piece of character...@>
+end
+
+@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
+if char_tag[c]=list_tag then
+ begin g:=char_remainder[c];
+ while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
+ if g=c then
+ begin char_tag[c]:=no_tag;
+ print('A cycle of NEXTLARGER characters has been broken at ');
+@.A cycle of NEXTLARGER...@>
+ print_octal(c); print_ln('.');
+ end;
+ end
+
+@ @<Glob...@>=
+@!delta:fix_word; {size of the intervals needed for rounding}
+
+@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
+@.I had to round...@>
+ #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
+
+@<Put the width, height, depth, and italic lists into final form@>=
+delta:=shorten(width,255); set_indices(width,delta); round_message('width');@/
+delta:=shorten(height,15); set_indices(height,delta); round_message('height');@/
+delta:=shorten(depth,15); set_indices(depth,delta); round_message('depth');@/
+delta:=shorten(italic,63); set_indices(italic,delta);
+ round_message('italic correction');
+
+@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
+ lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
+ lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
+
+@<Make sure the ligature/kerning program ends...@>=
+begin if bchar_label<@'77777 then {make room for it}
+ begin clear_lig_kern_entry; incr(nl);
+ end; {|bchar_label| will be stored later}
+while min_nl>nl do
+ begin clear_lig_kern_entry; incr(nl);
+ end;
+if lig_kern[nl-1].b0=0 then lig_kern[nl-1].b0:=stop_flag;
+end
+
+@ It's not trivial to check for infinite loops generated by repeated
+insertion of ligature characters. But fortunately there is a nice
+algorithm for such testing, copied here from the program \.{TFtoPL}
+where it is explained further.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+
+@ @<Glo...@>=
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!tt:indx; {temporary register}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Set init...@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for k:=0 to hash_size do hash[k]:=0;
+
+@ @d lig_exam==lig_kern[lig_ptr].b1
+@d lig_gen==lig_kern[lig_ptr].b3
+
+@<Check lig...@>=
+begin lig_ptr:=char_remainder[c];
+repeat if hash_input(lig_ptr,c) then
+ begin if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=256) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else if lig_exam<>bchar then
+ check_existence(lig_exam)('KRN character examined by');
+@.KRN character examined...@>
+ end;
+if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl
+else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
+until lig_ptr>=nl;
+end
+
+@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
+into a boolean function that returns |false| if the ligature command
+was masked by a previous one.
+
+@p function hash_input(@!p,@!c:indx):boolean;
+ {enter data for character |c| and command in location |p|, unless it isn't new}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then
+ begin hash_input:=false; goto 30;@+end;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then
+ begin hash_input:=false; goto 30; {unused ligature command}
+ end;
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+hash_input:=true;
+30:end;
+
+@ @<Compute the command param...@>=
+y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
+zz:=lig_kern[p].b3;
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ (More good stuff from \.{TFtoPL}.)
+
+@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:indx):indx| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@ @<Check for infinite...@>=
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do
+ begin tt:=hash_list[hh];
+ if class[tt]>simple then {make sure $f$ is well defined}
+ tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256);
+ end;
+if(hash_ptr=hash_size)or(y_lig_cycle<256) then
+ begin if hash_ptr<hash_size then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ end
+ else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ print_ln('All ligatures will be cleared.');
+ for c:=0 to 255 do if char_tag[c]=lig_tag then
+ begin char_tag[c]:=no_tag; char_remainder[c]:=0;
+ end;
+ nl:=0; bchar:=256; bchar_label:=@'77777;
+ end
+
+@ The lig/kern program may still contain references to nonexistent characters,
+if parts of that program are never used. Similarly, there may be extensible
+characters that are never used, because they were overridden by
+\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
+must fix such errors.
+
+@d double_check_tail(#)==@t\1@>if char_wd[0]=0
+ then char_wd[0]:=sort_in(width,0);
+ print('Unused ',#,' refers to nonexistent character ');
+ print_octal(c); print_ln('!');
+ end;
+ end
+@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
+ if char_wd[c]=0 then if c<>bchar then
+ begin lig_kern[lig_ptr].#:=0; double_check_tail
+@d double_check_ext(#)==begin c:=exten[g].#;
+ if c>0 then if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+@d double_check_rep(#)==begin c:=exten[g].#;
+ if char_wd[c]=0 then
+ begin exten[g].#:=0; double_check_tail
+
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+@.Unused LIG step...@>
+@.Unused KRN step...@>
+if ne>0 then for g:=0 to ne-1 do
+ begin double_check_ext(b0)('VARCHAR TOP');
+ double_check_ext(b1)('VARCHAR MID');
+ double_check_ext(b2)('VARCHAR BOT');
+ double_check_rep(b3)('VARCHAR REP');
+@.Unused VARCHAR...@>
+ end
+
+@* The output phase.
+Now that we know how to get all of the font data correctly stored in
+\.{PLtoTF}'s memory, it only remains to write the answers out.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{TFM} file:
+
+@d out(#)==write(tfm_file,#)
+
+@ The general plan for producing \.{TFM} files is long but simple:
+
+@<Do the output@>=
+@<Compute the twelve subfile sizes@>;
+@<Output the twelve subfile sizes@>;
+@<Output the header block@>;
+@<Output the character info@>;
+@<Output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes@>;
+@<Output the parameters@>
+
+@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
+We already know most of these numbers; for example, the number of distinct
+widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
+is always supposed to be present. But we still should compute the beginning
+and ending character codes (|bc| and |ec|), the number of header words (|lh|),
+and the total number of words in the \.{TFM} file (|lf|).
+
+@<Gl...@>=
+@!bc:byte; {the smallest character code in the font}
+@!ec:byte; {the largest character code in the font}
+@!lh:byte; {the number of words in the header block}
+@!lf:0..32767; {the number of words in the entire \.{TFM} file}
+@!not_found:boolean; {has a font character been found?}
+@!temp_width:fix_word; {width being used to compute a check sum}
+
+@ It might turn out that no characters exist at all. But \.{PLtoTF} keeps
+going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
+will be~1.
+
+@<Compute the twelve...@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+not_found:=true; ec:=255;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+incr(memory[italic]);@/
+@<Compute the ligature/kern program offset@>;
+lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+memory[italic]+nl+lk_offset+nk+ne+np;
+
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+
+@<Output the twelve subfile sizes@>=
+out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+out_size(memory[width]); out_size(memory[height]);
+out_size(memory[depth]); out_size(memory[italic]);
+out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+
+@ The routines that follow need a few temporary variables of different types.
+
+@<Gl...@>=
+@!j:0..max_header_bytes; {index into |header_bytes|}
+@!p:pointer; {index into |memory|}
+@!q:width..italic; {runs through the list heads for dimensions}
+@!par_ptr:0..max_param_words; {runs through the parameters}
+
+@ The header block follows the subfile sizes. The necessary information all
+appears in |header_bytes|, except that the design size and the seven-bit-safe
+flag must still be set.
+
+@<Output the header block@>=
+if not check_sum_specified then @<Compute the check sum@>;
+header_bytes[design_size_loc]:=design_size div @'100000000;
+ {this works since |design_size>0|}
+header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
+header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
+header_bytes[design_size_loc+3]:=design_size mod 256;
+if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+for j:=0 to header_ptr-1 do out(header_bytes[j]);
+
+@ @<Compute the check sum@>=
+begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
+for c:=bc to ec do if char_wd[c]>0 then
+ begin temp_width:=memory[char_wd[c]];
+ if design_units<>unity then
+ temp_width:=round((temp_width/design_units)*1048576.0);
+ temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
+ c0:=(c0+c0+temp_width) mod 255;
+ c1:=(c1+c1+temp_width) mod 253;
+ c2:=(c2+c2+temp_width) mod 251;
+ c3:=(c3+c3+temp_width) mod 247;
+ end;
+header_bytes[check_sum_loc]:=c0;
+header_bytes[check_sum_loc+1]:=c1;
+header_bytes[check_sum_loc+2]:=c2;
+header_bytes[check_sum_loc+3]:=c3;
+end
+
+@ The next block contains packed |char_info|.
+
+@<Output the character info@>=
+index[0]:=0;
+for c:=bc to ec do
+ begin out(index[char_wd[c]]);
+ out(index[char_ht[c]]*16+index[char_dp[c]]);
+ out(index[char_ic[c]]*4+char_tag[c]);
+ out(char_remainder[c]);
+ end
+
+@ When a scaled quantity is output, we may need to divide it by |design_units|.
+The following subroutine takes care of this, using floating point arithmetic
+only if |design_units<>1.0|.
+
+@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
+var @!n:byte; {the first byte after the sign}
+@!m:0..65535; {the two least significant bytes}
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
+ ' is too large.');
+@.The relative dimension...@>
+ print(' (Must be less than 16*designsize');
+ if design_units<>unity then print(' =',design_units/@'200000:1:3,
+ ' designunits');
+ print_ln(')'); x:=0;
+ end;
+if design_units<>unity then x:=round((x/design_units)*1048576.0);
+if x<0 then
+ begin out(255); x:=x+@'100000000;
+ if x<=0 then x:=1;
+ end
+else begin out(0);
+ if x>=@'100000000 then x:=@'77777777;
+ end;
+n:=x div @'200000; m:=x mod @'200000;
+out(n); out(m div 256); out(m mod 256);
+end;
+
+@ We have output the packed indices for individual characters.
+The scaled widths, heights, depths, and italic corrections are next.
+
+@<Output the dimensions themselves@>=
+for q:=width to italic do
+ begin out(0); out(0); out(0); out(0); {output the zero word}
+ p:=link[q]; {head of list}
+ while p>0 do
+ begin out_scaled(memory[p]);
+ p:=link[p];
+ end;
+ end;
+
+@ One embarrassing problem remains: The ligature/kern program might be very
+long, but the starting addresses in |char_remainder| can be at most~255.
+Therefore we need to output some indirect address information; we want to
+compute |lk_offset| so that addition of |lk_offset| to all remainders makes
+all but |lk_offset| distinct remainders less than~256.
+
+For this we need a sorted table of all relevant remainders.
+
+@<Glob...@>=
+@!label_table:array[0..256] of record
+ @!rr: -1..@'77777; {sorted label values}
+ @!cc: byte; {associated characters}
+ end;
+@!label_ptr:0..256; {index of highest entry in |label_table|}
+@!sort_ptr:0..256; {index into |label_table|}
+@!lk_offset:0..256; {smallest offset value that might work}
+@!t:0..@'77777; {label value that is being redirected}
+@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
+
+@ @<Compute the ligature/kern program offset@>=
+@<Insert all labels into |label_table|@>;
+if bchar<256 then
+ begin extra_loc_needed:=true; lk_offset:=1;
+ end
+else begin extra_loc_needed:=false; lk_offset:=0;
+ end;
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if bchar_label<@'77777 then
+ begin lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256;
+ lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256;
+ end
+
+@ @<Insert all labels...@>=
+label_ptr:=0; label_table[0].rr:=-1; {sentinel}
+for c:=bc to ec do if char_tag[c]=lig_tag then
+ begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+ label_table[sort_ptr+1].cc:=c;
+ label_table[sort_ptr+1].rr:=char_remainder[c];
+ incr(label_ptr);
+ end
+
+@ @<Find the minimum |lk_offset| and adjust all remainders@>=
+begin sort_ptr:=label_ptr; {the largest unallocated label}
+if label_table[sort_ptr].rr+lk_offset > 255 then
+ begin lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
+ repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do
+ begin decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
+ end;
+ incr(lk_offset); decr(sort_ptr);
+ until lk_offset+label_table[sort_ptr].rr<256;
+ {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
+ end;
+if lk_offset>0 then while sort_ptr>0 do
+ begin char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
+end
+
+@ @<Output the ligature/kern program@>=
+if extra_loc_needed then {|lk_offset=1|}
+ begin out(255); out(bchar); out(0); out(0);
+ end
+else for sort_ptr:=1 to lk_offset do {output the redirection specs}
+ begin t:=label_table[label_ptr].rr;
+ if bchar<256 then
+ begin out(255); out(bchar);
+ end
+ else begin out(254); out(0);
+ end;
+ out_size(t+lk_offset);
+ repeat decr(label_ptr); until label_table[label_ptr].rr<t;
+ end;
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ begin out(lig_kern[lig_ptr].b0);
+ out(lig_kern[lig_ptr].b1);
+ out(lig_kern[lig_ptr].b2);
+ out(lig_kern[lig_ptr].b3);
+ end;
+if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
+
+@ @<Output the extensible character recipes@>=
+if ne>0 then for c:=0 to ne-1 do
+ begin out(exten[c].b0);
+ out(exten[c].b1);
+ out(exten[c].b2);
+ out(exten[c].b3);
+ end;
+
+@ For our grand finale, we wind everything up by outputting the parameters.
+
+@<Output the parameters@>=
+for par_ptr:=1 to np do
+ begin if par_ptr=1 then
+ @<Output the slant (|param[1]|) without scaling@>
+ else out_scaled(param[par_ptr]);
+ end
+
+@ @<Output the slant...@>=
+begin if param[1]<0 then
+ begin param[1]:=param[1]+@'10000000000;
+ out((param[1] div @'100000000)+256-64);
+ end
+else out(param[1] div @'100000000);
+out((param[1] div @'200000) mod 256);
+out((param[1] div 256) mod 256);
+out(param[1] mod 256);
+end
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+@p procedure param_enter;
+begin @<Enter the parameter names@>;
+end;
+@#
+procedure name_enter; {enter all names and their equivalents}
+begin @<Enter all of the names...@>;
+param_enter;
+end;
+@#
+procedure read_lig_kern;
+var @!krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:byte; {runs through all character codes}
+begin @<Read ligature/kern list@>;
+end;
+@#
+procedure read_char_info;
+var @!c:byte; {the char}
+begin @<Read character info list@>;
+end;
+@#
+procedure read_input;
+var @!c:byte; {header or parameter index}
+begin @<Read all the input@>;
+end;
+@#
+procedure corr_and_check;
+var @!c:0..256; {runs through all character codes}
+@!hh:0..hash_size; {an index into |hash_list|}
+@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
+@!g:byte; {a character generated by the current character |c|}
+begin @<Correct and check the information@>
+end;
+
+@ Here is where \.{PLtoTF} begins and ends.
+
+@p begin initialize;@/
+name_enter;@/
+read_input; print_ln('.');@/
+corr_and_check;@/
+@<Do the output@>;
+end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/systems/knuth/dist/texware/pooltype.web b/systems/knuth/dist/texware/pooltype.web
new file mode 100644
index 0000000000..a7f7617abf
--- /dev/null
+++ b/systems/knuth/dist/texware/pooltype.web
@@ -0,0 +1,430 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in June 1982.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 2 (July 1983) is consistent with TeX version 0.999.
+% Version 3 (September 1989) is consistent with 8-bit TeX.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{POOL\lowercase{type}}
+\def\contentspagenumber{101}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont POOLtype} processor}
+ \vskip 15pt
+ \centerline{(Version 3, September 1989)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{POOLtype} utility program converts string pool files output
+by \.{TANGLE} into a slightly more symbolic format that may be useful
+when \.{TANGLE}d programs are being debugged.
+
+It's a pretty trivial routine, but people may want to try transporting
+this program before they get up enough courage to tackle \TeX\ itself.
+The first 256 strings are treated as \TeX\ treats them, using routines
+copied from \TeX82.
+
+@ \.{POOLtype} is written entirely in standard \PASCAL, except that it has
+to do some slightly system-dependent character code conversion on input
+and output. The input is read from |pool_file|, and the output is written
+on |output|. If the input is erroneous, the |output| file will describe
+the error.
+@^system dependencies@>
+
+@p program POOLtype(@!pool_file,@!output);
+label 9999; {this labels the end of the program}
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin @<Set initial values of key variables@>@/
+ end;
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* The character set.
+(The following material is copied verbatim from \TeX82.
+Thus, the same system-dependent changes should be made to both programs.)
+
+In order to make \TeX\ readily portable between a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.'' This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+
+Such an internal code is relevant to users of \TeX\ primarily because it
+governs the positions of characters in the fonts. For example, the
+character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
+this letter it specifies character number 65 in the current font.
+If that font actually has `\.A' in a different position, \TeX\ doesn't
+know what the real position is; the program that does the actual printing from
+\TeX's device-independent files is responsible for converting from ASCII to
+a particular font encoding.
+@^ASCII code@>
+
+\TeX's internal code is relevant also with respect to constants
+that begin with a reverse apostrophe; and it provides an index to the
+\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
+tables.
+
+@ Characters of text that have been converted to \TeX's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for typesetting;
+so the present specification of \TeX\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \TeX\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \TeX\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ Some of the ASCII codes without visible characters have been given symbolic
+names in this program because they are used with a special meaning.
+
+@d null_code=@'0 {ASCII code that might disappear}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d invalid_code=@'177 {ASCII code that many systems prohibit in text files}
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
+gives a complete specification of the intended correspondence between
+characters and \TeX's internal representation.
+@:TeXbook}{\sl The \TeX book@>
+
+If \TeX\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \TeX\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \TeX\ are allowed to have in their input files.
+It is best to make the codes correspond to the intended interpretations as
+shown in Appendix~C whenever possible; but this is not necessary. For
+example, in countries with an alphabet of more than 26 letters, it is
+usually best to map the additional letters into codes less than~@'40.
+To get the most ``permissive'' character set, change |' '| on the
+right of these assignment statements to |chr(i)|.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
+for i:=@'200 to @'377 do xord[xchr[i]]:=i;
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+
+@* String handling.
+(The following material is copied from the \\{get\_strings\_started} procedure
+of \TeX82, with slight changes.)
+
+@<Glob...@>=
+@!k,@!l:0..255; {small indices or counters}
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!s:integer; {number of strings treated so far}
+
+@ The global variable |count| keeps track of the total number of characters
+in strings.
+
+@<Glob...@>=
+@!count:integer; {how long the string pool is, so far}
+
+@ @<Set init...@>=
+count:=0;
+
+@ This is the main program, where \.{POOLtype} starts and ends.
+
+@d abort(#)==begin write_ln(#); goto 9999;
+ end
+
+@p begin initialize;@/
+@<Make the first 256 strings@>;
+s:=256;@/
+@<Read the other strings from the \.{POOL} file,
+ or give an error message and abort@>;
+write_ln('(',count:1,' characters in all.)');
+9999:end.
+
+@ @d lc_hex(#)==l:=#;
+ if l<10 then l:=l+"0" @+else l:=l-10+"a"
+
+@<Make the first 256...@>=
+for k:=0 to 255 do
+ begin write(k:3,': "'); l:=k;
+ if (@<Character |k| cannot be printed@>) then
+ begin write(xchr["^"],xchr["^"]);
+ if k<@'100 then l:=k+@'100
+ else if k<@'200 then l:=k-@'100
+ else begin lc_hex(k div 16); write(xchr[l]); lc_hex(k mod 16); incr(count);
+ end;
+ count:=count+2;
+ end;
+ if l="""" then write(xchr[l],xchr[l])
+ else write(xchr[l]);
+ incr(count); write_ln('"');
+ end
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be the single character @'32 instead of the
+three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
+produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \TeX\
+internal code number~|k| corresponds to a non-troublesome visible
+symbol in the local character set. An appropriate formula for the
+extended character set recommended in {\sl The \TeX book\/} would, for
+example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
+@'60..@'71, @'141..@'146, @'160..@'171]| must be printable.
+Thus, at least 80 printable characters are needed.
+@:TeXbook}{\sl The \TeX book@>
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+ (k<" ")or(k>"~")
+
+@ When the \.{WEB} system program called \.{TANGLE} processes a source file,
+it outputs a \PASCAL\ program and also a string pool file. The present
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is output with its
+associated index number. The strings are surrounded by double-quote marks;
+double-quotes in the string itself are repeated.
+
+@<Glob...@>=
+@!pool_file:packed file of text_char;
+ {the string-pool file output by \.{TANGLE}}
+@!xsum:boolean; {has the check sum been found?}
+
+@ @<Read the other strings...@>=
+reset(pool_file); xsum:=false;
+if eof(pool_file) then abort('! I can''t read the POOL file.');
+repeat @<Read one string, but abort if there are problems@>;
+until xsum;
+if not eof(pool_file) then abort('! There''s junk after the check sum')
+
+@ @<Read one string...@>=
+if eof(pool_file) then abort('! POOL file contained no check sum');
+read(pool_file,m,n); {read two digits of string length}
+if m<>'*' then
+ begin if (xord[m]<"0")or(xord[m]>"9")or(xord[n]<"0")or(xord[n]>"9") then
+ abort('! POOL line doesn''t begin with two digits');
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ write(s:3,': "'); count:=count+l;
+ for k:=1 to l do
+ begin if eoln(pool_file) then
+ begin write_ln('"'); abort('! That POOL line was too short');
+ end;
+ read(pool_file,m); write(xchr[xord[m]]);
+ if xord[m]="""" then write(xchr[""""]);
+ end;
+ write_ln('"'); incr(s);
+ end
+else xsum:=true;
+read_ln(pool_file)
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{POOLtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Indications of system dependencies appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/systems/knuth/dist/texware/tftopl.web b/systems/knuth/dist/texware/tftopl.web
new file mode 100644
index 0000000000..65095d4327
--- /dev/null
+++ b/systems/knuth/dist/texware/tftopl.web
@@ -0,0 +1,1596 @@
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was implemented in January 1982.
+% In February 1982 a new restriction on ligature steps was added.
+% In June 1982 the routines were divided into smaller pieces for IBM people,
+% and the result was designated "Version 1" in September 1982.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 2 (July 1983) was released with TeX version 0.999.
+% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
+% Version 2.2 (February 1984) simplified decimal fraction output.
+% Version 2.3 (May 1984) fixed a bug when lh=17.
+% Version 2.4 (July 1984) fixed a bug involving unused ligature code.
+% Version 2.5 (September 1985) updated the standard codingscheme names.
+% Version 3 (October 1989) introduced new ligature capabilities.
+% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability.
+% Version 3.2 (February 2008) added a newline after a warning message.
+% Version 3.3 (January 2014) added a space to an error message (Breitenlohner),
+% and tests nl>lig_size not 4*lig_size (C. M. Connelly, Melissa O'Neill).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{TF\lowercase{to}PL}
+\def\contentspagenumber{201}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont TFtoPL} processor}
+ \vskip 15pt
+ \centerline{(Version 3.3, January 2014)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{TFtoPL} utility program converts \TeX\ font metric (``\.{TFM}'')
+files into equivalent property-list (``\.{PL}'') files. It also
+makes a thorough check of the given \.{TFM} file, using essentially the
+same algorithm as \TeX. Thus if \TeX\ complains that a \.{TFM}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{PL} file output by this program can be edited with
+a normal text editor, and the result can be converted back to \.{TFM}
+format using the companion program \.{PLtoTF}.
+
+The first \.{TFtoPL} program was designed by Leo Guibas in the summer of
+1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
+also had a significant effect on the evolution of the present code.
+
+Extensions for an enhanced ligature mechanism were added by the author in 1989.
+
+The |banner| string defined here should be changed whenever \.{TFtoPL}
+gets modified.
+
+@d banner=='This is TFtoPL, Version 3.3' {printed when the program starts}
+
+@ This program is written entirely in standard \PASCAL, except that
+it occasionally has lower case letters in strings that are output.
+Such letters can be converted to upper case if necessary. The input is read
+from |tfm_file|, and the output is written on |pl_file|; error messages and
+other remarks are written on the |output| file, which the user may
+choose to assign to the terminal if the system permits it.
+@^system dependencies@>
+
+The term |print| is used instead of |write| when this program writes on
+the |output| file, so that all such output can be easily deflected.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{TFtoPL}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
+@!lig_size=5000; {maximum length of |lig_kern| program, in words}
+@!hash_size=5003; {preferably a prime number, a bit larger than the number
+ of character pairs in lig/kern steps}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@* Font metric data.
+The idea behind \.{TFM} files is that typesetting routines like \TeX\
+need a compact way to store the relevant information about several
+dozen fonts, and computer centers need a compact way to store the
+relevant information about several hundred fonts. \.{TFM} files are
+compact, and most of the information they contain is highly relevant,
+so they provide a solution to the problem.
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words; but \TeX\ uses the
+byte interpretation, and so does \.{TFtoPL}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of 0..255;
+
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|@!lf|&length of the entire file, in words;\cr
+|@!lh|&length of the header data, in words;\cr
+|@!bc|&smallest character code in the font;\cr
+|@!ec|&largest character code in the font;\cr
+|@!nw|&number of words in the width table;\cr
+|@!nh|&number of words in the height table;\cr
+|@!nd|&number of words in the depth table;\cr
+|@!ni|&number of words in the italic correction table;\cr
+|@!nl|&number of words in the lig/kern table;\cr
+|@!nk|&number of words in the kern table;\cr
+|@!ne|&number of words in the extensible character table;\cr
+|@!np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+
+@<Glob...@>=
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:0..@'77777;
+ {subfile sizes}
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]stuff|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but one of
+the |fix_word| values will lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+and for \.{TFM} files to be used with Xerox printing software it must
+contain at least 18 words, allocated as described below. When different
+kinds of devices need to be interfaced, it may be necessary to add further
+words to the header block.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
+\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
+file is printed, possibly on another computer, the actual font that gets
+used is supposed to have a check sum that agrees with the one in the
+\.{TFM} file used by \TeX. In this way, users will be warned about
+potential incompatibilities. (However, if the check sum is zero in either
+the font file or the \.{TFM} file, no check is made.) The actual relation
+between this check sum and the rest of the \.{TFM} file is not important;
+the check sum is simply an identification number with the property that
+incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
+must be at least 1.0; it is fairly arbitrary, but usually the design size
+is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
+best at a 10-point size, whatever that really means. When a \TeX\ user
+asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
+design size and replace it by $\delta$, and to multiply the $x$ and~$y$
+coordinates of the points in the font image by a factor of $\delta$
+divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
+file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
+the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
+value $2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
+the whole \.{TFM} file whose first byte might be something besides 0 or
+255. @^design size@>
+
+\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
+the character coding scheme. The first byte, which must be between 0 and
+39, is the number of subsequent ASCII bytes actually relevant in this
+string, which is intended to specify what character-code-to-symbol
+convention is present in the font. Examples are \.{ASCII} for standard
+ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
+extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
+special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
+when there is no information. Parentheses should not appear in this name.
+(Such a string is said to be in {\mc BCPL} format.)
+@^coding scheme@>
+
+\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
+font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
+This field is also known as the ``font identifier.''
+@^family name@>
+@^font identifier@>
+
+\yskip\hang|header[17]|, if present, contains a first byte called the
+|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
+called the |face|. If the value of the fourth byte is less than 18, it has
+the following interpretation as a ``weight, slope, and expansion'': Add 0
+or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
+0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
+0+1+12, so it represents medium italic extended. A three-letter code
+(e.g., \.{MIE}) can be used for such |face| data.
+
+\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
+words are simply called |header[18]|, |header[19]|, etc., at the moment.
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each |char_info_word| contains six fields packed into
+four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+ (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+ (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is |width[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
+should always hold, so that an index of zero implies a value of zero.
+The |width_index| should never be zero unless the character does
+not exist in the font, since a character is valid if and only if it lies
+between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at |lig_kern[remainder]|.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain. The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+
+@d no_tag=0 {vanilla character}
+@d lig_tag=1 {character has a ligature/kerning program}
+@d list_tag=2 {character has a successor in a charlist}
+@d ext_tag=3 {character is extensible}
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+ step if the byte is 128 or more, otherwise the next step is obtained by
+ skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+ then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+ a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+Notice that if $a=0$ and $b=1$, the current character is unchanged; if
+$a=b$ and $c=1$, the current character is changed but the next character is
+unchanged. \.{TFtoPL} will check to see that infinite loops are avoided.
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must have
+|256*op_byte+remainder<nl|. If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag=128 {op code for a kern step}
+
+@ Extensible characters are specified by an |extensible_recipe|,
+which consists of four bytes called |top|, |mid|,
+|bot|, and |rep| (in this order). These bytes are the character codes
+of individual pieces used to build up a large symbol.
+If |top|, |mid|, or |bot| are zero,
+they are not present in the built-up result. For example, an extensible
+vertical line is like an extensible bracket, except that the top and
+bottom pieces are missing.
+
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the height of letters for which accents don't
+have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+When the character coding scheme is \.{TeX math symbols}, the font is
+supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
+|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
+|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
+character coding scheme is \.{TeX math extension}, the font is supposed to
+have six additional parameters called |default_rule_thickness| and
+|big_op_spacing1| through |big_op_spacing5|.
+
+@ So that is what \.{TFM} files hold. The next question is, ``What about
+\.{PL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{PLtoTF}, so it will not
+be repeated here. Suffice it to say that a \.{PL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a
+subset of the possible constructions that might appear in a \.{PL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{PL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!pl_file:text;
+
+@ @<Set init...@>=
+rewrite(pl_file);
+
+@* Unpacked representation.
+The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+@!index=0..tfm_size; {address of a byte in |tfm|}
+
+@ @<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+
+@ The input may, of course, be all screwed up and not a \.{TFM} file
+at all. So we begin cautiously.
+
+@d abort(#)==begin print_ln(#);
+ print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
+ goto final_end;
+ end
+
+@<Read the whole input file@>=
+read(tfm_file,tfm[0]);
+if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
+@.The first byte...@>
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+if lf=0 then
+ abort('The file claims to have length zero, but that''s impossible!');
+@.The file claims...@>
+if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+for tfm_ptr:=2 to 4*lf-1 do
+ begin if eof(tfm_file) then
+ abort('The file has fewer bytes than it claims!');
+@.The file has fewer bytes...@>
+ read(tfm_file,tfm[tfm_ptr]);
+ end;
+if not eof(tfm_file) then
+ begin print_ln('There''s some extra junk at the end of the TFM file,');
+@.There's some extra junk...@>
+ print_ln('but I''ll proceed as if it weren''t there.');
+ end
+
+@ After the file has been read successfully, we look at the subfile sizes
+to see if they check out.
+
+@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
+ abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+ #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
+ tfm_ptr:=tfm_ptr+2;
+ end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin tfm_ptr:=2;@/
+eval_two_bytes(lh);
+eval_two_bytes(bc);
+eval_two_bytes(ec);
+eval_two_bytes(nw);
+eval_two_bytes(nh);
+eval_two_bytes(nd);
+eval_two_bytes(ni);
+eval_two_bytes(nl);
+eval_two_bytes(nk);
+eval_two_bytes(ne);
+eval_two_bytes(np);
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if nl>lig_size then
+ abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>255) then abort('The character code range ',
+@.The character code range...@>
+ bc:1,'..',ec:1,' is illegal!');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+ abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>256 then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then
+ abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+end
+
+@ Once the input data successfully passes these basic checks,
+\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
+to \.{PL} format will take place. Access to the various subfiles
+is facilitated by computing the following base addresses. For example,
+the |char_info| for character |c| will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base,
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+ {base addresses for the subfiles}
+
+@ @<Compute the base addresses@>=
+begin char_base:=6+lh-bc;
+width_base:=char_base+ec+1;
+height_base:=width_base+nw;
+depth_base:=height_base+nh;
+italic_base:=depth_base+nd;
+lig_kern_base:=italic_base+ni;
+kern_base:=lig_kern_base+nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+ne-1;
+end
+
+@ Of course we want to define macros that suppress the detail of how the
+font information is actually encoded. Each word will be referred to by
+the |tfm| index of its first byte. For example, if |c| is a character
+code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
+first byte of its |char_info|, i.e., the |width_index|; furthermore
+|width(c)| will point to the |fix_word| for |c|'s width.
+
+@d check_sum=24
+@d design_size=check_sum+4
+@d scheme=design_size+4
+@d family=scheme+40
+@d random_word=family+20
+@d char_info(#)==4*(char_base+#)
+@d width_index(#)==tfm[char_info(#)]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@d height_index(#)==(tfm[char_info(#)+1] div 16)
+@d depth_index(#)==(tfm[char_info(#)+1] mod 16)
+@d italic_index(#)==(tfm[char_info(#)+2] div 4)
+@d tag(#)==(tfm[char_info(#)+2] mod 4)
+@d reset_tag(#)==tfm[char_info(#)+2]:=4*italic_index(#)+no_tag
+@d remainder(#)==tfm[char_info(#)+3]
+@d width(#)==4*(width_base+width_index(#))
+@d height(#)==4*(height_base+height_index(#))
+@d depth(#)==4*(depth_base+depth_index(#))
+@d italic(#)==4*(italic_base+italic_index(#))
+@d exten(#)==4*(exten_base+remainder(#))
+@d lig_step(#)==4*(lig_kern_base+(#))
+@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@ One of the things we would like to do is take cognizance of fonts whose
+character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
+we will set the |font_type| variable to one of the three choices
+|vanilla|, |mathsy|, or |mathex|.
+
+@d vanilla=0 {not a special scheme}
+@d mathsy=1 {\.{TeX math symbols} scheme}
+@d mathex=2 {\.{TeX math extension} scheme}
+
+@<Glob...@>=
+@!font_type:vanilla..mathex; {is this font special?}
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{PL} file:
+
+@d out(#)==write(pl_file,#)
+
+@ In order to stick to standard \PASCAL, we use three strings called
+|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
+ {strings for output in the user's external character set}
+@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
+ {handy string constants for |face| codes}
+
+@ @<Set init...@>=
+ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
+ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
+ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
+MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
+
+@ The array |dig| will hold a sequence of digits to be output.
+
+@<Glob...@>=
+@!dig:array[0..11] of 0..9;
+
+@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|,
+given $j>0$.
+
+@p procedure out_digs(j:integer); {outputs |j| digits}
+begin repeat decr(j); out(dig[j]:1);
+until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(dig[j]:1);
+until j=0;
+end;
+
+@ The |print_octal| procedure indicates how |print_digs| can be used.
+Since this procedure is used only to print character codes, it always
+produces three digits.
+
+@p procedure print_octal(c:byte); {prints octal value of |c|}
+var j:0..2; {index into |dig|}
+begin print(''''); {an apostrophe indicates the octal notation}
+for j:=0 to 2 do
+ begin dig[j]:=c mod 8; c:=c div 8;
+ end;
+print_digs(3);
+end;
+
+@ A \.{PL} file has nested parentheses, and we want to format the output
+so that its structure is clear. The |level| variable keeps track of the
+depth of nesting.
+
+@<Glob...@>=
+@!level:0..5;
+
+@ @<Set init...@>=
+level:=0;
+
+@ Three simple procedures suffice to produce the desired structure in the
+output.
+
+@p procedure out_ln; {finishes one line, indents the next}
+var l:0..5;
+begin write_ln(pl_file);
+for l:=1 to level do out(' ');
+end;
+@#
+procedure left; {outputs a left parenthesis}
+begin incr(level); out('(');
+end;
+@#
+procedure right; {outputs a right parenthesis and finishes a line}
+begin decr(level); out(')'); out_ln;
+end;
+
+@ The value associated with a property can be output in a variety of
+ways. For example, we might want to output a {\mc BCPL} string that
+begins in |tfm[k]|:
+
+@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
+var l:0..39; {the number of bytes remaining}
+begin out(' '); l:=tfm[k];
+while l>0 do
+ begin incr(k); decr(l);
+ case tfm[k] div @'40 of
+ 1: out(ASCII_04[1+(tfm[k] mod @'40)]);
+ 2: out(ASCII_10[1+(tfm[k] mod @'40)]);
+ 3: out(ASCII_14[1+(tfm[k] mod @'40)]);
+ end;
+ end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in octal notation.
+The following procedure assumes that |l<=4|, but larger values of |l|
+could be handled easily by enlarging the |dig| array and increasing
+the upper bounds on |b| and |j|.
+
+@p procedure out_octal(@!k,@!l:index); {outputs |l| bytes in octal}
+var a:0..@'1777; {accumulator for bits not yet output}
+@!b:0..32; {the number of significant bits in |a|}
+@!j:0..11; {the number of digits of output}
+begin out(' O '); {specify octal format}
+a:=0; b:=0; j:=0;
+while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
+while (a>0)or(j=0) do
+ begin dig[j]:=a mod 8; a:=a div 8; incr(j);
+ end;
+out_digs(j);
+end;
+
+@ @<Reduce \(1)|l|...@>=
+begin decr(l);
+if tfm[k+l]<>0 then
+ begin while b>2 do
+ begin dig[j]:=a mod 8; a:=a div 8; b:=b-3; incr(j);
+ end;
+ case b of
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ end;
+ end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in octal
+unless it is a letter or a digit. This procedure is the only place
+where a lowercase letter will be output to the \.{PL} file.
+@^system dependencies@>
+
+@p procedure out_char(@!c:byte); {outputs a character}
+begin if font_type>vanilla then
+ begin tfm[0]:=c; out_octal(0,1)
+ end
+else if (c>="0")and(c<="9") then
+ out(' C ',c-"0":1)
+else if (c>="A")and(c<="Z") then
+ out(' C ',ASCII_10[c-"A"+2])
+else if (c>="a")and(c<="z") then
+ out(' C ',ASCII_14[c-"a"+2])
+else begin tfm[0]:=c; out_octal(0,1);
+ end;
+end;
+
+@ The property value might be a ``face'' byte, which is output in the
+curious code mentioned earlier, provided that it is less than 18.
+
+@p procedure out_face(@!k:index); {outputs a |face|}
+var s:0..1; {the slope}
+@!b:0..8; {the weight and expansion}
+begin if tfm[k]>=18 then out_octal(k,1)
+else begin out(' F '); {specify face-code format}
+ s:=tfm[k] mod 2; b:=tfm[k] div 2;
+ out(MBL_string[1+(b mod 3)]);
+ out(RI_string[1+s]);
+ out(RCE_string[1+(b div 3)]);
+ end;
+end;
+
+@ And finally, the value might be a |fix_word|, which is output in
+decimal notation with just enough decimal places for \.{PLtoTF}
+to recover every bit of the given |fix_word|.
+
+All of the numbers involved in the intermediate calculations of
+this procedure will be nonnegative and less than $10\cdot2^{24}$.
+
+@p procedure out_fix(@!k:index); {outputs a |fix_word|}
+var a:0..@'7777; {accumulator for the integer part}
+@!f:integer; {accumulator for the fraction part}
+@!j:0..12; {index into |dig|}
+@!delta:integer; {amount if allowable inaccuracy}
+begin out(' R '); {specify real format}
+a:=(tfm[k]*16)+(tfm[k+1] div 16);
+f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
+if a>@'3777 then @<Reduce \(2)negative to positive@>;
+@<Output the integer part, |a|, in decimal notation@>;
+@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
+end;
+
+@ The following code outputs at least one digit even if |a=0|.
+
+@<Output the integer...@>=
+begin j:=0;
+repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
+until a=0;
+out_digs(j);
+end
+
+@ And the following code outputs at least one digit to the right
+of the decimal point.
+
+@<Output the fraction...@>=
+begin out('.'); f:=10*f+5; delta:=10;
+repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
+out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
+until f<=delta;
+end;
+
+@ @<Reduce \(2)negative to positive@>=
+begin out('-'); a:=@'10000-a;
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
+ end;
+end
+
+@* Doing it.
+\TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. And when it finds something wrong, it justs
+calls the file ``bad,'' without identifying the nature of the problem,
+since \.{TFM} files are supposed to be good almost all of the time.
+
+Of course, a bad file shows up every now and again, and that's where
+\.{TFtoPL} comes in. This program wants to catch at least as many errors as
+\TeX\ does, and to give informative error messages besides.
+All of the errors are corrected, so that the \.{PL} output will
+be correct (unless, of course, the \.{TFM} file was so loused up
+that no attempt is being made to fathom it).
+
+@ Just before each character is processed, its code is printed in octal
+notation. Up to eight such codes appear on a line; so we have a variable
+to keep track of how many are currently there. We also keep track of
+whether or not any errors have had to be corrected.
+
+@<Glob...@>=
+@!chars_on_line:0..8; {the number of characters printed on the current line}
+@!perfect:boolean; {was the file free of errors?}
+
+@ @<Set init...@>=
+chars_on_line:=0;@/
+perfect:=true; {innocent until proved guilty}
+
+@ Error messages are given with the help of the |bad| and |range_error|
+and |bad_char| macros:
+
+@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print_ln('Bad TFM file: ',#);
+ end
+@.Bad TFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+ print(#,' index for character ');
+ print_octal(c); print_ln(' is too large;');
+ print_ln('so I reset it to zero.');
+ end
+@d bad_char_tail(#)==print_octal(#); print_ln('.');
+ end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ bad_char_tail
+@d correct_bad_char_tail(#)==print_octal(tfm[#]); print_ln('.'); tfm[#]:=bc;
+ end
+@d correct_bad_char(#)== begin perfect:=false;
+ if chars_on_line>0 then print_ln(' ');
+ chars_on_line:=0; print('Bad TFM file: ',#,' nonexistent character ');
+ correct_bad_char_tail
+
+@<Glob...@>=
+@!i:0..@'77777; {an index to words of a subfile}
+@!c:0..256; {a random character}
+@!d:0..3; {byte number in a word}
+@!k:index; {a random index}
+@!r:0..65535; {a random two-byte value}
+@!count:0..127; {for when we need to enumerate a small set}
+
+@ There are a lot of simple things to do, and they have to be done one
+at a time, so we might as well get down to business. The first things
+that \.{TFtoPL} will put into the \.{PL} file appear in the header part.
+
+@<Do the header@>=
+begin font_type:=vanilla;
+if lh>=12 then
+ begin @<Set the true |font_type|@>;
+ if lh>=17 then
+ begin @<Output the family name@>;
+ if lh>=18 then @<Output the rest of the header@>;
+ end;
+ @<Output the character coding scheme@>;
+ end;
+@<Output the design size@>;
+@<Output the check sum@>;
+@<Output the |seven_bit_safe_flag|@>;
+end
+
+@ @<Output the check sum@>=
+left; out('CHECKSUM'); out_octal(check_sum,4);
+right
+
+@ Incorrect design sizes are changed to 10 points.
+
+@d bad_design(#)==begin bad('Design size ',#,'!');
+@.Design size wrong@>
+ print_ln('I''ve set it to 10 points.');
+ out(' D 10');
+ end
+
+@ @<Output the design size@>=
+left; out('DESIGNSIZE');
+if tfm[design_size]>127 then bad_design('negative')
+else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
+ bad_design('too small')
+else out_fix(design_size);
+right;
+out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
+out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
+@.DESIGNSIZE IS IN POINTS@>
+
+@ Since we have to check two different {\mc BCPL} strings for validity,
+we might as well write a subroutine to make the check.
+
+@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
+var j:index; {runs through the string}
+@!c:byte; {character being checked}
+begin if tfm[k]>=l then
+ begin bad('String is too long; I''ve shortened it drastically.');
+@.String is too long...@>
+ tfm[k]:=1;
+ end;
+for j:=k+1 to k+tfm[k] do
+ begin c:=tfm[j];
+ if (c="(")or(c=")") then
+ begin bad('Parenthesis in string has been changed to slash.');
+@.Parenthesis...changed to slash@>
+ tfm[j]:="/";
+ end
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
+@.Nonstandard ASCII code...@>
+ tfm[j]:="?";
+ end
+ else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
+ end;
+end;
+
+@ The |font_type| starts out |vanilla|; possibly we need to reset it.
+
+@<Set the true |font_type|@>=
+begin check_BCPL(scheme,40);
+if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
+ (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
+ (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
+ (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
+ begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
+ end;
+end
+
+@ @<Output the character coding scheme@>=
+left; out('CODINGSCHEME');
+out_BCPL(scheme);
+right
+
+@ @<Output the family name@>=
+left; out('FAMILY');
+check_BCPL(family,20);
+out_BCPL(family);
+right
+
+@ @<Output the rest of the header@>=
+begin left; out('FACE'); out_face(random_word+3); right;
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
+ out_octal(check_sum+4*i,@,4); right;
+ end;
+end
+
+@ This program does not check to see if the |seven_bit_safe_flag| has the
+correct setting, i.e., if it really reflects the seven-bit-safety of
+the \.{TFM} file; the stated value is merely put into the \.{PL} file.
+The \.{PLtoTF} program will store a correct value and give a warning
+message if a file falsely claims to be safe.
+
+@<Output the |seven_bit_safe_flag|@>=
+if (lh>17) and (tfm[random_word]>127) then
+ begin left; out('SEVENBITSAFEFLAG TRUE'); right;
+ end
+
+@ The next thing to take care of is the list of parameters.
+
+@<Do the parameters@>=
+if np>0 then
+ begin left; out('FONTDIMEN'); out_ln;
+ for i:=1 to np do @<Check and output the $i$th parameter@>;
+ right;
+ end;
+@<Check to see if |np| is complete for this font type@>;
+
+@ @<Check to see if |np|...@>=
+if (font_type=mathsy)and(np<>22) then
+ print_ln('Unusual number of fontdimen parameters for a math symbols font (',
+@.Unusual number of fontdimen...@>
+ np:1,' not 22).')
+else if (font_type=mathex)and(np<>13) then
+ print_ln('Unusual number of fontdimen parameters for an extension font (',
+ np:1,' not 13).')
+
+@ All |fix_word| values except the design size and the first parameter
+will be checked to make sure that they are less than 16.0 in magnitude,
+using the |check_fix| macro:
+
+@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
+ print_ln('I have set it to zero.');
+ end
+@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
+ begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
+ check_fix_tail
+
+@<Check and output the $i$th parameter@>=
+begin left;
+if i=1 then out('SLANT') {this parameter is not checked}
+else begin check_fix(param(i))('Parameter');@/
+@.Parameter n is too big@>
+ @<Output the name of parameter $i$@>;
+ end;
+out_fix(param(i)); right;
+end
+
+@ @<Output the name...@>=
+if i<=7 then case i of
+ 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
+ 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
+else if (i<=22)and(font_type=mathsy) then case i of
+ 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
+ 11:out('DENOM1');@+12:out('DENOM2');
+ 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
+ 16:out('SUB1');@+17:out('SUB2');
+ 18:out('SUPDROP');@+19:out('SUBDROP');
+ 20:out('DELIM1');@+21:out('DELIM2');
+ 22:out('AXISHEIGHT')@+end
+else if (i<=13)and(font_type=mathex) then
+ if i=8 then out('DEFAULTRULETHICKNESS')
+ else out('BIGOPSPACING',i-8:1)
+else out('PARAMETER D ',i:1)
+
+@ We need to check the range of all the remaining |fix_word| values,
+and to make sure that |width[0]=0|, etc.
+
+@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
+
+@<Check the |fix_word| entries@>=
+if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
+@.should be zero@>
+if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
+if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
+if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
+for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
+@.Width n is too big@>
+for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
+@.Height n is too big@>
+for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
+@.Depth n is too big@>
+for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
+@.Italic correction n is too big@>
+if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
+@.Kern n is too big@>
+
+@ The ligature/kerning program comes next. Before we can put it out in
+\.{PL} format, we need to make a table of ``labels'' that will be inserted
+into the program. For each character |c| whose |tag| is |lig_tag| and
+whose starting address is |r|, we will store the pair |(c,r)| in the
+|label_table| array. If there's a boundary-char program starting at~|r|,
+we also store the pair |(256,r)|.
+This array is sorted by its second components, using the
+simple method of straight insertion.
+
+@<Glob...@>=
+@!label_table:array[0..258] of record@t@>@/@!cc:0..256;@!rr:0..lig_size;end;
+@!label_ptr: 0..257; {the largest entry in |label_table|}
+@!sort_ptr:0..257; {index into |label_table|}
+@!boundary_char:0..256; {boundary character, or 256 if none}
+@!bchar_label:0..@'77777; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=256; bchar_label:=@'77777;@/
+label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
+
+@ We'll also identify and remove inaccessible program steps, using the
+|activity| array.
+
+@d unreachable=0 {a program step not known to be reachable}
+@d pass_through=1 {a program step passed through on initialization}
+@d accessible=2 {a program step that can be relevant}
+
+@<Glob...@>=
+@!activity:array[0..lig_size] of unreachable..accessible;
+@!ai,@!acti:0..lig_size; {indices into |activity|}
+
+@ @<Do the ligatures and kerns@>=
+if nl>0 then
+ begin for ai:=0 to nl-1 do activity[ai]:=unreachable;
+ @<Check for a boundary char@>;
+ end;
+@<Build the label table@>;
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
+ @<Compute the |activity| array@>;
+ @<Output and correct the ligature/kern program@>;
+ right;
+ @<Check for ligature cycles@>;
+ end
+
+@ We build the label table even when |nl=0|, because this catches errors
+that would not otherwise be detected.
+
+@<Build...@>=
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin r:=remainder(c);
+ if r<nl then
+ begin if tfm[lig_step(r)]>stop_flag then
+ begin r:=256*tfm[lig_step(r)+2]+tfm[lig_step(r)+3];
+ if r<nl then if activity[remainder(c)]=unreachable then
+ activity[remainder(c)]:=pass_through;
+ end;
+ end;
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for character '); print_octal(c);
+ print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c);
+@.Ligature/kern starting index...@>
+ end
+ else @<Insert |(c,r)| into |label_table|@>;
+ end;
+label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
+
+@ @<Insert |(c,r)|...@>=
+begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+while label_table[sort_ptr].rr>r do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
+ decr(sort_ptr); {move the hole}
+ end;
+label_table[sort_ptr+1].cc:=c;
+label_table[sort_ptr+1].rr:=r; {fill the hole}
+incr(label_ptr); activity[r]:=accessible;
+end
+
+@ @<Check for a bound...@>=
+if tfm[lig_step(0)]=255 then
+ begin left; out('BOUNDARYCHAR');
+ boundary_char:=tfm[lig_step(0)+1]; out_char(boundary_char); right;
+ activity[0]:=pass_through;
+ end;
+if tfm[lig_step(nl-1)]=255 then
+ begin r:=256*tfm[lig_step(nl-1)+2]+tfm[lig_step(nl-1)+3];
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
+ print('Ligature/kern starting index for boundarychar is too large;');
+ print_ln('so I removed it.');
+@.Ligature/kern starting index...@>
+ end
+ else begin label_ptr:=1; label_table[1].cc:=256; label_table[1].rr:=r;
+ bchar_label:=r; activity[r]:=accessible;
+ end;
+ activity[nl-1]:=pass_through;
+ end
+
+@ @<Compute the |activity| array@>=
+for ai:=0 to nl-1 do if activity[ai]=accessible then
+ begin r:=tfm[lig_step(ai)];
+ if r<stop_flag then
+ begin r:=r+ai+1;
+ if r>=nl then
+ begin bad('Ligature/kern step ',ai:1,' skips too far;');
+@.Lig...skips too far@>
+ print_ln('I made it stop.'); tfm[lig_step(ai)]:=stop_flag;
+ end
+ else activity[r]:=accessible;
+ end;
+ end
+
+@ We ignore |pass_through| items, which don't need to be mentioned in
+the \.{PL} file.
+
+@<Output and correct the ligature...@>=
+sort_ptr:=1; {point to the next label that will be needed}
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then
+ begin i:=acti; @<Take care of commenting out unreachable steps@>;
+ @<Output any labels for step $i$@>;
+ @<Output step $i$ of the ligature/kern program@>;
+ end;
+if level=2 then right {the final step was unreachable}
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do
+ begin left; out('LABEL');
+ if label_table[sort_ptr].cc=256 then out(' BOUNDARYCHAR')
+ else out_char(label_table[sort_ptr].cc);
+ right; incr(sort_ptr);
+ end
+
+@ @<Take care of commenting out...@>=
+if activity[i]=unreachable then
+ begin if level=1 then
+ begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+ end
+ end
+else if level=2 then right
+
+@ @<Output step $i$...@>=
+begin k:=lig_step(i);
+if tfm[k]>stop_flag then
+ begin if 256*tfm[k+2]+tfm[k+3]>=nl then
+ bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+ end
+else if tfm[k+2]>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if tfm[k]>0 then
+ if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
+end
+
+@ The \.{SKIP} command is a bit tricky, because we will be omitting all
+inaccessible commands.
+
+@<Output either...@>=
+begin if tfm[k]>=stop_flag then out('(STOP)')
+else begin count:=0;
+ for ai:=i+1 to i+tfm[k] do if activity[ai]=accessible then incr(count);
+ out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
+ end;
+out_ln;
+end
+
+@ @<Output a kern step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Kern step for')(k+1);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(tfm[k+1]);
+r:=256*(tfm[k+2]-kern_flag)+tfm[k+3];
+if r>=nk then
+ begin bad('Kern index too large.');
+@.Kern index too large@>
+ out(' R 0.0');
+ end
+else out_fix(kern(r));
+right;
+end
+
+@ @<Output a ligature step@>=
+begin if nonexistent(tfm[k+1]) then if tfm[k+1]<>boundary_char then
+ correct_bad_char('Ligature step for')(k+1);
+@.Ligature step for nonexistent...@>
+if nonexistent(tfm[k+3]) then
+ correct_bad_char('Ligature step produces the')(k+3);
+@.Ligature step produces...@>
+left; r:=tfm[k+2];
+if (r=4)or((r>7)and(r<>11)) then
+ begin print_ln('Ligature step with nonstandard code changed to LIG');
+ r:=0; tfm[k+2]:=0;
+ end;
+if r mod 4>1 then out('/');
+out('LIG');
+if odd(r) then out('/');
+while r>3 do
+ begin out('>'); r:=r-4;
+ end;
+out_char(tfm[k+1]); out_char(tfm[k+3]); right;
+end
+
+@ The last thing on \.{TFtoPL}'s agenda is to go through the
+list of |char_info| and spew out the information about each individual
+character.
+
+@<Do the characters@>=
+sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
+for c:=bc to ec do if width_index(c)>0 then
+ begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+ else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ print_octal(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ @<Output the character's width@>;
+ if height_index(c)>0 then @<Output the character's height@>;
+ if depth_index(c)>0 then @<Output the character's depth@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end; {there are no other cases}
+ right;
+ end
+
+@ @<Output the character's width@>=
+begin left; out('CHARWD');
+if width_index(c)>=nw then range_error('Width')
+else out_fix(width(c));
+right;
+end
+
+@ @<Output the character's height@>=
+if height_index(c)>=nh then range_error('Height')
+@.Height index for char...@>
+else begin left; out('CHARHT'); out_fix(height(c)); right;
+ end
+
+@ @<Output the character's depth@>=
+if depth_index(c)>=nd then range_error('Depth')
+@.Depth index for char@>
+else begin left; out('CHARDP'); out_fix(depth(c)); right;
+ end
+
+@ @<Output the italic correction@>=
+if italic_index(c)>=ni then range_error('Italic correction')
+@.Italic correction index for char...@>
+else begin left; out('CHARIC'); out_fix(italic(c)); right;
+ end
+
+@ @<Output the applicable part of the ligature...@>=
+begin left; out('COMMENT'); out_ln;@/
+i:=remainder(c); r:=lig_step(i);
+if tfm[r]>stop_flag then i:=256*tfm[r+2]+tfm[r+3];
+repeat @<Output step...@>;
+if tfm[k]>=stop_flag then i:=nl
+else i:=i+1+tfm[k];
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since \TeX\ doesn't want to risk endless loops.
+If such a cycle exists, the routine here detects it when processing
+the largest character code in the cycle.
+
+@<Output the character link unless there is a problem@>=
+begin r:=remainder(c);
+if nonexistent(r) then
+ begin bad_char('Character list link to')(r); reset_tag(c);
+@.Character list link...@>
+ end
+else begin while (r<c)and(tag(r)=list_tag) do r:=remainder(r);
+ if r=c then
+ begin bad('Cycle in a character list!');
+@.Cycle in a character list@>
+ print('Character '); print_octal(c);
+ print_ln(' now ends the list.');
+ reset_tag(c);
+ end
+ else begin left; out('NEXTLARGER'); out_char(remainder(c));
+ right;
+ end;
+ end;
+end
+
+@ @<Output an extensible character recipe@>=
+if remainder(c)>=ne then
+ begin range_error('Extensible'); reset_tag(c);
+@.Extensible index for char@>
+ end
+else begin left; out('VARCHAR'); out_ln;
+ @<Output the extensible pieces that exist@>;
+ right;
+ end
+
+@ @<Output the extensible pieces that...@>=
+for k:=0 to 3 do if (k=3)or(tfm[exten(c)+k]>0) then
+ begin left;
+ case k of
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(tfm[exten(c)+k]) then out_char(c)
+ else out_char(tfm[exten(c)+k]);
+ right;
+ end
+
+@ Some of the extensible recipes may not actually be used, but \TeX\ will
+complain about them anyway if they refer to nonexistent characters.
+Therefore \.{TFtoPL} must check them too.
+
+@<Check the extensible recipes@>=
+if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do
+ begin k:=4*(exten_base+c)+d;
+ if (tfm[k]>0)or(d=3) then
+ begin if nonexistent(tfm[k]) then
+ begin bad_char('Extensible recipe involves the')(tfm[k]);
+@.Extensible recipe involves...@>
+ if d<3 then tfm[k]:=0;
+ end;
+ end;
+ end
+
+@* Checking for ligature loops.
+We have programmed almost everything but the most interesting calculation of
+all, which has been saved for last as a special treat. \TeX's extended ligature
+mechanism allows unwary users to specify sequences of ligature replacements
+that never terminate. For example, the pair of commands
+$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
+alternately replaces character $x$ by character $y$ and vice versa. A similar
+loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
+ \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
+
+More complicated loops are also possible. For example, suppose the ligature
+programs for $x$ and $y$ are
+$$\vcenter{\halign{#\hfil\cr
+\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
+\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
+then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
+\dots, ad infinitum.
+
+@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
+$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
+follows: If the current character is $x$ and the next character is
+$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
+first moves past $y$, the character immediately to its left is
+$f(x,y)$. This function is defined if and only if no infinite loop is
+generated when the cursor is between $x$ and~$y$.
+
+The function $f(x,y)$ can be defined recursively. It turns out that all pairs
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this
+happens if there's no ligature between $x$ and $y$, or in the cases
+\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
+\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
+then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
+either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
+ligature character.
+
+The first two of these classes can be merged; we can also consider
+$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
+For technical reasons we allow $x$ to be 256 (for the boundary character
+at the left) or 257 (in cases when an error has been detected).
+
+For each pair $(x,y)$ having a ligature program step, we store
+$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
+
+@d simple=0 {$f(x,y)=z$}
+@d left_z=1 {$f(x,y)=f(z,y)$}
+@d right_z=2 {$f(x,y)=f(x,z)$}
+@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
+@d pending=4 {$f(x,y)$ is being evaluated}
+
+@<Glob...@>=
+@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$}
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of 0..257;
+@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
+@!h,@!hh:0..hash_size; {indices into the hash table}
+@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=256;
+for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin i:=remainder(c);
+ if tfm[lig_step(i)]>stop_flag then
+ i:=256*tfm[lig_step(i)+2]+tfm[lig_step(i)+3];
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if bchar_label<nl then
+ begin c:=256; i:=bchar_label;
+ @<Enter data for character $c$ starting at location |i| in the hash table@>;
+ end;
+if hash_ptr=hash_size then
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+@.Sorry, I haven't room...@>
+ goto final_end;
+ end;
+for hh:=1 to hash_ptr do
+ begin r:=hash_list[hh];
+ if class[r]>simple then {make sure $f$ is defined}
+ r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
+ end;
+if y_lig_cycle<256 then
+ begin print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+ if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle);
+ print(' and '); print_octal(y_lig_cycle); print_ln('!');
+ out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
+ end
+
+@ @<Enter data for character $c$...@>=
+repeat hash_input; k:=tfm[lig_step(i)];
+if k>=stop_flag then i:=nl
+else i:=i+1+k;
+until i>=nl
+
+@ We use an ``ordered hash table'' with linear probing, because such a table
+is efficient when the lookup of a random key tends to be unsuccessful.
+
+@p procedure hash_input; {enter data for character |c| and command |i|}
+label 30; {go here for a quick exit}
+var @!cc:simple..both_z; {class of data being entered}
+@!zz:0..255; {function value or ligature character being entered}
+@!y:0..255; {the character after the cursor}
+@!key:integer; {value to be stored in |hash|}
+@!t:integer; {temporary register for swapping}
+begin if hash_ptr=hash_size then goto 30;
+@<Compute the command parameters |y|, |cc|, and |zz|@>;
+key:=256*c+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then goto 30; {unused ligature command}
+ t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
+ t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
+ end;
+ if h>0 then decr(h)@+else h:=hash_size;
+ end;
+hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
+incr(hash_ptr); hash_list[hash_ptr]:=h;
+30:end;
+
+@ We must store kern commands as well as ligature commands, because the former
+might make the latter inapplicable.
+
+@<Compute the command param...@>=
+k:=lig_step(i); y:=tfm[k+1]; t:=tfm[k+2]; cc:=simple; zz:=tfm[k+3];
+if t>=kern_flag then zz:=y
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
+ end
+
+@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
+Kind of a neat algorithm, generalizing a depth-first search.
+
+@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+ {compute $f$ for arguments known to be in |hash[h]|}
+function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
+var @!key:integer; {value sought in hash table}
+begin key:=256*x+y+1; h:=(1009*key) mod hash_size;
+while hash[h]>key do
+ if h>0 then decr(h)@+else h:=hash_size;
+if hash[h]<key then eval:=y {not in ordered hash table}
+else eval:=f(h,x,y);
+end;
+
+@ Pascal's beastly convention for |forward| declarations prevents us from
+saying |function f(h,x,y:index):index| here.
+
+@p function f;
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple;
+ end; {the value 257 will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* The main program.
+The routines sketched out so far need to be packaged into separate procedures,
+on some systems, since some \PASCAL\ compilers place a strict limit on the
+size of a routine. The packaging is done here in an attempt to avoid some
+system-dependent changes.
+
+First comes the |organize| procedure, which reads the input data and
+gets ready for subsequent events. If something goes wrong, the routine
+returns |false|.
+
+@p function organize:boolean;
+label final_end, 30;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole input file@>;@/
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/
+@<Compute the base addresses@>;@/
+organize:=true; goto 30;
+final_end: organize:=false;
+30: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:0..@'77777; {an index to words of a subfile}
+begin @<Do the header@>;@/
+@<Do the parameters@>;@/
+@<Check the |fix_word| entries@>@/
+end;
+
+@ And then there's a routine for individual characters.
+
+@p procedure do_characters;
+var @!c:byte; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+end;
+
+@ Here is where \.{TFtoPL} begins and ends.
+@p begin initialize;@/
+if not organize then goto final_end;
+do_simple_things;@/
+@<Do the ligatures and kerns@>;
+@<Check the extensible recipes@>;
+do_characters; print_ln('.');@/
+if level<>0 then print_ln('This program isn''t working!');
+@.This program isn't working@>
+if not perfect then
+ begin out('(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
+@.THE TFM FILE WAS BAD...@>
+ write_ln(pl_file);
+ end;
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.