summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/dvicopy.web
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/dvicopy.web')
-rw-r--r--Build/source/texk/web2c/dvicopy.web4480
1 files changed, 4480 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/dvicopy.web b/Build/source/texk/web2c/dvicopy.web
new file mode 100644
index 00000000000..70cabca04b0
--- /dev/null
+++ b/Build/source/texk/web2c/dvicopy.web
@@ -0,0 +1,4480 @@
+% Copyright (C) 1990,95 Peter Breitenlohner (peb@@mppmu.mpg.de)
+%
+% This program is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 1, or (at your option)
+% any later version.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program; if not, write to the Free Software
+% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+%
+% Version 0.9 was finished May 21, 1990.
+% Version 1.0 pixel rounding for real devices (August 6, 1990).
+% Version 1.1 major rearrangements for DVIprint (October 7, 1990).
+% Version 1.2 fixed some bugs, page selection (February 13, 1991).
+% Version 1.3 several more changes, command line options,
+% don't load fonts that are never used (August 25, 1992).
+% Version 1.4 fixed a typo (March 28, 1995).
+% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\font\logo=manfnt % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\mathchardef\RA="3221 % right arrow
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVI\lowercase{copy}} % don't change this line!
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVIcopy} processor}
+ \vskip 5pt
+ \centerline{Copyright (C) 1990,95 Peter Breitenlohner}
+ \centerline{Distributed under terms of GNU General Public License}
+ \vskip 15pt
+ \centerline{(Version 1.5, October 1995)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ This program was developed at the Max-Planck-Institut f\"ur Physik
+ (Werner-Heisenberg-Institut), Munich, Germany.
+ `\TeX' is a trademark of the American Mathematical Society.
+ `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
+ Publishing Company.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{DVIcopy} utility program copies (selected pages of) binary
+device-independent (``\.{DVI}'') files that are produced by document
+compilers such as \TeX, and replaces all references to characters from
+virtual fonts by the typesetting instructions specified for them in
+binary virtual-font (``\.{VF}'') files.
+This program has two chief purposes: (1)~It can be used as preprocessor
+for existing \.{DVI}-related software in cases where this software is
+unable to handle virtual fonts or (given suitable \.{VF} files) where
+this software cannot handle fonts with more than 128~characters;
+and (2)~it serves as an example of a program that reads \.{DVI} and
+\.{VF} files correctly, for system programmers who are developing
+\.{DVI}-related software.
+
+Goal number (1) is important since quite a few existing programs have
+to be adapted to the extened capabilities of Version~3 of \TeX\ which
+will require some time. Moreover some existing programs are `as is' and
+the source code is, unfortunately, not available.
+Goal number (2) needs perhaps a bit more explanation. Programs for
+typesetting need to be especially careful about how they do arithmetic; if
+rounding errors accumulate, margins won't be straight, vertical rules
+won't line up, and so on (see the documentaion of \.{DVItype} for more
+details). This program is written as if it were a \.{DVI}-driver for a
+hypothetical typesetting device |out_file|, the output file receiving
+the copy of the input |dvi_file|. In addition all code related to
+|out_file| is concentrated in two chapters at the end of this program
+and quite independent of the rest of the code concerned with the
+decoding of \.{DVI} and \.{VF} files and with font substitutions. Thus
+it should be relatively easy to replace the device dependent code of
+this program by the corresponding code required for a real typesetting
+device. Having this in mind \.{DVItype}'s pixel rounding algorithms are
+included as conditional code not used by \.{DVIcopy}.
+
+The |banner| and |preamble_comment| strings defined here should be
+changed whenever \.{DVIcopy} gets modified.
+
+@d banner=='This is DVIcopy, Version 1.5' {printed when the program starts}
+@d title=='DVIcopy' {the name of this program, used in some messages}
+@d copyright=='Copyright (C) 1990,95 Peter Breitenlohner'
+@#
+@d preamble_comment=='DVIcopy 1.5 output from '
+@d comm_length=24 {length of |preamble_comment|}
+@d from_length=6 {length of its |' from '| part}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVIcopy} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. Such extensions are not necessary
+for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a
+production program it should, however, be made as efficient as possible
+for a particular system. If \.{DVIcopy} is being used with
+\PASCAL s for which random file positioning is not efficiently available,
+the following definition should be changed from |true| to |false|; in such
+cases, \.{DVIcopy} will not include the optional feature that reads the
+postamble first.
+
+@d random_reading==true {should we skip around in the file?}
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{DVI} input comes from file
+|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages
+go to \PASCAL's standard |output| file.
+The \.{TFM} and \.{VF} files are defined later since their external
+names are determined dynamically.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |final_end|.
+
+@d final_end = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program DVI_copy(@!dvi_file,@!out_file,@!output);
+label final_end;
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ print_ln(copyright);
+ print_ln('Distributed under terms of GNU General Public License');@/
+ @<Set initial values@>@/
+ end;
+
+@ The definition of |max_font_type| should be adapted to the number of
+font types used by the program; the first three values have a fixed
+meaning: |defined_font=0| indicates that a font has been defined,
+|loaded_font=1| indicates that the \.{TFM} file has been loaded but the
+font has not yet been used, and |vf_font_type=2| indicates a virtual
+font. Font type values |>=real_font=3| indicate real fonts and
+different font types are used to distinguish various kinds of font files
+(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for
+fonts that appear in the output \.{DVI} file.
+@!@^font types@>
+
+@d defined_font=0 {this font has been defined}
+@d loaded_font=1 {this font has been defined and loaded}
+@d vf_font_type=2 {this font is a virtual font}
+@d real_font=3 {smallest font type for real fonts}
+@#
+@d out_font_type=3 {this font appears in the output file}
+@d max_font_type=3
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVIcopy}'s capacity.
+
+@d max_select=10 {maximum number of page selection ranges}
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts}
+@!max_chars=10000; {maximum number of different characters among all fonts}
+@!max_widths=3000; {maximum number of different characters widths}
+@!max_packets=5000; {maximum number of different characters packets;
+ must be less than 65536}
+@!max_bytes=30000; {maximum number of bytes for characters packets}
+@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!name_length=50; {a file name shouldn't be longer than this}
+
+@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces
+a copy of the input \.{DVI} file with all references to characters from
+virtual fonts replaced by their expansion as specified in the character
+packets of \.{VF} files; and (2)~it serves as an example of a program
+that reads \.{DVI} and \.{VF} files correctly, for system programmers
+who are developing \.{DVI}-related software.
+
+In fact, a very large section of code (starting with the second chapter
+`Introduction (continued)' and ending with the fifteenth chapter
+`The main program') is used in identical form in \.{DVIcopy} and in
+\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible
+mostly by using several \.{WEB} coding tricks, such as not to make the
+resulting \PASCAL\ program inefficient in any way.
+
+Parts of the program that are needed in \.{DVIprint} but not in
+\.{DVIcopy} are delimited by the codewords `$|device|\ldots|ecived|$';
+these are mostly the pixel rounding algorithms used to convert the
+\.{DVI} units of a \.{DVI} file to the raster units of a real output
+device and have been copied more or less verbatim from \.{DVItype}.
+
+@d device==@{ {change this to `$\\{device}\equiv\null$' when output
+ for a real device is produced}
+@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output
+ for a real device is produced}
+@f device==begin
+@f ecived==end
+
+@* Introduction (continued).
+On some systems it is necessary to use various integer subrange types
+in order to make \.{\title} efficient; this is true in particular for
+frequently used variables such as loop indices. Consider an integer
+variable |x| with values in the range |0..255|: on most small systems
+|x| should be a one or two byte integer whereas on most large systems
+|x| should be a four byte integer.
+Clearly the author of a program knows best which range of values is
+required for each variable; thus \.{\title} never uses \PASCAL's |integer|
+type. All integer variables are declared as one of the integer subrange
+types defined below as \.{WEB} macros or \PASCAL\ types; these definitions
+can be used without system-dependent changes, provided the signed 32~bit
+integers are a subset of the standard type |integer|, and the compiler
+automatically uses the optimal representation for integer subranges
+(both conditions need not be satisfied for a particular system).
+@^system dependencies@>
+
+The complementary problem of storing large arrays of integer type
+variables as compactly as possible is addressed differently; here
+\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array
+element.
+
+Note that the primary purpose of these definitions is optimizations, not
+range checking. All places where optimization for a particular system is
+highly desirable have been listed in the index under ``optimization.''
+@!@^optimization@>
+
+@d int_32 == integer {signed 32~bit integers}
+
+@<Types...@>=
+@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer}
+@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer}
+@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer}
+@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer}
+@!int_16u = 0..@"FFFF; {unsigned 16~bit integer}
+@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer}
+@!int_15 = 0..@"7FFF; {unsigned 15~bit integer}
+@!int_8u = 0..@"FF; {unsigned 8~bit integer}
+@!int_8 = -@"80..@"7F; {signed 8~bit integer}
+@!int_7 = 0..@"7F; {unsigned 7~bit integer}
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included
+if statistics about \.{\title}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+ when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+ when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this program has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{\title} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ The term |print| is used instead of |write| when this program writes on
+|output|, so that all such output could easily be redirected if desired;
+the term |d_print| is used for conditional output if we are debugging.
+
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d new_line==write_ln(output) {start new line}
+@d print_nl(#)== {print information starting on a new line}
+ begin new_line; print(#);
+ end
+@#
+@d d_print(#)==@!debug print(#) @; @+ gubed
+@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed
+
+@ 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 Incr_Decr_end(#)==#
+@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
+@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
+ variable |a| by |b|; this can be optimized for some compilers}
+@#
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases.
+Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE},
+@^Knuth, Donald Ervin@>
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{\title} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} and \.{VF} files use ASCII code for
+file names and certain other strings.
+
+The next few sections of \.{\title} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{\title} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{\title}.
+So we shall assume that the \PASCAL\ system being used for \.{\title}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ @<Local variables for init...@>=
+@!i:int_16; {loop index for initializations}
+
+@ The \.{\title} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Reporting errors to the user.
+The \.{\title} processor does not verify that every single bit read from
+one of its binary input files is meaningful and consistent; there are
+other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially
+designed for that purpose.
+
+On the other hand, \.{\title} is designed to avoid unpredictable results
+due to undetected arithmetic overflow, or due to violation of integer
+subranges or array bounds under {\it all\/} circumstances. Thus a fair
+amount of checking is done when reading and analyzing the input data,
+even in cases where such checking reduces the efficiency of the program
+to some extent.
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed,
+the whole process must be aborted; \.{\title} will give up, after issuing
+an error message about what caused the error. These messages will, however,
+in most cases just indicate which input file caused the error. One of the
+programs \.{DVItype}, \.{TFtoPL} or \.{VFtoVP} should then be used to
+diagnose the error in full detail.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+transfers control to the label |final_end| at the end of the program,
+contains the only non-local |@!goto| statement in \.{\title}.
+@^system dependencies@>
+Some \PASCAL\ compilers do not implement non-local |goto| statements. In
+such cases the |goto final_end| in |jump_out| should simply be replaced
+by a call on some system procedure that quietly terminates the program.
+@^system dependencies@>
+
+@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
+ end
+
+@<Error handling...@>=
+@<Basic printing procedures@>@;
+procedure close_files_and_terminate; forward;
+@#
+procedure jump_out;
+begin mark_fatal; close_files_and_terminate;
+goto final_end;
+end;
+
+@ Sometimes the program's behavior is far different from what it should
+be, and \.{\title} prints an error message that is really for the
+\.{\title} maintenance person, not the user. In such cases the program
+says |confusion(|indication of where we are|)|.
+
+@<Error handling...@>=
+procedure confusion(@!p:pckt_pointer);
+begin print(' !This can''t happen ('); print_packet(p); print_ln(').');
+@.This can't happen@>
+jump_out;
+end;
+
+@ An overflow stop occurs if \.{\title}'s tables aren't large enough.
+
+@<Error handling...@>=
+procedure overflow(@!p:pckt_pointer;@!n:int_16u);
+begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p);
+@.Sorry, {\title} capacity exceeded@>
+print_ln('=',n:1,'].');
+jump_out;
+end;
+
+@* Binary data and binary files.
+A detailed description of the \.{DVI} file format can be found in the
+documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define
+symbolic names for some of the \.{DVI} command bytes.
+
+@d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@#
+@d dvi_id=2 {identifies \.{DVI} files}
+@d dvi_pad=223 {pad bytes at end of \.{DVI} file}
+
+@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes.
+The bytes appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often
+interpreted as (signed or unsigned) integers.
+We might as well define the corresponding data types.
+@!@^system dependencies@>
+
+@<Types...@>=
+@!signed_byte=-@"80..@"7F; {signed one-byte quantity}
+@!eight_bits=0..@"FF; {unsigned one-byte quantity}
+@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity}
+@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity}
+@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity}
+@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity}
+@!signed_quad=int_32; {signed four-byte quantity}
+
+@ Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{\title} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+@ We shall stick to simple \PASCAL\ in the standard version of this program,
+for reasons of clarity, even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ For some operating systems it may be convenient or even necessary to
+close the input files.
+
+@d close_in(#)==do_nothing {close an input file}
+
+@ Character packets extracted from \.{VF} files will be stored in a large
+array |byte_mem|. Other packets of bytes, e.g., character packets
+extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the
+same way. A `|pckt_pointer|' variable, which signifies a packet,
+is an index into another array |pckt_start|. The actual sequence of bytes
+in the packet pointed to by |p| appears in positions |pckt_start[p]| to
+|pckt_start[p+1]-1|, inclusive, in |byte_mem|.
+
+Packets will also be used to store sequences of |ASCII_code|s; in this
+respect the |byte_mem| array is very similar to \TeX's string pool and
+part of the following code has, in fact, been copied more or less
+verbatim from \TeX.
+
+In other respects the packets resemble the identifiers used by
+\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|)
+since there is, in general, at most one packet with a given contents;
+thus part of the code below has been adapted from the corresponding code
+in these programs.
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems we
+access the array |byte_mem| only via macros that can easily be redefined.
+@^system dependencies@>
+
+@d bi(#) == # {convert from |eight_bits| to |packed_byte|}
+@d bo(#) == # {convert from |packed_byte| to |eight_bits|}
+
+@<Types...@>=
+@!packed_byte = eight_bits; {elements of |byte_mem| array}
+@!byte_pointer = 0..max_bytes; {an index into |byte_mem|}
+@!pckt_pointer = 0..max_packets; {an index into |pckt_start|}
+
+@ The global variable |byte_ptr| points to the first unused location in
+|byte_mem| and |pckt_ptr| points to the first unused location in
+|pckt_start|.
+
+@<Globals...@>=
+@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets}
+@!pckt_start: array [pckt_pointer] of byte_pointer;
+ {directory into |byte_mem|}
+@!byte_ptr: byte_pointer;
+@!pckt_ptr: pckt_pointer;
+
+@ Several of the elementary operations with packets are performed using
+\.{WEB} macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a packet.
+@.WEB@>
+
+@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes
+ in packet number \#}
+
+@ Packets are created by appending bytes to |byte_mem|.
+The |append_byte| macro, defined here, does not check to see if the
+value of |byte_ptr| has gotten too high; this test is supposed to be
+made before |append_byte| is used. There is also a |flush_byte|
+macro, which erases the last byte appended.
+
+To test if there is room to append |l| more bytes to |byte_mem|,
+we shall write |pckt_room(l)|, which aborts \.{\title} and gives an
+apologetic error message if there isn't enough room.
+
+@d append_byte(#) == {put byte \# at the end of |byte_mem|}
+begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr);
+end
+@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|}
+@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed}
+ if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes)
+@#
+@d append_one(#) ==
+begin pckt_room(1); append_byte(#);
+end
+
+@ The length of the current packet is called |cur_pckt_length|:
+
+@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr])
+
+@ Once a sequence of bytes has been appended to |byte_mem|, it
+officially becomes a packet when the |make_packet| function is called.
+This function returns as its value the identification number of either
+an existing packet with the same contents or, if no such packet exists,
+of the new packet. Thus two packets have the same contents if and only
+if they have the same identification number. In order to locate the
+packet with a given contents, or to find out that no such packet exists,
+we need a hash table. The hash table is kept by the method of simple
+chaining, where the heads of the individual lists appear in the |p_hash|
+array. If |h| is a hash code, the hash table list starts at |p_hash[h]|
+and proceeds through |p_link| pointers.
+
+@d hash_size=353 {should be prime, must be |>256|}
+
+@<Types...@>=
+@!hash_code=0..hash_size;
+
+@ @<Glob...@>=
+@!p_link:array[pckt_pointer] of pckt_pointer; {hash table}
+@!p_hash:array[hash_code] of pckt_pointer;
+
+@ Initially |byte_mem| and all the hash lists are empty; |empty_packet|
+is the empty packet.
+
+@d empty_packet=0 {the empty packet}
+@d invalid_packet==max_packets {used when there is no packet}
+
+@<Set init...@>=
+pckt_ptr:=1; byte_ptr:=1;
+pckt_start[0]:=1; pckt_start[1]:=1;
+for h:=0 to hash_size-1 do p_hash[h]:=0;
+
+@ @<Local variables for init...@>=
+@!h:hash_code; {index into hash-head arrays}
+
+@ Here now is the |make_packet| function used to create packets (and
+strings).
+
+@p function make_packet:pckt_pointer;
+label found;
+var i,@!k:byte_pointer; {indices into |byte_mem|}
+@!h:hash_code; {hash code}
+@!s,@!l:byte_pointer; {start and length of the given packet}
+@!p:pckt_pointer; {where the packet is being sought}
+begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length}
+if l=0 then p:=empty_packet
+else begin @<Compute the packet hash code |h|@>;
+ @<Compute the packet location |p|@>;
+ if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+ incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+ end;
+found:make_packet:=p;
+end;
+
+@ A simple hash code is used: If the sequence of bytes is
+$b_1b_2\ldots b_n$, its hash value will be
+$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the packet hash...@>=
+h:=bo(byte_mem[s]); i:=s+1;
+while i<byte_ptr do
+ begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i);
+ end
+
+@ If the packet is new, it will be placed in position |p=pckt_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the packet location...@>=
+p:=p_hash[h];
+while p<>0 do
+ begin if pckt_length(p)=l then
+ @<Compare packet |p| with current packet, |goto found| if equal@>;
+ p:=p_link[p];
+ end;
+p:=pckt_ptr; {the current packet is new}
+p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ @<Compare packet |p|...@>=
+begin i:=s; k:=pckt_start[p];
+while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do
+ begin incr(i); incr(k);
+ end;
+if i=byte_ptr then {all bytes agree}
+ begin byte_ptr:=pckt_start[pckt_ptr]; goto found;
+ end;
+end
+
+@ Some packets are initialized with predefined strings of |ASCII_code|s;
+a few macros permit us to do the initialization with a compact program.
+Since this initialization is done when |byte_mem| is still empty, and
+since |byte_mem| is supposed to be large enough for all the predefined
+strings, |pckt_room| is used only if we are debugging.
+
+@d pid0(#)==#:=make_packet
+@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0
+@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1
+@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2
+@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3
+@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4
+@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5
+@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6
+@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7
+@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8
+@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9
+@#
+@d pid_init(#)==
+ @!debug pckt_room(#); @+ gubed @;
+ Incr(byte_ptr)(#)
+@#
+@d id1==pid_init(1); pid1
+@d id2==pid_init(2); pid2
+@d id3==pid_init(3); pid3
+@d id4==pid_init(4); pid4
+@d id5==pid_init(5); pid5
+@d id6==pid_init(6); pid6
+@d id7==pid_init(7); pid7
+@d id8==pid_init(8); pid8
+@d id9==pid_init(9); pid9
+@d id10==pid_init(10); pid10
+
+@ Here we initialize some strings used as argument of the |overflow| and
+|confusion| procedures.
+
+@<Initialize predefined strings@>=
+id5("f")("o")("n")("t")("s")(str_fonts);
+id5("c")("h")("a")("r")("s")(str_chars);
+id6("w")("i")("d")("t")("h")("s")(str_widths);
+id7("p")("a")("c")("k")("e")("t")("s")(str_packets);
+id5("b")("y")("t")("e")("s")(str_bytes);
+id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion);
+id5("s")("t")("a")("c")("k")(str_stack);
+id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length);
+
+@ @<Glob...@>=
+@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes,
+@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer;
+
+@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files,
+are needed only temporarily. In such cases |new_packet| is used to
+create a packet (which might duplicate an existing packet) and
+|flush_packet| is used to discard it; the calls to |new_packet| and
+|flush_packet| must occur in balanced pairs, without any intervening
+calls to |make_packet|.
+
+@p function new_packet: pckt_pointer;
+begin if pckt_ptr=max_packets then overflow(str_packets,max_packets);
+new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
+end;
+@#
+procedure flush_packet;
+begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr];
+end;
+
+@ The |print_packet| procedure prints the contents of a packet; such a
+packets should, of course, consists of a sequence of |ASCII_code|s.
+
+@<Basic printing...@>=
+procedure print_packet(p:pckt_pointer);
+var k:byte_pointer;
+begin for k:=pckt_start[p] to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+end;
+
+@ When we interpret a packet we will use two (global or local) variables:
+|cur_loc| will point to the byte to be used next, and |cur_limit| will
+point to the start of the next packet. The macro |pckt_extract| will be
+used to extract one byte; it should, however, never be used with
+|cur_loc>=cur_limit|.
+
+@d pckt_extract(#) ==
+@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/
+gubed @;
+ begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end
+
+@<Globals...@>=
+@!cur_pckt: pckt_pointer; {the current packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+
+@ We will need routines to extract one, two, three, or four bytes from
+|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble
+them into (signed or unsigned) integers and these routines should be
+optimized for efficiency. Here we define \.{WEB} macros to be used for
+the body of these routines; thus the changes for system dependent
+optimization have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+In addition we demonstrates how these macros can be used to define
+functions that extract one, two, three, or four bytes from a character
+packet and assemble them into signed or unsigned integers (assuming that
+|cur_loc| and |cur_limit| are initialized suitably).
+
+@d begin_byte(#) ==
+var a:eight_bits;
+begin #(a)
+@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256
+@d comp_ubyte(#) == #:=a
+@f begin_byte == begin
+
+@p function pckt_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte);
+end;
+@#
+function pckt_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte);
+end;
+
+@ @d begin_pair(#) ==
+var a,@!b:eight_bits;
+begin #(a); #(b)
+@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
+@d comp_upair(#) == #:=a*256+b
+@f begin_pair == begin
+
+@p function pckt_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(pckt_extract); comp_spair(pckt_spair);
+end;
+@#
+function pckt_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(pckt_extract); comp_upair(pckt_upair);
+end;
+
+@ @d begin_trio(#) ==
+var a,@!b,@!c:eight_bits;
+begin #(a); #(b); #(c)
+@d comp_strio(#) ==
+if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
+@d comp_utrio(#) == #:=(a*256+b)*256+c
+@f begin_trio == begin
+
+@p function pckt_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(pckt_extract); comp_strio(pckt_strio);
+end;
+@#
+function pckt_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(pckt_extract); comp_utrio(pckt_utrio);
+end;
+
+@ @d begin_quad(#) ==
+var a,@!b,@!c,@!d:eight_bits;
+begin #(a); #(b); #(c); #(d)
+@d comp_squad(#) ==
+if a<128 then #:=((a*256+b)*256+c)*256+d
+else #:=(((a-256)*256+b)*256+c)*256+d
+@f begin_quad == begin
+
+@p function pckt_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(pckt_extract); comp_squad(pckt_squad);
+end;
+
+@ A similar set of routines is needed for the inverse task of
+decomposing a \.{DVI} command into a sequence of bytes to be appended
+to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the
+output file. Again we define \.{WEB} macros to be used for the body
+of these routines; thus the changes for system dependent optimization
+have to be applied only once.
+@^system dependencies@>
+@^optimization@>
+
+First, the |pckt_one| outputs one byte, negative values are represented
+in two's complement notation.
+
+@d begin_one == begin
+@d comp_one(#) ==
+if x<0 then Incr(x)(256);
+#(x)
+@f begin_one == begin
+
+@p @!device
+procedure pckt_one(@!x:int_32); {output one byte}
+@!begin_one; pckt_room(1); comp_one(append_byte);
+end;
+ecived
+
+@ The |pckt_two| outputs two bytes, negative values are represented in
+two's complement notation.
+
+@d begin_two == begin
+@d comp_two(#) ==
+if x<0 then Incr(x)(@"10000);
+#(x div @"100); #(x mod @"100)
+@f begin_two == begin
+
+@p @!device
+procedure pckt_two(@!x:int_32); {output two byte}
+@!begin_two; pckt_room(2); comp_two(append_byte);
+end;
+ecived
+
+@ The |pckt_four| procedure outputs four bytes in two's complement
+notation, without risking arithmetic overflow.
+
+@d begin_four == begin
+@d comp_four(#) ==
+if x>=0 then #(x div @"1000000)
+else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+x:=x mod @"1000000; #(x div @"10000);
+x:=x mod @"10000; #(x div @"100);
+#(x mod @"100)
+@f begin_four == begin
+
+@p procedure pckt_four(@!x:int_32); {output four bytes}
+@!begin_four; pckt_room(4); comp_four(append_byte);
+end;
+
+@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command
+or, if |upd=false|, a |put| command.
+
+@d begin_char ==
+var o:eight_bits; {|set1| or |put1|}
+begin
+@d comp_char(#) ==
+if (not upd)or(res>127)or(ext<>0) then
+ begin o:=dvi_char_cmd[upd]; {|set1| or |put1|}
+ if ext<0 then Incr(ext)(@"1000000);
+ if ext=0 then #(o) @+ else @;
+ begin if ext<@"100 then #(o+1) @+ else @;
+ begin if ext<@"10000 then #(o+2) @+ else @;
+ begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000;
+ end;
+ #(ext div @"100); ext:=ext mod @"100;
+ end;
+ #(ext);
+ end;
+ end;
+#(res)
+@f begin_char == begin
+
+@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
+ {output \\{set} or |put|}
+@!begin_char; pckt_room(5); comp_char(append_byte);
+end;
+
+@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@d begin_unsigned == begin
+@d comp_unsigned(#) ==
+if (x<@"100)and(x>=0) then
+ if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o)
+else
+ begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @;
+ begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @;
+ begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
+ #((x div @"1000000) + 128);
+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_unsigned == begin
+
+@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, or |xxx|}
+@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte);
+end;
+
+@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@d begin_signed ==
+var xx:int_31; {`absolute value' of |x|}
+begin
+@d comp_signed(#) ==
+if x>=0 then xx:=x @+ else xx:=-(x+1);
+if xx<@"80 then
+ begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end
+else begin if xx<@"8000 then
+ begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end
+ else begin if xx<@"800000 then
+ begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end
+ else begin #(o+3);
+ if x>=0 then #(x div @"1000000)
+ else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end;
+ x:=x mod @"1000000;
+ end;
+ #(x div @"10000); x:=x mod @"10000;
+ end;
+ #(x div @"100); x:=x mod @"100;
+ end;
+#(x)
+@f begin_signed == begin
+
+@p procedure pckt_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; pckt_room(5); comp_signed(append_byte);
+end;
+
+@ The |hex_packet| procedure prints the contents of a packet in
+hexadecimal form.
+
+@<Basic printing...@>=
+@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex}
+var j,@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!d:int_8u;
+begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1;
+print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1);
+for l:=j+1 to k do
+ begin d:=(bo(byte_mem[l])) div 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ d:=(bo(byte_mem[l])) mod 16;
+ if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
+ if (l=k)or(((l-j) mod 16)=0) then new_line
+ else if ((l-j) mod 4)=0 then print(' ')
+ else print(' ');
+ end;
+end;
+gubed
+
+@* File names.
+The structure of file names is different for different systems; therefore
+this part of the program will, in most cases, require system dependent
+modifications. Here we assume that a file name consists of three parts:
+an area or directory specifying where the file can be found, a name
+proper and an extension; \.{\title} assumes that these three parts appear
+in order stated above but this need not be true in all cases.
+
+The font names extracted from \.{DVI} and \.{VF} files consist of an area
+part and a name proper; these are stored as packets consisting of the
+length of the area part followed by the area and the name proper.
+When we print an external font name we simple print the area and the name
+contained in the `file name packet' without delimiter between them.
+This may need to be modified for some systems.
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_font(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k:byte_pointer; {index into |byte_mem|}
+@!m:int_31; {font magnification}
+begin print(' = '); p:=font_name(f);
+for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do
+ print(xchr[bo(byte_mem[k])]);
+m:=round((font_scaled(f)/font_design(f))*out_mag);
+if m<>1000 then print(' scaled ',m:1);
+end;
+
+@ Before a font file can be opened for input we must build a string
+with its external name.
+
+@<Glob...@>=
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!l_cur_name:int_15; {this many characters are actually relevant in
+ |cur_name|}
+
+@ For \.{TFM} and \.{VF} files we just append the apropriate extension
+to the file name packet; in addition a system dependent area part
+(usually different for \.{TFM} and \.{VF} files) is prepended if
+the file name packet contains no area part.
+@^system dependencies@>
+
+@d append_to_name(#)==
+ if l_cur_name<name_length then
+ begin incr(l_cur_name); cur_name[l_cur_name]:=#;
+ end
+ else overflow(str_name_length,name_length)
+@d make_font_name_end(#)==
+ append_to_name(#[l]); make_name
+@d make_font_name(#)==
+ l_cur_name:=0; for l:=1 to # do make_font_name_end
+
+@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the
+the extension and\slash or area part will in most cases depend on the
+resolution of the output device (corrected for font magnification).
+If the special character |res_char| occurs in the extension and\slash or
+default area, a character string representing the device resolution will
+be substituted.
+@^system dependencies@>
+
+@d res_char=='?' {character to be replaced by font resolution}
+@d res_ASCII="?" {|xord[res_char]|}
+@#
+@d append_res_to_name(#)==
+ begin c:=#;
+ @!device if c=res_char then
+ for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll])
+ else ecived@;@/
+ append_to_name(c);
+ end
+@d make_font_res_end(#)==
+ append_res_to_name(#[l]); make_name
+@d make_font_res(#)==
+ make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end
+
+@ @<Glob...@>=
+@!device
+@!f_res:int_16u; {font resolution}
+@!res_digits:array [1..5] of char;
+@!n_res_digits:int_7; {number of significant characters in |res_digits|}
+ecived
+
+@ The |make_res| procedure creates a sequence of characters representing
+to the font resolution |f_res|.
+
+@p @!device procedure make_res;
+var r:int_16u;
+begin n_res_digits:=0; r:=f_res;
+repeat incr(n_res_digits);
+ res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10;
+until r=0;
+end;
+ecived
+
+@ The |make_name| procedure used to build the external file name. The
+global variable |l_cur_name| contains the length of a default area
+which has been copied to |cur_name| before |make_name| is called.
+@^system dependencies@>
+
+@p procedure make_name(@!e:pckt_pointer);
+var b:eight_bits; {a byte extracted from |byte_mem|}
+@!n:pckt_pointer; {file name packet}
+@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|}
+@!device
+@!ll:int_15; {loop index}
+ecived@;@/
+@!c:char; {a character to be appended to |cur_name|}
+begin n:=font_name(cur_fnt);
+cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
+pckt_extract(b); {length of area part}
+if b>0 then l_cur_name:=0;
+while cur_loc<cur_limit do
+ begin pckt_extract(b);
+ if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
+ append_to_name(xchr[b]);
+ end;
+cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
+while cur_loc<cur_limit do
+ begin pckt_extract(b); append_res_to_name(xchr[b]);
+ end;
+while l_cur_name<name_length do
+ begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
+ end;
+end;
+
+@* Font data.
+\.{DVI} file format does not include information about character widths, since
+that would tend to make the files a lot longer. But a program that reads
+a \.{DVI} file is supposed to know the widths of the characters that appear
+in \\{set\_char} commands. Therefore \.{\title} looks at the font metric
+(\.{TFM}) files for the fonts that are involved.
+@.TFM {\rm files}@>
+
+The character-width data appears also in other files (e.g., in \.{VF} files
+or in \.{GF} and \.{PK} files that specify bit patterns for digitized
+characters); thus, it is usually possible for \.{DVI} reading programs
+to get by with accessing only one file per font. For \.{VF} reading
+programs there is, however, a problem: (1)~when reading the character
+packets from a \.{VF} file the \.{TFM} width for its local fonts should
+be known in order to analyze and optimize the packets (e.g., determine
+if a packet must indeed be enclosed with |push| and |pop| as implied by
+the \.{VF} format); and (2)~ in order to avoid infinite recursion such
+programs must not try to read a \.{VF} file for a font before a
+character from that font is actually used. Thus \.{\title} reads the
+\.{TFM} file whenever a new font is encountered and delays the decision
+whether this is a virtual font or not.
+
+@ First of all we need to know for each font~|f| such things as its
+external name, design and scaled size, and the approximate size of
+inter-word spaces. In addition we need to know the range |bc..ec| of
+valid characters for this font, and for each character~|c| in~|f| we
+need to know if this character exists and if so what is the width of~|c|.
+Depending on the font type of~|f| we may want to know a few other things
+about character~|c| in~|f| such as the character packet from a \.{VF}
+file or the raster data from a \.{PK} file.
+@^font types@>
+
+In \.{\title} we want to be able to handle the full range
+|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code
+is decomposed into a character residue |0<=res<256| and character
+extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|.
+At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use
+only characters in the range |0<=c<256| (i.e., |ext=0|), there are,
+however, extensions of \TeX\ which use characters with |ext<>0|.
+In any case characters with |ext<>0| will be used rather infrequently
+and we want to handle this possibility without too much overhead.
+
+Some of the data for each character~|c| depend only on its residue:
+first of all its width and escapement; others, such as \.{VF} packets or
+raster data will also depend on its extension. The later will be stored
+as packets in |byte_mem|, and the packets for characters with the same
+residue but different extension will be chained.
+
+Thus we have to maintain several variables for each character
+residue~|bc<=res<=ec| from each font~|f|; we store each type of variable
+in a large array such that the array index |font_chars(f)+res| points to
+the value for characters with residue |res| from font~|f|.
+
+@ Quite often a particular width value is shared by several characters in
+a font or even by characters from different fonts; the later will
+probably occur in particular for virtual fonts and the local fonts used
+by them. Thus the array |widths| is used to store all different \.{TFM}
+width values of all legal characters in all fonts; a variable of type
+|width_pointer| is an index into |widths| or is zero if a characters does
+not exist.
+
+In order to locate a given width value we use again a hash
+table with simple chaining; this time the heads of the individual lists
+appear in the |w_hash| array and the lists proceed through |w_link|
+pointers.
+
+@<Types...@>=
+@!width_pointer=0..max_widths; {an index into |widths|}
+
+@ @<Glob...@>=
+@!widths:array[width_pointer] of int_32; {the different width values}
+@!w_link:array[width_pointer] of width_pointer; {hash table}
+@!w_hash:array[hash_code] of width_pointer;
+@!n_widths:width_pointer; {first unoccupied position in |widths|}
+
+@ Initially the |widths| array and all the hash lists are empty, except
+for one entry: the width value zero; in addition we set |widths[0]:=0|.
+
+@d invalid_width=0 {width pointer for invalid characters}
+@d zero_width=1 {a width pointer to the value zero}
+
+@<Set init...@>=
+w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2;
+for h:=1 to hash_size-1 do w_hash[h]:=0;
+
+@ The |make_width| function returns an index into |widths| and, if
+necessary, adds a new width value; thus two characters will have the
+same |width_pointer| if and only if their widths agree.
+
+@p function make_width(@!w:int_32):width_pointer;
+label found;
+var h:hash_code; {hash code}
+@!p:width_pointer; {where the identifier is being sought}
+@!x:int_16; {intermediate value}
+begin widths[n_widths]:=w;
+@<Compute the width hash code |h|@>;
+@<Compute the width location |p|, |goto| found unless the value is new@>;
+if n_widths=max_widths then overflow(str_widths,max_widths);
+incr(n_widths);
+found:make_width:=p;
+end;
+
+@ A simple hash code is used: If the width value consists of the four
+bytes $b_0b_1b_2b_3$, its hash value will be
+$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$
+
+@<Compute the width hash...@>=
+if w>=0 then x:=w div @"1000000
+else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80;
+ end;
+w:=w mod @"1000000; x:=x+x+(w div @"10000);
+w:=w mod @"10000; x:=x+x+(w div @"100);
+h:=(x+x+(w mod @"100)) mod hash_size
+
+@ If the width is new, it has been placed into position |p=n_widths|,
+otherwise |p| will point to its existing location.
+
+@<Compute the width location...@>=
+p:=w_hash[h];
+while p<>0 do
+ begin if widths[p]=widths[n_widths] then goto found;
+ p:=w_link[p];
+ end;
+p:=n_widths; {the current width is new}
+w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list}
+
+@ The |char_widths| array is used to store the |width_pointer|s for all
+different characters among all fonts. The |char_packets| array is used
+to store the |pckt_pointer|s for all different characters among all
+fonts; they can point to character packets from \.{VF} files or, e.g.,
+raster packets from \.{PK} files.
+
+@<Types...@>=
+@!char_offset=-255..max_chars; {|char_pointer| offset for a font}
+@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays}
+
+@ @<Glob...@>=
+@!char_widths:array[char_pointer] of width_pointer; {width pointers}
+@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers}
+@!n_chars:char_pointer; {first unused position in |char_widths|}
+
+@ @<Set init...@>=
+n_chars:=0;
+
+@ The current number of known fonts is |nf|; each known font has an
+internal number |f|, where |0<=f<nf|. For the moment we need for each
+known font: |font_check|, |font_scaled|, |font_design|, |font_name|,
+|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled|
+and |font_design| are measured in \.{DVI} units and |font_chars| is of
+type |char_offset|: the width pointer for character~|c| of the font is
+stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|).
+Lateron we will need additional information depending on the font type:
+\.{VF} or real (\.{GF}, \.{PK}, or \.{PXL}).
+
+@<Types...@>=
+@!f_type=defined_font..max_font_type; {type of a font}
+@!font_number=0..max_fonts;
+
+@ @<Glob...@>=
+@!nf:font_number;
+
+@ These data are stored in several arrays and we use \.{WEB} macros
+to access the various fields. Thus it would be simple to store the
+data in an array of record structures and adapt the \.{WEB} macros
+accordingly.
+
+We will say, e.g., |font_name(f)| for the name field of font~|f|, and
+|font_width(f)(c)| for the width pointer of character~|c| in font~|f|
+and |font_packet(f)(c)| for its character packet (this character
+exists provided |font_bc(f)<=c<=font_ec(f)| and
+|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in
+font~|f| is stored in |widths[font_width(f)(c)]|.
+
+@d font_check(#)==fnt_check[#] {checksum}
+@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size}
+@d font_design(#)==fnt_design[#] {design size}
+@d font_name(#)==fnt_name[#] {area plus name packet}
+@d font_bc(#)==fnt_bc[#] {first character}
+@d font_ec(#)==fnt_ec[#] {last character}
+@d font_chars(#)==fnt_chars[#] {character info offset}
+@d font_type(#)==fnt_type[#] {type of this font}
+@d font_font(#)==fnt_font[#] {use depends on |font_type|}
+@#
+@d font_width_end(#)==#]
+@d font_width(#)==char_widths[font_chars(#)+font_width_end
+@d font_packet(#)==char_packets[font_chars(#)+font_width_end
+
+@<Glob...@>=
+@!fnt_check:array [font_number] of int_32; {checksum}
+@!fnt_scaled:array [font_number] of int_31; {scaled size}
+@!fnt_design:array [font_number] of int_31; {design size}
+@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/
+@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus
+ name packet}
+@!fnt_bc:array [font_number] of eight_bits; {first character}
+@!fnt_ec:array [font_number] of eight_bits; {last character}
+@!fnt_chars:array [font_number] of char_offset; {character info offset}
+@!fnt_type:array [font_number] of f_type; {type of font}
+@!fnt_font:array [font_number] of font_number; {use depends on |font_type|}
+
+@ @d invalid_font==max_fonts {used when there is no valid font}
+
+@<Set init...@>=
+@!device @<Initialize device dependent font data@>@; @+ ecived @;@/
+nf:=0;
+
+@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for
+several characters with the same residue but with different extension;
+all except the first of the corresponding packets in |byte_mem| will
+contain a pointer to the previous one and |font_packet(f)(res)|
+identifies the last such packet.
+
+A character packet in |byte_mem| starts with a flag byte
+$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$
+with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|,
+followed by |ext_flag| bytes with the character extension for this
+packet and, if |chain_flag=1|, by a two byte packet pointer to the
+previous packet for the same font and character residue. The actual
+character packet follows after these header bytes and the
+interpretation of the |type_flag| depends on whether this is a \.{VF}
+packet or a packet for raster data.
+
+The empty packet is interpreted as a special case of a packet with
+|flag=0|.
+
+@d ext_flag=@"40
+@d chain_flag=@"20
+
+@<Types...@>=
+@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|}
+
+@ The global variable |cur_fnt| is the internal font number of the
+currently selected font, or equals |invalid_font| if no font has
+been selected; |cur_res| and |cur_ext| are the residue and extension
+part of the current character code. The type of a character packet
+located by the |find_packet| function defined below is |cur_type|.
+While building a character packet for a character, |pckt_ext| and
+|pckt_res| are the extension and residue of this character; |pckt_dup|
+indicates whether a packet for this extension exists already.
+
+@<Glob...@>=
+@!cur_fnt:font_number; {the currently selected font}
+@!cur_ext:int_24; {the current character extension}
+@!cur_res:int_8u; {the current character residue}
+@!cur_type:type_flag; {type of the current character packet}
+@!pckt_ext:int_24; {character extension for the current character packet}
+@!pckt_res:int_8u; {character residue for the current character packet}
+@!pckt_dup:boolean; {is there a previous packet for the same extension?}
+@!pckt_prev:pckt_pointer; {a previous packet for the same extension}
+@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character
+ packet error messages}
+
+@ @<Set init...@>=
+cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0;
+
+@ The |find_packet| functions is used to locate the character packet for
+the character with residue~|cur_res| and extension~|cur_ext| from
+font~|cur_fnt| and returns |false| if no packet exists for any extension;
+otherwise the result is |true| and the global variables |cur_packet|,
+|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of
+the character packets has the correct extension, the last one in the
+chain (the one defined first) is used instead and |cur_ext| is changed
+accordingly.
+
+@p function find_packet:boolean;
+label found,exit;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:eight_bits; {a flag byte}
+@!e:int_24; {extension for a packet}
+begin @<Locate a character packet and |goto found| if found@>;
+if font_packet(cur_fnt)(cur_res)=invalid_packet then
+ begin if pckt_m_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---missing character packet for character ',cur_res:1,
+@.missing character packet...@>
+ ' font ',cur_fnt:1);
+ incr(pckt_m_msg); mark_error;
+ if pckt_m_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ find_packet:=false; return;
+ end;
+if pckt_s_msg<10 then {stop telling after first 10 times}
+ begin print_ln('---substituted character packet with extension ',
+@.substituted character packet...@>
+ e:1,' instead of ',cur_ext:1,' for character ',cur_res:1,
+ ' font ',cur_fnt:1);
+ incr(pckt_s_msg); mark_error;
+ if pckt_s_msg=10 then print_ln('---further messages suppressed.');
+ end;
+cur_ext:=e;
+found: cur_pckt:=p; cur_type:=f; find_packet:=true;
+exit: end;
+
+@ @<Locate a character packet and |goto found| if found@>=
+q:=font_packet(cur_fnt)(cur_res);
+while q<>invalid_packet do
+ begin p:=q; q:=invalid_packet;
+ cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1];
+ if p=empty_packet then
+ begin e:=0; f:=0;
+ end
+ else begin pckt_extract(f);
+ case (f div ext_flag) of
+ 0: e:=0;
+ 1: e:=pckt_ubyte;
+ 2: e:=pckt_upair;
+ 3: e:=pckt_strio;
+ end; {there are no other cases}
+ if (f mod ext_flag)>=chain_flag then q:=pckt_upair;
+ f:=f mod chain_flag;
+ end;
+ if e=cur_ext then goto found;
+ end
+
+@ The |start_packet| procedure is used to create the header bytes of a
+character packet for the character with residue~|cur_res| and
+extension~|cur_ext| from font~|cur_fnt|; if a previous such a packet
+exists, we try to build an exact duplicate, i.e., use the chain field of
+that previous packet.
+
+@p procedure start_packet(@!t:type_flag);
+label found,not_found;
+var p,@!q:pckt_pointer; {current and next packet}
+@!f:int_8u; {a flag byte}
+@!e:int_32; {extension for a packet}
+@!cur_loc: byte_pointer; {current location in a packet}
+@!cur_limit: byte_pointer; {start of next packet}
+begin @<Locate a character packet and |goto found| if found@>;
+q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found;
+found: pckt_dup:=true; pckt_prev:=p;
+not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6);
+@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets);
+gubed @;@/
+if q=invalid_packet then f:=t @+ else f:=t+chain_flag;
+e:=cur_ext;
+if e<0 then Incr(e)(@"1000000);
+if e=0 then append_byte(f) @+ else @;
+ begin if e<@"100 then append_byte(f+ext_flag) @+ else @;
+ begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @;
+ begin append_byte(f+ext_flag+ext_flag+ext_flag);
+ append_byte(e div @"10000); e:=e mod @"10000;
+ end;
+ append_byte(e div @"100); e:=e mod @"100;
+ end;
+ append_byte(e);
+ end;
+if q<>invalid_packet then
+ begin append_byte(q div @"100); append_byte(q mod @"100);
+ end;
+end;
+
+@ The |build_packet| procedure is used to finish a character packet.
+If a previous packet for the same character extension exists, the new
+one is discarded; if the two packets are identical, as it occasionally
+occurs for raster files, this is done without an error message.
+
+@p procedure build_packet;
+var k,@!l:byte_pointer; {indices into |byte_mem|}
+begin if pckt_dup then
+ begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr];
+ if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false;
+ while pckt_dup and(byte_ptr>l) do
+ begin flush_byte; decr(k);
+ if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false;
+ end;
+ if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times}
+ begin print('---duplicate packet for character ',pckt_res:1);
+@.duplicate packet for character...@>
+ if pckt_ext<>0 then print('.',pckt_ext:1);
+ print_ln(' font ',cur_fnt:1);
+ incr(pckt_d_msg); mark_error;
+ if pckt_d_msg=10 then print_ln('---further messages suppressed.');
+ end;
+ byte_ptr:=l;
+ end
+else font_packet(cur_fnt)(pckt_res):=make_packet;
+end;
+
+@* Defining fonts.
+A detailed description of the \.{TFM} file format can be found in the
+documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM}
+files the program uses the binary file variable |tfm_file|.
+
+@<Glob...@>=
+@!tfm_file:byte_file; {a \.{TFM} file}
+@!tfm_ext:pckt_pointer; {extension for \.{TFM} files}
+
+@ @<Initialize predefined strings@>=
+id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files}
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{TFM} directory, which is a system-dependent place where
+the \.{TFM} files for standard fonts are kept.
+The string variable |TFM_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
+@d TFM_default_area_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
+
+@ @<Set init...@>=
+TFM_default_area:=TFM_default_area_name;
+
+@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM}
+file the |bad_tfm| procedure is used to give an error message which
+refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_tfm;
+begin print('Bad TFM file'); print_font(cur_fnt); print_ln('!');
+@.Bad TFM file@>
+abort('Use TFtoPL/PLtoTF to diagnose and correct the problem');
+@.Use TFtoPL/PLtoTF@>
+end;
+@#
+procedure bad_font;
+begin new_line;
+case font_type(cur_fnt) of
+ defined_font: confusion(str_fonts);
+ loaded_font: bad_tfm;
+ @<Cases for |bad_font|@>@;@/
+ end; {there are no other cases}
+end;
+
+@ To prepare |tfm_file| for input we |reset| it.
+
+@<TFM: Open |tfm_file|@>=
+make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
+reset(tfm_file,cur_name);
+if eof(tfm_file) then
+@^system dependencies@>
+ abort('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+
+@ It turns out to be convenient to read four bytes at a time, when we
+are inputting from \.{TFM} files. The input goes into global variables
+|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting the
+first byte and |tfm_b3| the fourth.
+
+@<Glob...@>=
+@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once}
+
+@ Reading a \.{TFM} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |tfm_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} byte;
+this macro and |eof(tfm_file)| are used only in the |read_tfm_word|
+procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes
+in the current \.{TFM} file. Here we give simple minded definitions in
+terms of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte}
+
+@p procedure read_tfm_word;
+begin tfm_byte(tfm_b0); tfm_byte(tfm_b1);
+tfm_byte(tfm_b2); tfm_byte(tfm_b3);
+if eof(tfm_file) then bad_font;
+end;
+
+@ Here are three procedures used to check the consistency of font files:
+First, the |check_check_sum| procedure compares two check sum values: a
+warning is given if they differ and are both non-zero; if the second
+value is not zero it may replace the first one.
+Next, the |check_design_size| procedure compares two design size
+values: a warning is given if they differ by more than a small amount.
+Finally, the |check_width| function compares the character width value
+for character |cur_res| read from a \.{VF} or raster file for font
+|cur_fnt| with the value previously read from the \.{TFM} file and
+returns the width pointer for that value; a warning is given if the two
+values differ.
+
+@p procedure check_check_sum(@!c:int_32;@!u:boolean);
+ {compare |font_check(cur_fnt)| with |c|}
+begin if (c<>font_check(cur_fnt))and(c<>0) then
+ begin
+ if font_check(cur_fnt)<>0 then
+ begin new_line; print_ln('---beware: check sums do not agree! (',
+@.beware: check sums do not agree@>
+@.check sums do not agree@>
+ c:1,' vs. ',font_check(cur_fnt):1,')');
+ mark_harmless;
+ end;
+ if u then font_check(cur_fnt):=c;
+ end;
+end;
+@#
+procedure check_design_size(@!d:int_32);
+ {compare |font_design(cur_fnt)| with |d|}
+begin if abs(d-font_design(cur_fnt))>2 then
+ begin new_line; print_ln('---beware: design sizes do not agree! (',
+@.beware: design sizes do not agree@>
+@.design sizes do not agree@>
+ d:1,' vs. ',font_design(cur_fnt):1,')');
+ mark_error;
+ end;
+end;
+@#
+function check_width(w:int_32):width_pointer;
+ {compare |widths[font_width(cur_fnt)(cur_res)]| with |w|}
+var wp:width_pointer; {pointer to \.{TFM} width value}
+begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then
+ wp:=font_width(cur_fnt)(cur_res)
+else wp:=invalid_width;
+if wp=invalid_width then
+ begin print_nl('Bad char ',cur_res:1);
+@.Bad char c@>
+ if cur_ext<>0 then print('.',cur_ext:1);
+ print(' font ',cur_fnt:1); print_font(cur_fnt);
+ abort(' (compare TFM file)');
+ end;
+if w<>widths[wp] then
+ begin new_line; print_ln('---beware: char widths do not agree! (',
+@.beware: char widths do not agree@>
+@.char widths do not agree@>
+ w:1,' vs. ',widths[wp]:1,')');
+ mark_error;
+ end;
+check_width:=wp;
+end;
+
+@ The |load_font| procedure reads the \.{TFM} file for a font and puts
+the data extracted into position |cur_fnt| of the font data arrays.
+
+@p procedure load_font; {reads a \.{TFM} file}
+var l:int_16; {loop index}
+@!p:char_pointer; {index into |char_widths|}
+@!q:width_pointer; {index into |widths|}
+@!bc,@!ec:int_15; {first and last character in this font}
+@!lh:int_15; {length of header in four byte words}
+@!nw:int_15; {number of words in width table}
+@!w:int_32; {a four byte integer}
+@<Variables for scaling computation@>@;
+begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt);
+font_type(cur_fnt):=loaded_font;
+@<TFM: Open |tfm_file|@>;
+@<TFM: Read past the header data@>;
+@<TFM: Store character-width indices@>;
+@<TFM: Read and convert the width values@>;
+@<TFM: Convert character-width indices to character-width pointers@>;
+close_in(tfm_file);
+@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/
+d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units');
+print_ln('.');
+end;
+
+@ @<Glob...@>=
+@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
+
+@ We will use the following \.{WEB} macros to construct integers from
+two or four of the four bytes read by |read_tfm_word|.
+@^system dependencies@>
+
+@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
+if tfm_b0>127 then bad_font
+else #:=tfm_b0*256+tfm_b1
+@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
+if tfm_b2>127 then bad_font
+else #:=tfm_b2*256+tfm_b3
+@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
+if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
+@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
+(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
+
+@<TFM: Read past the header data@>=
+read_tfm_word; tfm_b23(lh);
+read_tfm_word; tfm_b01(bc); tfm_b23(ec);
+if ec<bc then
+ begin bc:=1; ec:=0;
+ end
+else if ec>255 then bad_font;
+read_tfm_word; tfm_b01(nw);
+if (nw=0)or(nw>256) then bad_font;
+for l:=-2 to lh do
+ begin read_tfm_word;
+ if l=1 then
+ begin tfm_squad(w); check_check_sum(w,true);
+ end
+ else if l=2 then
+ begin if tfm_b0>127 then bad_font;
+ check_design_size(round(tfm_conv*tfm_uquad));
+ end;
+ end
+
+@ The width indices for the characters are stored in positions |n_chars|
+through |n_chars-bc+ec| of the |char_widths| array; if characters on
+either end of the range |bc..ec| do not exist, they are ignored and the
+range is adjusted accordingly.
+
+@<TFM: Store character-width indices@>=
+read_tfm_word;
+while (tfm_b0=0)and(bc<=ec) do
+ begin incr(bc); read_tfm_word;
+ end;
+font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc;
+if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars);
+for l:=bc to ec do
+ begin char_widths[n_chars]:=tfm_b0; incr(n_chars); read_tfm_word;
+ end;
+while (char_widths[n_chars-1]=0)and(ec>=bc) do
+ begin decr(n_chars); decr(ec);
+ end;
+font_ec(cur_fnt):=ec
+
+@ The most important part of |load_font| is the width computation, which
+involves multiplying the relative widths in the \.{TFM} file by the
+scaling factor in the \.{DVI} file. A similar computation is used for
+dimensions read from \.{VF} files. This fixed-point multiplication must
+be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{TFM}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+This calculation must be done exactly, for the reasons stated above; the
+following program does the job in a system-independent way, assuming
+that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We
+use \.{WEB} macros for various versions of this computation.
+@^system dependencies@>
+@^optimization@>
+
+@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension}
+(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta
+@#
+@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u;
+ if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font
+@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension}
+ #:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha)
+@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension}
+ if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_fix3
+@d tfm_fix1== {convert |tfm_b3| to a scaled dimension}
+ if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0;
+ tfm_b2:=tfm_b1; tfm_fix3
+
+@<Variables for scaling computation@>=
+@!z:int_32; {multiplier}
+@!alpha:int_32; {correction for negative values}
+@!beta:int_15; {divisor}
+
+@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>=
+alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z
+
+@ The first width value, which indicates that a character does not exist
+and which must vanish, is converted to |invalid_width|; the other width
+values are scaled by |font_scaled(cur_fnt)| and converted to width
+pointers by |make_width|. The resulting width pointers are stored
+temporarily in the |char_widths| array, following the with indices.
+
+@<TFM: Read and convert the width values@>=
+if nw-1>max_chars-n_chars then overflow(str_chars,max_chars);
+if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font
+ else char_widths[n_chars]:=invalid_width;
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;
+for p:=n_chars+1 to n_chars+nw-1 do
+ begin read_tfm_word; tfm_fix4(w);
+ char_widths[p]:=make_width(w);
+ end
+
+@ We simply translate the width indices into width pointers. In addition
+we initialize the character packets with the invalid packet.
+
+@<TFM: Convert character-width indices to character-width pointers@>=
+for p:=font_chars(cur_fnt)+bc to n_chars-1 do
+ begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q;
+ char_packets[p]:=invalid_packet;
+ end
+
+@ When processing a font definition we put the data extracted from the
+\.{DVI} or \.{VF} file into position |nf| of the font data arrays and
+call |define_font| to obtain the internal font number for this font.
+The parameter |load| is true if the \.{TFM} file should be loaded.
+
+@p function define_font(@!load:boolean):font_number;
+var save_fnt:font_number; {used to save |cur_fnt|}
+begin save_fnt:=cur_fnt; {save}
+cur_fnt:=0;
+while (font_name(cur_fnt)<>font_name(nf))or@|
+ (font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt);
+d_print(' => ',cur_fnt:1); print_font(cur_fnt);
+if cur_fnt<nf then
+ begin check_check_sum(font_check(nf),true);
+ check_design_size(font_design(nf));
+ @!debug if font_type(cur_fnt)=defined_font then print(' defined')
+ else print(' loaded');
+ print(' previously');
+ gubed@;
+ end
+else begin if nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(nf); font_font(cur_fnt):=invalid_font;
+ font_type(cur_fnt):=defined_font;
+ d_print(' defined');
+ end;
+print_ln('.');
+if load and(font_type(cur_fnt)=defined_font) then load_font;
+define_font:=cur_fnt;
+cur_fnt:=save_fnt; {restore}
+end;
+
+@* Low-level DVI input routines.
+The program uses the binary file variable |dvi_file| for its main input
+file; |dvi_loc| is the number of the byte about to be read next from
+|dvi_file|.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are \.{\title}ing}
+@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
+
+@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this
+procedure gives an error message which refers the user to \.{DVItype},
+and terminates \.{\title}.
+
+@<Error handling...@>=
+procedure bad_dvi;
+begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!');
+@.Bad DVI file@>
+print(' Use DVItype with output level');
+@.Use DVItype@>
+if random_reading then print('=4') @+ else print('<4');
+abort('to diagnose the problem');
+end;
+
+@ To prepare |dvi_file| for input, we |reset| it.
+
+@<Open input file(s)@>=
+reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
+dvi_loc:=0;
+
+@ Reading the \.{DVI} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |dvi_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI}
+byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?}
+@d dvi_byte(#) ==
+ if dvi_eof then bad_dvi
+ else read(dvi_file,#) {obtain next \.{DVI} byte}
+
+@ Next we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position
+|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with
+|n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:int_32;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure dvi_move(@!n:int_32);
+begin set_pos(dvi_file,n); dvi_loc:=n;
+end;
+
+@ We need seven simple functions to read the next byte or bytes
+from |dvi_file|.
+
+@p function dvi_sbyte:int_8; {returns the next byte, signed}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte);
+end;
+@#
+function dvi_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte);
+end;
+@#
+function dvi_spair:int_16; {returns the next two bytes, signed}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair);
+end;
+@#
+function dvi_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair);
+end;
+@#
+function dvi_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio);
+end;
+@#
+function dvi_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio);
+end;
+@#
+function dvi_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad);
+end;
+
+@ Three other functions are used in cases where a four byte integer
+(which is always signed) must have a non-negative value, a positive
+value, or is a pointer which must be either positive or |=-1|.
+
+@p function dvi_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=dvi_squad; if x<0 then bad_dvi
+else dvi_uquad:=x;
+end;
+@#
+function dvi_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=dvi_squad; if x<=0 then bad_dvi
+else dvi_pquad:=x;
+end;
+@#
+function dvi_pointer:int_32; {result must be positive or |=-1|}
+var x:int_32;
+begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi
+else dvi_pointer:=x;
+end;
+
+@ Given the structure of the \.{DVI} commands it is fairly obvious
+that their interpretation consists of two steps: First zero to four
+bytes are read in order to obtain the value of the first parameter
+(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then,
+depending on the command class, a specific action is performed (e.g.,
+typeset a character but don't move the reference point for |put1..put4|).
+
+The \.{DVItype} program uses large case statements for both steps;
+unfortunately some \PASCAL\ compilers fail to implement large case
+statements efficiently -- in particular those as the one used in the
+|first_par| function of \.{DVItype}. Here we use a pair of look up tables:
+|dvi_par| determines how to obtain the value of the first parameter, and
+|dvi_cl| determines the command class.
+
+A slight complication arises from the fact that we want to decompose the
+character code of each character to be typset into a residue
+|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|;
+the \.{TFM} widths as well as the pixel widths for a given resolution
+are the same for all characters in a font with the same residue.
+
+@d two_cases(#)==#,#+1
+@d three_cases(#)==#,#+1,#+2
+@d five_cases(#)==#,#+1,#+2,#+3,#+4
+
+@ First we define the values used as array elements of |dvi_par|; we
+distinguish between pure numbers and dimensions because dimensions read
+from a \.{VF} file must be scaled.
+
+@d char_par=0 {character for \\{set} and |put|}
+@d no_par=1 {no parameter}
+@d dim1_par=2 {one-byte signed dimension}
+@d num1_par=3 {one-byte unsigned number}
+@d dim2_par=4 {two-byte signed dimension}
+@d num2_par=5 {two-byte unsigned number}
+@d dim3_par=6 {three-byte signed dimension}
+@d num3_par=7 {three-byte unsigned number}
+@d dim4_par=8 {four-byte signed dimension}
+@d num4_par=9 {four-byte signed number}
+@d numu_par=10 {four-byte non-negative number}
+@d rule_par=11 {dimensions for |set_rule| and |put_rule|}
+@d fnt_par=12 {font for |fnt_num| commands}
+@d max_par=12 {largest possible value}
+
+@<Types...@>=
+@!cmd_par=char_par..max_par;
+
+@ Here we declare the array |dvi_par|.
+
+@<Globals...@>=
+@!dvi_par:packed array [eight_bits] of cmd_par;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=0 to put1+3 do dvi_par[i]:=char_par;@/
+for i:=nop to 255 do dvi_par[i]:=no_par;@/
+dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/
+dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par;
+dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/
+for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/
+dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par;
+dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/
+dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par;
+dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/
+for i:=0 to 3 do
+ begin dvi_par[i+w1]:=dvi_par[i+right1];
+ dvi_par[i+x1]:=dvi_par[i+right1];
+ dvi_par[i+down1]:=dvi_par[i+right1];
+ dvi_par[i+y1]:=dvi_par[i+right1];
+ dvi_par[i+z1]:=dvi_par[i+right1];
+ dvi_par[i+fnt_def1]:=dvi_par[i+fnt1];
+ end;
+
+@ Next we define the values used as array elements of |dvi_cl|;
+several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will
+always be treated separately and are therfore assigned to the invalid
+class here.
+
+@d char_cl=0
+@d rule_cl=char_cl+1
+@d xxx_cl=char_cl+2
+@d push_cl=3
+@d pop_cl=4
+@d w0_cl=5
+@d x0_cl=w0_cl+1
+@d right_cl=w0_cl+2
+@d w_cl=w0_cl+3
+@d x_cl=w0_cl+4
+@d y0_cl=10
+@d z0_cl=y0_cl+1
+@d down_cl=y0_cl+2
+@d y_cl=y0_cl+3
+@d z_cl=y0_cl+4
+@d fnt_cl=15
+@d fnt_def_cl=16
+@d invalid_cl=17
+@d max_cl=invalid_cl {largest possible value}
+
+@<Types...@>=
+@!cmd_cl=char_cl..max_cl;
+
+@ Here we declare the array |dvi_cl|.
+
+@<Globals...@>=
+@!dvi_cl:packed array [eight_bits] of cmd_cl;
+
+@ And here we initialize it.
+
+@<Set init...@>=
+for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl;
+dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/
+dvi_cl[nop]:=invalid_cl;
+dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/
+dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/
+dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/
+dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/
+for i:=0 to 3 do
+ begin dvi_cl[i+right1]:=right_cl;
+ dvi_cl[i+w1]:=w_cl;
+ dvi_cl[i+x1]:=x_cl;@/
+ dvi_cl[i+down1]:=down_cl;
+ dvi_cl[i+y1]:=y_cl;
+ dvi_cl[i+z1]:=z_cl;@/
+ dvi_cl[i+xxx1]:=xxx_cl;
+ dvi_cl[i+fnt_def1]:=fnt_def_cl;
+ end;
+for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl;
+for i:=pre to 255 do dvi_cl[i]:=invalid_cl;
+
+@ A few small arrays are used to generate \.{DVI} commands.
+
+@<Glob...@>=
+@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|}
+@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|}
+@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|}
+@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|}
+
+@ @<Set init...@>=
+dvi_char_cmd[false]:=put1;
+dvi_char_cmd[true]:=set1;@/
+dvi_rule_cmd[false]:=put_rule;
+dvi_rule_cmd[true]:=set_rule;@/
+dvi_right_cmd[right_cl]:=right1;
+dvi_right_cmd[w_cl]:=w1;
+dvi_right_cmd[x_cl]:=x1;@/
+dvi_down_cmd[down_cl]:=down1;
+dvi_down_cmd[y_cl]:=y1;
+dvi_down_cmd[z_cl]:=z1;
+
+@ The global variables |cur_cmd|, |cur_parm| and |cur_class| are used
+for the current \.{DVI} command, its first parameter (if any), and its
+command class respectively.
+
+@<Glob...@>=
+@!cur_cmd:eight_bits; {current \.{DVI} command byte}
+@!cur_parm:int_32; {its first parameter (if any)}
+@!cur_class:cmd_cl; {its class}
+
+@ When typesetting a character or rule, the boolean variable |cur_upd|
+is |true| for \\{set} commands, |false| for |put| commands.
+
+@<Glob...@>=
+@!cur_cp:char_pointer; {|char_widths| index for the current character}
+@!cur_wp:width_pointer; {width pointer of the current character}
+@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?}
+@!cur_v_dimen:int_32; {a vertical dimension}
+@!cur_h_dimen:int_32; {a horizontal dimension}
+
+@ @<Set init...@>=
+cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!}
+
+@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into
+|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of
+the first parameter (if any) and |cur_class| to the command class.
+
+@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|}
+begin cur_ext:=0;
+if cur_cmd<set1 then
+ begin cur_res:=cur_cmd; cur_upd:=true
+ end
+else begin cur_res:=#; cur_upd:=(cur_cmd<put1);
+ Decr(cur_cmd)(dvi_char_cmd[cur_upd]);
+ while cur_cmd>0 do
+ begin if cur_cmd=3 then if cur_res>127 then cur_ext:=-1;
+ cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd);
+ end;
+ end;
+end
+
+@p procedure dvi_first_par;
+begin repeat cur_cmd:=dvi_ubyte;
+until cur_cmd<>nop; {skip over |nop|s}
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(dvi_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=dvi_sbyte;
+num1_par: cur_parm:=dvi_ubyte;
+dim2_par: cur_parm:=dvi_spair;
+num2_par: cur_parm:=dvi_upair;
+dim3_par: cur_parm:=dvi_strio;
+num3_par: cur_parm:=dvi_utrio;
+two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|}
+numu_par: cur_parm:=dvi_uquad;
+rule_par:
+ begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The global variable |dvi_nf| is used for the number of different
+\.{DVI} fonts defined so far; their external font numbers (as extracted
+from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the
+corresponding internal font numbers used internally by \.{\title} are
+stored in the array |dvi_i_fnts|.
+
+@<Glob...@>=
+@!dvi_e_fnts:array[font_number] of int_32; {external font numbers}
+@!dvi_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far}
+
+@ @<Set ini...@>=
+dvi_nf:=0;
+
+@ The |dvi_font| procedure sets |cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<DVI: Locate font |cur_parm|@>;
+if f=dvi_nf then bad_dvi;
+cur_fnt:=dvi_i_fnts[f];
+if font_type(cur_fnt)=defined_font then load_font;
+end;
+
+@ @<DVI: Locate font |cur_parm|@>=
+f:=0; dvi_e_fnts[dvi_nf]:=cur_parm;
+while cur_parm<>dvi_e_fnts[f] do incr(f)
+
+@ Finally the |dvi_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{DVI} file; the argument indicates whether this should be the second
+definition of the font (|true|) or not (|false|).
+
+@p procedure dvi_do_font(@!second:boolean);
+var f:font_number; {where the font is sought}
+@!k:int_15; {general purpose variable}
+begin print('DVI: font ',cur_parm:1);
+@<DVI: Locate font |cur_parm|@>;
+if (f=dvi_nf)=second then bad_dvi;
+font_check(nf):=dvi_squad;
+font_scaled(nf):=dvi_pquad;
+font_design(nf):=dvi_pquad;
+k:=dvi_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(dvi_ubyte); pckt_room(k);
+while k>0 do begin append_byte(dvi_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+dvi_i_fnts[dvi_nf]:=define_font(false);
+if not second then
+ begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts);
+ incr(dvi_nf);
+ end
+else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi;
+end;
+
+@* Low-level VF input routines.
+A detailed description of the \.{VF} file format can be found in the
+documentation of \.{VFtoVP}; here we just define symbolic names for
+some of the \.{VF} command bytes.
+
+@d long_char=242 {\.{VF} command for general character packet}
+@#
+@d vf_id=202 {identifies \.{VF} files}
+
+@ The program uses the binary file variable |vf_file| for input from
+\.{VF} files; |vf_loc| is the number of the byte about to be read next
+from |vf_file|.
+
+@<Glob...@>=
+@!vf_file:byte_file; {a \.{VF} file}
+@!vf_loc:int_32; {where we are about to look, in |vf_file|}
+@!vf_limit:int_32; {value of |vf_loc| at end of a character packet}
+@!vf_ext:pckt_pointer; {extension for \.{VF} files}
+@!vf_cur_fnt:font_number; {current font number in a \.{VF} file}
+
+@ @<Initialize predefined strings@>=
+id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files}
+
+@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure
+gives an error message which refers the user to \.{VFtoVP} and \.{VPtoVF},
+and terminates \.{\title}.
+
+@<Cases for |bad_font|@>=
+vf_font_type: begin print('Bad VF file'); print_font(cur_fnt);
+@.Bad VF file@>
+ print_ln(' loc=',vf_loc:1);
+ abort('Use VFtoVP/VPtoVF to diagnose and correct the problem');
+@.Use VFtoVP/VPtoVF@>
+ end;
+
+@ If no font directory has been specified, \.{\title} is supposed to use
+the default \.{VF} directory, which is a system-dependent place where
+the \.{VF} files for standard fonts are kept.
+The string variable |VF_default_area| contains the name of this area.
+@^system dependencies@>
+
+@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
+@d VF_default_area_name_length=10 {change this to the correct length}
+
+@<Glob...@>=
+@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
+
+@ @<Set init...@>=
+VF_default_area:=VF_default_area_name;
+
+@ To prepare |vf_file| for input we |reset| it.
+
+@<VF: Open |vf_file| or |goto not_found|@>=
+make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
+reset(vf_file,cur_name);
+if eof(vf_file) then
+@^system dependencies@>
+ goto not_found;
+vf_loc:=0
+
+@ Reading a \.{VF} file should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes from |vf_file| is read into a buffer and will then be extracted
+from that buffer. In order to simplify such system dependent changes
+we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF}
+byte and |vf_eof| is |true| if we have reached the end of the \.{VF}
+file. Here we give simple minded definitions for these macros in terms
+of standard \PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?}
+@d vf_byte(#) ==
+ if vf_eof then bad_font
+ else read(vf_file,#) {obtain next \.{VF} byte}
+
+@ We need several simple functions to read the next byte or bytes
+from |vf_file|.
+
+@p function vf_ubyte:int_8u; {returns the next byte, unsigned}
+@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte);
+end;
+@#
+function vf_upair:int_16u; {returns the next two bytes, unsigned}
+@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair);
+end;
+@#
+function vf_strio:int_24; {returns the next three bytes, signed}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio);
+end;
+@#
+function vf_utrio:int_24u; {returns the next three bytes, unsigned}
+@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio);
+end;
+@#
+function vf_squad:int_32; {returns the next four bytes, signed}
+@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad);
+end;
+
+@ All dimensions in a \.{VF} file, except the design sizes of a virtual
+font and its local fonts, are |fix_word|s that must be scaled in exactly
+the same way as the character widths from a \.{TFM} file; we can use the
+same code, but this time |z|, |alpha|, and |beta| are global variables.
+
+@<Glob...@>=
+@<Variables for scaling computation@>@;
+
+@ We need five functions to read the next byte or bytes and convert a
+|fix_word| to a scaled dimension.
+
+@p function vf_fix1:int_32; {returns the next byte as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b3); incr(vf_loc);
+tfm_fix1(x); vf_fix1:=x;
+end;
+@#
+function vf_fix2:int_32; {returns the next two bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2);
+tfm_fix2(x); vf_fix2:=x;
+end;
+@#
+function vf_fix3:int_32; {returns the next three bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+tfm_fix3(x); vf_fix3:=x;
+end;
+@#
+function vf_fix3u:int_32; {returns the next three bytes as scaled value}
+begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(3);@/
+vf_fix3u:=tfm_fix3u;
+end;
+@#
+function vf_fix4:int_32; {returns the next four bytes as scaled value}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+tfm_fix4(x); vf_fix4:=x;
+end;
+
+@ Three other functions are used in cases where the result must have a
+non-negative value or a positive value.
+
+@p function vf_uquad:int_31; {result must be non-negative}
+var x:int_32;
+begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x;
+end;
+@#
+function vf_pquad:int_31; {result must be positive}
+var x:int_32;
+begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x;
+end;
+@#
+function vf_fixp:int_31; {result must be positive}
+var x:int_32; {accumulator}
+begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
+Incr(vf_loc)(4);@/
+if tfm_b0>0 then bad_font;
+vf_fixp:=tfm_fix3u;
+end;
+
+@ The |vf_first_par| procedure first reads a \.{VF} command byte into
+|cur_cmd|; then |cur_parm| is set to the value of the first parameter
+(if any) and |cur_class| to the command class.
+
+@d set_cur_wp_end(#)== if cur_wp=invalid_width then #
+@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer}
+cur_wp:=invalid_width;
+if #<>invalid_font then
+ if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then
+ begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp];
+ end;
+set_cur_wp_end
+
+@p procedure vf_first_par;
+begin cur_cmd:=vf_ubyte;
+case dvi_par[cur_cmd] of
+char_par:
+ begin set_cur_char(vf_ubyte); set_cur_wp(vf_cur_fnt)(bad_font);
+ end;
+no_par: do_nothing;
+dim1_par: cur_parm:=vf_fix1;
+num1_par: cur_parm:=vf_ubyte;
+dim2_par: cur_parm:=vf_fix2;
+num2_par: cur_parm:=vf_upair;
+dim3_par: cur_parm:=vf_fix3;
+num3_par: cur_parm:=vf_utrio;
+dim4_par: cur_parm:=vf_fix4;
+num4_par: cur_parm:=vf_squad;
+numu_par: cur_parm:=vf_uquad;
+rule_par:
+ begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ For a virtual font we set |font_type(f):=vf_font_type|; in this case
+|font_font(f)| is the default font for character packets from virtual
+font~|f|.
+@^font types@>
+
+The global variable |vf_nf| is used for the number of different local
+fonts defined in a \.{VF} file so far; their external font numbers (as
+extracted from the \.{VF} file) are stored in the array |vf_e_fnts|, the
+corresponding internal font numbers used internally by \.{\title} are
+stored in the array |vf_i_fnts|.
+
+@<Glob...@>=
+@!vf_e_fnts:array[font_number] of int_32; {external font numbers}
+@!vf_i_fnts:array[font_number] of font_number; {corresponding
+ internal font numbers}
+@!vf_nf:font_number; {number of local fonts defined so far}
+@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file}
+
+@ @<Set init...@>=
+lcl_nf:=0;
+
+@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number
+corresponding to the external font number |cur_parm| (or aborts the
+program if such a font was never defined).
+
+@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|}
+var f:font_number; {where the font is sought}
+begin @<VF: Locate font |cur_parm|@>;
+if f=vf_nf then bad_font;
+vf_cur_fnt:=vf_i_fnts[f];
+end;
+
+@ @<VF: Locate font |cur_parm|@>=
+f:=0; vf_e_fnts[vf_nf]:=cur_parm;
+while cur_parm<>vf_e_fnts[f] do incr(f)
+
+@ Finally the |vf_do_font| procedure is called when one of the command
+|fnt_def1..fnt_def4| and its first parameter have been read from the
+\.{VF} file.
+
+@p procedure vf_do_font;
+var f:font_number; {where the font is sought}
+@!k:int_15; {general purpose variable}
+begin print('VF: font ',cur_parm:1);@/
+@<VF: Locate font |cur_parm|@>;
+if f<>vf_nf then bad_font;
+font_check(nf):=vf_squad;
+font_scaled(nf):=vf_fixp;
+font_design(nf):=round(tfm_conv*vf_pquad);
+k:=vf_ubyte; pckt_room(1); append_byte(k);
+Incr(k)(vf_ubyte); pckt_room(k);
+while k>0 do begin append_byte(vf_ubyte); decr(k);
+ end;
+font_name(nf):=make_packet; {the font area plus name}
+vf_i_fnts[vf_nf]:=define_font(true);
+if vf_nf=lcl_nf then
+ if lcl_nf=max_fonts then overflow(str_fonts,max_fonts)
+ else incr(lcl_nf);
+incr(vf_nf);
+end;
+
+@* Reading VF files.
+The |do_vf| function attempts to read the \.{VF} file for a font and
+returns |false| if the \.{VF} file could not be found; otherwise the
+font type is changed to |vf_font_type|.
+
+@p function do_vf:boolean; {read a \.{VF} file}
+label reswitch,done,not_found,exit;
+var temp_int:int_32; {integer for temporary variables}
+@!temp_byte:int_8u; {byte for temporary variables}
+@!k:byte_pointer; {index into |byte_mem|}
+@!l:int_15; {general purpose variable}
+@!save_ext:int_24; {used to save |cur_ext|}
+@!save_res:int_8u; {used to save |cur_res|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!vf_wp:width_pointer; {width pointer for the current character packet}
+@!vf_fnt:font_number; {current font in the current character packet}
+@!move_zero:boolean; {|true| if rule 1 is used}
+@!last_pop:boolean; {|true| if final |pop| has been manufactured}
+begin @<VF: Open |vf_file| or |goto not_found|@>;
+save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp;
+save_upd:=cur_upd; {save}
+font_type(cur_fnt):=vf_font_type;@/
+@<VF: Process the preamble@>;@/
+@<VF: Process the font definitions@>;@/
+while cur_cmd<=long_char do @<VF: Build a character packet@>;
+if cur_cmd<>post then bad_font;
+@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt);
+print_ln(' loaded.');
+gubed @;@/
+close_in(vf_file);
+cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp;
+cur_upd:=save_upd; {restore}
+do_vf:=true; return;
+not_found:do_vf:=false;
+exit:end;
+
+@ @<VF: Process the preamble@>=
+if vf_ubyte<>pre then bad_font;
+if vf_ubyte<>vf_id then bad_font;
+temp_byte:=vf_ubyte; pckt_room(temp_byte);
+for l:=1 to temp_byte do append_byte(vf_ubyte);
+print('VF file: '''); print_packet(new_packet); print(''',');
+flush_packet;@/
+check_check_sum(vf_squad,false);
+check_design_size(round(tfm_conv*vf_pquad));@/
+z:=font_scaled(cur_fnt);
+@<Replace |z|...@>;@/
+print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.')
+
+@ @<VF: Process the font definitions@>=
+vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/
+cur_cmd:=vf_ubyte;
+while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do
+ begin case cur_cmd-fnt_def1 of
+ 0: cur_parm:=vf_ubyte;
+ 1: cur_parm:=vf_upair;
+ 2: cur_parm:=vf_utrio;
+ 3: cur_parm:=vf_squad;
+ end; {there are no other cases}
+ vf_do_font;
+ cur_cmd:=vf_ubyte;
+ end;
+font_font(cur_fnt):=vf_i_fnts[0]
+
+@ The \.{VF} format specifies that the interpretation of each packet
+begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using
+these initial values will be ignored.
+
+@<Types...@>=
+@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|}
+
+@ As implied by the \.{VF} format the \.{DVI} commands read from the
+\.{VF} file are enclosed by |push| and |pop|; as we read \.{DVI}
+commands and append them to |byte_mem|, we perform a set of
+transformations in order to simplify the resulting packet: Let |zero| be
+any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which
+all leave the current position on the page unchanged, let |move| be any
+of the horizontal or vertical movement commands |right1..z4|, and let
+|any| be any sequence of commands containing |push| and |pop| in
+properly nested pairs; whenever possible we apply one of the following
+transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}}
+\leqalignno{
+\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr
+\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr
+\hbox{|push| |pop|}&\RA{}&\n3:\cr
+\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr
+\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr
+\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr
+\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr
+\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr
+}$$
+
+@ In order to perform these transformations we need a stack which is
+indexed by |vf_ptr|, the number of |push| commands without corresponding
+|pop| in the packet we are building; the |vf_push_loc| array contains
+the locations in |byte_mem| following such |push| commands.
+In view of rule~5 consecutive |push| commands are never stored, the
+|vf_push_num| array is used to count them.
+The |vf_last| array indicates the type of the last non-discardable item:
+a character, a rule, or a group enclosed by |push| and |pop|;
+the |vf_last_end| array points to the ending locations and, if
+|vf_last<>vf_other|, the |vf_last_loc| array points to the starting
+locations of these items.
+
+@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}}
+@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|}
+@d vf_group=2 {last item is a group enclosed by |push| and |pop|}
+@d vf_put=3 {last item is a |put|}
+@d vf_other=4 {last item (if any) is none of the above}
+
+@<Types...@>=
+@!vf_type=vf_set..vf_other;
+
+@ @<Glob...@>=
+@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|}
+@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|}
+@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item}
+@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item}
+@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count}
+@!vf_last: array[stack_pointer] of vf_type; {type of last item}
+@!vf_ptr:stack_pointer; {current number of unfinished groups}
+@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value}
+
+@ We use two small arrays to determine the item type of a character or a
+rule.
+
+@<Glob...@>=
+@!vf_char_type:array[boolean] of vf_type;
+@!vf_rule_type:array[boolean] of vf_type;
+
+@ @<Set init...@>=
+vf_move[0][0][0]:=false; vf_move[0][0][1]:=false;
+vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/
+stack_used:=0;@/
+vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/
+vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule;
+
+@ Here we read the first bytes of a character packet from the \.{VF}
+file and initialize the packet being built in |byte_mem|; the start of
+the whole packet is stored in |vf_push_loc[0]|. When the character
+packet is finished, a type is be assigned to it: |vf_simple| if the
+packet ends with a character of the correct width, or |vf_complex|
+otherwise. Moreover, if such a packet for a character with
+extension zero consists of just one character with extension zero and
+the same residue, and if there is no previous packet, the whole packet
+is replaced by the empty packet.
+
+@d vf_simple=0 {the packet ends with a character of the correct width}
+@d vf_complex=vf_simple+1 {otherwise}
+
+@<VF: Build a character packet@>=
+begin if cur_cmd<long_char then
+ begin vf_limit:=cur_cmd;
+ cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u);
+ end
+else begin vf_limit:=vf_uquad;
+ cur_ext:=vf_strio; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix4);
+ end;
+Incr(vf_limit)(vf_loc);
+vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr;
+vf_last[0]:=vf_other; vf_ptr:=0;@/
+start_packet(vf_complex);
+@<VF: Append \.{DVI} commands to the character packet@>;@/
+k:=pckt_start[pckt_ptr];
+if vf_last[0]=vf_put then if cur_wp=vf_wp then
+ begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|}
+ if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@|
+ (cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k;
+ end;
+build_packet;
+cur_cmd:=vf_ubyte;
+end
+
+@ For every \.{DVI} command read from the \.{VF} file some action is
+performed; in addition the initial |push| and the final |pop| are
+manufactured here.
+
+@<VF: Append \.{DVI} commands to the character packet@>=
+vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/
+last_pop:=false; cur_class:=push_cl; {initial |push|}
+loop begin
+reswitch:case cur_class of
+ three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>;
+ push_cl: @<VF: Do a |push|@>;
+ pop_cl: @<VF: Do a |pop|@>;
+ two_cases(w0_cl):
+ if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd);
+ three_cases(right_cl):
+ begin pckt_signed(dvi_right_cmd[cur_class],cur_parm);
+ if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true;
+ end;
+ two_cases(y0_cl):
+ if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd);
+ three_cases(down_cl):
+ begin pckt_signed(dvi_down_cmd[cur_class],cur_parm);
+ if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true;
+ end;
+ fnt_cl: vf_font;
+ fnt_def_cl: bad_font;
+ invalid_cl: if cur_cmd<>nop then bad_font;
+ end; {there are no other cases}
+ if vf_loc<vf_limit then vf_first_par
+ else if last_pop then goto done
+ else begin cur_class:=pop_cl; last_pop:=true; {final |pop|}
+ end;
+ end;
+done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font
+
+@ For a |push| we either increase |vf_push_num| or start a new level and
+append a |push|.
+
+@d incr_stack(#)==
+if #=stack_used then
+ if stack_used=stack_size then overflow(str_stack,stack_size)
+ else incr(stack_used);
+incr(#)
+
+@<VF: Do a |push|@>=
+if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then
+ begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255);
+ incr(vf_push_num[vf_ptr]);
+ end
+else begin incr_stack(vf_ptr);
+ @<VF: Start a new level@>;
+ vf_push_num[vf_ptr]:=0;
+ end
+
+@ @<VF: Start a new level@>=
+append_one(push);
+vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+vf_push_loc[vf_ptr]:=byte_ptr;
+vf_last_end[vf_ptr]:=byte_ptr;
+vf_last[vf_ptr]:=vf_other
+
+@ When a character, a rule, or an |xxx| is appended, transformation
+rule~1 might be applicable.
+
+@<VF: Do a |char|, |rule|, or |xxx|@>=
+begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false
+else case cur_class of
+char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt);
+rule_cl: move_zero:=not cur_upd;
+xxx_cl: move_zero:=true;
+end; {there are no other cases}
+if move_zero then
+ begin decr(byte_ptr); decr(vf_ptr);
+ end;
+case cur_class of
+char_cl: @<VF: Do a |fnt|, a |char|, or both@>;
+rule_cl: @<VF: Do a |rule|@>;
+xxx_cl: @<VF: Do an |xxx|@>;
+end; {there are no other cases}
+vf_last_end[vf_ptr]:=byte_ptr;
+if move_zero then
+ begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if cur_class=char_cl then if cur_upd then goto reswitch;
+ end;
+end
+
+@ A special situation arises if transformation rule~1 is applied to a
+|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command
+following it; in this case |cur_upd| and |move_zero| are both |true| and
+the |set_char| or \\{set} command will be appended later.
+
+@<VF: Do a |fnt|, a |char|, or both@>=
+begin if vf_cur_fnt<>vf_fnt then
+ begin vf_last[vf_ptr]:=vf_other;
+ pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt;
+ end;
+if (not move_zero)or(not cur_upd) then
+ begin vf_last[vf_ptr]:=vf_char_type[cur_upd];
+ vf_last_loc[vf_ptr]:=byte_ptr;
+ pckt_char(cur_upd,cur_ext,cur_res);
+ end;
+end
+
+@ @<VF: Do a |rule|@>=
+begin vf_last[vf_ptr]:=vf_rule_type[cur_upd];
+vf_last_loc[vf_ptr]:=byte_ptr;
+append_one(dvi_rule_cmd[cur_upd]);
+pckt_four(cur_v_dimen); pckt_four(cur_h_dimen);
+end
+
+@ @<VF: Do an |xxx|@>=
+begin vf_last[vf_ptr]:=vf_other;
+pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm);
+while cur_parm>0 do
+ begin append_byte(vf_ubyte); decr(cur_parm);
+ end;
+end
+
+@ Transformation rules 2--6 are triggered by a |pop|, either read from
+the \.{VF} file or manufactured at the end of the packet.
+
+@<VF: Do a |pop|@>=
+begin if vf_ptr<1 then bad_font;
+byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2}
+if vf_last[vf_ptr]<=vf_rule then
+ if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then
+ @<VF: Prepare for rule 4@>;
+if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@>
+else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>;
+ append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group;
+ vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1;
+ vf_last_end[vf_ptr]:=byte_ptr;
+ if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>;
+ end;
+end
+
+@ In order to implement transformation rule~4, we cancel the |set_char|,
+\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule|
+with the old parameters.
+
+@<VF: Prepare for rule 4@>=
+begin cur_class:=vf_last[vf_ptr]; cur_upd:=false;
+byte_ptr:=vf_push_loc[vf_ptr];
+end
+
+@ @<VF: Apply rule 3 or 4@>=
+begin if vf_push_num[vf_ptr]>0 then
+ begin decr(vf_push_num[vf_ptr]);
+ vf_move[vf_ptr]:=vf_move[vf_ptr-1];
+ end
+else begin decr(byte_ptr); decr(vf_ptr);
+ end;
+if cur_class<>pop_cl then goto reswitch; {this is rule 4}
+end
+
+@ @<VF: Apply rule 6@>=
+begin Decr(byte_ptr)(2);
+for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k];
+vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr;
+end
+
+@ @<VF: Apply rule 5@>=
+begin incr(vf_ptr);
+@<VF: Start a new level@>;
+decr(vf_push_num[vf_ptr]);
+end
+
+@ The \.{VF} format specifies that after a character packet 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'';
+for |vf_simple| packets this is achieved by changing the final |put|
+command into |set_char| or \\{set}, but for |vf_complex| packets an
+explicit movement must be done. This poses a problem for programs,
+such as \.{DVIcopy}, which write a new \.{DVI} file with all references
+to characters from virtual fonts replaced by their character packets:
+The \.{DVItype} program specifies that the horizontal movements after a
+|set_char| or \\{set} command, after a |set_rule| command, and after one
+of the commands |right1..x4|, are all treated differently when \.{DVI}
+units are converted to pixels.
+
+Thus we introduce a slight extension of \.{DVItype}'s pixel rounding
+algorithm and hope that this extension will become part of the standard
+\.{DVItype} program in the near future: If a \.{DVI} file contains a
+|set_rule| command for a rule with the negative height |width_dimen|,
+then this rule shall be treated in exactly the same way as a ficticious
+character whose width is the width of that rule; as value of |width_dimen|
+we choose $-2^{31}$, the smallest signed 32-bit integer.
+
+@<Glob...@>=
+@!width_dimen:int_32; {vertical dimension of special rules}
+
+@ When initializing |width_dimen| we are careful to avoid arithmetic
+overflow.
+
+@<Set init...@>=
+width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000);
+
+@* Terminal communication.
+When \.{\title} begins, it engages the user in a brief dialog so that
+various options may be specified. This part of \.{\title} requires
+nonstandard \PASCAL\ constructions to handle the online interaction; so
+it may be preferable in some cases to omit the dialog and simply to
+stick to the default options. On other hand, the system-dependent
+routines that are needed are not complicated, so it will not be terribly
+difficult to introduce them; furthermore they are similar to those in
+\.{DVItype}.
+
+It may be desirable to (optionally) specify all the options in the
+command line and skip the dialog with the user, provided the operating
+system permits this. Here we just define the system-indepent part of the
+code required for this possibility. Since a complete option (a keyword
+possibly followed by one or several parameters) may have embedded blanks
+it might be necessary to replace these blanks by some other separator,
+e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say
+$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$
+to override the magnification factor that is stated in the \.{DVI} file,
+and to select five pages starting with the page numbered~17.3 as well as
+all remaining pages starting with the one numbered~47; alternatively one
+might simply say
+$$\.{\title\space- ...}$$
+to skip the dialog and use the default options.
+
+The system-dependent initialization code should set the |n_opt| variable
+to the number of options found in the command line. If |n_opt=0| the
+|input_ln| procedure defined below will promt the user for options. If
+|n_opt>0| the |k_opt| variable will be incremented and another piece of
+system-dependent code is invoked instead of the dialog; that code should
+place the value of command line option number |k_opt| as temporary
+string into the |byte-mem| array. This process will be repeated until
+|k_opt=n_opt|, indicating that all command line options have been
+processed.
+@^system dependencies@>
+
+@d opt_separator="/" {acts as blank when scanning (command line) options}
+
+@<Set init...@>=
+n_opt:=0; {change this to indicate the presence of command line options}
+k_opt:=0; {just in case}
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that
+line into the |byte_mem| array as a temporary string. \PASCAL's
+standard |input| file is used for terminal input, as |output| is used
+for terminal output.
+
+Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(output) {empty the terminal output buffer}
+@#
+@d scan_blank(#)== {tests for `blank' when scanning (command line) options}
+ ((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator)))
+@d scan_skip== {skip `blanks'}
+ while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr)
+@d scan_init== {initialize |scan_ptr|}
+ byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip
+
+@<Action procedures for |dialog|@>=
+procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin if n_opt=0 then
+ begin print('Enter option: '); update_terminal; reset(input);
+ if eoln(input) then read_ln(input);
+ k:=0; pckt_room(terminal_line_length);
+ while (k<terminal_line_length)and not eoln(input) do
+ begin append_byte(xord[input^]); incr(k); get(input);
+ end;
+ end
+else if k_opt<n_opt then
+ begin incr(k_opt);
+ {Copy command line option number |k_opt| into |byte_mem| array!}
+ end;
+end;
+
+@ The global variable |scan_ptr| is used while scanning the temporary
+packet; it points to the next byte in |byte_mem| to be examined.
+
+@<Glob...@>=
+@!n_opt:int_16; {number of options found in command line}
+@!k_opt:int_16; {number of command line options processed}
+@!scan_ptr:byte_pointer; {pointer to next byte to be examined}
+@!sep_char:text_char; {|' '| or |xchr[opt_separator]|}
+
+@ The |scan_keyword| function is used to test for keywords in a character
+string stored as temporary packet in |byte_mem|; the result is |true|
+(and |scan_ptr| is updated) if the characters starting at position
+|scan_ptr| are an abbreviation of a given keyword followed by at least
+one blank.
+
+@<Action procedures for |dialog|@>=
+function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean;
+var i,@!j,@!k:byte_pointer; {indices into |byte_mem|}
+begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr;
+while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do
+ begin incr(i); incr(k);
+ end;
+if scan_blank(k)and(i-pckt_start[p]>=l) then
+ begin scan_ptr:=k; scan_skip; scan_keyword:=true;
+ end
+else scan_keyword:=false;
+end;
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |scan_ptr|, the
+value~0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@<Action procedures for |dialog|@>=
+function scan_int:int_32;
+var x:int_32; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if byte_mem[scan_ptr]="-" then
+ begin negative:=true; incr(scan_ptr);
+ end
+else negative:=false;
+x:=0;
+while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do
+ begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr);
+ end;
+scan_skip;
+if negative then scan_int:=-x @+ else scan_int:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{\title} begins.
+@^system dependencies@>
+
+@p @<Action procedures for |dialog|@>@;
+procedure dialog;
+label exit;
+var p:pckt_pointer; {packet being created}
+begin @<Initialize options@>@;
+loop begin input_ln; p:=new_packet; scan_init;
+ if scan_ptr=byte_ptr then
+ begin flush_packet; return;
+ end@;@/
+ @<Cases for options@>@;@/
+ else begin if n_opt=0 then sep_char:=' '
+ else sep_char:=xchr[opt_separator];
+ print_options;
+ if n_opt>0 then
+ begin print('Bad command line option: ');
+ print_packet(p); abort('---run terminated');
+ end;
+ end;
+ flush_packet;
+ end;
+exit:end;
+
+@ The |print_options| procedure might be used in a `Usage message'
+displaying the command line syntax.
+
+@<Basic printing...@>=
+procedure print_options;
+begin print_ln('Valid options are:');
+@<Print valid options@>@;
+end;
+
+@* Subroutines for typesetting commands.
+This is the central part of the whole \.{\title} program:
+When a typesetting command from the \.{DVI} file or from a \.{VF} packet
+has been decoded, one of the typesetting routines defined below is
+invoked to execute the command; apart from the necessary book keeping,
+these routines invoke device dependent code defined later.
+
+@p @<Declare typesetting procedures@>
+
+@ These typesetting routines communicate with the rest of the program
+through global variables.
+
+@<Glob...@>=
+@!type_setting:boolean; {|true| while typesetting a page}
+
+@ @<Set init...@>=
+type_setting:=false;
+
+@ The user may select up to |max_select| ranges of consecutive pages to
+be processed. Each starting page specification is recorded in two global
+arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}'
+is represented by |start_there[0]=true|, |start_count[0]=1|,
+|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We
+also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example. The number of pages is recorded in
+|max_pages|; a non positive value indicates that there is no limit.
+
+@d start_count==select_count[cur_select] {count values to select
+ starting page}
+@d start_there==select_there[cur_select] {is the |start_count| value
+ relevant?}
+@d start_vals==select_vals[cur_select] {the last count considered
+ significant}
+@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages
+ will be printed}
+
+@<Glob...@>=
+@!select_count:array[0..max_select-1,0..9] of int_32;
+@!select_there:array[0..max_select-1,0..9] of boolean;
+@!select_vals:array[0..max_select-1] of 0..9;
+@!select_max:array[0..max_select-1] of int_32;
+@!out_mag:int_32; {output maginfication}
+@!count:array[0..9] of int_32; {the count values on the current page}
+@!num_select:0..max_select; {number of page selection ranges specified}
+@!cur_select:0..max_select; {current page selection range}
+@!selected:boolean; {has starting page been found?}
+@!all_done:boolean; {have all selected pages been processed?}
+@!str_mag,@!str_select:pckt_pointer;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ @<Initialize options@>=
+out_mag:=0; cur_select:=0; max_pages:=0; selected:=true;
+
+@ @<Print valid options@>=
+print_ln(' mag',sep_char,'<new_mag>');
+print_ln(' select',sep_char,'<start_count>',sep_char,
+ '[<max_pages>] (up to ',max_select:1,' ranges)');
+
+@ @<Action procedures for |dialog|@>=
+procedure scan_count; {scan a |start_count| value}
+begin if byte_mem[scan_ptr]=bi("*") then
+ begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip;
+ end
+else begin start_there[start_vals]:=true;
+ start_count[start_vals]:=scan_int;
+ if cur_select=0 then selected:=false; {don't start at first page}
+ end;
+end;
+
+@ @<Cases for options@>=
+else if scan_keyword(str_mag,3) then out_mag:=scan_int
+else if scan_keyword(str_select,3) then
+ if cur_select=max_select then print_ln('Too many page selections')
+ else begin start_vals:=0; scan_count;
+ while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do
+ begin incr(start_vals); incr(scan_ptr); scan_count;
+ end;
+ max_pages:=scan_int; incr(cur_select);
+ end
+
+@ @<Initialize predefined strings@>=
+id3("m")("a")("g")(str_mag);
+id6("s")("e")("l")("e")("c")("t")(str_select);
+
+@ A stack is used to keep track of the current horizonal and vertical
+position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|;
+the register pairs |(w,x)| and |(y,z)| are maintained as arrays.
+
+@<Types...@>=
+@!device @<Declare device dependend types@>@; @+ ecived @; @/
+@!stack_pointer=0..stack_size;@/
+@!stack_index=1..stack_size;@/
+@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables}
+@!stack_record=record@;@/
+ @!h_field:int_32; {horizontal position |h|}
+ @!v_field:int_32; {vertical position |v|}
+ @!w_x_field:pair_32; {|w| and |x| register for horizontal movements}
+ @!y_z_field:pair_32; {|y| and |z| register for vertical movements}
+ @!device @<Device dependent stack record fields@>@; @+ ecived @; @/
+ end;
+
+@ The current values are kept in |cur_stack|; they are pushed onto and
+popped from |stack|. We use \.{WEB} macros to access the current values.
+
+@d cur_h==cur_stack.h_field {the current |@!h| value}
+@d cur_v==cur_stack.v_field {the current |@!v| value}
+@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value}
+@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value}
+
+@<Glob...@>=
+@!stack:array[stack_index] of stack_record; {the pushed values}
+@!cur_stack:stack_record; {the current values}
+@!zero_stack:stack_record; {initial values}
+@!stack_ptr:stack_pointer; {last used position in |stack|}
+
+@ @<Set init...@>=
+zero_stack.h_field:=0; zero_stack.v_field:=0;
+for i:=0 to 1 do
+ begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0;
+ end;
+@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/
+
+@ When typesetting for a real device we must convert the current
+position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into
+|cur_hh| and |cur_vv|. This might be a good place to collect everything
+related to the conversion from \.{DVI} units to pixels and in particular
+all the pixel rounding algorithms.
+
+@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large''
+ spaces}
+
+@<Declare device dependent font data arrays@>=
+@!fnt_space:array [font_number] of int_32; {boundary between ``small''
+ and ``large'' spaces}
+
+@ @<Initialize device dependent font data@>=
+font_space(invalid_font):=0;
+
+@ @<Initialize device dependent data for a font@>=
+font_space(cur_fnt):=font_scaled(cur_fnt) div 6;
+ {this is a 3-unit ``thin space''}
+
+@ The |char_pixels| array is used to store the horizontal character
+escapements: for \.{PK} or \.{GF} files we use the values given there,
+otherwise we must convert the character widths to (horizontal) pixels.
+The horizontal escapement of character~|c| in font~|f| is given by
+|font_pixel(f)(c)|.
+
+@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end
+@#
+@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not
+ suffice for high resolution output devices}
+
+@<Declare device dependend types@>=
+@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement}
+
+@ @<Glob...@>=
+@!device
+@!char_pixels:array[char_pointer] of pix_value; {character escapements}
+@!h_pixels:pix_value; {a horizontal dimension in pixels}
+@!v_pixels:pix_value; {a vertical dimension in pixels}
+@!temp_pix:pix_value; {temporary value for pixel rounding}
+ecived
+
+@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value}
+@d cur_vv==cur_stack.vv_field {the current |@!vv| value}
+
+@<Device dependent stack record fields@>=
+@!hh_field:pix_value; {horizontal pixel position |hh|}
+@!vv_field:pix_value; {vertical pixel position |vv|}
+
+@ @<Initialize device dependent stack record fields@>=
+zero_stack.hh_field:=0; zero_stack.vv_field:=0;
+
+@ For small movements we round the increment in position, for large
+movements we round the incremented position. The same applies to rule
+dimensions with the only difference that they will always be rounded
+towards larger values. For characters we increment the horizontal
+position by the escapement values obtained, e.g., from a \.{PK} file or
+by the \.{TFM} width converted to pixels.
+
+@d h_pixel_round(#)==round(h_conv*(#))
+@d v_pixel_round(#)==round(v_conv*(#))
+@^system dependencies@>
+@#
+@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt))
+ {is this a ``large'' horizontal distance?}
+@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt))
+ {is this a ``large'' vertical distance?}
+@#
+@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels}
+@!device if large_h_space(cur_h_dimen) then
+ begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh;
+ if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1;
+ end
+else begin h_pixels:=trunc(h_conv*cur_h_dimen);
+ if h_pixels<h_conv*cur_h_dimen then incr(h_pixels);
+ end;
+ecived
+@#
+@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels}
+@!device if large_v_space(cur_v_dimen) then
+ begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen);
+ if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|}
+ end
+else begin v_pixels:=trunc(v_conv*cur_v_dimen);
+ if v_pixels<v_conv*cur_v_dimen then incr(v_pixels);
+ end;
+ecived
+
+@ A sequence of consecutive rules, or consecutive characters in a
+fixed-width font whose width is not an integer number of pixels, can
+cause |hh| to drift far away from a correctly rounded value. \.{\title}
+ensures that the amount of drift will never exceed |max_h_drift| pixels;
+similarly |vv| shall never drift away from the correctly rounded value
+by more than |max_v_drift| pixels.
+
+@d h_upd_end(#)== {check for proper horizontal pixel rounding}
+begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h);
+if abs(temp_pix-cur_hh)>max_h_drift then
+ if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift
+ else cur_hh:=temp_pix+max_h_drift;
+end @+ ecived
+@d h_upd_char(#)==Incr(cur_h)(#)@;
+ @!device; h_upd_end
+@d h_upd_move(#)==Incr(cur_h)(#)@;
+ @!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h)
+ else h_upd_end
+@#
+@d v_upd_end(#)== {check for proper vertical pixel rounding}
+begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v);
+if abs(temp_pix-cur_vv)>max_v_drift then
+ if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift
+ else cur_vv:=temp_pix+max_v_drift;
+end @+ ecived
+@d v_upd_move(#)==Incr(cur_v)(#)@;
+ @!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v)
+ else v_upd_end
+
+@ The routines defined below use sections named `Declare local variables
+(if any) for \dots' or `Declare additional local variables for \dots';
+the former may declare variables (including the keyword \&{var}), whereas
+the later must at least contain the keyword \&{var}. In general, both may
+start with the declaration of labels, constants, and\slash or types.
+
+Let us start with the simple cases:
+The |do_pre| procedure is called when the preamble has been read from
+the \.{DVI} file; the preamble comment has just been converted into a
+temporary packet with the |new_packet| procedure.
+
+@p procedure do_pre;@/
+@<OUT: Declare local variables (if any) for |do_pre|@>@;
+begin all_done:=false; num_select:=cur_select; cur_select:=0;
+if num_select=0 then max_pages:=0;
+@!device
+h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0);
+v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0);
+ecived @; @/
+@<OUT: Process the |pre|@>@;@/
+end;
+
+@ The |do_bop| procedure is called when a |bop| has been read. This
+routine determines whether a page shall be processed or skipped and sets
+the variable |type_setting| accordingly.
+
+@p procedure do_bop;@/
+@<OUT: Declare additional local variables |do_bop|@>@;
+@!i,@!j:0..9; {indices into |count|}
+begin @<Determine whether this page should be processed or skipped@>;
+print('DVI: ');
+if type_setting then print('process') @+ else print('skipp');
+print('ing page ',count[0]:1); j:=9;
+while (j>0)and(count[j]=0) do decr(j);
+for i:=1 to j do print('.',count[i]:1);
+d_print(' at ',dvi_loc-45:1);
+print_ln('.');
+if type_setting then
+ begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/
+ @<OUT: Process a |bop|@>@;@/
+ end;
+end;
+
+@ Note that the device dependent code `OUT: Process a |bop|' may choose
+to set |type_setting| to false even if |selected| is true.
+
+@<Determine whether this page...@>=
+if not selected then selected:=start_match;
+type_setting:=selected
+
+@ The |do_eop| procedure is called in order to process an |eop|; the
+stack should be empty.
+
+@p procedure do_eop;@/
+@<OUT: Declare local variables (if any) for |do_eop|@>@;
+begin if stack_ptr<>0 then bad_dvi;
+@<OUT: Process an |eop|@>@;
+if max_pages>0 then
+ begin decr(max_pages);
+ if max_pages=0 then
+ begin selected:=false; incr(cur_select);
+ if cur_select=num_select then all_done:=true;
+ end;
+ end;
+type_setting:=false;
+end;
+
+@ The procedures |do_push| and |do_pop| are called in order to process
+|push| and |pop| commands; |do_push| must check for stack overflow,
+|do_pop| should never be called when the stack is empty.
+
+@p procedure do_push; {push onto stack}
+@<OUT: Declare local variables (if any) for |do_push|@>@;
+begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/
+@<OUT: Process a |push|@>@;
+end;
+@#
+procedure do_pop; {pop from stack}
+@<OUT: Declare local variables (if any) for |do_pop|@>@;
+begin if stack_ptr=0 then bad_dvi;
+cur_stack:=stack[stack_ptr]; decr(stack_ptr);
+@<OUT: Process a |pop|@>@;@/
+end;
+
+@ The |do_xxx| procedure is called in order to process a special command.
+The bytes of the special string have been put into |byte_mem| as the
+current string. They are converted to a temporary packet and discarded
+again.
+
+@p procedure do_xxx;@/
+@<OUT: Declare additional local variables for |do_xxx|@>@;
+@!p:pckt_pointer; {temporary packet}
+begin p:=new_packet;@/
+@<OUT: Process an |xxx|@>@;@/
+flush_packet;
+end;
+
+@ Next are the movement commands:
+The |do_right| procedure is called in order to process the horizontal
+movement commands |right|, |w|, and |x|.
+
+
+@p procedure do_right;@/
+@<OUT: Declare local variables (if any) for |do_right|@>@;
+begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm
+else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl];
+@<OUT: Process a |right| or |w| or |x|@>@;@/
+h_upd_move(cur_parm)(h_pixel_round(cur_parm));
+@<OUT: Move right@>@;
+end;
+
+@ The |do_down| procedure is called in order to process the vertical
+movement commands |down|, |y|, and |z|.
+
+@p procedure do_down;@/
+@<OUT: Declare local variables (if any) for |do_down|@>@;
+begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm
+else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl];
+@<OUT: Process a |down| or |y| or |z|@>@;@/
+v_upd_move(cur_parm)(v_pixel_round(cur_parm));
+@<OUT: Move down@>@;
+end;
+
+@ The |do_width| procedure, or actually the |do_a_width| macro, is
+called in order to increase the current horizontal position |cur_h| by
+|cur_h_dimen| in exactly the same way as if a character of width
+|cur_h_dimen| had been typeset.
+
+@d do_a_width(#)==
+ begin @!device h_pixels:=#; @+ ecived @; @+ do_width;
+ end
+
+@p procedure do_width;@/
+@<OUT: Declare local variables (if any) for |do_width|@>@;
+begin @<OUT: Typeset a |width|@>@;@/
+h_upd_char(cur_h_dimen)(h_pixels);
+@<OUT: Move right@>@;
+end;
+
+@ Finally we have the commands for the typesetting of rules and characters;
+the global variable |cur_upd| is |true| if the horizontal position shall
+be updated (\\{set} commands).
+
+The |do_rule| procedure is called in order to typeset a rule.
+
+@p procedure do_rule;@/
+@<OUT: Declare additional local variables |do_rule|@>@;
+@!visible:boolean;
+begin h_rule_pixels@;
+if (cur_h_dimen>0)and(cur_v_dimen>0) then
+ begin visible:=true; v_rule_pixels@;
+ @<OUT: Typeset a visible |rule|@>@;
+ end
+else begin visible:=false;
+ @<OUT: Typeset an invisible |rule|@>@;
+ end;
+if cur_upd then
+ begin h_upd_move(cur_h_dimen)(h_pixels);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ Last not least the |do_char| procedure is called in order to typeset
+character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|.
+
+@p procedure do_char;@/
+@<OUT: Declare local variables (if any) for |do_char|@>@;
+begin @<OUT: Typeset a |char|@>@;
+if cur_upd then
+ begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]);
+ @<OUT: Move right@>@;
+ end;
+end;
+
+@ If the program terminates abnormally, the following code may be
+invoked in the middle of a page.
+
+@<Finish output file(s)@>=
+begin if type_setting then @<OUT: Finish incomplete page@>;
+@<OUT: Finish output file(s)@>@;
+end
+
+@ When the first character of font~|cur_fnt| is about to be typeset, the
+|do_font| procedure is called in order to decide whether this is a
+virtual font or a real font.
+
+One step in this decision is the attempt to find and read the \.{VF}
+file for this font; other attempts to locate a font file may be
+performed before and after that, depending on the nature of the output
+device and on the structure of the file system at a particular
+installation. For a real device we convert the character widths to
+(horizontal) pixels.
+
+In any case |do_font| must change |font_type(cur_fnt)| to a value
+|>defined_font|; as a last resort one might use the \.{TFM} width data
+and draw boxes or leave blank spaces in the output.
+
+@p procedure do_font;@/
+label done;@/
+@<OUT: Declare additional local variables for |do_font|@>@;
+@!p:char_pointer; {index into |char_widths| and |char_pixels|}
+begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts);
+gubed@;
+@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt)
+ to font_chars(cur_fnt)+font_ec(cur_fnt) do
+ char_pixels[p]:=h_pixel_round(widths[char_widths[p]]);
+ecived@;
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>@;@/
+if do_vf then goto done; {try to read the \.{VF} file}
+@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/
+done:
+@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts);
+gubed@;
+end;
+
+@ Before a character of font~|cur_fnt| is typeset the following piece of
+code ensures that the font is ready to be used.
+
+@<Prepare to use font |cur_fnt|@>=
+@<OUT: Prepare to use font |cur_fnt|@>@;
+if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used}
+
+@* Interpreting VF packets.
+The |pckt_first_par| procedure first reads a \.{DVI} command byte from
+the packet into |cur_cmd|; then |cur_parm| is set to the value of the
+first parameter (if any) and |cur_class| to the command class.
+
+@p procedure pckt_first_par;
+begin cur_cmd:=pckt_ubyte;
+case dvi_par[cur_cmd] of
+char_par: set_cur_char(pckt_ubyte);
+no_par: do_nothing;
+dim1_par: cur_parm:=pckt_sbyte;
+num1_par: cur_parm:=pckt_ubyte;
+dim2_par: cur_parm:=pckt_spair;
+num2_par: cur_parm:=pckt_upair;
+dim3_par: cur_parm:=pckt_strio;
+num3_par: cur_parm:=pckt_utrio;
+three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|}
+rule_par:
+ begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad;
+ cur_upd:=(cur_cmd=set_rule);
+ end;
+fnt_par:cur_parm:=cur_cmd-fnt_num_0;
+end; {there are no other cases}
+cur_class:=dvi_cl[cur_cmd];
+end;
+
+@ The |do_vf_packet| procedure is called in order to interpret the
+character packet for a virtual character. Such a packet may contain the
+instruction to typeset a character from the same or an other virtual
+font; in such cases |do_vf_packet| calls itself recursively. The
+recursion level, i.e., the number of times this has happened, is kept
+in the global variable |n_recur| and should not exceed |max_recursion|.
+@^recursion@>
+
+@<Types...@>=
+@!recur_pointer=0..max_recursion;
+
+@ The \.{\title} processor should detect an infinite recursion caused by
+bad \.{VF} files; thus a new recursion level is entered even in cases
+where this could be avoided without difficulty.
+
+If the recursion level exceeds the allowed maximum, we want to give
+a traceback how this has happened; thus some of the global variables
+used in different invocations of |do_vf_packet| are saved in a stack,
+others are saved as local variables of |do_vf_packet|.
+
+@<Glob...@>=
+@!recur_fnt:array[recur_pointer] of font_number; {this packet's font}
+@!recur_ext:array[recur_pointer] of int_24; {this packet's extension}
+@!recur_res:array[recur_pointer] of eight_bits; {this packet's residue}
+@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet}
+@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet}
+@!n_recur:recur_pointer; {current recursion level}
+@!recur_used:recur_pointer; {highest recursion level used so far}
+
+@ @<Set init...@>=
+n_recur:=0; recur_used:=0;
+
+@ Here now is the |do_vf_packet| procedure.
+
+@p procedure do_vf_packet;
+label continue,found,done;
+var k:recur_pointer; {loop index}
+@!f:int_8u; {packet type flag}
+@!save_upd:boolean; {used to save |cur_upd|}
+@!save_cp:width_pointer; {used to save |cur_cp|}
+@!save_wp:width_pointer; {used to save |cur_wp|}
+@!save_limit:byte_pointer; {used to save |cur_limit|}
+begin @<VF: Save values on entry to |do_vf_packet|@>;@/
+@<VF: Interpret the \.{DVI} commands in the packet@>@;@/
+if save_upd then
+ begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]);
+ end;
+@<VF: Restore values on exit from |do_vf_packet|@>;@/
+end;
+
+@ On entry to |do_vf_packet| several values must be saved.
+
+@<VF: Save values on entry to |do_vf_packet|@>=
+save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/
+recur_fnt[n_recur]:=cur_fnt;
+recur_ext[n_recur]:=cur_ext;
+recur_res[n_recur]:=cur_res
+
+@ Some of these values must be restored on exit from |do_vf_packet|.
+
+@<VF: Restore values on exit from |do_vf_packet|@>=
+cur_fnt:=recur_fnt[n_recur]
+
+@ If |cur_pckt| is the empty packet, we manufacture a |put| command;
+otherwise we read and interpret \.{DVI} commands from the packet.
+
+@<VF: Interpret the \.{DVI} commands in the packet@>=
+if find_packet then f:=cur_type @+ else goto done;
+recur_pckt[n_recur]:=cur_pckt;
+save_limit:=cur_limit;
+cur_fnt:=font_font(cur_fnt);
+if cur_pckt=empty_packet then
+ begin cur_class:=char_cl; goto found;
+ end;
+if cur_loc>=cur_limit then goto done;
+continue: pckt_first_par;
+found: case cur_class of
+char_cl: @<VF: Typeset a |char|@>;
+rule_cl: do_rule;
+xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(pckt_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+push_cl: do_push;
+pop_cl: do_pop;
+five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+fnt_cl: cur_fnt:=cur_parm;
+othercases confusion(str_packets); {font definition or invalid}
+endcases;
+if cur_loc<cur_limit then goto continue;
+done:
+
+@ The final |put| of a simple packet may be changed into |set_char| or
+\\{set}.
+
+@<VF: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp];
+if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then
+ begin save_upd:=false; cur_upd:=true;
+ end;
+if font_type(cur_fnt)=vf_font_type then
+ @<VF: Enter a new recursion level@>
+else do_char;
+end
+
+@ Before entering a new recursion level we must test for overflow; in
+addition a few variables must be saved and restored.
+A |set_char| or \\{set} followed by |pop| is changed into |put|.
+
+@<VF: Enter a new recursion level@>=
+begin recur_loc[n_recur]:=cur_loc; {save}
+if cur_loc<cur_limit then
+ if byte_mem[cur_loc]=bi(pop) then cur_upd:=false;
+if n_recur=recur_used then
+ if recur_used=max_recursion then
+ @<VF: Display the recursion traceback and terminate@>
+ else incr(recur_used);@/
+incr(n_recur); do_vf_packet; decr(n_recur); {recurse}
+cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore}
+end
+
+@ @<VF: Display the recursion traceback and terminate@>=
+begin print_ln(' !Infinite VF recursion?');
+@.Infinite VF recursion?@>
+for k:=max_recursion downto 0 do
+ begin print('level=',k:1,' font');
+ d_print('=',recur_fnt[k]:1);
+ print_font(recur_fnt[k]);
+ print(' char=',recur_res[k]:1);
+ if recur_ext[k]<>0 then print('.',recur_ext[k]:1);
+ new_line;
+ @!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1);
+ gubed@;
+ end;
+overflow(str_recursion,max_recursion);
+end
+
+@* Interpreting the DVI file.
+The |do_dvi| procedure reads the entire \.{DVI} file and initiates
+whatever actions may be necessary.
+
+@p procedure do_dvi;
+label done,exit;
+var temp_byte:int_8u; {byte for temporary variables}
+@!temp_int:int_32; {integer for temporary variables}
+@!dvi_start:int_32; {starting location}
+@!dvi_bop_post:int_32; {location of |bop| or |post|}
+@!dvi_back:int_32; {a back pointer}
+@!k:int_15; {general purpose variable}
+begin @<DVI: Process the preamble@>;
+if random_reading then @<DVI: Process the postamble@>;
+repeat dvi_first_par;
+ while cur_class=fnt_def_cl do
+ begin dvi_do_font(random_reading); dvi_first_par;
+ end;
+ if cur_cmd=bop then @<DVI: Process one page@>;
+until cur_cmd<>eop;
+if cur_cmd<>post then bad_dvi;
+exit:end;
+
+@ @<DVI: Process the preamble@>=
+if dvi_ubyte<>pre then bad_dvi;
+if dvi_ubyte<>dvi_id then bad_dvi;
+dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad;
+tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0;
+temp_byte:=dvi_ubyte; pckt_room(temp_byte);
+for k:=1 to temp_byte do append_byte(dvi_ubyte);
+print('DVI file: '''); print_packet(new_packet); print_ln(''',');
+print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1);
+if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1);
+print_ln('.');
+do_pre; flush_packet
+
+@ @<Glob...@>=
+@!dvi_num:int_31; {numerator}
+@!dvi_den:int_31; {denominator}
+@!dvi_mag:int_31; {magnification}
+
+@ @<DVI: Process the postamble@>=
+begin dvi_start:=dvi_loc; {remember start of first page}
+@<DVI: Find the postamble@>;
+d_print_ln('DVI: postamble at ',dvi_bop_post:1);
+dvi_back:=dvi_pointer;
+if dvi_num<>dvi_pquad then bad_dvi;
+if dvi_den<>dvi_pquad then bad_dvi;
+if dvi_mag<>dvi_pquad then bad_dvi;
+temp_int:=dvi_squad; temp_int:=dvi_squad;
+if stack_size<dvi_upair then overflow(str_stack,stack_size);
+temp_int:=dvi_upair;
+dvi_first_par;
+while cur_class=fnt_def_cl do
+ begin dvi_do_font(false); dvi_first_par;
+ end;
+if cur_cmd<>post_post then bad_dvi;
+if not selected then @<DVI: Find the starting page@>;
+dvi_move(dvi_start); {go to first or starting page}
+end
+
+@ @<DVI: Find the postamble@>=
+temp_int:=dvi_length-5;
+repeat if temp_int<49 then bad_dvi;
+dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int);
+until temp_byte<>dvi_pad;
+if temp_byte<>dvi_id then bad_dvi;
+dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi;
+dvi_bop_post:=dvi_pointer;
+if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi;
+dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi
+
+@ @<DVI: Find the starting page@>=
+begin dvi_start:=dvi_bop_post; {just in case}
+while dvi_back<>-1 do
+ begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi;
+ dvi_bop_post:=dvi_back; dvi_move(dvi_back);
+ if dvi_ubyte<>bop then bad_dvi;
+ for k:=0 to 9 do count[k]:=dvi_squad;
+ if start_match then dvi_start:=dvi_bop_post;
+ dvi_back:=dvi_pointer;
+ end;
+end
+
+@ When a |bop| has been read, the \.{DVI} commands for one page are
+interpreted until an |eop| is found.
+
+@<DVI: Process one page@>=
+begin for k:=0 to 9 do count[k]:=dvi_squad;
+temp_int:=dvi_pointer; do_bop;
+dvi_first_par;
+if type_setting then @<DVI: Process a page; then |goto done|@>
+else @<DVI: Skip a page; then |goto done|@>;
+done:if cur_cmd<>eop then bad_dvi;
+if selected then
+ begin do_eop;
+ if all_done then return;
+ end;
+end
+
+@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|;
+then we should have found an |eop|.
+
+@<DVI: Process a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ char_cl: @<DVI: Typeset a |char|@>;
+ rule_cl:
+ if cur_upd and(cur_v_dimen=width_dimen) then
+ do_a_width(h_pixel_round(cur_h_dimen))
+ else do_rule;
+ xxx_cl:
+ begin pckt_room(cur_parm);
+ while cur_parm>0 do
+ begin append_byte(dvi_ubyte); decr(cur_parm);
+ end;
+ do_xxx;
+ end;
+ push_cl: do_push;
+ pop_cl: do_pop;
+ five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
+ five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
+ fnt_cl: dvi_font;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ end; {there are no other cases}
+dvi_first_par; {get the next command}
+end
+
+@ While skipping a page all commands other than font definitions are
+ignored.
+
+@<DVI: Skip a page; then |goto done|@>=
+loop begin
+ case cur_class of
+ xxx_cl: while cur_parm>0 do
+ begin temp_byte:=dvi_ubyte; decr(cur_parm);
+ end;
+ fnt_def_cl: dvi_do_font(random_reading);
+ invalid_cl: goto done;
+ othercases do_nothing;
+ endcases;
+dvi_first_par; {get the next command}
+end
+
+@ @<DVI: Typeset a |char|@>=
+begin @<Prepare to use font |cur_fnt|@>;
+set_cur_wp(cur_fnt)(bad_dvi);
+if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char;
+end
+
+@* The main program.
+The code for real devices is still rather incomplete.
+Moreover several branches of the program have not been tested because
+they are never used with \.{DVI} files made by \TeX\ and \.{VF} files
+made by \.{VPtoVF}.
+
+@ At the end of the program the output file(s) have to be finished and
+on some systems it may be necessary to close input and\slash or output
+files.
+@^system dependencies@>
+
+@p procedure close_files_and_terminate;
+var k:@!int_15; {general purpose index}
+begin close_in(dvi_file);
+if history<fatal_message then @<Finish output file(s)@>;
+stat @<Print memory usage statistics@>;@+tats@;@/
+@<Close output file(s)@>@;
+@<Print the job |history|@>;
+end;
+
+@ Now we are ready to put it all together.
+Here is where \.{\title} starts, and where it ends.
+@^system dependencies@>
+
+@p begin initialize; {get all variables initialized}
+@<Initialize predefined strings@>@;
+dialog; {get options}
+@<Open input file(s)@>@;
+@<Open output file(s)@>@;
+do_dvi; {process the entire \.{DVI} file}
+close_files_and_terminate;
+final_end:end.
+
+@ @<Print memory usage statistics@>=
+print_ln('Memory usage statistics:');
+print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, ');
+@<Print more font usage statistics@>@;@/
+print_ln('and ',nf:1,' internal fonts of ',max_fonts:1);
+print_ln(n_widths:1,' widths of ',max_widths:1,' for ',
+ n_chars:1,' characters of ',max_chars:1);
+print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ',
+ byte_ptr:1,' bytes of ',max_bytes:1);
+@<Print more memory usage statistics@>@;@/
+print_ln(stack_used:1,' of ',stack_size:1,' stack and ',
+ recur_used:1,' of ',max_recursion:1,' recursion levels.')
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_ln('(No errors were found.)');
+harmless_message: print_ln('(Did you see the warning message above?)');
+error_message: print_ln('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_ln('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* Low-level output routines.
+The program uses the binary file variable |out_file| for its main output
+file; |out_loc| is the number of the byte about to be written next on
+|out_file|.
+
+@<Glob...@>=
+@!out_file:byte_file; {the \.{DVI} file we are writing}
+@!out_loc:int_32; {where we are about to write, in |out_file|}
+@!out_back:int_32; {a back pointer}
+@!out_max_v:int_31; {maximum |v| value so far}
+@!out_max_h:int_31; {maximum |h| value so far}
+@!out_stack:int_16u; {maximum stack depth}
+@!out_pages:int_16u; {total number of pages}
+
+@ @<Set ini...@>=
+out_loc:=0; out_back:=-1;
+out_max_v:=0; out_max_h:=0;
+out_stack:=0; out_pages:=0;
+
+@ To prepare |out_file| for output, we |rewrite| it.
+
+@<Open output file(s)@>=
+rewrite(out_file); {prepares to write packed bytes to |out_file|}
+
+@ For some operating systems it may be necessary to close |out_file|.
+
+@<Close output file(s)@>=
+
+@ Writing the |out_file| should be done as efficient as possible for a
+particular system; on many systems this means that a large number of
+bytes will be accumulated in a buffer and is then written from that
+buffer to |out_file|. In order to simplify such system dependent changes
+we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here
+we give a simple minded definition for this macro in terms of standard
+\PASCAL.
+@^system dependencies@>
+@^optimization@>
+
+@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
+
+@ The \.{WEB} macro |out_one| is used to write one byte and to update
+|out_loc|.
+
+@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end
+
+@ First the |out_packet| procedure copies a packet to |out_file|.
+
+@<Declare typesetting procedures@>=
+procedure out_packet(@!p:pckt_pointer);
+var k:byte_pointer; {index into |byte_mem|}
+begin Incr(out_loc)(pckt_length(p));
+for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k]));
+end;
+
+@ Next are the procedures used to write integer numbers or even complete
+\.{DVI} commands to |out_file|; they all keep |out_loc| up to date.
+
+The |out_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@<Declare typesetting procedures@>=
+procedure out_four(@!x:int_32); {output four bytes}
+@!begin_four; comp_four(out_byte); Incr(out_loc)(4);
+end;
+
+@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if
+|upd=false|, a |put| command.
+
+@<Declare typesetting procedures@>=
+procedure out_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
+ {output \\{set} or |put|}
+@!begin_char; comp_char(out_one);
+end;
+
+@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def|
+command with its first parameter (normally unsigned); a |fnt| command
+is converted into |fnt_num| whenever this is possible.
+
+@<Declare typesetting procedures@>=
+procedure out_unsigned(@!o:eight_bits;@!x:int_32);
+ {output |fnt_num|, |fnt|, |xxx|, or |fnt_def|}
+@!begin_unsigned; comp_unsigned(out_one);
+end;
+
+@ The |out_signed| procedure outputs a movement (|right|, |w|,
+|x|, |down|, |y|, or |z|) command with its (signed) parameter.
+
+@<Declare typesetting procedures@>=
+procedure out_signed(@!o:eight_bits;@!x:int_32);
+ {output |right|, |w|, |x|, |down|, |y|, or |z|}
+@!begin_signed; comp_signed(out_one);
+end;
+
+@ For an output font we set |font_type(f):=out_font_type|; in this case
+|font_font(f)| is the font number used for font~|f| in |out_file|.
+@^font types@>
+
+The global variable |out_nf| is the number of fonts already used in
+|out_file| and the array |out_fnts| contains their internal font numbers;
+the current font in |out_file| is called |out_fnt|.
+
+@<Glob...@>=
+@!out_fnts:array[font_number] of font_number; {internal font numbers}
+@!out_nf:font_number; {number of fonts used in |out_file|}
+@!out_fnt:font_number; {internal font number of current output font}
+
+@ @<Set init...@>=
+out_nf:=0;
+
+@ @<Print more font usage statistics@>=
+print(out_nf:1,' out, ');
+
+@ The |out_fnt_def| procedure outputs a complete font definition
+command.
+
+@<Declare typesetting procedures@>=
+procedure out_fnt_def(@!f:font_number);
+var p:pckt_pointer; {the font name packet}
+@!k,@!l:byte_pointer; {indices into |byte_mem|}
+@!a:eight_bits; {length of area part}
+begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f));
+out_four(font_scaled(f)); out_four(font_design(f));@/
+p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1;
+a:=bo(byte_mem[k]);@/
+Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a);
+while k<l do
+ begin incr(k); out_byte(bo(byte_mem[k]));
+ end;
+end;
+
+@* Writing the output file.
+Here we define the device dependent parts of the typesetting routines
+described earlier in this program.
+
+First we define a few quantities required by the device dependent code
+for a real output device in order to demonstrate how they might be
+defined and in order to be able to compile \.{DVIcopy} with the device
+dependent code included.
+
+@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)}
+@d v_resolution==300 {vertical resolution in pixels per inch (dpi)}
+
+@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|}
+@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|}
+
+@<Glob...@>=
+@!device
+@!h_conv:real; {converts \.{DVI} units to horizontal pixels}
+@!v_conv:real; {converts \.{DVI} units to vertical pixels}
+ecived
+
+@ These are the local variables (if any) needed for |do_pre|.
+
+@<OUT: Declare local variables (if any) for |do_pre|@>=
+var k:int_15; {general purpose variable}
+@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|}
+@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
+
+@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble
+comment written to |out_file| is similar to the one produced by \.{GFtoPK},
+but we want to apply our preamble comment prefix only once.
+
+@<OUT: Process the |pre|@>=
+out_one(pre); out_one(dvi_id);
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment}
+comment:=preamble_comment; pckt_room(comm_length);
+for k:=1 to comm_length do append_byte(xord[comment[k]]);
+while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks}
+if p=q then Decr(byte_ptr)(from_length)
+else begin k:=0;
+ while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k);
+ if k=comm_length then Incr(p)(comm_length);
+ end;
+k:=byte_ptr-p; {total length}
+if k>255 then
+ begin k:=255; q:=p+255-comm_length; {at most 255 bytes}
+ end;
+out_one(k); out_packet(new_packet); flush_packet;
+for r:=p to q-1 do out_one(bo(byte_mem[r]));
+
+@ These are the additional local variables (if any) needed for |do_bop|;
+the variables |@!i| and |@!j| are already declared.
+
+@<OUT: Declare additional local variables |do_bop|@>=
+var
+
+@ And here is the device dependent code for |do_bop|.
+
+@<OUT: Process a |bop|@>=
+out_one(bop); incr(out_pages);
+for i:=0 to 9 do out_four(count[i]);
+out_four(out_back); out_back:=out_loc-45;
+out_fnt:=invalid_font;
+
+@ These are the local variables (if any) needed for |do_eop|.
+
+@<OUT: Declare local variables (if any) for |do_eop|@>=
+
+@ And here is the device dependent code for |do_eop|.
+
+@<OUT: Process an |eop|@>=
+out_one(eop);
+
+@ These are the local variables (if any) needed for |do_push|.
+
+@<OUT: Declare local variables (if any) for |do_push|@>=
+
+@ And here is the device dependent code for |do_push|.
+
+@<OUT: Process a |push|@>=
+if stack_ptr>out_stack then out_stack:=stack_ptr;
+out_one(push);
+
+@ These are the local variables (if any) needed for |do_pop|.
+
+@<OUT: Declare local variables (if any) for |do_pop|@>=
+
+@ And here is the device dependent code for |do_pop|.
+
+@<OUT: Process a |pop|@>=
+out_one(pop);
+
+@ These are the additional local variables (if any) needed for |do_xxx|;
+the variable |@!p|, the pointer to the packet containing the special
+string, is already declared.
+
+@<OUT: Declare additional local variables for |do_xxx|@>=
+var
+
+@ And here is the device dependent code for |do_xxx|.
+
+@<OUT: Process an |xxx|@>=
+out_unsigned(xxx1,pckt_length(p)); out_packet(p);
+
+@ These are the local variables (if any) needed for |do_right|.
+
+@<OUT: Declare local variables (if any) for |do_right|@>=
+
+@ And here is the device dependent code for |do_right|.
+
+@<OUT: Process a |right| or |w| or |x|@>=
+if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|}
+else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|}
+
+@ Here we update the |out_max_h| value.
+
+@<OUT: Move right@>=
+if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h);
+
+@ These are the local variables (if any) needed for |do_down|.
+
+@<OUT: Declare local variables (if any) for |do_down|@>=
+
+@ And here is the device dependent code for |do_down|.
+
+@<OUT: Process a |down| or |y| or |z|@>=
+if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|}
+else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|}
+
+@ Here we update the |out_max_v| value.
+
+@<OUT: Move down@>=
+if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v);
+
+@ These are the local variables (if any) needed for |do_width|.
+
+@<OUT: Declare local variables (if any) for |do_width|@>=
+
+@ And here is the device dependent code for |do_width|.
+
+@<OUT: Typeset a |width|@>=
+out_one(set_rule);
+out_four(width_dimen); out_four(cur_h_dimen);
+
+@ These are the additional local variables (if any) needed for |do_rule|;
+the variable |@!visible| is already declared.
+
+@<OUT: Declare additional local variables |do_rule|@>=
+var
+
+@ And here is the device dependent code for |do_rule|.
+
+@<OUT: Typeset a visible |rule|@>=
+out_one(dvi_rule_cmd[cur_upd]);
+out_four(cur_v_dimen); out_four(cur_h_dimen);
+
+@ @<OUT: Typeset an invisible |rule|@>=
+@<OUT: Typeset a visible |rule|@>
+
+@ These are the additional local variables (if any) needed for |do_font|;
+the variable |@!p| is already declared.
+
+@<OUT: Declare additional local variables for |do_font|@>=
+var
+
+@ And here is the device dependent code for |do_font|; if the \.{VF} file
+for a font could not be found, we simply assume this must be a real font.
+
+@<OUT: Look for a font file before trying to read the \.{VF} file;
+ if found |goto done|@>=
+
+@ @<OUT: Look for a font file after trying to read the \.{VF} file@>=
+if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts);
+print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1);
+print_font(cur_fnt);
+d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.');
+font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf;
+out_fnts[out_nf]:=cur_fnt; incr(out_nf);
+out_fnt_def(cur_fnt);
+
+@ And here is some device dependent code used before each character.
+
+@<OUT: Prepare to use font |cur_fnt|@>=
+
+@ These are the local variables (if any) needed for |do_char|.
+
+@<OUT: Declare local variables (if any) for |do_char|@>=
+
+@ And here is the device dependent code for |do_char|.
+
+@<OUT: Typeset a |char|@>=
+@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts);
+gubed @;
+if cur_fnt<>out_fnt then
+ begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt;
+ end;
+out_char(cur_upd,cur_ext,cur_res);
+
+@ If the program terminates in the middle of a page, we write as many
+|pop|s as necessary and one |eop|.
+
+@<OUT: Finish incomplete page@>=
+begin while stack_ptr>0 do
+ begin out_one(pop); decr(stack_ptr);
+ end;
+ out_one(eop);
+end
+
+@ If the output file has been started, we write the postamble; in
+addition we print the number of bytes and pages written to |out_file|.
+
+@<OUT: Finish output file(s)@>=
+if out_loc>0 then
+ begin @<OUT: Write the postamble@>;
+ k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes}
+ while k>0 do
+ begin out_one(dvi_pad); decr(k);
+ end;
+ print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page');
+ if out_pages<>1 then print('s');
+ end
+else print('OUT file: no output');
+print_ln(' written.');
+if out_pages=0 then mark_harmless;
+
+@ Here we simply write the values accumulated during the \.{DVI} output.
+
+@<OUT: Write the postamble@>=
+out_one(post); out_four(out_back); out_back:=out_loc-5;@/
+out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
+out_four(out_max_v); out_four(out_max_h);@/
+out_one(out_stack div @"100); out_one(out_stack mod @"100);@/
+out_one(out_pages div @"100); out_one(out_pages mod @"100);@/
+k:=out_nf;
+while k>0 do
+ begin decr(k); out_fnt_def(out_fnts[k]);
+ end;
+out_one(post_post); out_four(out_back);@/
+out_one(dvi_id)
+
+@ Here we could print more memory usage statistics; this possibility is,
+however, not used for \.{DVIcopy}.
+
+@<Print more memory usage statistics@>=
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIcopy} 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.