texk 1

git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 3138 insertions, 0 deletions

diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
new file mode 100644
index 00000000000..2e2e374dca5
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.web
@@ -0,0 +1,3138 @@
+% 
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+% applies only to the changes to the original vftovp.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 1 was implemented in December 1989.
+% Version 1.1 fixed problems of strict Pascal (April 1990).
+% Version 1.2 fixed various bugs found by Peter Breitenlohner (September 1990).
+
+% 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{OVF2OVP}
+\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 OVF2OVP} processor}
+  \vskip 15pt
+  \centerline{(Version 1.11, February 2000)}
+  \vfill}
+\def\botofcontents{\vfill
+  \centerline{\hsize 5in\baselineskip9pt
+    \vbox{\ninerm\noindent
+    The preparation of this program
+    was supported in part by the National Science
+    Foundation and by the System Development Foundation. `\TeX' is a
+    trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file
+and its associated \TeX\ font metric (``\.{TFM}'')
+file into an equivalent virtual-property-list (``\.{VPL}'') file. It also
+makes a thorough check of the given files, using algorithms that are
+essentially the same as those used by
+\.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver
+complains that a \.{TFM} or \.{VF}
+file is ``bad,'' this program will pinpoint the source or sources of
+badness. A \.{VPL} file output by this program can be edited with
+a normal text editor, and the result can be converted back to \.{VF} and \.{TFM}
+format using the companion program \.{VPtoVF}.
+
+\indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which
+is part of the standard \TeX ware library.
+The idea of a virtual font was inspired by the work of David R. Fuchs
+@^Fuchs, David Raymond@>
+who designed a similar set of conventions in 1984 while developing a
+device driver for ArborText, Inc. He wrote a somewhat similar program
+called \.{AMFtoXPL}.
+
+The |banner| string defined here should be changed whenever \.{VFtoVP}
+gets modified.
+
+@d banner=='This is OVF2OVP, Version 1.11' {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 |vf_file| and |tfm_file|; the output is written on |vpl_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 OVF2OVP(@!vf_file,@!tfm_file,@!vpl_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 @!k:integer; {all-purpose index for initialization}
+  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 \.{VFtoVP}'s capacity.
+
+@<Constants...@>=
+@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
+@!vf_size=600000; {maximum length of |vf| data, in bytes}
+@!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!lig_size=800000; {maximum length of |lig_kern| program, in words}
+@!hash_size=130003; {preferably a prime number, a bit larger than the number
+  of character pairs in lig/kern steps}
+@!hash_mult=16007; {another prime}
+@!max_char=65535; {the largest character number in a font}
+@!xmax_char=65536; {|max_char|+1}
+@!xxmax_char=65537;{|max_char|+2}
+@!xmax_label=80001;{must be greater than |max_lig_steps|}
+@!mem_size=40008; {|max_char|*4+8}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!max_stack=50; {maximum depth of \.{DVI} stack in character packets}
+
+@ 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}
+@d exit=10 {go here to leave a procedure}
+@d not_found=45 {go here when you've found nothing}
+@d return==goto exit {terminate a procedure call}
+@f return==nil
+
+@<Types...@>=
+@!byte=0..255; {unsigned eight-bit quantity}
+
+@* Virtual fonts.  The idea behind \.{VF} files is that a general
+interface mechanism is needed to switch between the myriad font
+layouts provided by different suppliers of typesetting equipment.
+Without such a mechanism, people must go to great lengths writing
+inscrutable macros whenever they want to use typesetting conventions
+based on one font layout in connection with actual fonts that have
+another layout. This puts an extra burden on the typesetting system,
+interfering with the other things it needs to do (like kerning,
+hyphenation, and ligature formation).
+
+These difficulties go away when we have a ``virtual font,''
+i.e., a font that exists in a logical sense but not a physical sense.
+A typesetting system like \TeX\ can do its job without knowing where the
+actual characters come from; a device driver can then do its job by
+letting a \.{VF} file tell what actual characters correspond to the
+characters \TeX\ imagined were present. The actual characters
+can be shifted and/or magnified and/or combined with other characters
+from many different fonts. A virtual font can even make use of characters
+from virtual fonts, including itself.
+
+Virtual fonts also allow convenient character substitutions for proofreading
+purposes, when fonts designed for one output device are unavailable on another.
+
+@ A \.{VF} file is organized as a stream of 8-bit bytes, using conventions
+borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows
+about \.{DVI} and \.{PK} format will already
+contain most of the mechanisms necessary to process \.{VF} files. 
+We shall assume that \.{DVI} format is understood; the conventions in the
+\.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31)
+are adopted here to define \.{VF} format.
+
+A preamble
+appears at the beginning, followed by a sequence of character definitions,
+followed by a postamble. More precisely, the first byte of every \.{VF} file
+must be the first byte of the following ``preamble command'':
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]| |cs[4]| |ds[4]|.
+Here |i| is the identification byte of \.{VF}, currently 202. The string
+|x| is merely a comment, usually indicating the source of the \.{VF} file.
+Parameters |cs| and |ds| are respectively the check sum and the design size
+of the virtual font; they should match the first two words in the header of
+the \.{TFM} file, as described below.
+
+\yskip
+After the |pre| command, the preamble continues with font definitions;
+every font needed to specify ``actual'' characters in later
+\\{set\_char} commands is defined here. The font definitions are
+exactly the same in \.{VF} files as they are in \.{DVI} files, except
+that the scaled size |s| is relative and the design size |d| is absolute:
+
+\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|.
+
+\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\noindent
+These font numbers |k| are ``local''; they have no relation to font numbers
+defined in the \.{DVI} file that uses this virtual font. The dimension~|s|,
+which represents the scaled size of the local font being defined,
+is a |fix_word| relative to the design size of the virtual font.
+Thus if the local font is to be used at the same size
+as the design size of the virtual font itself, |s| will be the
+integer value $2^{20}$. The value of |s| must be positive and less than
+$2^{24}$ (thus less than 16 when considered as a |fix_word|). 
+The dimension~|d| is a |fix_word| in units of printer's points; hence it
+is identical to the design size found in the corresponding \.{TFM} file.
+
+@d id_byte=202
+
+@<Glob...@>=
+@!vf_file:packed file of byte;
+
+@ The preamble is followed by zero or more character packets, where each
+character packet begins with a byte that is $<243$. Character packets have
+two formats, one long and one short:
+
+\yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form
+specifies a virtual character in the general case.
+
+\yskip\hang|short_char0..short_char241|
+|pl[1]| |cc[1]| |tfm[3]| |dvi[pl]|. This short form specifies a
+virtual character in the common case
+when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$.
+
+\yskip\noindent
+Here |pl| denotes the packet length following the |tfm| value; |cc| is
+the character code; and |tfm| is the character width copied from the
+\.{TFM} file for this virtual font. There should be at most one character
+packet having any given |cc| code.
+
+The |dvi| bytes are a sequence of complete \.{DVI} commands, properly
+nested with respect to |push| and |pop|. All \.{DVI} operations are
+permitted except |bop|, |eop|, and commands with opcodes |>=243|.
+Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts
+defined in the preamble.
+
+Dimensions that appear in the \.{DVI} instructions are analogous to
+|fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times
+the design size of the virtual font. For example, if the virtual font
+has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt
+would be a \\{down} instruction with parameter $2^{19}$. The virtual font
+itself might be used at a different size, say $12\,$pt; then that
+\\{down} instruction would move down $6\,$pt instead. Each dimension
+must be less than $2^{24}$ in absolute value.
+
+Device drivers processing \.{VF} files treat the sequences of |dvi| bytes
+as subroutines or macros, implicitly enclosing them with |push| and |pop|.
+Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the
+number of the first-defined in the preamble (undefined if there's no
+such font). After the |dvi| commands have been
+performed, the |h| and~|v| position registers of \.{DVI} format and the
+current font~|f| are restored to their former values;
+then, if the subroutine has been invoked by a \\{set\_char} or \\{set}
+command, |h|~is increased by the \.{TFM} width
+(properly scaled)---just as if a simple character had been typeset.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@d set_char_0=0 {\.{DVI} command to 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 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 improper_DVI_for_VF==139,140,243,244,245,246,247,248,249,250,251,252,
+    253,254,255
+
+@ The character packets are followed by a trivial postamble, consisting of
+one or more bytes all equal to |post| (248). The total number of bytes
+in the file should be a multiple of~4.
+
+@* 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 \.{VFtoVP}. Note that the bytes
+are considered to be unsigned numbers.
+
+@<Glob...@>=
+@!tfm_file:packed file of byte;
+
+@ 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); reset(vf_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...@>=
+@!ofm_level,
+@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp,
+@!nkm,@!nwm,@!real_lf,
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer;
+  {subfile sizes}
+@!ofm_on:boolean;
+
+@ @<Set init...@>=
+ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0;
+nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0;
+nl:=0; nk:=0; ne:=0; np:=0;
+nki:=0; nwi:=0; nkf:=0; nwf:=0;
+nkm:=0; nwm:=0; real_lf:=0;
+nkr:=0; nwr:=0; nkg:=0; nwg:=0;
+nkp:=0; nwp:=0; font_dir:=0;
+
+@ 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. \.{VFtoVP} 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
+\.{VPL} files?'' A complete answer to that question appears in the
+documentation of the companion program, \.{VPtoVF}, so it will not
+be repeated here. Suffice it to say that a \.{VPL} file is an ordinary
+\PASCAL\ text file, and that the output of \.{VFtoVP} uses only a
+subset of the possible constructions that might appear in a \.{VPL} file.
+Furthermore, hardly anybody really wants to look at the formal
+definition of \.{VPL} format, because it is almost self-explanatory when
+you see an example or two.
+
+@<Glob...@>=
+@!vpl_file:text;
+
+@ @<Set init...@>=
+rewrite(vpl_file);
+
+@* Unpacking the TFM file.
+The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of
+bytes, |tfm[0..(4*lf-1)]|.
+
+@<Types...@>=
+@!index=0..tfm_size; {address of a byte in |tfm|}
+@!char_type=0..65535;
+@!xchar_type=0..65536;
+@!xxchar_type=0..65537;
+@!xxxchar_type=0..65538;
+
+@ 
+@<Glob...@>=
+@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
+ {the negative addresses avoid range checks for invalid characters}
+@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
+@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer;
+@!header_length,@!char_ptr,@!copies,@!j:integer;
+
+@ 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 OFM?');
+  goto final_end;
+  end
+
+@<Read the whole font metric 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 begin
+  for i:=2 to 7 do begin
+    if eof(tfm_file)
+    then abort('The input file is too short to designate its length!');
+    read(tfm_file, tfm[i]);
+    end;
+  ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
+  if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
+  lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
+  end
+else begin
+  ofm_on := false;
+  end;
+case ofm_level of
+  -1: begin start_ptr:=2; check_sum:=24; end;
+  0: begin start_ptr:=8; check_sum:=56; end;
+  1: begin start_ptr:=8; check_sum:=116; end;
+  end;
+design_size:=check_sum+4;
+scheme:=design_size+4;
+family:=scheme+40;
+random_word:=family+20;
+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:=start_ptr 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 OFM 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
+@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then
+    abort('One of the subfile sizes is negative!');
+@.One of the subfile sizes...@>
+  #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+
+  tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3];
+  tfm_ptr:=tfm_ptr+4;
+  end
+
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
+begin
+if not ofm_on then 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);
+  ncw:=(ec-bc+1);
+  header_length:=6;
+  top_char:=255;
+  top_width:=255;
+  top_height:=15;
+  top_depth:=15;
+  top_italic:=63;
+  end
+else begin
+  tfm_ptr:=8;
+  eval_four_bytes(lh);
+  eval_four_bytes(bc);
+  eval_four_bytes(ec);
+  eval_four_bytes(nw);
+  eval_four_bytes(nh);
+  eval_four_bytes(nd);     
+  eval_four_bytes(ni);
+  eval_four_bytes(nl);
+  eval_four_bytes(nk);
+  eval_four_bytes(ne);
+  eval_four_bytes(np);
+  eval_four_bytes(font_dir);
+  top_char:=65535;
+  top_width:=65535;
+  top_height:=255;
+  top_depth:=255;
+  top_italic:=255;
+  if ofm_level=0 then begin
+    header_length:=14;
+    ncw:=2*(ec-bc+1);
+    end
+  else begin
+    header_length:=29;
+    eval_four_bytes(nco);
+    eval_four_bytes(ncw);
+    eval_four_bytes(npc);
+    eval_four_bytes(nki); {Kinds of font ivalues}
+    eval_four_bytes(nwi); {Words of font ivalues}
+    eval_four_bytes(nkf); {Kinds of font fvalues}
+    eval_four_bytes(nwf); {Words of font fvalues}
+    eval_four_bytes(nkm); {Kinds of font mvalues}
+    eval_four_bytes(nwm); {Words of font mvalues}
+    eval_four_bytes(nkr); {Kinds of font rules}
+    eval_four_bytes(nwr); {Words of font rules}
+    eval_four_bytes(nkg); {Kinds of font glues}
+    eval_four_bytes(nwg); {Words of font glues}
+    eval_four_bytes(nkp); {Kinds of font penalties}
+    eval_four_bytes(nwp); {Words of font penalties}
+    end;
+  end;
+if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+
+        nki+nwi+nkf+nwf+nkr+nwr+nkg+nwg+nkp+nwp) then
+  abort('Subfile sizes don''t add up to the stated total!');
+@.Subfile sizes don't add up...@>
+if lh<2 then abort('The header length is only ',lh:1,'!');
+@.The header length...@>
+if (2*nl)>(4*lig_size) then
+  abort('The lig/kern program is longer than I can handle!');
+@.The lig/kern program...@>
+if (bc>ec+1)or(ec>top_char) then abort('The character code range ',
+@.The character code range...@>
+  bc:1,'..',ec:1,'is illegal!');
+if ec>max_char then
+  abort('Character ',ec:1,'is too large.  Ask a wizard to enlarge me.');
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
+  abort('Incomplete subfiles for character dimensions!');
+@.Incomplete subfiles...@>
+if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
+@.There are ... recipes@>
+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| in a \.{TFM} file will start in location
+|4*(char_base+c)| of the |tfm| array.
+
+@<Globals...@>=
+@!ivalues_start,@!fvalues_start,@!mvalues_start,
+@!rules_start,@!glues_start,@!penalties_start:
+integer;
+@!ivalues_base,@!fvalues_base,@!mvalues_base,
+@!rules_base,@!glues_base,@!penalties_base:
+integer;
+@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer;
+@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
+  {base addresses for the subfiles}
+@!char_start:array [0..max_char] of integer;
+@!bytes_per_entry:integer;
+
+@ @<Compute the base addresses@>=
+begin 
+ivalues_start:=header_length+lh;
+fvalues_start:=ivalues_start+nki;
+mvalues_start:=fvalues_start+nkf;
+rules_start:=mvalues_start+nkm;
+glues_start:=rules_start+nkr;
+penalties_start:=glues_start+nkg;
+ivalues_base:=penalties_start+nkp;
+fvalues_base:=ivalues_base+nwi;
+mvalues_base:=fvalues_base+nwi;
+rules_base:=mvalues_base+nwm;
+glues_base:=rules_base+nwr;
+penalties_base:=glues_base+nwg;
+char_base:=penalties_base+nwp;
+bytes_per_entry:=(12 + 2*npc) div 4 * 4;
+if not ofm_on then begin
+  for i:=bc to ec do begin
+    char_start[i]:=4*char_base+4*(i-bc);
+    end;
+  end
+else if ofm_level=0 then begin
+  for i:=bc to ec do begin
+    char_start[i]:=4*char_base+8*(i-bc);
+    end;
+  end   
+else begin
+  char_ptr:=4*char_base;
+  i:=bc;
+  while i<=ec do begin
+    copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9];
+    for j:=1 to copies do begin
+      char_start[i]:=char_ptr;
+      i:=i+1;
+      end;
+    char_ptr:=char_ptr + bytes_per_entry;
+    end;
+  if char_ptr<>(4*(char_base+ncw)) then
+    abort('Length of char info table does not correspond to specification');
+  end;
+width_base:=char_base+ncw;
+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+2*nl;
+exten_base:=kern_base+nk;
+param_base:=exten_base+2*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 char_info(#)==char_start[#]
+@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
+@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 kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
+@d param(#)==4*(param_base+#) {likewise}
+
+@p function width_index(c:char_type):integer;
+begin if not ofm_on then
+  width_index:=tfm[char_info(c)]
+else
+  width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1];
+end;
+
+function height_index(c:char_type):integer;
+begin if not ofm_on then
+  height_index:=tfm[char_info(c)+1] div 16
+else
+  height_index:=tfm[char_info(c)+2];
+end;
+
+function depth_index(c:char_type):integer;
+begin if not ofm_on then
+  depth_index:=tfm[char_info(c)+1] mod 16
+else
+  depth_index:=tfm[char_info(c)+3];
+end;
+
+function italic_index(c:char_type):integer;
+begin if not ofm_on then
+  italic_index:=tfm[char_info(c)+2] div 4
+else if ofm_level=0 then
+  italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4
+else
+  italic_index:=tfm[char_info(c)+4];
+end;
+
+function tag(c:char_type):integer;
+begin if not ofm_on then
+  tag:=tfm[char_info(c)+2] mod 4
+else
+  tag:=tfm[char_info(c)+5] mod 4;
+end;
+
+procedure set_no_tag(c:char_type);
+begin if not ofm_on then
+  tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag
+else
+  tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
+end;
+
+function ctag(c:char_type):boolean;
+begin if not (ofm_level=1) then
+  ctag:=false
+else
+  ctag:=tfm[char_info(c)+5] div 4 mod 2;
+end;
+
+procedure set_no_ctag(c:char_type);
+begin if not (ofm_level=1) then
+  tfm[char_info(c)+5] := 
+    tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4;
+end;
+
+function no_repeats(c:char_type):integer;
+begin if ofm_level<=0 then
+  no_repeats:=0
+else
+  no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9];
+end;
+
+function char_param(c:char_type; i:integer):integer;
+begin
+  char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11];
+end;
+
+function rremainder(c:char_type):integer;
+begin if not ofm_on then
+  rremainder:=tfm[char_info(c)+3]
+else
+  rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7];
+end;
+
+function lig_step(c:char_type):integer;
+begin if not ofm_on then
+  lig_step:=4*(lig_kern_base+c)
+else
+  lig_step:=4*(lig_kern_base+2*c);
+end;
+
+function exten(c:char_type):integer;
+begin if not ofm_on then
+  exten:=4*(exten_base+rremainder(c))
+else
+  exten:=4*(exten_base+2*rremainder(c));
+end;
+
+function l_skip_byte(c:integer):integer;
+begin if not ofm_on then
+  l_skip_byte:=tfm[c]
+else
+  l_skip_byte:=256*tfm[c]+tfm[c+1];
+end;
+
+procedure set_l_skip_byte(c:integer; newc:integer);
+begin if not ofm_on then
+  tfm[c]:=newc
+else begin
+  tfm[c]:=newc div 256;
+  tfm[c+1]:=newc mod 256
+  end
+end;
+
+function l_next_char(c:integer):integer;
+begin if not ofm_on then
+  l_next_char:=tfm[c+1]
+else
+  l_next_char:=256*tfm[c+2]+tfm[c+3];
+end;
+
+procedure set_l_next_char(c:integer; newc:char_type);
+begin if not ofm_on then
+  tfm[c+1]:=newc
+else begin
+  tfm[c+2]:=newc div 256;
+  tfm[c+3]:=newc mod 256
+  end
+end;
+
+function l_op_byte(c:integer):integer;
+begin if not ofm_on then
+  l_op_byte:=tfm[c+2]
+else
+  l_op_byte:=256*tfm[c+4]+tfm[c+5];
+end;
+
+procedure set_l_op_byte(c:integer; newc:integer);
+begin if not ofm_on then
+  tfm[c+2]:=newc
+else begin
+  tfm[c+2]:=newc div 256;
+  tfm[c+3]:=newc mod 256
+  end
+end;
+
+function l_remainder(c:integer):integer;
+begin if not ofm_on then
+  l_remainder:=tfm[c+3]
+else
+  l_remainder:=256*tfm[c+6]+tfm[c+7];
+end;
+
+procedure set_l_remainder(c:integer; newc:char_type);
+begin if not ofm_on then
+  tfm[c+3]:=newc
+else begin
+  tfm[c+6]:=newc div 256;
+  tfm[c+7]:=newc mod 256
+  end
+end;
+
+@ 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?}
+
+@* Unpacking the VF file.
+Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes
+the input phase by reading the \.{VF} information into another array of bytes.
+In this case we don't store all the data; we check the redundant bytes
+for consistency with their \.{TFM} counterparts, and we partially decode
+the packets.
+
+@<Glob...@>=
+@!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here}
+@!font_number:array[0..max_fonts] of integer; {local font numbers}
+@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info}
+@!font_ptr:0..max_fonts; {number of local fonts}
+@!packet_start,@!packet_end:array[char_type] of 0..vf_size;
+  {character packet boundaries}
+@!packet_found:boolean; {at least one packet has appeared}
+@!temp_byte:byte;@+@!reg_count:integer; {registers for simple calculations}
+@!real_dsize:real; {the design size, converted to floating point}
+@!pl:integer; {packet length}
+@!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vf_count:integer; {number of bytes read from |vf_file|}
+
+@ Again we cautiously verify that we've been given decent data.
+
+@d read_vf(#)==read(vf_file,#)
+@d vf_abort(#)==begin
+  print_ln(#);
+  print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
+  goto final_end;
+  end
+
+@<Read the whole \.{VF} file@>=
+read_vf(temp_byte);
+if temp_byte<>pre then vf_abort('The first byte isn''t `pre''!');
+@.The first byte...@>
+@<Read the preamble command@>;
+@<Read and store the font definitions and character packets@>;
+@<Read and verify the postamble@>
+
+@ @d vf_store(#)==@t@>@;@/
+  if vf_ptr+#>=vf_size then vf_abort('The file is bigger than I can handle!');
+@.The file is bigger...@>
+  for k:=vf_ptr to vf_ptr+#-1 do
+    begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+    read_vf(vf[k]);
+    end;
+  vf_count:=vf_count+#; vf_ptr:=vf_ptr+#
+
+@<Read the preamble command@>=
+if eof(vf_file) then vf_abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read_vf(temp_byte);
+if temp_byte<>id_byte then vf_abort('Wrong OVF version number in second byte!');
+@.Wrong OVF version...@>
+if eof(vf_file) then vf_abort('The input file is only two bytes long!');
+read_vf(temp_byte); {read the length of introductory comment}
+vf_count:=11; vf_ptr:=0; vf_store(temp_byte);
+for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
+print_ln(' '); reg_count:=0;
+for k:=0 to 7 do
+  begin if eof(vf_file) then vf_abort('The file ended prematurely!');
+@.The file ended prematurely@>
+  read_vf(temp_byte);
+  if temp_byte=tfm[check_sum+k] then incr(reg_count);
+  end;
+real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2])
+ *256+tfm[design_size+3])/@'4000000;
+if reg_count<>8 then
+  begin print_ln('Check sum and/or design size mismatch.');
+@.Check sum...mismatch@>
+  print_ln('Data from OFM file will be assumed correct.');
+  end
+
+@ @<Read and store the font definitions and character packets@>=
+for k:=0 to 65535 do packet_start[k]:=vf_size;
+font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr;
+repeat if eof(vf_file) then
+  begin print_ln('File ended without a postamble!'); temp_byte:=post;
+@.File ended without a postamble@>
+  end
+else begin read_vf(temp_byte); incr(vf_count);
+  if temp_byte<>post then
+    if temp_byte>long_char then @<Read and store a font definition@>
+    else @<Read and store a character packet@>;
+  end;
+until temp_byte=post
+
+@ @<Read and verify the postamble@>=
+while (temp_byte=post)and not eof(vf_file) do
+  begin read_vf(temp_byte); incr(vf_count);
+  end;
+if not eof(vf_file) then
+  begin print_ln('There''s some extra junk at the end of the OVF file.');
+@.There's some extra junk...@>
+  print_ln('I''ll proceed as if it weren''t there.');
+  end;
+if vf_count mod 4 <> 0 then
+  print_ln('VF data not a multiple of 4 bytes')
+@.VF data not a multiple of 4 bytes@>
+
+@ @<Read and store a font definition@>=
+begin if packet_found or(temp_byte>=pre) then
+  vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!');
+@.Illegal byte...@>
+font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1);
+if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!');
+@.I can't handle that many fonts@>
+vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|}
+if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$}
+  vf_abort('Mapped font size is too big!');
+@.Mapped font size...big@>
+a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|}
+@<Print the name of the local font@>;
+@<Read the local font's \.{TFM} file and record the characters it contains@>;
+incr(font_ptr); font_start[font_ptr]:=vf_ptr; 
+end
+
+@ The font area may need to be separated from the font name on some systems.
+Here we simply reproduce the font area and font name (with no space
+or punctuation between them).
+@^system dependencies@>
+
+@<Print the name...@>=
+print('MAPFONT ',font_ptr:1,': ');
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]);
+k:=font_start[font_ptr]+5;
+print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
+  'pt')
+
+@ Now we must read in another \.{TFM} file. But this time we needn't be so
+careful, because we merely want to discover which characters are present.
+The next few sections of the program are copied pretty much verbatim from
+\.{DVItype}, so that system-dependent modifications can be copied from existing
+software.
+
+It turns out to be convenient to read four bytes at a time, when we are
+inputting from the local \.{TFM} files. The input goes into global variables
+|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
+the fourth.
+
+@<Glob...@>=
+@!a:integer; {length of the area/directory spec}
+@!l:integer; {length of the font name proper}
+@!cur_name:packed array[1..name_length] of char; {external name,
+  with no lower case letters}
+@!b0,@!b1,@!b2,@!b3: byte; {four bytes input at once}
+@!font_lh:integer; {header length of current local font}
+@!font_bc,@!font_ec:integer; {character range of current local font}
+@!font_ofm_level,@!font_extra_words:integer;
+@!font_kprime,@!font_j:integer;
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#)
+
+@p procedure read_tfm_word;
+begin read_tfm(b0); read_tfm(b1);
+read_tfm(b2); read_tfm(b3);
+end;
+
+@ We use the |vf| array to store a list of all valid characters in the
+local font, beginning at location |font_chars[f]|.
+
+@<Read the local font's \.{TFM} file...@>=
+font_chars[font_ptr]:=vf_ptr;
+@<Move font name into the |cur_name| string@>;
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+  print_ln('---not loaded, font metric file can''t be opened!')
+@.font metric file can\'t be opened@>
+else  begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
+  @<Read past the header@>;
+  if font_bc<=font_ec then
+    if font_ec>65535 then print_ln('---not loaded, bad font metric file!')
+@.bad font metric file@>
+    else @<Read |char_info| entries@>;
+  if eof(tfm_file) then
+    print_ln('---trouble is brewing, font metric file ended too soon!');
+@.trouble is brewing...@>
+  end;
+incr(vf_ptr) {leave space for character search later}
+
+@ @<Read past the header@>=
+read_tfm_word;
+if (b0*256+b1)<>0 then begin {TFM file}
+  font_ofm_level:=-1;
+  font_lh:=b2*256+b3;
+  read_tfm_word; font_bc:=b0*256+b1; font_ec:=b2*256+b3;
+  if font_ec<font_bc then font_bc:=font_ec+1;
+  read_tfm_word;
+  for k:=1 to 3+font_lh do begin
+    read_tfm_word;
+    if k=4 then @<Check the check sum@>;
+    if k=5 then @<Check the design size@>;
+    end;
+  end
+else begin
+  font_ofm_level:=b2*256+b3;
+  read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3;
+  read_tfm_word; font_bc:=((b0*256+b1)*256+b2)*256+b3;
+  read_tfm_word; font_ec:=((b0*256+b1)*256+b2)*256+b3;
+  if font_ec<font_bc then font_bc:=font_ec+1;
+  read_tfm_word; 
+  for k:=1 to 8 do begin
+    read_tfm_word;
+    end;
+  if font_ofm_level=1 then begin
+    read_tfm_word; read_tfm_word; read_tfm_word;
+    font_extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
+    for k:=1 to 5 do begin
+      read_tfm_word;
+      end;
+    end;
+  for k:=1 to lh do begin
+    read_tfm_word;
+    if k=1 then @<Check the check sum@>;
+    if k=2 then @<Check the design size@>;
+    end;
+  end
+
+@ @<Read |char_info| entries@>=
+case font_ofm_level of
+ -1: begin
+    for k:=font_bc to font_ec do begin
+      read_tfm_word;
+      if b0>0 then begin {character |k| exists in the font}
+        vf[vf_ptr]:=k; incr(vf_ptr);
+        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        end;
+      end;
+    end;
+  0: begin
+    for k:=font_bc to font_ec do
+      begin read_tfm_word;
+      if (b0*256+b1)>0 then {character |k| exists in the font}
+        begin vf[vf_ptr]:=k; incr(vf_ptr);
+        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        end;
+      read_tfm_word;
+      end;
+    end;
+  1: begin
+    k:=font_bc;
+    while k<font_ec do begin
+      read_tfm_word;
+      if (b0*256+b1)>0 then begin {character |k| exists in the font}
+        vf[vf_ptr]:=k; incr(vf_ptr);
+        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        end;
+      read_tfm_word; read_tfm_word;
+      font_kprime:=k+(b0*256+b1);
+      for font_j:=k+1 to font_kprime do begin
+        vf[vf_ptr]:=font_j; incr(vf_ptr);
+        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        end;
+      k:=font_kprime;
+      for font_j:=1 to font_extra_words do
+        read_tfm_word;
+      end
+    end;
+end;
+
+@ @<Check the check sum@>=
+if b0+b1+b2+b3>0 then
+  if(b0<>vf[font_start[font_ptr]])or@|
+   (b1<>vf[font_start[font_ptr]+1])or@|
+   (b2<>vf[font_start[font_ptr]+2])or@|
+   (b3<>vf[font_start[font_ptr]+3]) then begin
+    print_ln('Check sum in OVF file being replaced by font metric check sum');
+@.Check sum...replaced...@>
+    vf[font_start[font_ptr]]:=b0;
+    vf[font_start[font_ptr]+1]:=b1;
+    vf[font_start[font_ptr]+2]:=b2;
+    vf[font_start[font_ptr]+3]:=b3;
+    end
+
+@ @<Check the design size@>=
+if(b0<>vf[font_start[font_ptr]+8])or@|
+ (b1<>vf[font_start[font_ptr]+9])or@|
+ (b2<>vf[font_start[font_ptr]+10])or@|
+ (b3<>vf[font_start[font_ptr]+11]) then
+  begin print_ln('Design size in OVF file being replaced by font metric design size');
+@.Design size...replaced...@>
+  vf[font_start[font_ptr]+8]:=b0;
+  vf[font_start[font_ptr]+9]:=b1;
+  vf[font_start[font_ptr]+10]:=b2;
+  vf[font_start[font_ptr]+11]:=b3;
+  end
+
+@ If no font directory has been specified, \.{DVI}-reading software
+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 a=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_start[font_ptr]+14 to vf_ptr-1 do begin
+  incr(r);
+  if r+4>name_length then vf_abort('Font name too long for me!');
+@.Font name too long for me@>
+  if (vf[k]>="a")and(vf[k]<="z") then
+      cur_name[r]:=xchr[vf[k]-@'40]
+  else cur_name[r]:=xchr[vf[k]];
+  end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+
+
+@ It's convenient to have a subroutine
+that reads a |k|-byte number from |vf_file|.
+
+@d get_vf(#)==if eof(vf_file) then #:=0 @+else read_vf(#)
+
+@p function vf_read(@!k:integer):integer; {actually |1<=k<=4|}
+var @!b:byte; {input byte}
+@!a:integer; {accumulator}
+begin vf_count:=vf_count+k; get_vf(b); a:=b;
+if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed}
+while k>1 do begin
+  get_vf(b);
+  a:=256*a+b; decr(k);
+  end;
+vf_read:=a;
+end;
+
+@ The \.{VF} format supports arbitrary 4-byte character codes,
+but \.{VPL} format presently does not.  But \.{OVP} does.
+
+@<Read and store a character packet@>=
+begin if temp_byte=long_char then
+  begin pl:=vf_read(4); c:=vf_read(4); reg_count:=vf_read(4);
+    {|pl[4]| |cc[4]| |tfm[4]|}
+  end
+else begin pl:=temp_byte; c:=vf_read(1); reg_count:=vf_read(3);
+    {|pl[1]| |cc[1]| |tfm[3]|}
+  end;
+if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!');
+@.Character c does not exist@>
+if packet_start[c]<vf_size then
+  print_ln('Discarding earlier packet for character ',c:1);
+@.Discarding earlier packet...@>
+if reg_count<>tfm_width(c) then
+  print_ln('Incorrect OFM width for character ',c:1,' in OVF file');
+@.Incorrect OFM width...@>
+if pl<0 then vf_abort('Negative packet length!');
+@.Negative packet length@>
+packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1;
+packet_found:=true;
+end
+
+@ The preceding code requires a simple subroutine that evaluates \.{TFM} data.
+
+@p function tfm_width(@!c:integer):integer;
+var @!a:integer; {accumulator}
+@!k:index; {index into |tfm|}
+begin k:=width(c); {we assume that character |c| exists}
+a:=tfm[k];
+if a>=128 then a:=a-256;
+tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3];
+end;
+
+@* Basic output subroutines.
+Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s
+work to a triviality.
+
+First of all, it is convenient to have an abbreviation for output to the
+\.{VPL} file:
+
+@d out(#)==write(vpl_file,#)
+
+@ In order to stick to standard \PASCAL, we use an |xchr| array to do
+appropriate conversion of ASCII codes. Three other little strings are
+used to produce |face| codes like \.{MIE}.
+
+@<Glob...@>=
+@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
+  {strings for output in the user's external character set}
+@!xchr:packed array [0..255] of char;
+@!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{|}~?';@/
+HEX:='0123456789ABCDEF';@/
+for k:=0 to 255 do xchr[k]:='?';
+for k:=0 to @'37 do begin
+  xchr[k+@'40]:=ASCII_04[k+1];
+  xchr[k+@'100]:=ASCII_10[k+1];
+  xchr[k+@'140]:=ASCII_14[k+1];
+  end;
+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 integer;
+
+@ 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(HEX[1+dig[j]]);
+  until j=0;
+end;
+@#
+procedure print_digs(j:integer); {prints |j| digits}
+begin repeat decr(j); print(HEX[1+dig[j]]);
+  until j=0;
+end;
+
+@ The |print_number| procedure indicates how |print_digs| can be used.
+This procedure can print in octal, decimal or hex notation.
+
+@d print_hex(#)==print_number(#,16)
+@d print_octal(#)==print_number(#,8)
+@d print_decimal(#)==print_number(#,10)
+
+@p procedure print_number(c:integer; form:integer); {prints value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+  print_ln('Internal error: print_number (negative value)');
+  c:=0;
+  end;
+if form=8 then
+  print('''') {an apostrophe indicates the octal notation}
+else if form=16 then
+  print('"')  { a double apostrophe indicates the hexadecimal notation}
+else if form<>10 then begin
+  print_ln('Internal error: print_number (form)');
+  form:=16;
+  end;
+while (c>0) or (j=0) do begin
+  dig[j]:=c mod form; c:=c div form;
+  j:=j+1;
+  end;
+print_digs(j);
+end;
+
+@ A \.{VPL} 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(vpl_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); out(xchr[tfm[k]]);
+  end;
+end;
+
+@ The property value might also be a sequence of |l| bytes, beginning
+in |tfm[k]|, that we would like to output in hex 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|.
+
+@d out_octal_number(#)==out_number(#,8)
+@d out_decimal_number(#)==out_number(#,10)
+@d out_hex_number(#)==out_number(#,16)
+@d out_dec(#)==out_decimal_number(#)
+@d out_hex_char(#)==out_hex_number(#)
+
+@p procedure out_number(c:integer; form:integer); {outputs value of |c|}
+var j:0..32; {index into |dig|}
+begin
+j:=0;
+if (c<0) then begin
+  print_ln('Internal error: print_number (negative value)');
+  c:=0;
+  end;
+if form=8 then
+  out(' O ')
+else if form=10 then
+  out(' D ')
+else if form=16 then
+  out(' H ')
+else begin
+  print_ln('Internal error: print_number (form)');
+  form:=16;
+  out(' H ')
+  end;
+while (c>0) or (j=0) do begin
+  dig[j]:=c mod form; c:=c div form;
+  j:=j+1;
+  end;
+out_digs(j);
+end;
+@#
+procedure out_hex(@!k,@!l:index);
+   {outputs |l| bytes in hex}
+var a:0..@"7FFFFFFF; {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(' H ');
+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 16; a:=a div 16; 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 16; a:=a div 16; b:=b-4; 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];
+    3:a:=a+8*tfm[k+l];
+    end;
+  end;
+b:=b+8;
+end
+
+@ The property value may be a character, which is output in hex
+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:integer); {outputs a character}
+begin if font_type>vanilla then
+  out_hex_char(c)
+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 out_hex_char(c);
+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_hex(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 \.{VPtoVF}
+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
+
+@* Outputting the TFM info.
+\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
+\.{VFtoVP} 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 \.{VPL} 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 hex
+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 OFM file: ',#);
+  end
+@.Bad OFM file@>
+@d range_error(#)==begin perfect:=false; print_ln(' ');
+  print(#,' index for character ');
+  print_hex(c); print_ln(' is too large;');
+  print_ln('so I reset it to zero.');
+  end
+@d bad_char_tail(#)==print_hex(#); print_ln('.');
+  end
+@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+  chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+  bad_char_tail
+@d correct_bad_char_tail(#)==#(k,0)
+  end
+@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.');
+  correct_bad_char_tail
+@d correct_bad_char(#)== begin perfect:=false;
+  if chars_on_line>0 then print_ln(' ');
+  chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
+  correct_bad_char_middle
+
+@<Glob...@>=
+@!i:integer; {an index to words of a subfile}
+@!c:xchar_type; {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 \.{VFtoVP} will put into the \.{VPL} file appear in the header part.
+
+@<Do the header@>=
+begin
+case ofm_level of
+  0: begin out('(OFMLEVEL H 0)'); out_ln; end;
+  1: begin out('(OFMLEVEL H 1)'); out_ln; end;
+  end;
+if ofm_on then begin
+  left;
+  if font_dir<=7 then out('FONTDIR')
+  else out('NFONTDIR');
+  case font_dir mod 8 of
+    0: out(' TL');
+    1: out(' LT');
+    2: out(' TR');
+    3: out(' LB');
+    4: out(' BL');
+    5: out(' RT');
+    6: out(' BR');
+    7: out(' RB');
+    end;
+  right
+  end;
+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_hex(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:integer; {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_hex(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 \.{VPL} file.
+The \.{VPtoVF} 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 FALSE'); 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)
+
+@ @<Glob...@>=
+@!start_counter,@!base_counter,@!number_entries:integer;
+@!value:integer;
+
+@ @<Do the ivalue parameters@>=
+if nki>0 then begin
+  start_counter:=ivalues_start*4;
+  base_counter:=ivalues_base*4;
+  for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>;
+  end;
+
+@ @<Check and output the $i$th ivalue table@>=
+begin
+left; out('FONTIVALUE'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+  left; out('IVALUE'); out_hex_number(j); out_ln; 
+  value:=256*tfm[base_counter+2]+tfm[base_counter+3];
+  left; out('IVALUEVAL'); out_hex_number(value); right;
+  right;
+  base_counter:=base_counter+4;
+  end;
+right;
+start_counter:=start_counter+4;;
+end;
+
+@ @<Do the fvalue parameters@>=
+if nkf>0 then begin
+  start_counter:=fvalues_start*4;
+  base_counter:=fvalues_base*4;
+  for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>;
+  end;
+
+@ @<Check and output the $i$th fvalue table@>=
+begin
+left; out('FONTFVALUE'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+  left; out('FVALUE'); out_hex_number(j); out_ln; 
+  left; out('FVALUEVAL'); out_fix(base_counter); right;
+  right;
+  base_counter:=base_counter+4;
+  end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the mvalue parameters@>=
+if nkm>0 then begin
+  start_counter:=mvalues_start*4;
+  base_counter:=mvalues_base*4;
+  for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>;
+  end;
+
+@ @<Check and output the $i$th mvalue table@>=
+begin
+left; out('FONTMVALUE'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+  left; out('MVALUE'); out_hex_number(j); out_ln; 
+  left; out('MVALUEVAL'); out_fix(base_counter); right;
+  right;
+  base_counter:=base_counter+4;
+  end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the rule parameters@>=
+if nkr>0 then begin
+  start_counter:=rules_start*4;
+  base_counter:=rules_base*4;
+  for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
+  end;
+
+@ @<Check and output the $i$th rule table@>=
+begin
+left; out('FONTRULE'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+  left; out('RULE'); out_hex_number(j); out_ln; 
+  left; out('RULEWD'); out_fix(base_counter); right;
+  left; out('RULEHT'); out_fix(base_counter+4); right;
+  left; out('RULEDP'); out_fix(base_counter+8); right;
+  right;
+  base_counter:=base_counter+12;
+  end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the glue parameters@>=
+if nkg>0 then begin
+  start_counter:=glues_start*4;
+  base_counter:=glues_base*4;
+  for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
+  end;
+
+@ @<Glob...@>=
+@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order,
+@!glue_shrink_order,@!glue_argument:integer;
+
+@ @<Check and output the $i$th glue table@>=
+begin
+left; out('FONTGLUE'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
+for j:=0 to number_entries-1 do begin
+  left; out('GLUE'); out_hex_number(j); out_ln; 
+  glue_subtype:=tfm[base_counter] div 16;
+  glue_argument_kind:=tfm[base_counter] mod 16;
+  glue_stretch_order:=tfm[base_counter+1] div 16;
+  glue_shrink_order:=tfm[base_counter+1] mod 16;
+  glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3];
+  left;
+  out('GLUETYPE'); 
+  case glue_subtype of
+    0: out(' H 0');
+    1: out(' H 1');
+    2: out(' H 2');
+    3: out(' H 3');
+    end;
+  right;
+  case glue_argument_kind of
+    1: begin
+      left; out('GLUERULE'); out_hex_number(glue_argument); right;
+      end; 
+    2: begin
+      left; out('GLUECHAR'); out_hex_number(glue_argument); right;
+      end; 
+    end;
+  left;
+  out('GLUESTRETCHORDER'); 
+  case glue_stretch_order of
+    0: out(' H 0');
+    1: out(' H 1');
+    2: out(' H 2');
+    3: out(' H 3');
+    4: out(' H 4');
+    end;
+  right;
+  left;
+  out('GLUESHRINKORDER'); 
+  case glue_shrink_order of
+    0: out(' H 0');
+    1: out(' H 1');
+    2: out(' H 2');
+    3: out(' H 3');
+    4: out(' H 4');
+    end;
+  right;
+  left; out('GLUEWD'); out_fix(base_counter+4); right;
+  left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
+  left; out('GLUESHRINK'); out_fix(base_counter+12); right;
+  right;
+  base_counter:=base_counter+16;
+  end;
+right;
+start_counter:=start_counter+4;
+end;
+
+@ @<Do the penalty parameters@>=
+if nkp>0 then begin
+  start_counter:=penalties_start*4;
+  base_counter:=penalties_base*4;
+  for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
+  end;
+ 
+@ @<Check and output the $i$th penalty table@>=
+begin 
+left; out('FONTPENALTY'); out_hex_number(i); out_ln; 
+number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 
+for j:=0 to number_entries-1 do begin 
+  left; out('PENALTY'); out_hex_number(j); out_ln;
+  value:=256*tfm[base_counter+2]+tfm[base_counter+3]; 
+  left; out('PENALTYVAL'); out_hex_number(value); right; 
+  right; 
+  base_counter:=base_counter+4; 
+  end; 
+right;
+start_counter:=start_counter+4; 
+end;
+
+@ 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[xxxchar_type] of record
+@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end;
+@!label_ptr:xxchar_type; {the largest entry in |label_table|}
+@!sort_ptr:xxchar_type; {index into |label_table|}
+@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none}
+@!bchar_label:0..xmax_label; {beginning of boundary character program}
+
+@ @<Set init...@>=
+boundary_char:=xmax_char; bchar_label:=xmax_label;@/
+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) or (ctag(c)) then begin
+  r:=rremainder(c);
+  if (l_skip_byte(lig_step(r)) div 256)=0 then begin
+    if r<nl then begin
+      if l_skip_byte(lig_step(r))>stop_flag then begin
+        r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
+        if r<nl then if activity[rremainder(c)]=unreachable then
+          activity[rremainder(c)]:=pass_through;
+        end;
+      end;
+    end;
+  if r>=nl then begin
+    perfect:=false; print_ln(' ');
+    print('Ligature/kern starting index for character '); print_hex(c);
+    print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
+    set_no_ctag(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].ischar:=not ctag(c);
+if ctag(c) then
+  label_table[sort_ptr+1].cc:=char_param(c,0)
+else
+  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 l_skip_byte(lig_step(0))=255 then begin
+  left; out('BOUNDARYCHAR');
+  boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
+  activity[0]:=pass_through;
+  end;
+if l_skip_byte(lig_step(nl-1))=255 then begin
+  r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
+  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:=xmax_char;
+    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 (l_skip_byte(lig_step(ai)) div 256)=1 then
+  activity[ai]:=accessible
+else if activity[ai]=accessible then begin
+  r:=l_skip_byte(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.'); set_l_skip_byte(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}
+
+@ @<Globals...@>=
+@!output_clabels:array[0..256] of boolean;
+@!clabel_runner:integer;
+@!cprime:integer;
+
+@ @<Set init...@>=
+for clabel_runner:=0 to 256 do
+  output_clabels[clabel_runner]:=false;
+
+@ @<Output any labels...@>=
+while i=label_table[sort_ptr].rr do begin
+  if not label_table[sort_ptr].ischar then begin
+    if not output_clabels[label_table[sort_ptr].cc] then begin
+      output_clabels[label_table[sort_ptr].cc]:=true;
+      left;
+      out('CLABEL');
+      out_char(label_table[sort_ptr].cc);
+      right;
+      end
+    end
+  else begin
+    left;
+    out('LABEL');
+    if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR')
+    else out_char(label_table[sort_ptr].cc);
+    right;
+    end;
+  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 (l_skip_byte(k) div 256)=1 then begin
+  case l_op_byte(k) of
+    17: begin
+      left; out('CPEN');
+      out_hex_number(l_next_char(k));
+      out_hex_number(l_remainder(k));
+      right;
+      end;
+    18: begin
+      left; out('CGLUE');
+      out_hex_number(l_next_char(k));
+      out_hex_number(l_remainder(k));
+      right;
+      end;
+    19: begin
+      left; out('CPENGLUE');
+      out_hex_number(l_next_char(k));
+      out_hex_number(l_remainder(k) div 256);
+      out_hex_number(l_remainder(k) mod 256);
+      right;
+      end;
+    20: begin
+      left; out('CKRN');
+      out_hex_number(l_next_char(k));
+      r:=l_remainder(k);
+      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;
+    end;
+  end
+else if l_skip_byte(k)>stop_flag then begin
+  if (256*l_op_byte(k)+l_remainder(k))>=nl then
+    bad('Ligature unconditional stop command address is too big.');
+@.Ligature unconditional stop...@>
+  end
+else if l_op_byte(k)>=kern_flag then @<Output a kern step@>
+else @<Output a ligature step@>;
+if (l_skip_byte(k) mod 256)>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 (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
+else begin
+  count:=0;
+  for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) 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(l_next_char(k)) then
+         if l_next_char(k)<>boundary_char then
+  correct_bad_char('Kern step for')(l_next_char)(set_l_next_char);
+@.Kern step for nonexistent...@>
+left; out('KRN'); out_char(l_next_char(k));
+r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
+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(l_next_char(k)) then
+         if l_next_char(k)<>boundary_char then
+  correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
+@.Ligature step for nonexistent...@>
+if nonexistent(l_remainder(k)) then
+correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
+@.Ligature step produces...@>
+left; r:=l_op_byte(k);
+if (r=4)or((r>7)and(r<>11)) then begin
+  print_ln('Ligature step with nonstandard code changed to LIG');
+  r:=0; set_l_op_byte(k,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(l_next_char(k)); out_char(l_remainder(k)); right;
+end
+
+@ The last thing on \.{VFtoVP}'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}
+c:=bc;
+while (c<=ec) do begin
+  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;
+    for cprime:=c to (c+no_repeats(c)) do begin
+      print_hex(cprime); {progress report}
+      left; out('CHARACTER'); out_char(cprime); 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}
+      for i:=0 to npc-1 do begin
+        if char_param(c,i)<>0 then begin
+          left;
+          if i<nki then begin
+            out('CHARIVALUE'); out_hex_number(i);
+            end
+          else if i<(nki+nkf) then begin
+            out('CHARFVALUE'); out_hex_number(i-nki);
+            end
+          else if i<(nki+nkf+nkr) then begin
+            out('CHARRULE'); out_hex_number(i-nki-nkf);
+            end
+          else if i<(nki+nkf+nkr+nkg) then begin
+            out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr);
+            end
+          else if i<(nki+nkf+nkr+nkg+nkp) then begin
+            out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg);
+            end;
+          out_hex_number(char_param(c,i));
+          right;
+          end;
+        end;
+      if not do_map(cprime) then goto final_end;
+      right;
+      end;
+    end;
+  c:=c+1+no_repeats(c);
+  end
+
+@ @<Output the character's width@>=
+if width_index(c)>=nw then range_error('Width')
+@.Width index for char...@>
+else begin left; out('CHARWD'); 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:=rremainder(c); r:=lig_step(i);
+if (l_skip_byte(r) mod 256)>stop_flag
+then i:=256*l_op_byte(r)+l_remainder(r);
+repeat @<Output step...@>;
+if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
+else i:=i+1+(l_skip_byte(k) mod 256);
+until i>=nl;
+right;
+end
+
+@ We want to make sure that there is no cycle of characters linked together
+by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+loop. 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:=rremainder(c);
+if nonexistent(r) then begin
+  bad_char('Character list link to')(r); set_no_tag(c);
+@.Character list link...@>
+  end
+else begin
+  while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
+  if r=c then begin
+    bad('Cycle in a character list!');
+@.Cycle in a character list@>
+    print('Character '); print_hex(c);
+    print_ln(' now ends the list.');
+    set_no_tag(c);
+    end
+  else begin
+    left; out('NEXTLARGER'); out_char(rremainder(c));
+    right;
+    end;
+  end;
+end
+
+@ @<Output an extensible character recipe@>=
+if rremainder(c)>=ne then begin
+  range_error('Extensible'); set_no_tag(c);
+@.Extensible index for char@>
+  end
+else begin
+  left; out('VARCHAR'); out_ln;
+  @<Output the extensible pieces that exist@>;
+  right;
+  end
+
+@ @<Glob...@>=
+@!exten_char:integer;
+
+@ @<Output the extensible pieces that...@>=
+for d:=0 to 3 do begin
+  if not ofm_on then begin
+    k:=exten(c)+d;
+    exten_char:=tfm[k];
+    end
+  else begin
+    k:=exten(c)+2*d;
+    exten_char:=256*tfm[k]+tfm[k+1];
+    end;
+  if (d=3)or(exten_char>0) then begin
+    left;
+    case d of
+      0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+      if nonexistent(exten_char) then out_char(c)
+      else out_char(exten_char);
+      right;
+    end
+  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 \.{VFtoVP} 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
+      if not ofm_on then begin
+        k:=4*(exten_base+c)+d;
+        exten_char:=tfm[k];
+        end
+      else begin
+        k:=4*(exten_base+c)+2*d;
+        exten_char:=256*tfm[k]+tfm[k+1];
+        end;
+      if (exten_char>0)or(d=3) then begin
+        if nonexistent(exten_char) then begin
+          bad_char('Extensible recipe involves the')(exten_char);
+@.Extensible recipe involves...@>
+          if d<3 then begin
+            if not ofm_on then begin
+              tfm[k]:=0;
+              end
+            else begin
+              tfm[k]:=0;
+              tfm[k+1]:=0;
+              end;
+            end;
+          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 integer;
+@!class:array[0..hash_size] of simple..pending;
+@!lig_z:array[0..hash_size] of xxchar_type;
+@!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:xchar_type; {problematic ligature pair}
+
+@ @<Check for ligature cycles@>=
+hash_ptr:=0; y_lig_cycle:=xmax_char;
+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:=rremainder(c);
+  if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
+    i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
+  @<Enter data for character $c$ starting at location |i| in the hash table@>;
+  end;
+if bchar_label<nl then begin
+  c:=xmax_char; 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 xmax_char,(hash[r]-1)mod xmax_char);
+  end;
+if y_lig_cycle<xmax_char then begin
+  print('Infinite ligature loop starting with ');
+@.Infinite ligature loop...@>
+  if x_lig_cycle=xmax_char
+  then print('boundary')@+else print_hex(x_lig_cycle);
+  print(' and '); print_hex(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:=l_skip_byte(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:char_type; {function value or ligature character being entered}
+@!y:char_type; {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:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) 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:=l_next_char(k); t:=l_op_byte(k);
+cc:=simple; zz:=l_remainder(k);
+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:=xmax_char*x+y+1; h:=(hash_mult*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]:=xxmax_char; class[h]:=simple;
+  end; {the value |xxmax_char| will break all cycles, 
+        since it's not in |hash|}
+end; {there are no other cases}
+f:=lig_z[h];
+end;
+
+@* Outputting the VF info.
+The routines we've used for output from the |tfm| array have counterparts
+for output from |vf|. One difference is that the string outputs from |vf|
+need to be checked for balanced parentheses. The |string_balance| routine
+tests the string of length~|l| that starts at location~|k|.
+
+@p function string_balance(@!k,@!l:integer):boolean;
+label not_found,exit;
+var @!j,@!bal:integer;
+begin if l>0 then if vf[k]=" " then goto not_found;
+  {a leading blank is considered unbalanced}
+bal:=0;
+for j:=k to k+l-1 do begin
+  if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
+  if vf[j]="(" then incr(bal)
+  else if vf[j]=")" then
+    if bal=0 then goto not_found else decr(bal);
+  end;
+if bal>0 then goto not_found;
+string_balance:=true; return;
+not_found:string_balance:=false;
+exit:end;
+
+@ @d bad_vf(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
+  chars_on_line:=0; print_ln('Bad OVF file: ',#);
+  end
+@.Bad OVF file@>
+
+@<Do the virtual font title@>=
+if string_balance(0,font_start[0]) then begin
+  left; out('VTITLE ');
+  for k:=0 to font_start[0]-1 do out(xchr[vf[k]]);
+  right;
+  end
+else bad_vf('Title is not a balanced ASCII string')
+@.Title is not balanced@>
+
+@ We can re-use some code by moving |fix_word| data to |tfm|, using the
+fact that the design size has already been output.
+
+@p procedure out_as_fix(@!x:integer);
+var @!k:1..3;
+begin if abs(x)>=@'100000000 then
+  bad_vf('Oversize dimension has been reset to zero.');
+@.Oversize dimension...@>
+if x>=0 then tfm[design_size]:=0
+else begin
+  tfm[design_size]:=255; x:=x+@'100000000;
+  end;
+for k:=3 downto 1 do begin
+  tfm[design_size+k]:=x mod 256; x:=x div 256;
+  end;
+out_fix(design_size);
+end;
+
+@ @<Do the local fonts@>=
+for f:=0 to font_ptr-1 do begin
+  left; out('MAPFONT D ',f:1); out_ln;
+  @<Output the font area and name@>;
+  for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k];
+  if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin
+    left; out('FONTCHECKSUM'); out_hex(0,4); right;
+    end;
+  left; out('FONTAT'); out_fix(4); right;
+  left; out('FONTDSIZE'); out_fix(8); right; right;
+  end
+
+@ @<Output the font area and name@>=
+a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13];
+if a>0 then
+  if not string_balance(font_start[f]+14,a) then
+    bad_vf('Improper font area will be ignored')
+@.Improper font area@>
+  else begin
+    left; out('FONTAREA ');
+    for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]);
+    right;
+    end;
+if (l=0)or not string_balance(font_start[f]+14+a,l) then
+  bad_vf('Improper font name will be ignored')
+@.Improper font name@>
+else begin
+  left; out('FONTNAME ');
+  for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]);
+  right;
+  end
+
+@ Now we get to the interesting part of \.{VF} output, where \.{DVI}
+commands are translated into symbolic form. The \.{VPL} language is a subset
+of \.{DVI}, so we sometimes need to output semantic equivalents of
+the commands instead of producing a literal translation. This causes a
+small but tolerable loss of efficiency. We need to simulate the stack
+used by \.{DVI}-reading software.
+
+@<Glob...@>=
+@!top:0..max_stack; {\.{DVI} stack pointer}
+@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of integer;
+ {stacked values of \.{DVI} registers |w|, |x|, |y|, |z|}
+@!vf_limit:0..vf_size; {the current packet ends here}
+@!o:byte; {the current opcode}
+
+@ @<Do the packet for character |c|@>=
+if packet_start[c]=vf_size then
+  bad_vf('Missing packet for character ',c:1)
+@.Missing packet@>
+else begin
+  left; out('MAP'); out_ln;
+  top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0;
+  vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0;
+  while vf_ptr<vf_limit do begin
+    o:=vf[vf_ptr]; incr(vf_ptr);
+    case o of
+    @<Cases of \.{DVI} instructions that can appear in character packets@>@;
+    improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored');
+    end; {there are no other cases}
+    end;
+  if top>0 then begin
+    bad_vf('More pushes than pops!');
+@.More pushes than pops@>
+    repeat out('(POP)'); decr(top);@+until top=0;
+    end;
+  right;
+  end
+
+@ A procedure called |get_bytes| helps fetch the parameters of \.{DVI} commands.
+
+@p function get_bytes(@!k:integer;@!signed:boolean):integer;
+var @!a:integer; {accumulator}
+begin if vf_ptr+k>vf_limit then begin
+  bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
+  end;
+a:=vf[vf_ptr];
+if (k=4) or signed then
+  if a>=128 then a:=a-256;
+incr(vf_ptr);
+while k>1 do begin
+  a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
+  end;
+get_bytes:=a;
+end;
+
+@ Let's look at the simplest cases first, in order to get some experience.
+
+@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)
+
+@<Cases...@>=
+nop:do_nothing;
+push:begin if top=max_stack then
+    begin print_ln('Stack overflow!'); goto final_end;
+@.Stack overflow@>
+    end;
+  incr(top); wstack[top]:=wstack[top-1]; xstack[top]:=xstack[top-1];
+  ystack[top]:=ystack[top-1]; zstack[top]:=zstack[top-1]; out('(PUSH)');
+  out_ln;
+  end;                            
+pop:if top=0 then bad_vf('More pops than pushes!')
+@.More pops than pushes@>
+  else begin decr(top); out('(POP)'); out_ln;
+    end;
+set_rule,put_rule:begin if o=put_rule then out('(PUSH)');
+  left; out('SETRULE'); out_as_fix(get_bytes(4,true));
+  out_as_fix(get_bytes(4,true));
+  if o=put_rule then out(')(POP');
+  right;
+  end;
+
+@ Horizontal and vertical motions become \.{RIGHT} and \.{DOWN} in \.{VPL}
+lingo.
+
+@<Cases...@>=
+four_cases(right1):begin out('(MOVERIGHT');
+  out_as_fix(get_bytes(o-right1+1,true));
+  out(')'); out_ln;@+end;
+w0,four_cases(w1):begin if o<>w0 then wstack[top]:=get_bytes(o-w1+1,true);
+  out('(MOVERIGHT'); out_as_fix(wstack[top]); out(')'); out_ln;@+end;
+x0,four_cases(x1):begin if o<>x0 then xstack[top]:=get_bytes(o-x1+1,true);
+  out('(MOVERIGHT'); out_as_fix(xstack[top]); out(')'); out_ln;@+end;
+four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true));
+  out(')'); out_ln;@+end;
+y0,four_cases(y1):begin if o<>y0 then ystack[top]:=get_bytes(o-y1+1,true);
+  out('(MOVEDOWN'); out_as_fix(ystack[top]); out(')'); out_ln;@+end;
+z0,four_cases(z1):begin if o<>z0 then zstack[top]:=get_bytes(o-z1+1,true);
+  out('(MOVEDOWN'); out_as_fix(zstack[top]); out(')'); out_ln;@+end;
+
+@ Variable |f| always refers to the current font. If |f=font_ptr|, it's
+a font that hasn't been defined (so its characters will be ignored).
+
+@<Cases...@>=
+sixty_four_cases(fnt_num_0),four_cases(fnt1):begin f:=0;
+  if o>=fnt1 then font_number[font_ptr]:=get_bytes(o-fnt1+1,false)
+  else font_number[font_ptr]:=o-fnt_num_0;
+  while font_number[f]<>font_number[font_ptr] do incr(f);
+  if f=font_ptr then bad_vf('Undeclared font selected')
+@.Undeclared font selected@>
+  else begin out('(SELECTFONT D ',f:1,')'); out_ln;
+    end;
+  end;
+
+@ Before we typeset a character we make sure that it exists.
+
+@<Cases...@>=
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
+ four_cases(set1),four_cases(put1):begin if o>=set1 then
+    if o>=put1 then c:=get_bytes(o-put1+1,false)
+    else c:=get_bytes(o-set1+1,false)
+  else c:=o;
+  if f=font_ptr then
+    bad_vf('Character ',c:1,' in undeclared font will be ignored')
+@.Character...will be ignored@>
+  else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+    k:=font_chars[f];@+while vf[k]<>c do incr(k);
+    if k=font_start[f+1]-1 then
+      bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
+    else begin if o>=put1 then out('(PUSH)');
+      left; out('SETCHAR'); out_char(c);
+      if o>=put1 then out(')(POP');
+      right;
+      end;
+    end;
+  end;
+
+@ The ``special'' commands are the only ones remaining to be dealt with.
+We use a hexadecimal
+output in the general case, if a simple string would be inadequate.
+
+@d vf_out_hex(#)==begin a:=#;
+    if a<10 then out(a:1)
+    else out(xchr[a-10+"A"]);
+    end
+
+@<Cases...@>=
+four_cases(xxx1):begin k:=get_bytes(o-xxx1+1,false);
+  if k<0 then bad_vf('String of negative length!')
+  else begin left;
+    if k+vf_ptr>vf_limit then
+      begin bad_vf('Special command truncated to packet length');
+      k:=vf_limit-vf_ptr;
+      end;
+    if (k>64)or not string_balance(vf_ptr,k) then
+      begin out('SPECIALHEX ');
+      while k>0 do
+        begin if k mod 32=0 then out_ln
+        else if k mod 4=0 then out(' ');
+        vf_out_hex(vf[vf_ptr] div 16); vf_out_hex(vf[vf_ptr] mod 16);
+        incr(vf_ptr); decr(k);
+        end;
+      end
+    else begin out('SPECIAL ');
+      while k>0 do
+        begin out(xchr[vf[vf_ptr]]); incr(vf_ptr); decr(k);
+        end;
+      end;
+    right;
+    end;
+  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 come the |vf_input| and |organize| procedures, which read the input data
+and get ready for subsequent events. If something goes wrong, the routines
+return |false|.
+
+@p function vf_input:boolean;
+label final_end, exit;
+var vf_ptr:0..vf_size; {an index into |vf|}
+@!k:integer; {all-purpose index}
+@!c:integer; {character code}
+begin @<Read the whole \.{VF} file@>;
+vf_input:=true; return;
+final_end: vf_input:=false;
+exit: end;
+@#
+function organize:boolean;
+label final_end, exit;
+var tfm_ptr:index; {an index into |tfm|}
+begin @<Read the whole font metric file@>;
+@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;
+@<Compute the base addresses@>;
+organize:=vf_input; return;
+final_end: organize:=false;
+exit: end;
+
+@ Next we do the simple things.
+
+@p procedure do_simple_things;
+var i:0..@'77777; {an index to words of a subfile}
+@!f:0..vf_size; {local font number}
+@!k:integer; {all-purpose index}
+begin @<Do the virtual font title@>;
+@<Do the header@>;
+@<Do the parameters@>;
+@<Do the ivalue parameters@>;@/
+@<Do the fvalue parameters@>;@/
+@<Do the rule parameters@>;@/
+@<Do the glue parameters@>;@/
+@<Do the penalty parameters@>;@/
+@<Do the local fonts@>;
+@<Check the |fix_word| entries@>;
+end;
+
+@ And then there's a routine for individual characters.
+
+@p function do_map(@!c:integer):boolean;
+label final_end,exit;
+var @!k:integer;
+@!f:0..vf_size; {current font number}
+begin @<Do the packet for character |c|@>;
+do_map:=true; return;
+final_end: do_map:=false;
+exit:end;
+@#
+function do_characters:boolean;
+label final_end, exit;
+var @!c:integer; {character being done}
+@!k:index; {a random index}
+@!ai:0..lig_size; {index into |activity|}
+begin @<Do the characters@>;@/
+do_characters:=true; return;
+final_end: do_characters:=false;
+exit:end;
+
+@ Here is where \.{VFtoVP} 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@>;
+if not do_characters then goto final_end;
+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 OFM AND/OR OVF FILE WAS BAD, ');
+  out('SO THE DATA HAS BEEN CHANGED!)');
+  end;
+@.THE OFM AND/OR OVF FILE WAS BAD...@>
+final_end:end.
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{VFtoVP} 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.