1% This program by D. E. Knuth is not copyrighted and can be used freely. 2% Version 1 was implemented in December 1989. 3% Version 1.1 fixed some for-loop indices for stricter Pascal (April 1990). 4% Version 1.2 fixed `nonexistent char 0' bug, and a bit more (September 1990). 5% Version 1.3 has more robust `out_scaled' (March 1991). 6% Version 1.4 (March 1995) initialized lk_step_ended (Armin K\"ollner). 7% Version 1.5 (August 1998) corrected vf_fix(0) (Wayne Sullivan). 8% Version 1.6 (January 2014) corrected possible end-of-line glitch (Ken Nakano), 9% and get_fix now treats -- as + (Peter Breitenlohner). 10 11% Here is TeX material that gets inserted after \input webmac 12\def\hang{\hangindent 3em\indent\ignorespaces} 13\font\ninerm=cmr9 14\let\mc=\ninerm % medium caps for names like SAIL 15\def\PASCAL{Pascal} 16\font\logo=logo10 % for the METAFONT logo 17\def\MF{{\logo METAFONT}} 18 19\def\(#1){} % this is used to make section names sort themselves better 20\def\9#1{} % this is used for sort keys in the index 21 22\def\title{VP\lowercase{to}VF} 23\def\contentspagenumber{201} 24\def\topofcontents{\null 25 \def\titlepage{F} % include headline on the contents page 26 \def\rheader{\mainfont\hfil \contentspagenumber} 27 \vfill 28 \centerline{\titlefont The {\ttitlefont VPtoVF} processor} 29 \vskip 15pt 30 \centerline{(Version 1.6, January 2014)} 31 \vfill} 32\def\botofcontents{\vfill 33 \centerline{\hsize 5in\baselineskip9pt 34 \vbox{\ninerm\noindent 35 The preparation of this program 36 was supported in part by the National Science 37 Foundation and by the System Development Foundation. `\TeX' is a 38 trademark of the American Mathematical Society.}}} 39\pageno=\contentspagenumber \advance\pageno by 1 40 41@* Introduction. 42The \.{VPtoVF} utility program converts virtual-property-list (``\.{VPL}'') 43files into an equivalent pair of files called a virtual font (``\.{VF}'') file 44and a \TeX\ font metric (``\.{TFM}'') file. It also makes a thorough check 45of the given \.{VPL} file, so that the \.{VF} file should be acceptable to 46device drivers and the \.{TFM} file should be acceptable to \TeX. 47 48\indent\.{VPtoVF} is an extended version of the program \.{PLtoTF}, which 49is part of the standard \TeX ware library. 50The idea of a virtual font was inspired by the work of David R. Fuchs 51@^Fuchs, David Raymond@> 52who designed a similar set of conventions in 1984 while developing a 53device driver for ArborText, Inc. He wrote a somewhat similar program 54called \.{PLFONT}. 55 56The |banner| string defined here should be changed whenever \.{VPtoVF} 57gets modified. 58 59@d banner=='This is VPtoVF, Version 1.6' {printed when the program starts} 60 61@ This program is written entirely in standard \PASCAL, except that 62it has to do some slightly system-dependent character code conversion 63on input. Furthermore, lower case letters are used in error messages; 64they could be converted to upper case if necessary. The input is read 65from |vpl_file|, and the output is written on |vf_file| and |tfm_file|; 66error messages and 67other remarks are written on the |output| file, which the user may 68choose to assign to the terminal if the system permits it. 69@^system dependencies@> 70 71The term |print| is used instead of |write| when this program writes on 72the |output| file, so that all such output can be easily deflected. 73 74@d print(#)==write(#) 75@d print_ln(#)==write_ln(#) 76 77@p program VPtoVF(@!vpl_file,@!vf_file,@!tfm_file,@!output); 78const @<Constants in the outer block@>@/ 79type @<Types in the outer block@>@/ 80var @<Globals in the outer block@>@/ 81procedure initialize; {this procedure gets things started properly} 82 var @<Local variables for initialization@>@/ 83 begin print_ln(banner);@/ 84 @<Set initial values@>@/ 85 end; 86 87@ The following parameters can be changed at compile time to extend or 88reduce \.{VPtoVF}'s capacity. 89 90@<Constants...@>= 91@!buf_size=60; {length of lines displayed in error messages} 92@!max_header_bytes=100; {four times the maximum number of words allowed in 93 the \.{TFM} file header block, must be 1024 or less} 94@!vf_size=10000; {maximum length of |vf| data, in bytes} 95@!max_stack=100; {maximum depth of simulated \.{DVI} stack} 96@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed} 97@!max_lig_steps=5000; 98 {maximum length of ligature program, must be at most $32767-257=32510$} 99@!max_kerns=500; {the maximum number of distinct kern values} 100@!hash_size=5003; {preferably a prime number, a bit larger than the number 101 of character pairs in lig/kern steps} 102 103@ Here are some macros for common programming idioms. 104 105@d incr(#) == #:=#+1 {increase a variable by unity} 106@d decr(#) == #:=#-1 {decrease a variable by unity} 107@d do_nothing == {empty statement} 108 109@* Property list description of font metric data. 110The idea behind \.{VPL} files is that precise details about fonts, i.e., the 111facts that are needed by typesetting routines like \TeX, sometimes have to 112be supplied by hand. The nested property-list format provides a reasonably 113convenient way to do this. 114 115A good deal of computation is necessary to parse and process a 116\.{VPL} file, so it would be inappropriate for \TeX\ itself to do this 117every time it loads a font. \TeX\ deals only with the compact descriptions 118of font metric data that appear in \.{TFM} files. Such data is so compact, 119however, it is almost impossible for anybody but a computer to read it. 120 121Device drivers also need a compact way to describe mappings from \TeX's idea 122of a font to the actual characters a device can produce. They can do this 123conveniently when given a packed sequence of bytes called a \.{VF} file. 124 125The purpose of \.{VPtoVF} is to convert from a human-oriented file of text 126to computer-oriented files of binary numbers. There's a companion program, 127\.{VFtoVP}, which goes the other way. 128 129@<Glob...@>= 130@!vpl_file:text; 131 132@ @<Set init...@>= 133reset(vpl_file); 134 135@ A \.{VPL} file is like a \.{PL} file with a few extra features, so we 136can begin to define it by reviewing the definition of \.{PL} files. The 137material in the next few sections is copied from the program \.{PLtoTF}. 138 139A \.{PL} file is a list of entries of the form 140$$\.{(PROPERTYNAME VALUE)}$$ 141where the property name is one of a finite set of names understood by 142this program, and the value may itself in turn be a property list. 143The idea is best understood by looking at an example, so let's consider 144a fragment of the \.{PL} file for a hypothetical font. 145$$\vbox{\halign{\.{#}\hfil\cr 146(FAMILY NOVA)\cr 147(FACE F MIE)\cr 148(CODINGSCHEME ASCII)\cr 149(DESIGNSIZE D 10)\cr 150(DESIGNUNITS D 18)\cr 151(COMMENT A COMMENT IS IGNORED)\cr 152(COMMENT (EXCEPT THIS ONE ISN'T))\cr 153(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr 154\qquad\qquad IT SAYS IT ISN'T))\cr 155(FONTDIMEN\cr 156\qquad (SLANT R -.25)\cr 157\qquad (SPACE D 6)\cr 158\qquad (SHRINK D 2)\cr 159\qquad (STRETCH D 3)\cr 160\qquad (XHEIGHT R 10.55)\cr 161\qquad (QUAD D 18)\cr 162\qquad )\cr 163(LIGTABLE\cr 164\qquad (LABEL C f)\cr 165\qquad (LIG C f O 200)\cr 166\qquad (SKIP D 1)\cr 167\qquad (LABEL O 200)\cr 168\qquad (LIG C i O 201)\cr 169\qquad (KRN O 51 R 1.5)\cr 170\qquad (/LIG C ? C f)\cr 171\qquad (STOP)\cr 172\qquad )\cr 173(CHARACTER C f\cr 174\qquad (CHARWD D 6)\cr 175\qquad (CHARHT R 13.5)\cr 176\qquad (CHARIC R 1.5)\cr 177\qquad )\cr}}$$ 178This example says that the font whose metric information is being described 179belongs to the hypothetical 180\.{NOVA} family; its face code is medium italic extended; 181and the characters appear in ASCII code positions. The design size is 10 points, 182and all other sizes in this \.{PL} file are given in units such that 18 units 183equals the design size. The font is slanted with a slope of $-.25$ (hence the 184letters actually slant backward---perhaps that is why the family name is 185\.{NOVA}). The normal space between words is 6 units (i.e., one third of 186the 18-unit design size), with glue that shrinks by 2 units or stretches by 3. 187The letters for which accents don't need to be raised or lowered are 10.55 188units high, and one em equals 18 units. 189 190The example ligature table is a bit trickier. It specifies that the 191letter \.f followed by another \.f is changed to code @'200, while 192code @'200 followed by \.i is changed to @'201; presumably codes @'200 193and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases 194\.f and @'200, if the following character is the code @'51 (which is a 195right parenthesis), an additional 1.5 units of space should be inserted 196before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or 197\.{KRN} command, which in this case is the second \.{LIG}; in this way 198two different ligature/kern programs can come together.) 199Finally, if either \.f or @'200 is followed by a question mark, 200the question mark is replaced by \.f and the ligature program is 201started over. (Thus, the character pair `\.{f?}' would actually become 202the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To 203avoid this restart procedure, the \.{/LIG} command could be replaced 204by \.{/LIG>}; then `\.{f?}' would become `f\kern0ptf' and `\.{f?f}' 205would become `f\kern0ptff'.) 206 207Character \.f itself is 6 units wide and 13.5 units tall, in this example. 208Its depth is zero (since \.{CHARDP} is not given), and its italic correction 209is 1.5 units. 210 211@ The example above illustrates most of the features found in \.{PL} files. 212Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a 213string as their value; this string continues until the first unmatched 214right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT} 215and \.{LABEL}, take a number as their value. This number can be expressed in 216a variety of ways, indicated by a prefixed code; \.D stands for decimal, 217\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and 218\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as 219their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and 220\.{CHARACTER}, have more complicated values that involve property lists. 221 222A property name is supposed to be used only in an appropriate property 223list. For example, \.{CHARWD} shouldn't occur on the outer level or 224within \.{FONTDIMEN}. 225 226The individual property-and-value pairs in a property list can appear in 227any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the example 228above, although the \.{TFM} file always puts the stretch parameter first. 229One could even give the information about characters like `\.f' before 230specifying the number of units in the design size, or before specifying the 231ligature and kerning table. However, the \.{LIGTABLE} itself is an exception 232to this rule; the individual elements of the \.{LIGTABLE} property list 233can be reordered only to a certain extent without changing the meaning 234of that table. 235 236If property-and-value pairs are omitted, a default value is used. For example, 237we have already noted that the default for \.{CHARDP} is zero. The default 238for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated 239below. 240 241If the same property name is used more than once, \.{VPtoVF} will not notice 242the discrepancy; it simply uses the final value given. Once again, however, the 243\.{LIGTABLE} is an exception to this rule; \.{VPtoVF} will complain if there 244is more than one label for some character. And of course many of the 245entries in the \.{LIGTABLE} property list have the same property name. 246 247@ A \.{VPL} file also includes information about how to create each character, 248by typesetting characters from other fonts and/or by drawing lines, etc. 249Such information is the value of the `\.{MAP}' property, which can be 250illustrated as follows: 251$$\vbox{\halign{\.{#}\hfil\cr 252(MAPFONT D 0 (FONTNAME Times-Roman))\cr 253(MAPFONT D 1 (FONTNAME Symbol))\cr 254(MAPFONT D 2 (FONTNAME cmr10)(FONTAT D 20))\cr 255(CHARACTER O 0 (MAP (SELECTFONT D 1)(SETCHAR C G)))\cr 256(CHARACTER O 76 (MAP (SETCHAR O 277)))\cr 257(CHARACTER D 197 (MAP\cr 258\qquad(PUSH)(SETCHAR C A)(POP)\cr 259\qquad(MOVEUP R 0.937)(MOVERIGHT R 1.5)(SETCHAR O 312)))\cr 260(CHARACTER O 200 (MAP (MOVEDOWN R 2.1)(SETRULE R 1 R 8)))\cr 261(CHARACTER O 201 (MAP\cr 262\qquad (SPECIAL ps: /SaveGray currentgray def .5 setgray)\cr 263\qquad (SELECTFONT D 2)(SETCHAR C A)\cr 264\qquad (SPECIAL ps: SaveGray setgray)))\cr 265}}$$ 266(These specifications appear in addition to the conventional \.{PL} 267information. The \.{MAP} attribute can be mixed in with other attributes 268like \.{CHARWD} or it can be given separately.) 269 270In this example, the virtual font is composed of characters that can be 271fabricated from three actual fonts, `\.{Times-Roman}', 272`\.{Symbol}', and `\.{cmr10} \.{at} \.{20\\u}' (where \.{\\u} 273is the unit size in this \.{VPL} file). Character |@'0| is typeset as 274a `G' from the symbol font. Character |@'76| is typeset as character |@'277| 275from the ordinary Times font. (If no other font is selected, font 276number~0 is the default. If no \.{MAP} attribute is given, the default map 277is a character of the same number in the default font.) 278 279Character 197 (decimal) is more interesting: First an A is typeset (in the 280default font Times), and this is enclosed by \.{PUSH} and \.{POP} so that 281the original position is restored. Then the accent character |@'312| is 282typeset, after moving up .937 units and right 1.5 units. 283 284To typeset character |@'200| in this virtual font, we move down 2.1 units, 285then typeset a rule that is 1 unit high and 8 units wide. 286 287Finally, to typeset character |@'201|, we do something that requires a 288special ability to interpret PostScript commands; this example 289sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A' 290from \.{cmr10} \.{at} \.{20\\u} in that color. 291 292In general, the \.{MAP} attribute of a virtual character can be any sequence 293of typesetting commands that might appear in a page of a \.{DVI} file. 294A single character might map into an entire page. 295 296@ But instead of relying on a hypothetical example, let's consider a complete 297grammar for \.{VPL} files, beginning with the (unchanged) grammatical rules 298for \.{PL} files. At the outer level, the following property names 299are valid in any \.{PL} file: 300 301\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a 302nonnegative integer less than $2^{32}$, is used to identify a particular 303version of a font; it should match the check sum value stored with the font 304itself. An explicit check sum of zero is used to bypass 305check sum testing. If no checksum is specified in the \.{VPL} file, 306\.{VPtoVF} will compute the checksum that \MF\ would compute from the 307same data. 308 309\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which 310should be a real number in the range |1.0<=x<2048|, represents the default 311amount by which all quantities will be scaled if the font is not loaded 312with an `\.{at}' specification. For example, if one says 313`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM} 314file is ignored and effectively replaced by 15 points; but if one simply 315says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is 316always in units of printer's points. 317 318\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value 319should be a positive real number; it says how many units equals the design 320size (or the eventual `\.{at}' size, if the font is being scaled). For 321example, suppose you have a font that has been digitized with 600 pixels per 322em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}' 323if you wanted to give all of your measurements in units of pixels. 324 325\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}'). 326The string should not contain parentheses, and its length must be less than 40. 327It identifies the correspondence between the numeric codes and font characters. 328(\TeX\ ignores this information, but other software programs make use of it.) 329 330\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}'). 331The string should not contain parentheses, and its length must be less than 20. 332It identifies the name of the family to which this font belongs, e.g., 333`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for 334example, when converting \.{DVI} files to \.{PRESS} files for Xerox 335equipment.) 336 337\yskip\hang\.{FACE} (one-byte value). This number, which must lie between 3380 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its 339family. For example, bold italic condensed fonts might have the same family name 340as light roman extended fonts, differing only in their face byte. (\TeX\ 341ignores this information; but it is needed, for example, when converting 342\.{DVI} files to \.{PRESS} files for Xerox equipment.) 343 344\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The 345value should start with either `\.T' (true) or `\.F' (false). If true, character 346codes less than 128 cannot lead to codes of 128 or more via ligatures or 347charlists or extensible characters. (\TeX82 ignores this flag, but older 348versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.) 349\.{VPtoVF} computes the correct value of this flag and gives an error message 350only if a claimed ``true'' value is incorrect. 351 352\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value). 353The one-byte value should be between 18 and a maximum limit that can be 354raised or lowered depending on the compile-time setting of |max_header_bytes|. 355The four-byte value goes into the header word whose index is the one-byte 356value; for example, to set |header[18]:=1|, one may write 357`\.{(HEADER D 18 O 1)}'. This notation is used for header information that 358is presently unnamed. (\TeX\ ignores it.) 359 360\yskip\hang\.{FONTDIMEN} (property list value). See below for the names 361allowed in this property list. 362 363\yskip\hang\.{LIGTABLE} (property list value). See below for the rules 364about this special kind of property list. 365 366\yskip\hang\.{BOUNDARYCHAR} (one-byte value). If this character appears in 367a \.{LIGTABLE} command, it matches ``end of word'' as well as itself. 368If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs 369within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning. 370 371\yskip\hang\.{CHARACTER}. The value is a one-byte integer followed by 372a property list. The integer represents the number of a character that is 373present in the font; the property list of a character is defined below. 374The default is an empty property list. 375 376@ Numeric property list values can be given in various forms identified by 377a prefixed letter. 378 379\yskip\hang\.C denotes an ASCII character, which should be a standard visible 380character that is not a parenthesis. The numeric value will therefore be 381between @'41 and @'176 but not @'50 or @'51. 382 383\yskip\hang\.D denotes an unsigned decimal integer, which must be 384less than $2^{32}$, i.e., at most `\.{D 4294967295}'. 385 386\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes 387are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC}, 388\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE}, 389\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively. 390 391\yskip\hang\.O denotes an unsigned octal integer, which must be less than 392$2^{32}$, i.e., at most `\.{O 37777777777}'. 393 394\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than 395$2^{32}$, i.e., at most `\.{H FFFFFFFF}'. 396 397\yskip\hang\.R denotes a real number in decimal notation, optionally preceded 398by a `\.+' or `\.-' sign, and optionally including a decimal point. The 399absolute value must be less than 2048. 400 401@ The property names allowed in a \.{FONTDIMEN} property list correspond to 402various \TeX\ parameters, each of which has a (real) numeric value. All 403of the parameters except \.{SLANT} are in design units. The admissible 404names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT}, 405\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1}, 406\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP}, 407\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters 4081~to~22. The alternate names \.{DEFAULTRULETHICKNESS}, 409\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3}, 410\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters 4118 to 13. 412 413The notation `\.{PARAMETER} $n$' provides another way to specify the 414$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way 415to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive 416and less than |max_param_words|. 417 418@ The elements of a \.{CHARACTER} property list can be of six different types. 419 420\yskip\hang\.{CHARWD} (real value) denotes the character's width in 421design units. 422 423\yskip\hang\.{CHARHT} (real value) denotes the character's height in 424design units. 425 426\yskip\hang\.{CHARDP} (real value) denotes the character's depth in 427design units. 428 429\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in 430design units. 431 432\yskip\hang\.{NEXTLARGER} (one-byte value), specifies the character that 433follows the present one in a ``charlist.'' The value must be the number of a 434character in the font, and there must be no infinite cycles of supposedly 435larger and larger characters. 436 437\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character. 438This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot 439both be used within the same \.{CHARACTER} list. 440 441\yskip\noindent 442The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID}, 443\.{BOT} or \.{REP}; the values are integers, which must be zero or the number 444of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means 445that the corresponding piece of the extensible character is absent. A nonzero 446value, or a \.{REP} value of zero, denotes the character code used to make 447up the top, middle, bottom, or replicated piece of an extensible character. 448 449@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a 450program in a simple command language that \TeX\ uses for ligatures and kerns. 451If several \.{LIGTABLE} lists appear, they are effectively concatenated into 452a single list. 453 454\yskip\hang\.{LABEL} (one-byte value) means that the program for the 455stated character value starts here. The integer must be the number of a 456character in the font; its \.{CHARACTER} property list must not have a 457\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step 458must follow. 459 460\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for 461beginning-of-word ligatures starts here. 462 463\yskip\hang\.{LIG} (two one-byte values). The instruction `\.{(LIG} $c$ $r$\.)' 464means, ``If the next character is $c$, then insert character~$r$ and 465possibly delete the current character and/or~$c$; 466otherwise go on to the next instruction.'' 467Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately 468preceded or followed by a slash, and then immediately followed by \.> 469characters not exceeding the number of slashes. Thus there are eight 470possible forms: 471$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil 472\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$ 473The slashes specify retention of the left or right original character; the 474\.> signs specify passing over the result without further ligature processing. 475 476\yskip\hang\.{KRN} (a one-byte value and a real value). The instruction 477`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert 478a blank space of width $r$ between the current character character and $c$; 479otherwise go on to the next intruction.'' The value of $r$, which is in 480design units, is often negative. Character code $c$ must exist 481in the font. 482 483\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program. 484It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL} 485or \.{STOP} or \.{SKIP}. 486 487\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies 488continuation of a ligature/kern program after the specified number of \.{LIG} 489or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and 490\.{KRN} instructions must therefore exceed this specified amount. 491 492@ In addition to all these possibilities, the property name \.{COMMENT} is 493allowed in any property list. Such comments are ignored. 494 495@ So that is what \.{PL} files hold. In a \.{VPL} file additional 496properties are recognized; two of these are valid on the outermost level: 497 498\yskip\hang\.{VTITLE} (string value, default is empty). The value will be 499reproduced at the beginning of the \.{VF} file (and printed on the terminal 500by \.{VFtoVP} when it examines that file). 501 502\yskip\hang\.{MAPFONT}. The value is a nonnegative integer followed by 503a property list. The integer represents an identifying number for fonts 504used in \.{MAP} attributes. The property list, which identifies the font and 505relative size, is defined below. 506 507\yskip\noindent 508And one additional ``virtual property'' is valid within a \.{CHARACTER}: 509 510\yskip\hang\.{MAP}. The value is a property list consisting of typesetting 511commands. Default is the single command \.{SETCHAR}~$c$, where $c$ is 512the current character number. 513 514@ The elements of a \.{MAPFONT} property list can be of the following types. 515 516\yskip\hang\.{FONTNAME} (string value, default is \.{NULL}). 517This is the font's identifying name. 518 519\yskip\hang\.{FONTAREA} (string value, default is empty). If the font appears 520in a nonstandard directory, according to local conventions, the directory 521name is given here. (This is system dependent, just as in \.{DVI} files.) 522 523\yskip\hang\.{FONTCHECKSUM} (four-byte value, default is zero). This value, 524which should be a nonnegative integer less than $2^{32}$, can be used to 525check that the font being referred to matches the intended font. If nonzero, 526it should equal the \.{CHECKSUM} parameter in that font. 527 528\yskip\hang\.{FONTAT} (numeric value, default is the \.{DESIGNUNITS} of the 529present virtual font). This value is relative to the design units of 530the present virtual font, hence it will be scaled when the virtual 531font is magnified or reduced. It represents the value that will 532effectively replace the design size of the font being referred to, 533so that all characters will be scaled appropriately. 534 535\yskip\hang\.{FONTDSIZE} (numeric value, default is 10). This value is 536absolute, in units of printer's points. It should equal the \.{DESIGNSIZE} 537parameter in the font being referred to. 538 539\yskip\noindent 540If any of the 541string values contain parentheses, the parentheses must be balanced. Leading 542blanks are removed from the strings, but trailing blanks are not. 543 544@ Finally, the elements of a \.{MAP} property list are an ordered sequence 545of typesetting commands chosen from among the following: 546 547\yskip\hang\.{SELECTFONT} (four-byte integer value). The value must be the 548number of a previously defined \.{MAPFONT}. This font (or more precisely, the 549final font that is mapped to that code number, if two \.{MAPFONT} properties 550happen to specify the same code) will be used in subsequent \.{SETCHAR} 551instructions until overridden by another \.{SELECTFONT}. The first-specified 552\.{MAPFONT} is implicitly selected before the first \.{SELECTFONT} in every 553character's map. 554 555\yskip\hang\.{SETCHAR} (one-byte integer value). There must be a character of 556this number in the currently selected font. (\.{VPtoVF} doesn't check that 557the character is valid, but \.{VFtoVP} does.) That character is typeset at the 558current position, and the typesetter moves right by the \.{CHARWD} in 559that character's \.{TFM} file. 560 561\yskip\hang\.{SETRULE} (two real values). The first value specifies height, 562the second specifies width, in design units. If both height and width are 563positive, a rule is typeset at the current position. Then the typesetter 564moves right, by the specified width. 565 566\yskip\hang\.{MOVERIGHT}, \.{MOVELEFT}, \.{MOVEUP}, \.{MOVEDOWN} (real 567value). The typesetter moves its current position 568by the number of design units specified. 569 570\yskip\hang\.{PUSH}. The current typesetter position is remembered, to 571be restored on a subsequent \.{POP}. 572 573\yskip\hang\.{POP}. The current typesetter position is reset to where it 574was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP} 575commands in any \.{MAP} must be properly nested like balanced parentheses. 576 577\yskip\hang\.{SPECIAL} (string value). The subsequent characters, starting 578with the first nonblank and ending just before the first `\.)' that has no 579matching `\.(', are interpreted according to local conventions with the 580same system-dependent meaning as a `special' (\\{xxx}) command 581in a \.{DVI} file. 582 583\yskip\hang\.{SPECIALHEX} (hexadecimal string value). The subsequent 584nonblank characters before the next `\.)' must consist entirely of 585hexadecimal digits, and they must contain an even number of such digits. 586Each pair of hex digits specifies a byte, and this string of bytes is 587treated just as the value of a \.{SPECIAL}. (This convention permits 588arbitrary byte strings to be represented in an ordinary text file.) 589 590@ Virtual font mapping is a recursive process, like macro expansion. 591Thus, a \.{MAPFONT} might 592specify another virtual font, whose characters are themselves mapped to 593other fonts. As an example of this possibility, consider the 594following curious file called \.{recurse.vpl}, which defines a 595virtual font that is self-contained and self-referential: 596$$\vbox{\halign{\.{#}\cr 597(VTITLE Example of recursion)\cr 598(MAPFONT D 0 (FONTNAME recurse)(FONTAT D 2))\cr 599(CHARACTER C A (CHARWD D 1)(CHARHT D 1)(MAP (SETRULE D 1 D 1)))\cr 600(CHARACTER C B (CHARWD D 2)(CHARHT D 2)(MAP (SETCHAR C A)))\cr 601(CHARACTER C C (CHARWD D 4)(CHARHT D 4)(MAP (SETCHAR C B)))\cr 602}}$$ 603The design size is 10 points (the default), hence the character \.A 604in font \.{recurse} is a $10\times10$ point black square. Character \.B 605is typeset as character \.A in \.{recurse} {scaled} {2000}, hence it 606is a $20\times20$ point black square. And character \.C is typeset as 607character \.{B} in \.{recurse} {scaled} {2000}, hence its size is 608$40\times40$. 609 610Users are responsible for making sure that infinite recursion doesn't happen. 611 612@ So that is what \.{VPL} files hold. From these rules, 613you can guess (correctly) that \.{VPtoVF} operates in four main stages. 614First it assigns the default values to all properties; then it scans 615through the \.{VPL} file, changing property values as new ones are seen; then 616it checks the information and corrects any problems; and finally it outputs 617the \.{VF} and \.{TFM} files. 618 619@ The next question is, ``What are \.{VF} and 620\.{TFM} files?'' A complete answer to that question appears in the 621documentation of the companion programs, \.{VFtoVP} and 622\.{TFtoPL}, so the details will not 623be repeated here. Suffice it to say that a \.{VF} or 624\.{TFM} file stores all of the 625relevant font information in a sequence of 8-bit bytes. The number of 626bytes is always a multiple of 4, so we could regard the files 627as sequences of 32-bit words; but \TeX\ uses the byte interpretation, 628and so does \.{VPtoVF}. Note that the bytes are considered to be unsigned 629numbers. 630 631@<Glob...@>= 632@!vf_file:packed file of 0..255; 633@!tfm_file:packed file of 0..255; 634 635@ On some systems you may have to do something special to write a 636packed file of bytes. For example, the following code didn't work 637when it was first tried at Stanford, because packed files have to be 638opened with a special switch setting on the \PASCAL\ that was used. 639@^system dependencies@> 640 641@<Set init...@>= 642rewrite(vf_file); rewrite(tfm_file); 643 644@* Basic input routines. 645For the purposes of this program, a |byte| is an unsigned eight-bit quantity, 646and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes 647correspond to one-character constants like \.{"A"} in \.{WEB} language. 648 649@<Types...@>= 650@!byte=0..255; {unsigned eight-bit quantity} 651@!ASCII_code=@'40..@'177; {standard ASCII code numbers} 652 653@ One of the things \.{VPtoVF} has to do is convert characters of strings 654to ASCII form, since that is the code used for the family name and the 655coding scheme in a \.{TFM} file. An array |xord| is used to do the 656conversion from |char|; the method below should work with little or no change 657on most \PASCAL\ systems. 658@^system dependencies@> 659 660@d first_ord=0 {ordinal number of the smallest element of |char|} 661@d last_ord=127 {ordinal number of the largest element of |char|} 662 663@<Global...@>= 664@!xord:array[char] of ASCII_code; {conversion table} 665 666@ @<Local variables for init...@>= 667@!k:integer; {all-purpose initialization index} 668 669@ Characters that should not appear in \.{VPL} files (except in comments) 670are mapped into @'177. 671 672@d invalid_code=@'177 {code deserving an error message} 673 674@<Set init...@>= 675for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; 676xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#"; 677xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'"; 678xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=","; 679xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1"; 680xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6"; 681xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";"; 682xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?"; 683xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C"; 684xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H"; 685xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M"; 686xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R"; 687xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W"; 688xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\"; 689xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a"; 690xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f"; 691xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k"; 692xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p"; 693xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u"; 694xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z"; 695xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~"; 696 697@ In order to help catch errors of badly nested parentheses, \.{VPtoVF} 698assumes that the user will begin each line with a number of blank spaces equal 699to some constant times the number of open parentheses at the beginning of 700that line. However, the program doesn't know in advance what the constant 701is, nor does it want to print an error message on every line for a user 702who has followed no consistent pattern of indentation. 703 704Therefore the following strategy is adopted: If the user has been consistent 705with indentation for ten or more lines, an indentation error will be 706reported. The constant of indentation is reset on every line that should 707have nonzero indentation. 708 709@<Glob...@>= 710@!line:integer; {the number of the current line} 711@!good_indent:integer; {the number of lines since the last bad indentation} 712@!indent: integer; {the number of spaces per open parenthesis, zero if unknown} 713@!level: integer; {the current number of open parentheses} 714 715@ @<Set init...@>= 716line:=0; good_indent:=0; indent:=0; level:=0; 717 718@ The input need not really be broken into lines of any maximum length, and 719we could read it character by character without any buffering. But we shall 720place it into a small buffer so that offending lines can be displayed in error 721messages. 722 723@<Glob...@>= 724@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer 725 at end-of-line marks?} 726@!limit:0..buf_size; {position of the last character present in the buffer} 727@!loc:0..buf_size; {position of the last character read in the buffer} 728@!buffer:array[1..buf_size] of char; 729@!input_has_ended:boolean; {there is no more input to read} 730 731@ @<Set init...@>= 732limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false; 733 734@ Just before each \.{CHARACTER} property list is evaluated, the character 735code is printed in octal notation. Up to eight such codes appear on a line; 736so we have a variable to keep track of how many are currently there. 737 738@<Glob...@>= 739@!chars_on_line:0..8; {the number of characters printed on the current line} 740 741@ @<Set init...@>= 742chars_on_line:=0; 743 744@ The following routine prints an error message and an indication of 745where the error was detected. The error message should not include any 746final punctuation, since this procedure supplies its own. 747 748@d err_print(#)==begin if chars_on_line>0 then print_ln(' '); 749 print(#); show_error_context; 750 end 751 752@p procedure show_error_context; {prints the current scanner location} 753var k:0..buf_size; {an index into |buffer|} 754begin print_ln(' (line ',line:1,').'); 755if not left_ln then print('...'); 756for k:=1 to loc do print(buffer[k]); {print the characters already scanned} 757print_ln(' '); 758if not left_ln then print(' '); 759for k:=1 to loc do print(' '); {space out the second line} 760for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen} 761if right_ln then print_ln(' ')@+else print_ln('...'); 762chars_on_line:=0; 763end; 764 765@ Here is a procedure that does the right thing when we are done 766reading the present contents of the buffer. It keeps |buffer[buf_size]| 767empty, in order to avoid range errors on certain \PASCAL\ compilers. 768 769An infinite sequence of right parentheses is placed at the end of the 770file, so that the program is sure to get out of whatever level of nesting 771it is in. 772 773On some systems it is desirable to modify this code so that tab marks 774in the buffer are replaced by blank spaces. (Simply setting 775|xord[chr(@'11)]:=" "| would not work; for example, two-line 776error messages would not come out properly aligned.) 777@^system dependencies@> 778 779@p procedure fill_buffer; 780begin left_ln:=right_ln; limit:=0; loc:=0; 781if left_ln then 782 begin if line>0 then read_ln(vpl_file); 783 incr(line); 784 end; 785if eof(vpl_file) then 786 begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true; 787 end 788else begin while (limit<buf_size-2)and(not eoln(vpl_file)) do 789 begin incr(limit); read(vpl_file,buffer[limit]); 790 end; 791 buffer[limit+1]:=' '; right_ln:=eoln(vpl_file); 792 if right_ln then begin incr(limit); buffer[limit+1]:=' '; 793 end; 794 if left_ln then @<Set |loc| to the number of leading blanks in 795 the buffer, and check the indentation@>; 796 end; 797end; 798 799@ The interesting part about |fill_buffer| is the part that learns what 800indentation conventions the user is following, if any. 801 802@d bad_indent(#)==begin if good_indent>=10 then err_print(#); 803 good_indent:=0; indent:=0; 804 end 805 806@<Set |loc|...@>= 807begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc); 808if loc<limit then 809 begin if level=0 then 810 if loc=0 then incr(good_indent) 811 else bad_indent('Warning: Indented line occurred at level zero') 812@.Warning: Indented line...@> 813 else if indent=0 then 814 if loc mod level=0 then 815 begin indent:=loc div level; good_indent:=1; 816 end 817 else good_indent:=0 818 else if indent*level=loc then incr(good_indent) 819 else bad_indent('Warning: Inconsistent indentation; ', 820@.Warning: Inconsistent indentation...@> 821 'you are at parenthesis level ',level:1); 822 end; 823end 824 825@* Basic scanning routines. 826The global variable |cur_char| holds the ASCII code corresponding to the 827character most recently read from the input buffer, or to a character that 828has been substituted for the real one. 829 830@<Global...@>= 831@!cur_char:ASCII_code; {we have just read this} 832 833@ Here is a procedure that sets |cur_char| to an ASCII code for the 834next character of input, if that character is a letter or digit or slash 835or \.>. Otherwise 836it sets |cur_char:=" "|, and the input system will be poised to reread the 837character that was rejected, whether or not it was a space. 838Lower case letters are converted to upper case. 839 840@p procedure get_keyword_char; 841begin while (loc=limit)and(not right_ln) do fill_buffer; 842if loc=limit then cur_char:=" " {end-of-line counts as a delimiter} 843else begin cur_char:=xord[buffer[loc+1]]; 844 if cur_char>="a" then cur_char:=cur_char-@'40; 845 if ((cur_char>="0")and(cur_char<="9")) then incr(loc) 846 else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc) 847 else if cur_char="/" then incr(loc) 848 else if cur_char=">" then incr(loc) 849 else cur_char:=" "; 850 end; 851end; 852 853@ The following procedure sets |cur_char| to the next character code, 854and converts lower case to upper case. If the character is a left or 855right parenthesis, it will not be ``digested''; the character will 856be read again and again, until the calling routine does something 857like `|incr(loc)|' to get past it. Such special treatment of parentheses 858insures that the structural information they contain won't be lost in 859the midst of other error recovery operations. 860 861@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc); 862 end {undoes the effect of |get_next|} 863 864@p procedure get_next; {sets |cur_char| to next, balks at parentheses} 865begin while loc=limit do fill_buffer; 866incr(loc); cur_char:=xord[buffer[loc]]; 867if cur_char>="a" then 868 if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify} 869 else begin if cur_char=invalid_code then 870 begin err_print('Illegal character in the file'); 871@.Illegal character...@> 872 cur_char:="?"; 873 end; 874 end 875else if (cur_char<=")")and(cur_char>="(") then decr(loc); 876end; 877 878@ Here's a procedure that scans a hexadecimal digit or a right parenthesis. 879 880@p function get_hex:byte; 881var @!a:integer; {partial result} 882begin repeat get_next; 883until cur_char<>" "; 884a:=cur_char-")"; 885if a>0 then 886 begin a:=cur_char-"0"; 887 if cur_char>"9" then 888 if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10; 889 end; 890if (a<0)or(a>15) then 891 begin err_print('Illegal hexadecimal digit'); get_hex:=0; 892@.Illegal hexadecimal digit@> 893 end 894else get_hex:=a; 895end; 896 897@ The next procedure is used to ignore the text of a comment, or to pass over 898erroneous material. As such, it has the privilege of passing parentheses. 899It stops after the first right parenthesis that drops the level below 900the level in force when the procedure was called. 901 902@p procedure skip_to_end_of_item; 903var l:integer; {initial value of |level|} 904begin l:=level; 905while level>=l do 906 begin while loc=limit do fill_buffer; 907 incr(loc); 908 if buffer[loc]=')' then decr(level) 909 else if buffer[loc]='(' then incr(level); 910 end; 911if input_has_ended then err_print('File ended unexpectedly: No closing ")"'); 912@.File ended unexpectedly...@> 913cur_char:=" "; {now the right parenthesis has been read and digested} 914end; 915 916@ A similar procedure copies the bytes remaining in an item. The copied bytes 917go into an array |vf| that we'll declare later. Leading blanks are ignored. 918 919@d vf_store(#)== 920 begin vf[vf_ptr]:=#; 921 if vf_ptr=vf_size then err_print('I''m out of memory---increase my vfsize!') 922@.I'm out of memory...@> 923 else incr(vf_ptr); 924 end 925 926@p procedure copy_to_end_of_item; 927label 30; 928var l:integer; {initial value of |level|} 929@!nonblank_found:boolean; {have we seen a nonblank character yet?} 930begin l:=level; nonblank_found:=false; 931while true do 932 begin while loc=limit do fill_buffer; 933 if buffer[loc+1]=')' then 934 if level=l then goto 30@+else decr(level); 935 incr(loc); 936 if buffer[loc]='(' then incr(level); 937 if buffer[loc]<>' ' then nonblank_found:=true; 938 if nonblank_found then 939 if xord[buffer[loc]]=invalid_code then 940 begin err_print('Illegal character in the file'); 941@.Illegal character...@> 942 vf_store("?"); 943 end 944 else vf_store(xord[buffer[loc]]); 945 end; 94630:end; 947 948@ Sometimes we merely want to skip past characters in the input until we 949reach a left or a right parenthesis. For example, we do this whenever we 950have finished scanning a property value and we hope that a right parenthesis 951is next (except for possible blank spaces). 952 953@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")") 954@d skip_error(#)==begin err_print(#); skip_to_paren; 955 end {this gets to the right parenthesis if something goes wrong} 956@d flush_error(#)==begin err_print(#); skip_to_end_of_item; 957 end {this gets past the right parenthesis if something goes wrong} 958 959@ After a property value has been scanned, we want to move just past the 960right parenthesis that should come next in the input (except for possible 961blank spaces). 962 963@p procedure finish_the_property; {do this when the value has been scanned} 964begin while cur_char=" " do get_next; 965if cur_char<>")" then err_print('Junk after property value will be ignored'); 966@.Junk after property value...@> 967skip_to_end_of_item; 968end; 969 970@* Scanning property names. 971We have to figure out the meaning of names that appear in the \.{VPL} file, 972by looking them up in a dictionary of known keywords. Keyword number $n$ 973appears in locations |start[n]| through |start[n+1]-1| of an array called 974|dictionary|. 975 976@d max_name_index=100 {upper bound on the number of keywords} 977@d max_letters=666 {upper bound on the total length of all keywords} 978 979@<Global...@>= 980@!start:array[1..max_name_index] of 0..max_letters; 981@!dictionary:array[0..max_letters] of ASCII_code; 982@!start_ptr:0..max_name_index; {the first available place in |start|} 983@!dict_ptr:0..max_letters; {the first available place in |dictionary|} 984 985@ @<Set init...@>= 986start_ptr:=1; start[1]:=0; dict_ptr:=0; 987 988@ When we are looking for a name, we put it into the |cur_name| array. 989When we have found it, the corresponding |start| index will go into 990the global variable |name_ptr|. 991 992@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}} 993 994@<Glob...@>= 995@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up} 996@!name_length:0..longest_name; {its length} 997@!name_ptr:0..max_name_index; {its ordinal number in the dictionary} 998 999@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L 1000in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary 1001operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]| 1002points into the |start| array. 1003 1004@d hash_prime=141 {size of the hash table} 1005 1006@<Glob...@>= 1007@!nhash:array[0..hash_prime-1] of 0..max_name_index; 1008@!cur_hash:0..hash_prime-1; {current position in the hash table} 1009 1010@ @<Local...@>= 1011@!h:0..hash_prime-1; {runs through the hash table} 1012 1013@ @<Set init...@>= 1014for h:=0 to hash_prime-1 do nhash[h]:=0; 1015 1016@ Since there is no chance of the hash table overflowing, the procedure 1017is very simple. After |lookup| has done its work, |cur_hash| will point 1018to the place where the given name was found, or where it should be inserted. 1019 1020@p procedure lookup; {finds |cur_name| in the dictionary} 1021var k:0..longest_name; {index into |cur_name|} 1022@!j:0..max_letters; {index into |dictionary|} 1023@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement} 1024begin @<Compute the hash code, |cur_hash|, for |cur_name|@>; 1025not_found:=true; 1026while not_found do 1027 begin if cur_hash=0 then cur_hash:=hash_prime-1@+else decr(cur_hash); 1028 if nhash[cur_hash]=0 then not_found:=false 1029 else begin j:=start[nhash[cur_hash]]; 1030 if start[nhash[cur_hash]+1]=j+name_length then 1031 begin not_found:=false; 1032 for k:=1 to name_length do 1033 if dictionary[j+k-1]<>cur_name[k] then not_found:=true; 1034 end; 1035 end; 1036 end; 1037name_ptr:=nhash[cur_hash]; 1038end; 1039 1040@ @<Compute the hash...@>= 1041cur_hash:=cur_name[1]; 1042for k:=2 to name_length do 1043 cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime 1044 1045@ The ``meaning'' of the keyword that begins at |start[k]| in the 1046dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given 1047symbolic meanings by the following definitions. 1048 1049@d comment_code=0 1050@d check_sum_code=1 1051@d design_size_code=2 1052@d design_units_code=3 1053@d coding_scheme_code=4 1054@d family_code=5 1055@d face_code=6 1056@d seven_bit_safe_flag_code=7 1057@d header_code= 8 1058@d font_dimen_code=9 1059@d lig_table_code=10 1060@d boundary_char_code=11 1061@d virtual_title_code=12 1062@d map_font_code=13 1063@d character_code=14 1064@d font_name_code=20 1065@d font_area_code=21 1066@d font_checksum_code=22 1067@d font_at_code=23 1068@d font_dsize_code=24 1069@d parameter_code=30 1070@d char_info_code=60 1071@d width=1 1072@d height=2 1073@d depth=3 1074@d italic=4 1075@d char_wd_code=char_info_code+width 1076@d char_ht_code=char_info_code+height 1077@d char_dp_code=char_info_code+depth 1078@d char_ic_code=char_info_code+italic 1079@d next_larger_code=65 1080@d map_code=66 1081@d var_char_code=67 1082@d select_font_code=80 1083@d set_char_code=81 1084@d set_rule_code=82 1085@d move_right_code=83 1086@d move_down_code=85 1087@d push_code=87 1088@d pop_code=88 1089@d special_code=89 1090@d special_hex_code=90 1091@d label_code=100 1092@d stop_code=101 1093@d skip_code=102 1094@d krn_code=103 1095@d lig_code=104 1096 1097@<Glo...@>= 1098@!equiv:array[0..max_name_index] of byte; 1099@!cur_code:byte; {equivalent most recently found in |equiv|} 1100 1101@ We have to get the keywords into the hash table and into the dictionary in 1102the first place (sigh). The procedure that does this has the desired 1103|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing 1104for the initialization, the keyword being initialized is placed into the 1105last positions of |cur_name|, instead of the first positions. 1106 1107@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary} 1108var k:0..longest_name; 1109begin for k:=1 to name_length do 1110 cur_name[k]:=cur_name[k+longest_name-name_length]; 1111{now the name has been shifted into the correct position} 1112lookup; {this sets |cur_hash| to the proper insertion place} 1113nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v; 1114for k:=1 to name_length do 1115 begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr); 1116 end; 1117incr(start_ptr); start[start_ptr]:=dict_ptr; 1118end; 1119 1120@ Here are the macros to load a name of up to 20 letters into the 1121dictionary. For example, the macro |load5| is used for five-letter keywords. 1122 1123@d tail(#)==enter_name(#) 1124@d t20(#)==cur_name[20]:=#;tail 1125@d t19(#)==cur_name[19]:=#;t20 1126@d t18(#)==cur_name[18]:=#;t19 1127@d t17(#)==cur_name[17]:=#;t18 1128@d t16(#)==cur_name[16]:=#;t17 1129@d t15(#)==cur_name[15]:=#;t16 1130@d t14(#)==cur_name[14]:=#;t15 1131@d t13(#)==cur_name[13]:=#;t14 1132@d t12(#)==cur_name[12]:=#;t13 1133@d t11(#)==cur_name[11]:=#;t12 1134@d t10(#)==cur_name[10]:=#;t11 1135@d t9(#)==cur_name[9]:=#;t10 1136@d t8(#)==cur_name[8]:=#;t9 1137@d t7(#)==cur_name[7]:=#;t8 1138@d t6(#)==cur_name[6]:=#;t7 1139@d t5(#)==cur_name[5]:=#;t6 1140@d t4(#)==cur_name[4]:=#;t5 1141@d t3(#)==cur_name[3]:=#;t4 1142@d t2(#)==cur_name[2]:=#;t3 1143@d t1(#)==cur_name[1]:=#;t2 1144@d load3==name_length:=3;t18 1145@d load4==name_length:=4;t17 1146@d load5==name_length:=5;t16 1147@d load6==name_length:=6;t15 1148@d load7==name_length:=7;t14 1149@d load8==name_length:=8;t13 1150@d load9==name_length:=9;t12 1151@d load10==name_length:=10;t11 1152@d load11==name_length:=11;t10 1153@d load12==name_length:=12;t9 1154@d load13==name_length:=13;t8 1155@d load14==name_length:=14;t7 1156@d load15==name_length:=15;t6 1157@d load16==name_length:=16;t5 1158@d load17==name_length:=17;t4 1159@d load18==name_length:=18;t3 1160@d load19==name_length:=19;t2 1161@d load20==name_length:=20;t1 1162 1163@ (Thank goodness for keyboard macros in the text editor used to create this 1164\.{WEB} file.) 1165 1166@<Enter all the \.{PL} names and their equivalents, 1167 except the parameter names@>= 1168equiv[0]:=comment_code; {this is used after unknown keywords} 1169load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/ 1170load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/ 1171load11("D")("E")("S")("I")("G")("N") 1172 ("U")("N")("I")("T")("S")(design_units_code);@/ 1173load12("C")("O")("D")("I")("N")("G") 1174 ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/ 1175load6("F")("A")("M")("I")("L")("Y")(family_code);@/ 1176load4("F")("A")("C")("E")(face_code);@/ 1177load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@> 1178 ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/ 1179load6("H")("E")("A")("D")("E")("R")(header_code);@/ 1180load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/ 1181load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/ 1182load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R") 1183 (boundary_char_code);@/ 1184load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/ 1185load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/ 1186load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/ 1187load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/ 1188load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/ 1189load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/ 1190load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/ 1191load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/ 1192load3("T")("O")("P")(var_char_code+1);@/ 1193load3("M")("I")("D")(var_char_code+2);@/ 1194load3("B")("O")("T")(var_char_code+3);@/ 1195load3("R")("E")("P")(var_char_code+4);@/ 1196load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format} 1197load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/ 1198load5("L")("A")("B")("E")("L")(label_code);@/ 1199load4("S")("T")("O")("P")(stop_code);@/ 1200load4("S")("K")("I")("P")(skip_code);@/ 1201load3("K")("R")("N")(krn_code);@/ 1202load3("L")("I")("G")(lig_code);@/ 1203load4("/")("L")("I")("G")(lig_code+2);@/ 1204load5("/")("L")("I")("G")(">")(lig_code+6);@/ 1205load4("L")("I")("G")("/")(lig_code+1);@/ 1206load5("L")("I")("G")("/")(">")(lig_code+5);@/ 1207load5("/")("L")("I")("G")("/")(lig_code+3);@/ 1208load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/ 1209load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/ 1210 1211@ \.{VPL} files may contain the following in addition to the \.{PL} names. 1212 1213@<Enter all the \.{VPL} names@>= 1214load6("V")("T")("I")("T")("L")("E")(virtual_title_code);@/ 1215load7("M")("A")("P")("F")("O")("N")("T")(map_font_code);@/ 1216load3("M")("A")("P")(map_code);@/ 1217load8("F")("O")("N")("T")("N")("A")("M")("E")(font_name_code);@/ 1218load8("F")("O")("N")("T")("A")("R")("E")("A")(font_area_code);@/ 1219load12("F")("O")("N")("T") 1220 ("C")("H")("E")("C")("K")("S")("U")("M")(font_checksum_code);@/ 1221load6("F")("O")("N")("T")("A")("T")(font_at_code);@/ 1222load9("F")("O")("N")("T")("D")("S")("I")("Z")("E")(font_dsize_code);@/ 1223load10("S")("E")("L")("E")("C")("T")("F")("O")("N")("T")(select_font_code);@/ 1224load7("S")("E")("T")("C")("H")("A")("R")(set_char_code);@/ 1225load7("S")("E")("T")("R")("U")("L")("E")(set_rule_code);@/ 1226load9("M")("O")("V")("E")("R")("I")("G")("H")("T")(move_right_code);@/ 1227load8("M")("O")("V")("E")("L")("E")("F")("T")(move_right_code+1);@/ 1228load8("M")("O")("V")("E")("D")("O")("W")("N")(move_down_code);@/ 1229load6("M")("O")("V")("E")("U")("P")(move_down_code+1);@/ 1230load4("P")("U")("S")("H")(push_code);@/ 1231load3("P")("O")("P")(pop_code);@/ 1232load7("S")("P")("E")("C")("I")("A")("L")(special_code);@/ 1233load10("S")("P")("E")("C")("I")("A")("L")("H")("E")("X")(special_hex_code);@/ 1234 1235@ @<Enter the parameter names@>= 1236load5("S")("L")("A")("N")("T")(parameter_code+1);@/ 1237load5("S")("P")("A")("C")("E")(parameter_code+2);@/ 1238load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/ 1239load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/ 1240load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/ 1241load4("Q")("U")("A")("D")(parameter_code+6);@/ 1242load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/ 1243load4("N")("U")("M")("1")(parameter_code+8);@/ 1244load4("N")("U")("M")("2")(parameter_code+9);@/ 1245load4("N")("U")("M")("3")(parameter_code+10);@/ 1246load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/ 1247load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/ 1248load4("S")("U")("P")("1")(parameter_code+13);@/ 1249load4("S")("U")("P")("2")(parameter_code+14);@/ 1250load4("S")("U")("P")("3")(parameter_code+15);@/ 1251load4("S")("U")("B")("1")(parameter_code+16);@/ 1252load4("S")("U")("B")("2")(parameter_code+17);@/ 1253load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/ 1254load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/ 1255load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/ 1256load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/ 1257load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/ 1258load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@> 1259 ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/ 1260load13("B")("I")("G")("O")("P") 1261 ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/ 1262load13("B")("I")("G")("O")("P") 1263 ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/ 1264load13("B")("I")("G")("O")("P") 1265 ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/ 1266load13("B")("I")("G")("O")("P") 1267 ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/ 1268load13("B")("I")("G")("O")("P") 1269 ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/ 1270 1271@ When a left parenthesis has been scanned, the following routine 1272is used to interpret the keyword that follows, and to store the 1273equivalent value in |cur_code|. 1274 1275@p procedure get_name; 1276begin incr(loc); incr(level); {pass the left parenthesis} 1277cur_char:=" "; 1278while cur_char=" " do get_next; 1279if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character} 1280name_length:=0; get_keyword_char; {prepare to scan the name} 1281while cur_char<>" " do 1282 begin if name_length=longest_name then cur_name[1]:="X" {force error} 1283 else incr(name_length); 1284 cur_name[name_length]:=cur_char; 1285 get_keyword_char; 1286 end; 1287lookup; 1288if name_ptr=0 then err_print('Sorry, I don''t know that property name'); 1289@.Sorry, I don't know...@> 1290cur_code:=equiv[name_ptr]; 1291end; 1292 1293@* Scanning numeric data. 1294The next thing we need is a trio of subroutines to read the one-byte, 1295four-byte, and real numbers that may appear as property values. 1296These subroutines are careful to stick to numbers between $-2^{31}$ 1297and $2^{31}-1$, inclusive, so that a computer with two's complement 129832-bit arithmetic will not be interrupted by overflow. 1299 1300@ The first number scanner, which returns a one-byte value, surely has 1301no problems of arithmetic overflow. 1302 1303@p function get_byte:byte; {scans a one-byte property value} 1304var acc:integer; {an accumulator} 1305@!t:ASCII_code; {the type of value to be scanned} 1306begin repeat get_next; 1307until cur_char<>" "; {skip the blanks before the type code} 1308t:=cur_char; acc:=0; 1309repeat get_next; 1310until cur_char<>" "; {skip the blanks after the type code} 1311if t="C" then @<Scan an ASCII character code@> 1312else if t="D" then @<Scan a small decimal number@> 1313else if t="O" then @<Scan a small octal number@> 1314else if t="H" then @<Scan a small hexadecimal number@> 1315else if t="F" then @<Scan a face code@> 1316else skip_error('You need "C" or "D" or "O" or "H" or "F" here'); 1317@.You need "C" or "D" ...here@> 1318cur_char:=" "; get_byte:=acc; 1319end; 1320 1321@ The |get_next| routine converts lower case to upper case, but it leaves 1322the character in the buffer, so we can unconvert it. 1323 1324@<Scan an ASCII...@>= 1325if (cur_char>=@'41)and(cur_char<=@'176)and 1326 ((cur_char<"(")or(cur_char>")")) then 1327 acc:=xord[buffer[loc]] 1328else skip_error('"C" value must be standard ASCII and not a paren') 1329@:C value}\.{"C" value must be...@> 1330 1331@ @<Scan a small dec...@>= 1332begin while (cur_char>="0")and(cur_char<="9") do 1333 begin acc:=acc*10+cur_char-"0"; 1334 if acc>255 then 1335 begin skip_error('This value shouldn''t exceed 255'); 1336@.This value shouldn't...@> 1337 acc:=0; cur_char:=" "; 1338 end 1339 else get_next; 1340 end; 1341backup; 1342end 1343 1344@ @<Scan a small oct...@>= 1345begin while (cur_char>="0")and(cur_char<="7") do 1346 begin acc:=acc*8+cur_char-"0"; 1347 if acc>255 then 1348 begin skip_error('This value shouldn''t exceed ''377'); 1349@.This value shouldn't...@> 1350 acc:=0; cur_char:=" "; 1351 end 1352 else get_next; 1353 end; 1354backup; 1355end 1356 1357@ @<Scan a small hex...@>= 1358begin while ((cur_char>="0")and(cur_char<="9"))or 1359 ((cur_char>="A")and(cur_char<="F")) do 1360 begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; 1361 acc:=acc*16+cur_char-"0"; 1362 if acc>255 then 1363 begin skip_error('This value shouldn''t exceed "FF'); 1364@.This value shouldn't...@> 1365 acc:=0; cur_char:=" "; 1366 end 1367 else get_next; 1368 end; 1369backup; 1370end 1371 1372@ @<Scan a face...@>= 1373begin if cur_char="B" then acc:=2 1374else if cur_char="L" then acc:=4 1375else if cur_char<>"M" then acc:=18; 1376get_next; 1377if cur_char="I" then incr(acc) 1378else if cur_char<>"R" then acc:=18; 1379get_next; 1380if cur_char="C" then acc:=acc+6 1381else if cur_char="E" then acc:=acc+12 1382else if cur_char<>"R" then acc:=18; 1383if acc>=18 then 1384 begin skip_error('Illegal face code, I changed it to MRR'); 1385@.Illegal face code...@> 1386 acc:=0; 1387 end; 1388end 1389 1390@ The routine that scans a four-byte value puts its output into |cur_bytes|, 1391which is a record containing (yes, you guessed it) four bytes. 1392 1393@<Types...@>= 1394@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end; 1395 1396@ @d c0==cur_bytes.b0 1397@d c1==cur_bytes.b1 1398@d c2==cur_bytes.b2 1399@d c3==cur_bytes.b3 1400 1401@<Glob...@>= 1402@!cur_bytes:four_bytes; {a four-byte accumulator} 1403@!zero_bytes:four_bytes; {four bytes all zero} 1404 1405@ @<Set init...@>= 1406zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0; 1407 1408@ Since the |get_four_bytes| routine is used very infrequently, no attempt 1409has been made to make it fast; we only want it to work. 1410 1411@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|} 1412var c:integer; {local two-byte accumulator} 1413@!r:integer; {radix} 1414begin repeat get_next; 1415until cur_char<>" "; {skip the blanks before the type code} 1416r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero} 1417if cur_char="H" then r:=16 1418else if cur_char="O" then r:=8 1419else if cur_char="D" then r:=10 1420else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here'); 1421@.Decimal ("D"), octal ("O"), or hex...@> 1422if r>0 then 1423 begin repeat get_next; 1424 until cur_char<>" "; {skip the blanks after the type code} 1425 while ((cur_char>="0")and(cur_char<="9"))or@| 1426 ((cur_char>="A")and(cur_char<="F")) do 1427 @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>; 1428 end; 1429end; 1430 1431@ @<Multiply by |r|...@>= 1432begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; 1433if cur_char>="0"+r then skip_error('Illegal digit') 1434@.Illegal digit@> 1435else begin c:=c3*r+cur_char-"0"; c3:=c mod 256;@/ 1436 c:=c2*r+c div 256; c2:=c mod 256;@/ 1437 c:=c1*r+c div 256; c1:=c mod 256;@/ 1438 c:=c0*r+c div 256; 1439 if c<256 then c0:=c 1440 else begin cur_bytes:=zero_bytes; 1441 if r=8 then 1442 skip_error('Sorry, the maximum octal value is O 37777777777') 1443@.Sorry, the maximum...@> 1444 else if r=10 then 1445 skip_error('Sorry, the maximum decimal value is D 4294967295') 1446 else skip_error('Sorry, the maximum hex value is H FFFFFFFF'); 1447 end; 1448 get_next; 1449 end; 1450end 1451 1452@ The remaining scanning routine is the most interesting. It scans a real 1453constant and returns the nearest |fix_word| approximation to that constant. 1454A |fix_word| is a 32-bit integer that represents a real value that 1455has been multiplied by $2^{20}$. Since \.{VPtoVF} restricts the magnitude 1456of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$. 1457 1458@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0} 1459 1460@<Types...@>= 1461@!fix_word=integer; {a scaled real value with 20 bits of fraction} 1462 1463@ When a real value is desired, we might as well treat `\.D' and `\.R' 1464formats as if they were identical. 1465 1466@p function get_fix:fix_word; {scans a real property value} 1467var negative:boolean; {was there a minus sign?} 1468@!acc:integer; {an accumulator} 1469@!int_part:integer; {the integer part} 1470@!j:0..7; {the number of decimal places stored} 1471begin repeat get_next; 1472until cur_char<>" "; {skip the blanks before the type code} 1473negative:=false; acc:=0; {start with the accumulators zero} 1474if (cur_char<>"R")and(cur_char<>"D") then 1475 skip_error('An "R" or "D" value is needed here') 1476@.An "R" or "D" ... needed here@> 1477else begin @<Scan the blanks and/or signs after the type code@>; 1478 while (cur_char>="0") and (cur_char<="9") do 1479 @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>; 1480 int_part:=acc; acc:=0; 1481 if cur_char="." then @<Scan the fraction part and put it in |acc|@>; 1482 if (acc>=unity)and(int_part=2047) then 1483 skip_error('Real constants must be less than 2048') 1484@.Real constants must be...@> 1485 else acc:=int_part*unity+acc; 1486 end; 1487if negative then get_fix:=-acc@+else get_fix:=acc; 1488end; 1489 1490@ @<Scan the blanks...@>= 1491repeat get_next; 1492if cur_char="-" then 1493 begin cur_char:=" "; negative:=not negative; 1494 end 1495else if cur_char="+" then cur_char:=" "; 1496until cur_char<>" " 1497 1498@ @<Multiply by 10...@>= 1499begin acc:=acc*10+cur_char-"0"; 1500if acc>=2048 then 1501 begin skip_error('Real constants must be less than 2048'); 1502@.Real constants must be...@> 1503 acc:=0; cur_char:=" "; 1504 end 1505else get_next; 1506end 1507 1508@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven 1509of the digits $d_j$. A correct result is obtained if we first compute 1510$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which 1511$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$. 1512 1513@<Glob...@>= 1514@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$} 1515 1516@ @<Scan the frac...@>= 1517begin j:=0; get_next; 1518while (cur_char>="0")and(cur_char<="9") do 1519 begin if j<7 then 1520 begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0"); 1521 end; 1522 get_next; 1523 end; 1524acc:=0; 1525while j>0 do 1526 begin acc:=fraction_digits[j]+(acc div 10); decr(j); 1527 end; 1528acc:=(acc+10) div 20; 1529end 1530 1531@* Storing the property values. 1532When property values have been found, they are squirreled away in a bunch 1533of arrays. The header information is unpacked into bytes in an array 1534called |header_bytes|. The ligature/kerning program is stored in an array 1535of type |four_bytes|. 1536Another |four_bytes| array holds the specifications of extensible characters. 1537The kerns and parameters are stored in separate arrays of |fix_word| values. 1538Virtual font data goes into an array |vf| of single-byte values. 1539 1540We maintain information about at most 256 local fonts. (If this is inadequate, 1541several arrays need to be made longer and we need to output font definitions 1542that go beyond |fnt1| and |fnt_def1| in the \.{VF} file.) 1543 1544Instead of storing the design size in the header array, we will keep it 1545in a |fix_word| variable until the last minute. The number of units in the 1546design size is also kept in a |fix_word|. 1547 1548@<Glob...@>= 1549@!header_bytes:array[header_index] of byte; {the header block} 1550@!header_ptr:header_index; {the number of header bytes in use} 1551@!design_size:fix_word; {the design size} 1552@!design_units:fix_word; {reciprocal of the scaling factor} 1553@!frozen_du:boolean; {have we used |design_units| irrevocably?} 1554@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?} 1555@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program} 1556@!nl:0..32767; {the number of ligature/kern instructions so far} 1557@!min_nl:0..32767; {the final value of |nl| must be at least this} 1558@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts} 1559@!nk:0..max_kerns; {the number of entries of |kern|} 1560@!exten:array[0..255] of four_bytes; {extensible character specs} 1561@!ne:0..256; {the number of extensible characters} 1562@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters} 1563@!np:0..max_param_words; {the largest parameter set nonzero} 1564@!check_sum_specified:boolean; {did the user name the check sum?} 1565@!bchar:0..256; {the right boundary character, or 256 if unspecified} 1566@!vf:array[0..vf_size] of byte; {stored bytes for \.{VF} file} 1567@!vf_ptr:0..vf_size; {first unused location in |vf|} 1568@!vtitle_start:0..vf_size; {starting location of \.{VTITLE} string} 1569@!vtitle_length:byte; {length of \.{VTITLE} string} 1570@!packet_start:array[byte] of 0..vf_size; 1571 {beginning location of character packet} 1572@!packet_length:array[byte] of integer; {length of character packet} 1573@!font_ptr:0..256; {number of distinct local fonts seen} 1574@!cur_font:0..256; {number of the current local font} 1575@!fname_start:array[byte] of 0..vf_size; {beginning of local font name} 1576@!fname_length:array[byte] of byte; {length of local font name} 1577@!farea_start:array[byte] of 0..vf_size; {beginning of local font area} 1578@!farea_length:array[byte] of byte; {length of local font area} 1579@!font_checksum:array[byte] of four_bytes; {local font checksum} 1580@!font_number:array[0..256] of four_bytes; {local font id number} 1581@!font_at:array[byte] of fix_word; {local font ``at size''} 1582@!font_dsize:array[byte] of fix_word; {local font design size} 1583 1584@ @<Types...@>= 1585@!header_index=0..max_header_bytes; 1586@!indx=0..@'77777; 1587 1588@ @<Local...@>= 1589@!d:header_index; {an index into |header_bytes|} 1590 1591@ We start by setting up the default values. 1592 1593@d check_sum_loc=0 1594@d design_size_loc=4 1595@d coding_scheme_loc=8 1596@d family_loc=coding_scheme_loc+40 1597@d seven_flag_loc=family_loc+20 1598@d face_loc=seven_flag_loc+3 1599 1600@<Set init...@>= 1601for d:=0 to 18*4-1 do header_bytes[d]:=0; 1602header_bytes[8]:=11; header_bytes[9]:="U"; 1603header_bytes[10]:="N"; 1604header_bytes[11]:="S"; 1605header_bytes[12]:="P"; 1606header_bytes[13]:="E"; 1607header_bytes[14]:="C"; 1608header_bytes[15]:="I"; 1609header_bytes[16]:="F"; 1610header_bytes[17]:="I"; 1611header_bytes[18]:="E"; 1612header_bytes[19]:="D"; 1613@.UNSPECIFIED@> 1614for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40]; 1615design_size:=10*unity; design_units:=unity; frozen_du:=false; 1616seven_bit_safe_flag:=false;@/ 1617header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/ 1618check_sum_specified:=false; bchar:=256;@/ 1619vf_ptr:=0; vtitle_start:=0; vtitle_length:=0; font_ptr:=0; 1620for k:=0 to 255 do packet_start[k]:=vf_size; 1621for k:=0 to 127 do packet_length[k]:=1; 1622for k:=128 to 255 do packet_length[k]:=2; 1623 1624@ Most of the dimensions, however, go into the |memory| array. There are 1625at most 257 widths, 257 heights, 257 depths, and 257 italic corrections, 1626since the value 0 is required but it need not be used. So |memory| has room 1627for 1028 entries, each of which is a |fix_word|. An auxiliary table called 1628|link| is used to link these words together in linear lists, so that 1629sorting and other operations can be done conveniently. 1630 1631We also add four ``list head'' words to the |memory| and |link| arrays; 1632these are in locations |width| through |italic|, i.e., 1 through 4. 1633For example, |link[height]| points to the smallest element in 1634the sorted list of distinct heights that have appeared so far, and 1635|memory[height]| is the number of distinct heights. 1636 1637@d mem_size=1028+4 {number of nonzero memory addresses} 1638 1639@<Types...@>= 1640@!pointer=0..mem_size; {an index into memory} 1641 1642@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain 1643pointers to the |memory| array entries where the corresponding dimensions 1644appear. Two other arrays, |char_tag| and |char_remainder|, hold 1645the other information that \.{TFM} files pack into a |char_info_word|. 1646 1647@d no_tag=0 {vanilla character} 1648@d lig_tag=1 {character has a ligature/kerning program} 1649@d list_tag=2 {character has a successor in a charlist} 1650@d ext_tag=3 {character is extensible} 1651@d bchar_label==char_remainder[256] 1652 {beginning of ligature program for left boundary} 1653 1654@<Glob...@>= 1655@!memory:array[pointer] of fix_word; {character dimensions and kerns} 1656@!mem_ptr:pointer; {largest |memory| word in use} 1657@!link:array[pointer] of pointer; {to make lists of |memory| items} 1658@!char_wd:array[byte] of pointer; {pointers to the widths} 1659@!char_ht:array[byte] of pointer; {pointers to the heights} 1660@!char_dp:array[byte] of pointer; {pointers to the depths} 1661@!char_ic:array[byte] of pointer; {pointers to italic corrections} 1662@!char_tag:array[byte] of no_tag..ext_tag; {character tags} 1663@!char_remainder:array[0..256] of 0..65535; {pointers to ligature labels, 1664 next larger characters, or extensible characters} 1665 1666@ @<Local...@>= 1667@!c:byte; {runs through all character codes} 1668 1669@ @<Set init...@>= 1670bchar_label:=@'77777; 1671for c:=0 to 255 do 1672 begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/ 1673 char_tag[c]:=no_tag; char_remainder[c]:=0; 1674 end; 1675memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists} 1676memory[width]:=0; link[width]:=0; {width list is empty} 1677memory[height]:=0; link[height]:=0; {height list is empty} 1678memory[depth]:=0; link[depth]:=0; {depth list is empty} 1679memory[italic]:=0; link[italic]:=0; {italic list is empty} 1680mem_ptr:=italic; 1681 1682@ As an example of these data structures, let us consider the simple 1683routine that inserts a potentially new element into one of the dimension 1684lists. The first parameter indicates the list head (i.e., |h=width| for 1685the width list, etc.); the second parameter is the value that is to be 1686inserted into the list if it is not already present. The procedure 1687returns the value of the location where the dimension appears in |memory|. 1688The fact that |memory[0]| is larger than any legal dimension makes the 1689algorithm particularly short. 1690 1691We do have to handle two somewhat subtle situations. A width of zero must be 1692put into the list, so that a zero-width character in the font will not appear 1693to be nonexistent (i.e., so that its |char_wd| index will not be zero), but 1694this does not need to be done for heights, depths, or italic corrections. 1695Furthermore, it is necessary to test for memory overflow even though we 1696have provided room for the maximum number of different dimensions in any 1697legal font, since the \.{VPL} file might foolishly give any number of 1698different sizes to the same character. 1699 1700@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list} 1701var p:pointer; {the current node of interest} 1702begin if (d=0)and(h<>width) then sort_in:=0 1703else begin p:=h; 1704 while d>=memory[link[p]] do p:=link[p]; 1705 if (d=memory[p])and(p<>h) then sort_in:=p 1706 else if mem_ptr=mem_size then 1707 begin err_print('Memory overflow: more than 1028 widths, etc'); 1708@.Memory overflow...@> 1709 print_ln('Congratulations! It''s hard to make this error.'); 1710 sort_in:=p; 1711 end 1712 else begin incr(mem_ptr); memory[mem_ptr]:=d; 1713 link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]); 1714 sort_in:=mem_ptr; 1715 end; 1716 end; 1717end; 1718 1719@ When these lists of dimensions are eventually written to the \.{TFM} 1720file, we may have to do some rounding of values, because the \.{TFM} file 1721allows at most 256 widths, 16 heights, 16 depths, and 64 italic 1722corrections. The following procedure takes a given list head |h| and a 1723given dimension |d|, and returns the minimum $m$ such that the elements of 1724the list can be covered by $m$ intervals of width $d$. It also sets 1725|next_d| to the smallest value $d^\prime>d$ such that the covering found 1726by this procedure would be different. In particular, if $d=0$ it computes 1727the number of elements of the list, and sets |next_d| to the smallest 1728distance between two list elements. (The covering by intervals of width 1729|next_d| is not guaranteed to have fewer than $m$ elements, but in practice 1730this seems to happen most of the time.) 1731 1732@<Glob...@>= 1733@!next_d:fix_word; {the next larger interval that is worth trying} 1734 1735@ Once again we can make good use of the fact that |memory[0]| is ``infinite.'' 1736 1737@p function min_cover(@!h:pointer;@!d:fix_word):integer; 1738var p:pointer; {the current node of interest} 1739@!l:fix_word; {the least element covered by the current interval} 1740@!m:integer; {the current size of the cover being generated} 1741begin m:=0; p:=link[h]; next_d:=memory[0]; 1742while p<>0 do 1743 begin incr(m); l:=memory[p]; 1744 while memory[link[p]]<=l+d do p:=link[p]; 1745 p:=link[p]; 1746 if memory[p]-l<next_d then next_d:=memory[p]-l; 1747 end; 1748min_cover:=m; 1749end; 1750 1751@ The following procedure uses |min_cover| to determine the smallest $d$ 1752such that a given list can be covered with at most a given number of 1753intervals. 1754 1755@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round} 1756var d:fix_word; {the current trial interval length} 1757@!k:integer; {the size of a minimum cover} 1758begin if memory[h]>m then 1759 begin excess:=memory[h]-m; 1760 k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|} 1761 repeat d:=d+d; k:=min_cover(h,d); 1762 until k<=m; {first we ascend rapidly until finding the range} 1763 d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps} 1764 while k>m do 1765 begin d:=next_d; k:=min_cover(h,d); 1766 end; 1767 shorten:=d; 1768 end 1769else shorten:=0; 1770end; 1771 1772@ When we are nearly ready to output the \.{TFM} file, we will set 1773|index[p]:=k| if the dimension in |memory[p]| is being rounded to the 1774|k|th element of its list. 1775 1776@<Glob...@>= 1777@!index:array[pointer] of byte; 1778@!excess:byte; {number of words to remove, if list is being shortened} 1779 1780@ Here is the procedure that sets the |index| values. It also shortens 1781the list so that there is only one element per covering interval; 1782the remaining elements are the midpoints of their clusters. 1783 1784@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list} 1785var p:pointer; {the current node of interest} 1786@!q:pointer; {trails one step behind |p|} 1787@!m:byte; {index number of nodes in the current interval} 1788@!l:fix_word; {least value in the current interval} 1789begin q:=h; p:=link[q]; m:=0; 1790while p<>0 do 1791 begin incr(m); l:=memory[p]; index[p]:=m; 1792 while memory[link[p]]<=l+d do 1793 begin p:=link[p]; index[p]:=m; decr(excess); 1794 if excess=0 then d:=0; 1795 end; 1796 link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p]; 1797 end; 1798memory[h]:=m; 1799end; 1800 1801@* The input phase. 1802We're ready now to read and parse the \.{VPL} file, storing property 1803values as we go. 1804 1805@<Glob...@>= 1806@!c:byte; {the current character or byte being processed} 1807@!x:fix_word; {current dimension of interest} 1808@!k:integer; {general-purpose index} 1809 1810@ @<Read all the input@>= 1811cur_char:=" "; 1812repeat while cur_char=" " do get_next; 1813if cur_char="(" then @<Read a font property value@> 1814else if (cur_char=")")and not input_has_ended then 1815 begin err_print('Extra right parenthesis'); 1816 incr(loc); cur_char:=" "; 1817 end 1818@.Extra right parenthesis@> 1819else if not input_has_ended then junk_error; 1820until input_has_ended 1821 1822@ The |junk_error| routine just referred to is called when something 1823appears in the forbidden area between properties of a property list. 1824 1825@p procedure junk_error; {gets past no man's land} 1826begin err_print('There''s junk here that is not in parentheses'); 1827@.There's junk here...@> 1828skip_to_paren; 1829end; 1830 1831@ For each font property, we are supposed to read the data from the 1832left parenthesis that is the current value of |cur_char| to the right 1833parenthesis that matches it in the input. The main complication is 1834to recover with reasonable grace from various error conditions that might arise. 1835 1836@<Read a font property value@>= 1837begin get_name; 1838if cur_code=comment_code then skip_to_end_of_item 1839else if cur_code>character_code then 1840 flush_error('This property name doesn''t belong on the outer level') 1841@.This property name doesn't belong...@> 1842else begin @<Read the font property value specified by |cur_code|@>; 1843 finish_the_property; 1844 end; 1845end 1846 1847@ @<Read the font property value spec...@>= 1848case cur_code of 1849check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc); 1850 end; 1851design_size_code: @<Read the design size@>; 1852design_units_code: @<Read the design units@>; 1853coding_scheme_code: read_BCPL(coding_scheme_loc,40); 1854family_code: read_BCPL(family_loc,20); 1855face_code:header_bytes[face_loc]:=get_byte; 1856seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>; 1857header_code: @<Read an indexed header word@>; 1858font_dimen_code: @<Read font parameter list@>; 1859lig_table_code: read_lig_kern; 1860boundary_char_code: bchar:=get_byte; 1861virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item; 1862 if vf_ptr>vtitle_start+255 then 1863 begin err_print('VTITLE clipped to 255 characters'); vtitle_length:=255; 1864@.VTITLE clipped...@> 1865 end 1866 else vtitle_length:=vf_ptr-vtitle_start; 1867 end; 1868map_font_code:@<Read a local font list@>; 1869character_code: read_char_info; 1870end 1871 1872@ The |case| statement just given makes use of three subroutines that we 1873haven't defined yet. The first of these puts a 32-bit octal quantity 1874into four specified bytes of the header block. 1875 1876@p procedure read_four_bytes(l:header_index); 1877begin get_four_bytes; 1878header_bytes[l]:=c0; 1879header_bytes[l+1]:=c1; 1880header_bytes[l+2]:=c2; 1881header_bytes[l+3]:=c3; 1882end; 1883 1884@ The second little procedure is used to scan a string and to store it in 1885the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed 1886to contain at most |n| bytes, including the first byte (which holds the 1887length of the rest of the string). 1888 1889@p procedure read_BCPL(l:header_index;n:byte); 1890var k:header_index; 1891begin k:=l; 1892while cur_char=" " do get_next; 1893while (cur_char<>"(")and(cur_char<>")") do 1894 begin if k<l+n then incr(k); 1895 if k<l+n then header_bytes[k]:=cur_char; 1896 get_next; 1897 end; 1898if k=l+n then 1899 begin err_print('String is too long; its first ',n-1:1, 1900@.String is too long...@> 1901 ' characters will be kept'); decr(k); 1902 end; 1903header_bytes[l]:=k-l; 1904while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls} 1905 begin incr(k); header_bytes[k]:=0; 1906 end; 1907end; 1908 1909@ @<Read the design size@>= 1910begin next_d:=get_fix; 1911if next_d<unity then 1912 err_print('The design size must be at least 1') 1913@.The design size must...@> 1914else design_size:=next_d; 1915end 1916 1917@ @<Read the design units@>= 1918begin next_d:=get_fix; 1919if next_d<=0 then 1920 err_print('The number of units per design size must be positive') 1921@.The number of units...@> 1922else if frozen_du then 1923 err_print('Sorry, it''s too late to change the design units') 1924@.Sorry, it's too late...@> 1925else design_units:=next_d; 1926end 1927 1928@ @<Read the seven-bit-safe...@>= 1929begin while cur_char=" " do get_next; 1930if cur_char="T" then seven_bit_safe_flag:=true 1931else if cur_char="F" then seven_bit_safe_flag:=false 1932else err_print('The flag value should be "TRUE" or "FALSE"'); 1933@.The flag value should be...@> 1934skip_to_paren; 1935end 1936 1937@ @<Read an indexed header word@>= 1938begin c:=get_byte; 1939if c<18 then skip_error('HEADER indices should be 18 or more') 1940@.HEADER indices...@> 1941else if 4*c+4>max_header_bytes then 1942 skip_error('This HEADER index is too big for my present table size') 1943@.This HEADER index is too big...@> 1944else begin while header_ptr<4*c+4 do 1945 begin header_bytes[header_ptr]:=0; incr(header_ptr); 1946 end; 1947 read_four_bytes(4*c); 1948 end; 1949end 1950 1951@ The remaining kinds of font property values that need to be read are 1952those that involve property lists on higher levels. Each of these has a 1953loop similar to the one that was used at level zero. Then we put the 1954right parenthesis back so that `|finish_the_property|' will be happy; 1955there is probably a more elegant way to do this. 1956 1957@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")"; 1958 end 1959 1960@<Read font parameter list@>= 1961begin while level=1 do 1962 begin while cur_char=" " do get_next; 1963 if cur_char="(" then @<Read a parameter value@> 1964 else if cur_char=")" then skip_to_end_of_item 1965 else junk_error; 1966 end; 1967finish_inner_property_list; 1968end 1969 1970@ @<Read a parameter value@>= 1971begin get_name; 1972if cur_code=comment_code then skip_to_end_of_item 1973else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then 1974 flush_error('This property name doesn''t belong in a FONTDIMEN list') 1975@.This property name doesn't belong...@> 1976else begin if cur_code=parameter_code then c:=get_byte 1977 else c:=cur_code-parameter_code; 1978 if c=0 then flush_error('PARAMETER index must not be zero') 1979@.PARAMETER index must not...@> 1980 else if c>max_param_words then 1981 flush_error('This PARAMETER index is too big for my present table size') 1982@.This PARAMETER index is too big...@> 1983 else begin while np<c do 1984 begin incr(np); param[np]:=0; 1985 end; 1986 param[c]:=get_fix; 1987 finish_the_property; 1988 end; 1989 end; 1990end 1991 1992@ @d numbers_differ==(font_number[cur_font].b3<>font_number[font_ptr].b3)or@| 1993(font_number[cur_font].b2<>font_number[font_ptr].b2)or@| 1994(font_number[cur_font].b1<>font_number[font_ptr].b1)or@| 1995(font_number[cur_font].b0<>font_number[font_ptr].b0) 1996 1997@<Read a local font list@>= 1998begin get_four_bytes; font_number[font_ptr]:=cur_bytes; cur_font:=0; 1999while numbers_differ do incr(cur_font); 2000if cur_font=font_ptr then {it's a new font number} 2001 if font_ptr<256 then @<Initialize a new local font@> 2002 else err_print('I can handle only 256 different mapfonts'); 2003@.I can handle only 256...@> 2004if cur_font=font_ptr then skip_to_end_of_item 2005else while level=1 do 2006 begin while cur_char=" " do get_next; 2007 if cur_char="(" then @<Read a local font property@> 2008 else if cur_char=")" then skip_to_end_of_item 2009 else junk_error; 2010 end; 2011finish_inner_property_list; 2012end 2013 2014@ @<Initialize a new local font@>= 2015begin incr(font_ptr); 2016fname_start[cur_font]:=vf_size; fname_length[cur_font]:=4; {\.{NULL}} 2017farea_start[cur_font]:=vf_size; farea_length[cur_font]:=0; 2018font_checksum[cur_font]:=zero_bytes; 2019font_at[cur_font]:=@'4000000; {denotes design size of this virtual font} 2020font_dsize[cur_font]:=@'50000000; {the |fix_word| for 10} 2021end 2022 2023@ @<Read a local font property@>= 2024begin get_name; 2025if cur_code=comment_code then skip_to_end_of_item 2026else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then 2027 flush_error('This property name doesn''t belong in a MAPFONT list') 2028@.This property name doesn't belong...@> 2029else begin case cur_code of 2030 font_name_code:@<Read a local font name@>; 2031 font_area_code:@<Read a local font area@>; 2032 font_checksum_code:begin get_four_bytes; font_checksum[cur_font]:=cur_bytes; 2033 end; 2034 font_at_code: begin frozen_du:=true; 2035 if design_units=unity then font_at[cur_font]:=get_fix 2036 else font_at[cur_font]:=round((get_fix/design_units)*1048576.0); 2037 end; 2038 font_dsize_code:font_dsize[cur_font]:=get_fix; 2039 end; {there are no other cases} 2040 finish_the_property; 2041 end; 2042end 2043 2044@ @<Read a local font name@>= 2045begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item; 2046if vf_ptr>fname_start[cur_font]+255 then 2047 begin err_print('FONTNAME clipped to 255 characters'); 2048@.FONTNAME clipped...@> 2049 fname_length[cur_font]:=255; 2050 end 2051else fname_length[cur_font]:=vf_ptr-fname_start[cur_font]; 2052end 2053 2054@ @<Read a local font area@>= 2055begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item; 2056if vf_ptr>farea_start[cur_font]+255 then 2057 begin err_print('FONTAREA clipped to 255 characters'); 2058@.FONTAREA clipped...@> 2059 farea_length[cur_font]:=255; 2060 end 2061else farea_length[cur_font]:=vf_ptr-farea_start[cur_font]; 2062end 2063 2064@ @<Read ligature/kern list@>= 2065begin lk_step_ended:=false; 2066while level=1 do 2067 begin while cur_char=" " do get_next; 2068 if cur_char="(" then @<Read a ligature/kern command@> 2069 else if cur_char=")" then skip_to_end_of_item 2070 else junk_error; 2071 end; 2072finish_inner_property_list; 2073end 2074 2075@ @<Read a ligature/kern command@>= 2076begin get_name; 2077if cur_code=comment_code then skip_to_end_of_item 2078else if cur_code<label_code then 2079 flush_error('This property name doesn''t belong in a LIGTABLE list') 2080@.This property name doesn't belong...@> 2081else begin case cur_code of 2082 label_code:@<Read a label step@>; 2083 stop_code:@<Read a stop step@>; 2084 skip_code:@<Read a skip step@>; 2085 krn_code:@<Read a kerning step@>; 2086 lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7, 2087 lig_code+11:@<Read a ligature step@>; 2088 end; {there are no other cases |>=label_code|} 2089 finish_the_property; 2090 end; 2091end 2092 2093@ When a character is about to be tagged, we call the following 2094procedure so that an error message is given in case of multiple tags. 2095 2096@p procedure check_tag(c:byte); {print error if |c| already tagged} 2097begin case char_tag[c] of 2098no_tag: do_nothing; 2099lig_tag: err_print('This character already appeared in a LIGTABLE LABEL'); 2100@.This character already...@> 2101list_tag: err_print('This character already has a NEXTLARGER spec'); 2102ext_tag: err_print('This character already has a VARCHAR spec'); 2103end; 2104end; 2105 2106@ @<Read a label step@>= 2107begin while cur_char=" " do get_next; 2108if cur_char="B" then 2109 begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}} 2110 end 2111else begin backup; c:=get_byte; 2112 check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl; 2113 end; 2114if min_nl<=nl then min_nl:=nl+1; 2115lk_step_ended:=false; 2116end 2117 2118@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program} 2119@d kern_flag=128 {op code for a kern step} 2120 2121@<Globals...@>= 2122@!lk_step_ended:boolean; 2123 {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?} 2124@!krn_ptr:0..max_kerns; {an index into |kern|} 2125 2126@ @<Read a stop step@>= 2127if not lk_step_ended then 2128 err_print('STOP must follow LIG or KRN') 2129@.STOP must follow LIG or KRN@> 2130else begin lig_kern[nl-1].b0:=stop_flag; lk_step_ended:=false; 2131 end 2132 2133@ @<Read a skip step@>= 2134if not lk_step_ended then 2135 err_print('SKIP must follow LIG or KRN') 2136@.SKIP must follow LIG or KRN@> 2137else begin c:=get_byte; 2138 if c>=128 then err_print('Maximum SKIP amount is 127') 2139@.Maximum SKIP amount...@> 2140 else if nl+c>=max_lig_steps then 2141 err_print('Sorry, LIGTABLE too long for me to handle') 2142@.Sorry, LIGTABLE too long...@> 2143 else begin lig_kern[nl-1].b0:=c; 2144 if min_nl<=nl+c then min_nl:=nl+c+1; 2145 end; 2146 lk_step_ended:=false; 2147 end 2148 2149@ @<Read a ligature step@>= 2150begin lig_kern[nl].b0:=0; 2151lig_kern[nl].b2:=cur_code-lig_code; 2152lig_kern[nl].b1:=get_byte; 2153lig_kern[nl].b3:=get_byte; 2154if nl>=max_lig_steps-1 then 2155 err_print('Sorry, LIGTABLE too long for me to handle') 2156@.Sorry, LIGTABLE too long...@> 2157else incr(nl); 2158lk_step_ended:=true; 2159end 2160 2161@ @<Read a kerning step@>= 2162begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; 2163kern[nk]:=get_fix; krn_ptr:=0; 2164while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); 2165if krn_ptr=nk then 2166 begin if nk<max_kerns then incr(nk) 2167 else begin err_print('Sorry, too many different kerns for me to handle'); 2168@.Sorry, too many different kerns...@> 2169 decr(krn_ptr); 2170 end; 2171 end; 2172lig_kern[nl].b2:=kern_flag+(krn_ptr div 256); 2173lig_kern[nl].b3:=krn_ptr mod 256; 2174if nl>=max_lig_steps-1 then 2175 err_print('Sorry, LIGTABLE too long for me to handle') 2176@.Sorry, LIGTABLE too long...@> 2177else incr(nl); 2178lk_step_ended:=true; 2179end 2180 2181@ Finally we come to the part of \.{VPtoVF}'s input mechanism 2182that is used most, the processing of individual character data. 2183 2184@<Read character info list@>= 2185begin c:=get_byte; {read the character code that is being specified} 2186@<Print |c| in octal notation@>; 2187while level=1 do 2188 begin while cur_char=" " do get_next; 2189 if cur_char="(" then @<Read a character property@> 2190 else if cur_char=")" then skip_to_end_of_item 2191 else junk_error; 2192 end; 2193if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|} 2194finish_inner_property_list; 2195end 2196 2197@ @<Read a character prop...@>= 2198begin get_name; 2199if cur_code=comment_code then skip_to_end_of_item 2200else if (cur_code<char_wd_code)or(cur_code>var_char_code) then 2201 flush_error('This property name doesn''t belong in a CHARACTER list') 2202@.This property name doesn't belong...@> 2203else begin case cur_code of 2204 char_wd_code:char_wd[c]:=sort_in(width,get_fix); 2205 char_ht_code:char_ht[c]:=sort_in(height,get_fix); 2206 char_dp_code:char_dp[c]:=sort_in(depth,get_fix); 2207 char_ic_code:char_ic[c]:=sort_in(italic,get_fix); 2208 next_larger_code:begin check_tag(c); char_tag[c]:=list_tag; 2209 char_remainder[c]:=get_byte; 2210 end; 2211 map_code:read_packet(c); 2212 var_char_code:@<Read an extensible recipe for |c|@>; 2213 end;@/ 2214 finish_the_property; 2215 end; 2216end 2217 2218@ @<Read an extensible r...@>= 2219begin if ne=256 then 2220 err_print('At most 256 VARCHAR specs are allowed') 2221@.At most 256 VARCHAR specs...@> 2222else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/ 2223 exten[ne]:=zero_bytes; 2224 while level=2 do 2225 begin while cur_char=" " do get_next; 2226 if cur_char="(" then @<Read an extensible piece@> 2227 else if cur_char=")" then skip_to_end_of_item 2228 else junk_error; 2229 end; 2230 incr(ne); 2231 finish_inner_property_list; 2232 end; 2233end 2234 2235@ @<Read an extensible p...@>= 2236begin get_name; 2237if cur_code=comment_code then skip_to_end_of_item 2238else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then 2239 flush_error('This property name doesn''t belong in a VARCHAR list') 2240@.This property name doesn't belong...@> 2241else begin case cur_code-(var_char_code+1) of 2242 0:exten[ne].b0:=get_byte; 2243 1:exten[ne].b1:=get_byte; 2244 2:exten[ne].b2:=get_byte; 2245 3:exten[ne].b3:=get_byte; 2246 end;@/ 2247 finish_the_property; 2248 end; 2249end 2250 2251@* Assembling the mappings. 2252Each \.{MAP} property is a sequence of \.{DVI} instructions, for which 2253we need to know some of the opcodes. 2254 2255@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right} 2256@d set1=128 {typeset a character and move right} 2257@d set_rule=132 {typeset a rule and move right} 2258@d push=141 {save the current positions} 2259@d pop=142 {restore previous positions} 2260@d right1=143 {move right} 2261@d w0=147 {move right by |w|} 2262@d w1=148 {move right and set |w|} 2263@d x0=152 {move right by |x|} 2264@d x1=153 {move right and set |x|} 2265@d down1=157 {move down} 2266@d y0=161 {move down by |y|} 2267@d y1=162 {move down and set |y|} 2268@d z0=166 {move down by |z|} 2269@d z1=167 {move down and set |z|} 2270@d fnt_num_0=171 {set current font to 0} 2271@d fnt1=235 {set current font} 2272@d xxx1=239 {extension to \.{DVI} primitives} 2273@d xxx4=242 {potentially long extension to \.{DVI} primitives} 2274@d fnt_def1=243 {define the meaning of a font number} 2275@d pre=247 {preamble} 2276@d post=248 {postamble beginning} 2277 2278@ We keep stacks of movement values, in order to optimize the \.{DVI} code 2279in simple cases. 2280 2281@<Glob...@>= 2282@!hstack:array[0..max_stack] of 0..2; {number of known horizontal movements} 2283@!vstack:array[0..max_stack] of 0..2; {number of known vertical movements} 2284@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of fix_word; 2285@!stack_ptr:0..max_stack; 2286 2287@ The packet is built by straightforward assembly of \.{DVI} instructions. 2288 2289@p @<Declare the |vf_fix| procedure@>@;@/ 2290procedure read_packet(@!c:byte); 2291var @!cc:byte; {character being typeset} 2292@!x:fix_word; {movement} 2293@!h,@!v:0..2; {top of |hstack| and |vstack|} 2294@!special_start:0..vf_size; {location of |xxx1| command} 2295@!k:0..vf_size; {loop index} 2296begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0; 2297cur_font:=0; 2298while level=2 do 2299 begin while cur_char=" " do get_next; 2300 if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@> 2301 else if cur_char=")" then skip_to_end_of_item 2302 else junk_error; 2303 end; 2304while stack_ptr>0 do 2305 begin err_print('Missing POP supplied'); 2306@.Missing POP supplied@> 2307 vf_store(pop); decr(stack_ptr); 2308 end; 2309packet_length[c]:=vf_ptr-packet_start[c]; 2310finish_inner_property_list; 2311end; 2312 2313@ @<Read and assemble a list of \.{DVI}...@>= 2314begin get_name; 2315if cur_code=comment_code then skip_to_end_of_item 2316else if (cur_code<select_font_code)or(cur_code>special_hex_code) then 2317 flush_error('This property name doesn''t belong in a MAP list') 2318@.This property name doesn't belong...@> 2319else begin case cur_code of 2320 select_font_code:@<Assemble a font selection@>; 2321 set_char_code:@<Assemble a typesetting instruction@>; 2322 set_rule_code:@<Assemble a rulesetting instruction@>; 2323 move_right_code,move_right_code+1:@<Assemble a horizontal movement@>; 2324 move_down_code,move_down_code+1:@<Assemble a vertical movement@>; 2325 push_code:@<Assemble a stack push@>; 2326 pop_code:@<Assemble a stack pop@>; 2327 special_code,special_hex_code:@<Assemble a special command@>; 2328 end;@/ 2329 finish_the_property; 2330 end; 2331end 2332 2333@ @<Assemble a font selection@>= 2334begin get_four_bytes; font_number[font_ptr]:=cur_bytes; 2335cur_font:=0; 2336while numbers_differ do incr(cur_font); 2337if cur_font=font_ptr then err_print('Undefined MAPFONT cannot be selected') 2338@.Undefined MAPFONT...@> 2339else if cur_font<64 then vf_store(fnt_num_0+cur_font) 2340else begin vf_store(fnt1); vf_store(cur_font); 2341 end; 2342end 2343 2344@ @<Assemble a typesetting instruction@>= 2345if cur_font=font_ptr then 2346 err_print('Character cannot be typeset in undefined font') 2347@.Character cannot be typeset...@> 2348else begin cc:=get_byte; 2349 if cc>=128 then vf_store(set1); 2350 vf_store(cc); 2351 end 2352 2353@ Here's a procedure that converts a |fix_word| to a sequence of 2354\.{DVI} bytes. 2355 2356@<Declare the |vf_fix|...@>= 2357procedure vf_fix(@!opcode:byte;@!x:fix_word); 2358var negative:boolean; 2359@!k:0..4; {number of bytes to typeset} 2360@!t:integer; {threshold} 2361begin frozen_du:=true; 2362if design_units<>unity then x:=round((x/design_units)*1048576.0); 2363if x>=0 then negative:=false 2364else begin negative:=true; x:=-1-x;@+end; 2365if opcode=0 then 2366 begin k:=4; t:=@'100000000;@+end 2367else begin t:=127; k:=1; 2368 while x>t do 2369 begin t:=256*t+255; incr(k); 2370 end; 2371 vf_store(opcode+k-1); t:=t div 128 +1; 2372 end; 2373repeat if negative then 2374 begin vf_store(255-(x div t)); negative:=false; 2375 x:=(x div t)*t+t-1-x; 2376 end 2377else vf_store((x div t) mod 256); 2378decr(k); t:=t div 256; 2379until k=0; 2380end; 2381 2382@ @<Assemble a rulesetting instruction@>= 2383begin vf_store(set_rule); vf_fix(0,get_fix); vf_fix(0,get_fix); 2384end 2385 2386@ @<Assemble a horizontal movement@>= 2387begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix; 2388if h=0 then 2389 begin wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end 2390else if x=wstack[stack_ptr] then vf_store(w0) 2391else if h=1 then 2392 begin xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end 2393else if x=xstack[stack_ptr] then vf_store(x0) 2394else vf_fix(right1,x); 2395end 2396 2397@ @<Assemble a vertical movement@>= 2398begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix; 2399if v=0 then 2400 begin ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end 2401else if x=ystack[stack_ptr] then vf_store(y0) 2402else if v=1 then 2403 begin zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end 2404else if x=zstack[stack_ptr] then vf_store(z0) 2405else vf_fix(down1,x); 2406end 2407 2408@ @<Assemble a stack push@>= 2409if stack_ptr=max_stack then {too pushy} 2410 err_print('Don''t push so much---stack is full!') 2411@.Don't push so much...@> 2412else begin vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v; 2413 incr(stack_ptr); h:=0; v:=0; 2414 end 2415 2416@ @<Assemble a stack pop@>= 2417if stack_ptr=0 then 2418 err_print('Empty stack cannot be popped') 2419@.Empty stack...@> 2420else begin vf_store(pop); decr(stack_ptr); 2421 h:=hstack[stack_ptr]; v:=vstack[stack_ptr]; 2422 end 2423 2424@ @<Assemble a special command@>= 2425begin vf_store(xxx1); vf_store(0); {dummy length} 2426special_start:=vf_ptr; 2427if cur_code=special_code then copy_to_end_of_item 2428else begin repeat x:=get_hex; 2429 if cur_char>")" then vf_store(x*16+get_hex); 2430 until cur_char<=")"; 2431 end; 2432if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@> 2433else vf[special_start-1]:=vf_ptr-special_start; 2434end 2435 2436@ @<Convert |xxx1|...@>= 2437if vf_ptr+3>vf_size then 2438 begin err_print('Special command being clipped---no room left!'); 2439@.Special command being clipped...@> 2440 vf_ptr:=special_start+255; vf[special_start-1]:=255; 2441 end 2442else begin for k:=vf_ptr downto special_start do vf[k+3]:=vf[k]; 2443 x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3; 2444 vf[special_start-2]:=xxx4; 2445 vf[special_start-1]:=x div @'100000000; 2446 vf[special_start]:=(x div @'200000) mod 256; 2447 vf[special_start+1]:=(x div @'400) mod 256; 2448 vf[special_start+2]:=x mod 256; 2449 end 2450 2451@ The input routine is now complete except for the following code, 2452which prints a progress report as the file is being read. 2453 2454@p procedure print_octal(c:byte); {prints three octal digits} 2455begin print('''',(c div 64):1,((c div 8) mod 8):1,(c mod 8):1); 2456end; 2457 2458@ @<Print |c| in octal...@>= 2459begin if chars_on_line=8 then 2460 begin print_ln(' '); chars_on_line:=1; 2461 end 2462else begin if chars_on_line>0 then print(' '); 2463 incr(chars_on_line); 2464 end; 2465print_octal(c); {progress report} 2466end 2467 2468@* The checking and massaging phase. 2469Once the whole \.{VPL} file has been read in, we must check it for consistency 2470and correct any errors. This process consists mainly of running through 2471the characters that exist and seeing if they refer to characters that 2472don't exist. We also compute the true value of |seven_unsafe|; we make sure 2473that the charlists and ligature programs contain no loops; and we 2474shorten the lists of widths, heights, depths, and italic corrections, 2475if necessary, to keep from exceeding the required maximum sizes. 2476 2477@<Glob...@>= 2478@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?} 2479 2480@ @<Correct and check the information@>= 2481if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>; 2482seven_unsafe:=false; 2483for c:=0 to 255 do if char_wd[c]<>0 then 2484 @<For all characters |g| generated by |c|, 2485 make sure that |char_wd[g]| is nonzero, and 2486 set |seven_unsafe| if |c<128<=g|@>; 2487if bchar_label<@'77777 then 2488 begin c:=256; @<Check ligature program of |c|@>; 2489 end; 2490if seven_bit_safe_flag and seven_unsafe then 2491 print_ln('The font is not really seven-bit-safe!'); 2492@.The font is not...safe@> 2493@<Check for infinite ligature loops@>; 2494@<Doublecheck the lig/kern commands and the extensible recipes@>; 2495for c:=0 to 255 do 2496 @<Make sure that |c| is not the largest element of a charlist cycle@>; 2497@<Put the width, height, depth, and italic lists into final form@> 2498 2499@ The checking that we need in several places is accomplished by three 2500macros that are only slightly tricky. 2501 2502@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0); 2503 print(#,' '); print_octal(c); 2504 print_ln(' had no CHARACTER spec.'); 2505 end; 2506 end 2507@d check_existence_and_safety(#)==begin g:=#; 2508 if (g>=128)and(c<128) then seven_unsafe:=true; 2509 if char_wd[g]=0 then existence_tail 2510@d check_existence(#)==begin g:=#; 2511 if char_wd[g]=0 then existence_tail 2512 2513@<For all characters |g| generated by |c|...@>= 2514case char_tag[c] of 2515no_tag: do_nothing; 2516lig_tag: @<Check ligature program of |c|@>; 2517list_tag: check_existence_and_safety(char_remainder[c]) 2518 ('The character NEXTLARGER than'); 2519@.The character NEXTLARGER...@> 2520ext_tag:@<Check the pieces of |exten[c]|@>; 2521end 2522 2523@ @<Check the pieces...@>= 2524begin if exten[char_remainder[c]].b0>0 then 2525 check_existence_and_safety(exten[char_remainder[c]].b0) 2526 ('TOP piece of character'); 2527@.TOP piece of character...@> 2528if exten[char_remainder[c]].b1>0 then 2529 check_existence_and_safety(exten[char_remainder[c]].b1) 2530 ('MID piece of character'); 2531@.MID piece of character...@> 2532if exten[char_remainder[c]].b2>0 then 2533 check_existence_and_safety(exten[char_remainder[c]].b2) 2534 ('BOT piece of character'); 2535@.BOT piece of character...@> 2536check_existence_and_safety(exten[char_remainder[c]].b3) 2537 ('REP piece of character'); 2538@.REP piece of character...@> 2539end 2540 2541@ @<Make sure that |c| is not the largest element of a charlist cycle@>= 2542if char_tag[c]=list_tag then 2543 begin g:=char_remainder[c]; 2544 while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g]; 2545 if g=c then 2546 begin char_tag[c]:=no_tag; 2547 print('A cycle of NEXTLARGER characters has been broken at '); 2548@.A cycle of NEXTLARGER...@> 2549 print_octal(c); print_ln('.'); 2550 end; 2551 end 2552 2553@ @<Glob...@>= 2554@!delta:fix_word; {size of the intervals needed for rounding} 2555 2556@ @d round_message(#)==if delta>0 then print_ln('I had to round some ', 2557@.I had to round...@> 2558 #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.') 2559 2560@<Put the width, height, depth, and italic lists into final form@>= 2561delta:=shorten(width,255); set_indices(width,delta); round_message('width');@/ 2562delta:=shorten(height,15); set_indices(height,delta); round_message('height');@/ 2563delta:=shorten(depth,15); set_indices(depth,delta); round_message('depth');@/ 2564delta:=shorten(italic,63); set_indices(italic,delta); 2565 round_message('italic correction'); 2566 2567@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}} 2568 lig_kern[nl].b0:=255; lig_kern[nl].b1:=0; 2569 lig_kern[nl].b2:=0; lig_kern[nl].b3:=0 2570 2571@<Make sure the ligature/kerning program ends...@>= 2572begin if bchar_label<@'77777 then {make room for it} 2573 begin clear_lig_kern_entry; incr(nl); 2574 end; {|bchar_label| will be stored later} 2575while min_nl>nl do 2576 begin clear_lig_kern_entry; incr(nl); 2577 end; 2578if lig_kern[nl-1].b0=0 then lig_kern[nl-1].b0:=stop_flag; 2579end 2580 2581@ It's not trivial to check for infinite loops generated by repeated 2582insertion of ligature characters. But fortunately there is a nice 2583algorithm for such testing, copied here from the program \.{TFtoPL} 2584where it is explained further. 2585 2586@d simple=0 {$f(x,y)=z$} 2587@d left_z=1 {$f(x,y)=f(z,y)$} 2588@d right_z=2 {$f(x,y)=f(x,z)$} 2589@d both_z=3 {$f(x,y)=f(f(x,z),y)$} 2590@d pending=4 {$f(x,y)$ is being evaluated} 2591 2592 2593@ @<Glo...@>= 2594@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} 2595@!hash:array[0..hash_size] of 0..66048; {$256x+y+1$ for $x\le257$ and $y\le255$} 2596@!class:array[0..hash_size] of simple..pending; 2597@!lig_z:array[0..hash_size] of 0..257; 2598@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} 2599@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries} 2600@!h,@!hh:0..hash_size; {indices into the hash table} 2601@!tt:indx; {temporary register} 2602@!x_lig_cycle,@!y_lig_cycle:0..256; {problematic ligature pair} 2603 2604@ @<Set init...@>= 2605hash_ptr:=0; y_lig_cycle:=256; 2606for k:=0 to hash_size do hash[k]:=0; 2607 2608@ @d lig_exam==lig_kern[lig_ptr].b1 2609@d lig_gen==lig_kern[lig_ptr].b3 2610 2611@<Check lig...@>= 2612begin lig_ptr:=char_remainder[c]; 2613repeat if hash_input(lig_ptr,c) then 2614 begin if lig_kern[lig_ptr].b2<kern_flag then 2615 begin if lig_exam<>bchar then 2616 check_existence(lig_exam)('LIG character examined by'); 2617@.LIG character examined...@> 2618 check_existence(lig_gen)('LIG character generated by'); 2619@.LIG character generated...@> 2620 if lig_gen>=128 then if(c<128)or(c=256) then 2621 if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; 2622 end 2623 else if lig_exam<>bchar then 2624 check_existence(lig_exam)('KRN character examined by'); 2625@.KRN character examined...@> 2626 end; 2627if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl 2628else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0; 2629until lig_ptr>=nl; 2630end 2631 2632@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made 2633into a boolean function that returns |false| if the ligature command 2634was masked by a previous one. 2635 2636@p function hash_input(@!p,@!c:indx):boolean; 2637 {enter data for character |c| and command in location |p|, unless it isn't new} 2638label 30; {go here for a quick exit} 2639var @!cc:simple..both_z; {class of data being entered} 2640@!zz:0..255; {function value or ligature character being entered} 2641@!y:0..255; {the character after the cursor} 2642@!key:integer; {value to be stored in |hash|} 2643@!t:integer; {temporary register for swapping} 2644begin if hash_ptr=hash_size then 2645 begin hash_input:=false; goto 30;@+end; 2646@<Compute the command parameters |y|, |cc|, and |zz|@>; 2647key:=256*c+y+1; h:=(1009*key) mod hash_size; 2648while hash[h]>0 do 2649 begin if hash[h]<=key then 2650 begin if hash[h]=key then 2651 begin hash_input:=false; goto 30; {unused ligature command} 2652 end; 2653 t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion} 2654 t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} 2655 t:=lig_z[h]; lig_z[h]:=zz; zz:=t; 2656 end; 2657 if h>0 then decr(h)@+else h:=hash_size; 2658 end; 2659hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; 2660incr(hash_ptr); hash_list[hash_ptr]:=h; 2661hash_input:=true; 266230:end; 2663 2664@ @<Compute the command param...@>= 2665y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple; 2666zz:=lig_kern[p].b3; 2667if t>=kern_flag then zz:=y 2668else begin case t of 2669 0,6:do_nothing; {\.{LIG},\.{/LIG>}} 2670 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} 2671 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} 2672 2:cc:=right_z; {\.{/LIG}} 2673 3:cc:=both_z; {\.{/LIG/}} 2674 end; {there are no other cases} 2675 end 2676 2677@ (More good stuff from \.{TFtoPL}.) 2678 2679@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@> 2680 {compute $f$ for arguments known to be in |hash[h]|} 2681function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup} 2682var @!key:integer; {value sought in hash table} 2683begin key:=256*x+y+1; h:=(1009*key) mod hash_size; 2684while hash[h]>key do 2685 if h>0 then decr(h)@+else h:=hash_size; 2686if hash[h]<key then eval:=y {not in ordered hash table} 2687else eval:=f(h,x,y); 2688end; 2689 2690@ Pascal's beastly convention for |forward| declarations prevents us from 2691saying |function f(h,x,y:indx):indx| here. 2692 2693@p function f; 2694begin case class[h] of 2695simple: do_nothing; 2696left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; 2697 end; 2698right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; 2699 end; 2700both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); 2701 class[h]:=simple; 2702 end; 2703pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=257; class[h]:=simple; 2704 end; {the value 257 will break all cycles, since it's not in |hash|} 2705end; {there are no other cases} 2706f:=lig_z[h]; 2707end; 2708 2709@ @<Check for infinite...@>= 2710if hash_ptr<hash_size then for hh:=1 to hash_ptr do 2711 begin tt:=hash_list[hh]; 2712 if class[tt]>simple then {make sure $f$ is well defined} 2713 tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256); 2714 end; 2715if(hash_ptr=hash_size)or(y_lig_cycle<256) then 2716 begin if hash_ptr<hash_size then 2717 begin print('Infinite ligature loop starting with '); 2718@.Infinite ligature loop...@> 2719 if x_lig_cycle=256 then print('boundary')@+else print_octal(x_lig_cycle); 2720 print(' and '); print_octal(y_lig_cycle); print_ln('!'); 2721 end 2722 else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); 2723@.Sorry, I haven't room...@> 2724 print_ln('All ligatures will be cleared.'); 2725 for c:=0 to 255 do if char_tag[c]=lig_tag then 2726 begin char_tag[c]:=no_tag; char_remainder[c]:=0; 2727 end; 2728 nl:=0; bchar:=256; bchar_label:=@'77777; 2729 end 2730 2731@ The lig/kern program may still contain references to nonexistent characters, 2732if parts of that program are never used. Similarly, there may be extensible 2733characters that are never used, because they were overridden by 2734\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we 2735must fix such errors. 2736 2737@d double_check_tail(#)==@t\1@>if char_wd[0]=0 2738 then char_wd[0]:=sort_in(width,0); 2739 print('Unused ',#,' refers to nonexistent character '); 2740 print_octal(c); print_ln('!'); 2741 end; 2742 end 2743@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#; 2744 if char_wd[c]=0 then if c<>bchar then 2745 begin lig_kern[lig_ptr].#:=0; double_check_tail 2746@d double_check_ext(#)==begin c:=exten[g].#; 2747 if c>0 then if char_wd[c]=0 then 2748 begin exten[g].#:=0; double_check_tail 2749@d double_check_rep(#)==begin c:=exten[g].#; 2750 if char_wd[c]=0 then 2751 begin exten[g].#:=0; double_check_tail 2752 2753@<Doublecheck...@>= 2754if nl>0 then for lig_ptr:=0 to nl-1 do 2755 if lig_kern[lig_ptr].b2<kern_flag then 2756 begin if lig_kern[lig_ptr].b0<255 then 2757 begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step'); 2758 end; 2759 end 2760 else double_check_lig(b1)('KRN step'); 2761@.Unused LIG step...@> 2762@.Unused KRN step...@> 2763if ne>0 then for g:=0 to ne-1 do 2764 begin double_check_ext(b0)('VARCHAR TOP'); 2765 double_check_ext(b1)('VARCHAR MID'); 2766 double_check_ext(b2)('VARCHAR BOT'); 2767 double_check_rep(b3)('VARCHAR REP'); 2768@.Unused VARCHAR...@> 2769 end 2770 2771@* The TFM output phase. 2772Now that we know how to get all of the font data correctly stored in 2773\.{VPtoVF}'s memory, it only remains to write the answers out. 2774 2775First of all, it is convenient to have an abbreviation for output to the 2776\.{TFM} file: 2777 2778@d out(#)==write(tfm_file,#) 2779 2780@ The general plan for producing \.{TFM} files is long but simple: 2781 2782@<Do the \.{TFM} output@>= 2783@<Compute the twelve subfile sizes@>; 2784@<Output the twelve subfile sizes@>; 2785@<Output the header block@>; 2786@<Output the character info@>; 2787@<Output the dimensions themselves@>; 2788@<Output the ligature/kern program@>; 2789@<Output the extensible character recipes@>; 2790@<Output the parameters@> 2791 2792@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are. 2793We already know most of these numbers; for example, the number of distinct 2794widths is |memory[width]+1|, where the $+1$ accounts for the zero width that 2795is always supposed to be present. But we still should compute the beginning 2796and ending character codes (|bc| and |ec|), the number of header words (|lh|), 2797and the total number of words in the \.{TFM} file (|lf|). 2798 2799@<Gl...@>= 2800@!bc:byte; {the smallest character code in the font} 2801@!ec:byte; {the largest character code in the font} 2802@!lh:byte; {the number of words in the header block} 2803@!lf:0..32767; {the number of words in the entire \.{TFM} file} 2804@!not_found:boolean; {has a font character been found?} 2805@!temp_width:fix_word; {width being used to compute a check sum} 2806 2807@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps 2808going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc| 2809will be~1. 2810 2811@<Compute the twelve...@>= 2812lh:=header_ptr div 4;@/ 2813not_found:=true; bc:=0; 2814while not_found do 2815 if (char_wd[bc]>0)or(bc=255) then not_found:=false 2816 else incr(bc); 2817not_found:=true; ec:=255; 2818while not_found do 2819 if (char_wd[ec]>0)or(ec=0) then not_found:=false 2820 else decr(ec); 2821if bc>ec then bc:=1; 2822incr(memory[width]); incr(memory[height]); incr(memory[depth]); 2823incr(memory[italic]);@/ 2824@<Compute the ligature/kern program offset@>; 2825lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ 2826memory[italic]+nl+lk_offset+nk+ne+np; 2827 2828@ @d out_size(#)==out((#) div 256); out((#) mod 256) 2829 2830@<Output the twelve subfile sizes@>= 2831out_size(lf); out_size(lh); out_size(bc); out_size(ec); 2832out_size(memory[width]); out_size(memory[height]); 2833out_size(memory[depth]); out_size(memory[italic]); 2834out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np); 2835 2836@ The routines that follow need a few temporary variables of different types. 2837 2838@<Gl...@>= 2839@!j:0..max_header_bytes; {index into |header_bytes|} 2840@!p:pointer; {index into |memory|} 2841@!q:width..italic; {runs through the list heads for dimensions} 2842@!par_ptr:0..max_param_words; {runs through the parameters} 2843 2844@ The header block follows the subfile sizes. The necessary information all 2845appears in |header_bytes|, except that the design size and the seven-bit-safe 2846flag must still be set. 2847 2848@<Output the header block@>= 2849if not check_sum_specified then @<Compute the check sum@>; 2850header_bytes[design_size_loc]:=design_size div @'100000000; 2851 {this works since |design_size>0|} 2852header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256; 2853header_bytes[design_size_loc+2]:=(design_size div 256) mod 256; 2854header_bytes[design_size_loc+3]:=design_size mod 256; 2855if not seven_unsafe then header_bytes[seven_flag_loc]:=128; 2856for j:=0 to header_ptr-1 do out(header_bytes[j]); 2857 2858@ @<Compute the check sum@>= 2859begin c0:=bc; c1:=ec; c2:=bc; c3:=ec; 2860for c:=bc to ec do if char_wd[c]>0 then 2861 begin temp_width:=memory[char_wd[c]]; 2862 if design_units<>unity then 2863 temp_width:=round((temp_width/design_units)*1048576.0); 2864 temp_width:=temp_width + (c+4)*@'20000000; {this should be positive} 2865 c0:=(c0+c0+temp_width) mod 255; 2866 c1:=(c1+c1+temp_width) mod 253; 2867 c2:=(c2+c2+temp_width) mod 251; 2868 c3:=(c3+c3+temp_width) mod 247; 2869 end; 2870header_bytes[check_sum_loc]:=c0; 2871header_bytes[check_sum_loc+1]:=c1; 2872header_bytes[check_sum_loc+2]:=c2; 2873header_bytes[check_sum_loc+3]:=c3; 2874end 2875 2876@ The next block contains packed |char_info|. 2877 2878@<Output the character info@>= 2879index[0]:=0; 2880for c:=bc to ec do 2881 begin out(index[char_wd[c]]); 2882 out(index[char_ht[c]]*16+index[char_dp[c]]); 2883 out(index[char_ic[c]]*4+char_tag[c]); 2884 out(char_remainder[c]); 2885 end 2886 2887@ When a scaled quantity is output, we may need to divide it by |design_units|. 2888The following subroutine takes care of this, using floating point arithmetic 2889only if |design_units<>1.0|. 2890 2891@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} 2892var @!n:byte; {the first byte after the sign} 2893@!m:0..65535; {the two least significant bytes} 2894begin if abs(x/design_units)>=16.0 then 2895 begin print_ln('The relative dimension ',x/@'4000000:1:3, 2896 ' is too large.'); 2897@.The relative dimension...@> 2898 print(' (Must be less than 16*designsize'); 2899 if design_units<>unity then print(' =',design_units/@'200000:1:3, 2900 ' designunits'); 2901 print_ln(')'); x:=0; 2902 end; 2903if design_units<>unity then x:=round((x/design_units)*1048576.0); 2904if x<0 then 2905 begin out(255); x:=x+@'100000000; 2906 if x<=0 then x:=1; 2907 end 2908else begin out(0); 2909 if x>=@'100000000 then x:=@'77777777; 2910 end; 2911n:=x div @'200000; m:=x mod @'200000; 2912out(n); out(m div 256); out(m mod 256); 2913end; 2914 2915@ We have output the packed indices for individual characters. 2916The scaled widths, heights, depths, and italic corrections are next. 2917 2918@<Output the dimensions themselves@>= 2919for q:=width to italic do 2920 begin out(0); out(0); out(0); out(0); {output the zero word} 2921 p:=link[q]; {head of list} 2922 while p>0 do 2923 begin out_scaled(memory[p]); 2924 p:=link[p]; 2925 end; 2926 end; 2927 2928@ One embarrassing problem remains: The ligature/kern program might be very 2929long, but the starting addresses in |char_remainder| can be at most~255. 2930Therefore we need to output some indirect address information; we want to 2931compute |lk_offset| so that addition of |lk_offset| to all remainders makes 2932all but |lk_offset| distinct remainders less than~256. 2933 2934For this we need a sorted table of all relevant remainders. 2935 2936@<Glob...@>= 2937@!label_table:array[0..256] of record 2938 @!rr: -1..@'77777; {sorted label values} 2939 @!cc: byte; {associated characters} 2940 end; 2941@!label_ptr:0..256; {index of highest entry in |label_table|} 2942@!sort_ptr:0..256; {index into |label_table|} 2943@!lk_offset:0..256; {smallest offset value that might work} 2944@!t:0..@'77777; {label value that is being redirected} 2945@!extra_loc_needed:boolean; {do we need a special word for |bchar|?} 2946 2947@ @<Compute the ligature/kern program offset@>= 2948@<Insert all labels into |label_table|@>; 2949if bchar<256 then 2950 begin extra_loc_needed:=true; lk_offset:=1; 2951 end 2952else begin extra_loc_needed:=false; lk_offset:=0; 2953 end; 2954@<Find the minimum |lk_offset| and adjust all remainders@>; 2955if bchar_label<@'77777 then 2956 begin lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256; 2957 lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256; 2958 end 2959 2960@ @<Insert all labels...@>= 2961label_ptr:=0; label_table[0].rr:=-1; {sentinel} 2962for c:=bc to ec do if char_tag[c]=lig_tag then 2963 begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} 2964 while label_table[sort_ptr].rr>char_remainder[c] do 2965 begin label_table[sort_ptr+1]:=label_table[sort_ptr]; 2966 decr(sort_ptr); {move the hole} 2967 end; 2968 label_table[sort_ptr+1].cc:=c; 2969 label_table[sort_ptr+1].rr:=char_remainder[c]; 2970 incr(label_ptr); 2971 end 2972 2973@ @<Find the minimum |lk_offset| and adjust all remainders@>= 2974begin sort_ptr:=label_ptr; {the largest unallocated label} 2975if label_table[sort_ptr].rr+lk_offset > 255 then 2976 begin lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty} 2977 repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset; 2978 while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do 2979 begin decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset; 2980 end; 2981 incr(lk_offset); decr(sort_ptr); 2982 until lk_offset+label_table[sort_ptr].rr<256; 2983 {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|} 2984 end; 2985if lk_offset>0 then while sort_ptr>0 do 2986 begin char_remainder[label_table[sort_ptr].cc]:= 2987 char_remainder[label_table[sort_ptr].cc]+lk_offset; 2988 decr(sort_ptr); 2989 end; 2990end 2991 2992@ @<Output the ligature/kern program@>= 2993if extra_loc_needed then {|lk_offset=1|} 2994 begin out(255); out(bchar); out(0); out(0); 2995 end 2996else for sort_ptr:=1 to lk_offset do {output the redirection specs} 2997 begin t:=label_table[label_ptr].rr; 2998 if bchar<256 then 2999 begin out(255); out(bchar); 3000 end 3001 else begin out(254); out(0); 3002 end; 3003 out_size(t+lk_offset); 3004 repeat decr(label_ptr); until label_table[label_ptr].rr<t; 3005 end; 3006if nl>0 then for lig_ptr:=0 to nl-1 do 3007 begin out(lig_kern[lig_ptr].b0); 3008 out(lig_kern[lig_ptr].b1); 3009 out(lig_kern[lig_ptr].b2); 3010 out(lig_kern[lig_ptr].b3); 3011 end; 3012if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr]) 3013 3014@ @<Output the extensible character recipes@>= 3015if ne>0 then for c:=0 to ne-1 do 3016 begin out(exten[c].b0); 3017 out(exten[c].b1); 3018 out(exten[c].b2); 3019 out(exten[c].b3); 3020 end; 3021 3022@ For our grand finale, we wind everything up by outputting the parameters. 3023 3024@<Output the parameters@>= 3025for par_ptr:=1 to np do 3026 begin if par_ptr=1 then 3027 @<Output the slant (|param[1]|) without scaling@> 3028 else out_scaled(param[par_ptr]); 3029 end 3030 3031@ @<Output the slant...@>= 3032begin if param[1]<0 then 3033 begin param[1]:=param[1]+@'10000000000; 3034 out((param[1] div @'100000000)+256-64); 3035 end 3036else out(param[1] div @'100000000); 3037out((param[1] div @'200000) mod 256); 3038out((param[1] div 256) mod 256); 3039out(param[1] mod 256); 3040end 3041 3042@* The VF output phase. 3043Output to |vf_file| is considerably simpler. 3044 3045@d id_byte=202 {current version of \.{VF} format} 3046@d vout(#)==write(vf_file,#) 3047 3048@<Glob...@>= 3049@!vcount:integer; {number of bytes written to |vf_file|} 3050 3051@ We need a routine to output integers as four bytes. Negative values 3052will never be less than $-2^{24}$. 3053 3054@p procedure vout_int(@!x:integer); 3055begin if x>=0 then vout(x div @'100000000) 3056else begin vout(255); x:=x+@'100000000; 3057 end; 3058vout((x div @'200000) mod 256); 3059vout((x div @'400) mod 256); vout(x mod 256); 3060end; 3061 3062@ @<Do the \.{VF} output@>= 3063vout(pre); vout(id_byte); vout(vtitle_length); 3064for k:=0 to vtitle_length-1 do vout(vf[vtitle_start+k]); 3065for k:=check_sum_loc to design_size_loc+3 do vout(header_bytes[k]); 3066vcount:=vtitle_length+11; 3067for cur_font:=0 to font_ptr-1 do @<Output a local font definition@>; 3068for c:=bc to ec do if char_wd[c]>0 then 3069 @<Output a packet for character |c|@>; 3070repeat vout(post); incr(vcount); 3071until vcount mod 4 = 0 3072 3073@ @<Output a local font definition@>= 3074begin vout(fnt_def1); vout(cur_font);@/ 3075vout(font_checksum[cur_font].b0); 3076vout(font_checksum[cur_font].b1); 3077vout(font_checksum[cur_font].b2); 3078vout(font_checksum[cur_font].b3); 3079vout_int(font_at[cur_font]); 3080vout_int(font_dsize[cur_font]); 3081vout(farea_length[cur_font]); 3082vout(fname_length[cur_font]); 3083for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]); 3084if fname_start[cur_font]=vf_size then 3085 begin vout("N"); vout("U"); vout("L"); vout("L"); 3086 end 3087else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]); 3088vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font]; 3089end 3090 3091@ @<Output a packet for character |c|@>= 3092begin x:=memory[char_wd[c]]; 3093if design_units<>unity then x:=round((x/design_units)*1048576.0); 3094if (packet_length[c]>241)or(x<0)or(x>=@'100000000) then 3095 begin vout(242); vout_int(packet_length[c]); vout_int(c); vout_int(x); 3096 vcount:=vcount+13+packet_length[c]; 3097 end 3098else begin vout(packet_length[c]); vout(c); vout(x div @'200000); 3099 vout((x div @'400) mod 256); vout(x mod 256); 3100 vcount:=vcount+5+packet_length[c]; 3101 end; 3102if packet_start[c]=vf_size then 3103 begin if c>=128 then vout(set1); 3104 vout(c); 3105 end 3106else for k:=0 to packet_length[c]-1 do vout(vf[packet_start[c]+k]); 3107end 3108 3109@* The main program. 3110The routines sketched out so far need to be packaged into separate procedures, 3111on some systems, since some \PASCAL\ compilers place a strict limit on the 3112size of a routine. The packaging is done here in an attempt to avoid some 3113system-dependent changes. 3114 3115@p procedure param_enter; 3116begin @<Enter the parameter names@>; 3117end; 3118@# 3119procedure vpl_enter; 3120begin @<Enter all the \.{VPL} names@>; 3121end; 3122@# 3123procedure name_enter; {enter all names and their equivalents} 3124begin @<Enter all the \.{PL} names...@>; 3125vpl_enter; param_enter; 3126end; 3127@# 3128procedure read_lig_kern; 3129var @!krn_ptr:0..max_kerns; {an index into |kern|} 3130@!c:byte; {runs through all character codes} 3131begin @<Read ligature/kern list@>; 3132end; 3133@# 3134procedure read_char_info; 3135var @!c:byte; {the char} 3136begin @<Read character info list@>; 3137end; 3138@# 3139procedure read_input; 3140var @!c:byte; {header or parameter index} 3141begin @<Read all the input@>; 3142end; 3143@# 3144procedure corr_and_check; 3145var @!c:0..256; {runs through all character codes} 3146@!hh:0..hash_size; {an index into |hash_list|} 3147@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} 3148@!g:byte; {a character generated by the current character |c|} 3149begin @<Correct and check the information@> 3150end; 3151@# 3152procedure vf_output; 3153var @!c:byte; {runs through all character codes} 3154@!cur_font:0..256; {runs through all local fonts} 3155@!k:integer; {loop index} 3156begin @<Do the \.{VF} output@>; 3157end; 3158 3159@ Here is where \.{VPtoVF} begins and ends. 3160 3161@p begin initialize;@/ 3162name_enter;@/ 3163read_input; print_ln('.');@/ 3164corr_and_check;@/ 3165@<Do the \.{TFM} output@>; 3166vf_output; 3167end. 3168 3169@* System-dependent changes. 3170This section should be replaced, if necessary, by changes to the program 3171that are necessary to make \.{VPtoVF} work at a particular installation. 3172It is usually best to design your change file so that all changes to 3173previous sections preserve the section numbering; then everybody's version 3174will be consistent with the printed program. More extensive changes, 3175which introduce new sections, can be inserted here; then only the index 3176itself will get a new section number. 3177@^system dependencies@> 3178 3179@* Index. 3180Pointers to error messages appear here together with the section numbers 3181where each ident\-i\-fier is used. 3182